Line data Source code
1 : !=======================================================================
2 :
3 : ! Diagnostic information output during run for biogeochemistry
4 : !
5 : ! authors: Elizabeth C. Hunke, LANL
6 : ! Nicole Jeffery, LANL
7 :
8 : module icedrv_diagnostics_bgc
9 :
10 : use icedrv_kinds
11 : use icedrv_constants, only: nu_diag, nu_diag_out
12 : use icedrv_constants, only: c0, mps_to_cmpdy, c100, p5, c1
13 : use icedrv_domain_size, only: nx
14 : use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted
15 : use icepack_intfc, only: icepack_query_parameters
16 : use icepack_intfc, only: icepack_query_tracer_flags, icepack_query_tracer_indices
17 : use icepack_intfc, only: icepack_max_algae, icepack_max_aero, icepack_max_fe
18 : use icepack_intfc, only: icepack_max_doc, icepack_max_don
19 : use icedrv_system, only: icedrv_system_abort
20 :
21 : implicit none
22 : private
23 : public :: hbrine_diags, bgc_diags
24 :
25 : !=======================================================================
26 :
27 : contains
28 :
29 : !=======================================================================
30 :
31 : !
32 : ! Writes diagnostic info (max, min, global sums, etc) to standard out
33 : !
34 : ! authors: Nicole Jeffery, LANL
35 :
36 5054 : subroutine hbrine_diags ()
37 :
38 : use icedrv_arrays_column, only: darcy_V
39 : use icedrv_diagnostics, only: nx_names
40 : use icedrv_domain_size, only: nilyr
41 : use icedrv_state, only: aice, aicen, vicen, vice, trcr, trcrn
42 :
43 : ! local variables
44 :
45 : integer (kind=int_kind) :: &
46 : k, n
47 :
48 : integer (kind=int_kind) :: &
49 : ktherm
50 :
51 : integer (kind=int_kind) :: &
52 : nt_sice, &
53 : nt_fbri
54 :
55 : ! fields at diagnostic points
56 : real (kind=dbl_kind) :: &
57 : phinS, phinS1, pdarcy_V, pfbri
58 :
59 : real (kind=dbl_kind), dimension(nilyr) :: &
60 : pSin, pSin1
61 :
62 : character(len=*), parameter :: subname='(hbrine_diags)'
63 :
64 : !-----------------------------------------------------------------
65 : ! query Icepack values
66 : !-----------------------------------------------------------------
67 :
68 2527 : call icepack_query_parameters(ktherm_out=ktherm)
69 2527 : call icepack_query_tracer_indices(nt_sice_out=nt_sice, nt_fbri_out=nt_fbri)
70 2527 : call icepack_warnings_flush(nu_diag)
71 2527 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
72 0 : file=__FILE__,line= __LINE__)
73 :
74 : !-----------------------------------------------------------------
75 : ! Dynamic brine height
76 : !-----------------------------------------------------------------
77 : ! NOTE these are computed for the last timestep only (not avg)
78 :
79 12635 : do n = 1, nx
80 10108 : phinS1 = c0
81 10108 : phinS = c0
82 10108 : pfbri = trcrn(n,nt_fbri,1)
83 10108 : pdarcy_V = darcy_V(n,1)
84 10108 : if (aice (n) > c0) phinS = trcr (n,nt_fbri )*vice (n )/aice (n )
85 10108 : if (aicen(n,1)> c0) phinS1 = trcrn(n,nt_fbri,1)*vicen(n,1)/aicen(n,1)
86 80864 : do k = 1 , nilyr
87 70756 : pSin (k) = trcr (n,nt_sice+k-1 )
88 80864 : pSin1(k) = trcrn(n,nt_sice+k-1,1)
89 : enddo
90 :
91 : !-----------------------------------------------------------------
92 : ! start spewing
93 : !-----------------------------------------------------------------
94 :
95 10108 : write(nu_diag_out+n-1,899) nx_names(n)
96 :
97 10108 : write(nu_diag_out+n-1,*) '------ hbrine ------'
98 10108 : write(nu_diag_out+n-1,900) 'hbrine, (m) = ',phinS
99 10108 : write(nu_diag_out+n-1,900) 'fbri, cat1 (m) = ',pfbri
100 10108 : write(nu_diag_out+n-1,900) 'hbrine cat1, (m) = ',phinS1
101 10108 : write(nu_diag_out+n-1,900) 'darcy_V cat1, (m/s)= ',pdarcy_V
102 12635 : if (ktherm == 2) then
103 10108 : write(nu_diag_out+n-1,*) ' '
104 10108 : write(nu_diag_out+n-1,*) '------ Thermosaline Salinity ------'
105 10108 : write(nu_diag_out+n-1,803) 'Sice1 cat1 S (ppt)'
106 10108 : write(nu_diag_out+n-1,*) '---------------------------------------------------'
107 80864 : write(nu_diag_out+n-1,802) (pSin1(k), k = 1,nilyr)
108 10108 : write(nu_diag_out+n-1,*) ' '
109 10108 : write(nu_diag_out+n-1,803) 'Sice bulk S (ppt) '
110 10108 : write(nu_diag_out+n-1,*) '---------------------------------------------------'
111 80864 : write(nu_diag_out+n-1,802) (pSin(k), k = 1,nilyr)
112 10108 : write(nu_diag_out+n-1,*) ' '
113 : endif
114 : enddo ! nx
115 :
116 : 802 format (f24.17,2x)
117 : 803 format (a25,2x)
118 : 899 format (43x,a24)
119 : 900 format (a25,2x,f24.17)
120 :
121 2527 : end subroutine hbrine_diags
122 :
123 : !=======================================================================
124 : !
125 : ! Writes diagnostic info (max, min, global sums, etc) to standard out
126 : !
127 : ! authors: Nicole Jeffery, LANL
128 :
129 5054 : subroutine bgc_diags ()
130 :
131 : use icedrv_arrays_column, only: ocean_bio, zfswin, fbio_atmice, fbio_snoice
132 : use icedrv_arrays_column, only: Zoo, grow_net, ice_bio_net, trcrn_sw
133 : use icedrv_domain_size, only: ncat, nblyr, n_algae, n_zaero
134 : use icedrv_domain_size, only: n_doc, n_don, n_fed, n_fep, nilyr, nslyr
135 : use icedrv_flux, only: flux_bio, flux_bio_atm
136 : use icedrv_state, only: vicen, vice, trcr
137 :
138 : ! local variables
139 :
140 : integer (kind=int_kind) :: &
141 : k, n, nn, kk, klev
142 :
143 : logical (kind=log_kind) :: &
144 : skl_bgc, z_tracers, dEdd_algae
145 :
146 : ! fields at diagnostic points
147 : real (kind=dbl_kind) :: &
148 : pNit_sk, pAm_sk, pSil_sk, phum_sk, &
149 : pDMSPp_sk, pDMSPd_sk, pDMS_sk, &
150 : pNit_ac, pAm_ac, pSil_ac, pDMSP_ac, pDMS_ac, &
151 : pflux_NO, pflux_Am, phum_ac, &
152 : pflux_snow_NO, pflux_snow_Am, &
153 : pflux_atm_NO, pflux_atm_Am, pgrow_net, &
154 : pflux_hum
155 :
156 : logical (kind=log_kind) :: &
157 : tr_bgc_DMS, tr_bgc_PON, &
158 : tr_bgc_N, tr_bgc_C, tr_bgc_DON, tr_zaero, tr_bgc_hum, &
159 : tr_bgc_Nit, tr_bgc_Am, tr_bgc_Sil, tr_bgc_Fe
160 :
161 : integer (kind=int_kind) :: &
162 : nt_fbri, nt_sice, nt_bgc_nit, nt_bgc_am, nt_bgc_sil, &
163 : nt_bgc_hum, nt_bgc_pon, nt_bgc_dmspp, nt_bgc_dmspd, nt_bgc_dms, &
164 : nlt_bgc_hum, nlt_bgc_Nit, nlt_bgc_Am, nlt_bgc_Sil, nlt_chl_sw, &
165 : nlt_bgc_DMSPp, nlt_bgc_DMS
166 : integer (kind=int_kind), dimension(icepack_max_algae) :: &
167 : nt_bgc_n, nlt_bgc_N
168 : integer (kind=int_kind), dimension(icepack_max_doc) :: &
169 : nt_bgc_doc, nlt_bgc_DOC
170 : integer (kind=int_kind), dimension(icepack_max_don) :: &
171 : nt_bgc_don, nlt_bgc_DON
172 : integer (kind=int_kind), dimension(icepack_max_aero) :: &
173 : nt_zaero, nlt_zaero, nlt_zaero_sw
174 : integer (kind=int_kind), dimension(icepack_max_fe) :: &
175 : nt_bgc_fed, nt_bgc_fep, nlt_bgc_Fed, nlt_bgc_Fep
176 :
177 : real (kind=dbl_kind), dimension(icepack_max_algae) :: &
178 : pN_ac, pN_tot, pN_sk, pflux_N
179 : real (kind=dbl_kind), dimension(icepack_max_doc) :: &
180 : pDOC_ac, pDOC_sk
181 : real (kind=dbl_kind), dimension(icepack_max_don) :: &
182 : pDON_ac, pDON_sk
183 : real (kind=dbl_kind), dimension(icepack_max_fe ) :: &
184 : pFed_ac, pFed_sk, pFep_ac, pFep_sk
185 : real (kind=dbl_kind), dimension(icepack_max_aero) :: &
186 : pflux_zaero, pflux_snow_zaero, pflux_atm_zaero, &
187 : pflux_atm_zaero_s
188 :
189 : ! vertical fields of category 1 at diagnostic points for bgc layer model
190 : real (kind=dbl_kind), dimension(2) :: &
191 : pNOs, pAms, pPONs, phums
192 : real (kind=dbl_kind), dimension(2,icepack_max_algae) :: &
193 : pNs
194 : real (kind=dbl_kind), dimension(2,icepack_max_doc) :: &
195 : pDOCs
196 : real (kind=dbl_kind), dimension(2,icepack_max_don) :: &
197 : pDONs
198 : real (kind=dbl_kind), dimension(2,icepack_max_fe ) :: &
199 : pFeds, pFeps
200 : real (kind=dbl_kind), dimension(2,icepack_max_aero) :: &
201 : pzaeros
202 : real (kind=dbl_kind), dimension(nblyr+1) :: &
203 : pNO, pAm, pPON, pzfswin, pZoo, phum
204 : real (kind=dbl_kind), dimension(nblyr+1,icepack_max_algae) :: &
205 : pN
206 : real (kind=dbl_kind), dimension(nblyr+1,icepack_max_aero) :: &
207 : pzaero
208 : real (kind=dbl_kind), dimension(nblyr+1,icepack_max_doc) :: &
209 : pDOC
210 : real (kind=dbl_kind), dimension(nblyr+1,icepack_max_don) :: &
211 : pDON
212 : real (kind=dbl_kind), dimension(nblyr+1,icepack_max_fe ) :: &
213 : pFed, pFep
214 : real (kind=dbl_kind), dimension (nblyr+1) :: &
215 : zspace
216 : real (kind=dbl_kind), dimension (nslyr+nilyr+2) :: &
217 : pchlsw
218 : real (kind=dbl_kind), dimension(nslyr+nilyr+2,icepack_max_aero) :: &
219 : pzaerosw
220 :
221 : character(len=*), parameter :: subname='(bgc_diags)'
222 :
223 : !-----------------------------------------------------------------
224 : ! query Icepack values
225 : !-----------------------------------------------------------------
226 :
227 : call icepack_query_parameters(skl_bgc_out=skl_bgc, &
228 2527 : z_tracers_out=z_tracers, dEdd_algae_out=dEdd_algae)
229 : call icepack_query_tracer_flags( &
230 : tr_bgc_DMS_out=tr_bgc_DMS, tr_bgc_PON_out=tr_bgc_PON, &
231 : tr_bgc_N_out=tr_bgc_N, tr_bgc_C_out=tr_bgc_C, &
232 : tr_bgc_DON_out=tr_bgc_DON, tr_zaero_out=tr_zaero, &
233 : tr_bgc_hum_out=tr_bgc_hum,tr_bgc_Sil_out=tr_bgc_Sil, &
234 : tr_bgc_Nit_out=tr_bgc_Nit, tr_bgc_Am_out=tr_bgc_Am, &
235 2527 : tr_bgc_Fe_out=tr_bgc_Fe)
236 : call icepack_query_tracer_indices( &
237 : nt_fbri_out=nt_fbri, nt_sice_out=nt_sice, nt_zaero_out=nt_zaero, &
238 : nt_bgc_n_out=nt_bgc_n, nt_bgc_doc_out=nt_bgc_doc, &
239 : nt_bgc_don_out=nt_bgc_don, nt_bgc_sil_out=nt_bgc_sil, &
240 : nt_bgc_fed_out=nt_bgc_fed, nt_bgc_fep_out=nt_bgc_fep, &
241 : nt_bgc_nit_out=nt_bgc_nit, nt_bgc_am_out=nt_bgc_am, &
242 : nt_bgc_hum_out=nt_bgc_hum, nt_bgc_pon_out=nt_bgc_pon, &
243 : nt_bgc_dmspp_out=nt_bgc_dmspp, nt_bgc_dmspd_out=nt_bgc_dmspd, &
244 : nt_bgc_dms_out=nt_bgc_dms, nlt_chl_sw_out=nlt_chl_sw, &
245 : nlt_bgc_N_out=nlt_bgc_N, nlt_zaero_out=nlt_zaero, &
246 : nlt_zaero_sw_out=nlt_zaero_sw, &
247 : nlt_bgc_Fed_out=nlt_bgc_Fed, nlt_bgc_Fep_out=nlt_bgc_Fep, &
248 : nlt_bgc_hum_out=nlt_bgc_hum, nlt_bgc_Nit_out=nlt_bgc_Nit, &
249 : nlt_bgc_Am_out=nlt_bgc_Am, nlt_bgc_Sil_out=nlt_bgc_Sil, &
250 : nlt_bgc_DOC_out=nlt_bgc_DOC, nlt_bgc_DON_out=nlt_bgc_DON, &
251 2527 : nlt_bgc_DMSPp_out=nlt_bgc_DMSPp, nlt_bgc_DMS_out=nlt_bgc_DMS)
252 2527 : call icepack_warnings_flush(nu_diag)
253 2527 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
254 0 : file=__FILE__,line= __LINE__)
255 :
256 22743 : zspace(:) = c1/real(nblyr,kind=dbl_kind)
257 2527 : zspace(1) = zspace(1)*p5
258 2527 : zspace(nblyr+1) = zspace(nblyr+1)*p5
259 2527 : klev = 1+nilyr+nslyr
260 :
261 : !-----------------------------------------------------------------
262 : ! biogeochemical state of the ice
263 : !-----------------------------------------------------------------
264 : ! NOTE these are computed for the last timestep only (not avg)
265 :
266 12635 : do n = 1, nx
267 10108 : pAm_ac = c0
268 10108 : pSil_ac = c0
269 10108 : phum_ac = c0
270 10108 : pDMSP_ac = c0
271 10108 : pDMS_ac = c0
272 10108 : pN_ac(:) = c0
273 10108 : pDOC_ac(:)= c0
274 10108 : pDON_ac(:)= c0
275 10108 : pFed_ac(:)= c0
276 10108 : pFep_ac(:)= c0
277 10108 : pNit_ac = c0
278 10108 : if (tr_bgc_N) then
279 24352 : do k = 1,n_algae
280 24352 : pN_ac(k) = ocean_bio(n,nlt_bgc_N(k))
281 : enddo !n_algae
282 : endif !tr_bgc_N
283 10108 : if (tr_bgc_C) then
284 18264 : do k = 1,n_doc
285 18264 : pDOC_ac(k) = ocean_bio(n,nlt_bgc_DOC(k))
286 : enddo !n_algae
287 : endif !tr_bgc_N
288 10108 : if (tr_bgc_DON) then
289 12176 : do k = 1,n_don
290 12176 : pDON_ac(k) = ocean_bio(n,nlt_bgc_DON(k))
291 : enddo
292 : endif
293 10108 : if (tr_bgc_Fe ) then
294 12176 : do k = 1,n_fed
295 12176 : pFed_ac (k) = ocean_bio(n,nlt_bgc_Fed (k))
296 : enddo
297 12176 : do k = 1,n_fep
298 12176 : pFep_ac (k) = ocean_bio(n,nlt_bgc_Fep (k))
299 : enddo
300 : endif
301 10108 : if (tr_bgc_Nit) pNit_ac = ocean_bio(n,nlt_bgc_Nit)
302 10108 : if (tr_bgc_Am) pAm_ac = ocean_bio(n,nlt_bgc_Am)
303 10108 : if (tr_bgc_Sil) pSil_ac = ocean_bio(n,nlt_bgc_Sil)
304 10108 : if (tr_bgc_hum) phum_ac = ocean_bio(n,nlt_bgc_hum)
305 10108 : if (tr_bgc_DMS) then
306 6088 : pDMSP_ac = ocean_bio(n,nlt_bgc_DMSPp)
307 6088 : pDMS_ac = ocean_bio(n,nlt_bgc_DMS)
308 : endif
309 :
310 : ! fluxes in mmol/m^2/d
311 : ! concentrations are bulk in mmol/m^3
312 : ! iron is in 10^-3 mmol/m^3 (nM)
313 :
314 10108 : if (skl_bgc) then
315 0 : pNit_sk = c0
316 0 : pAm_sk = c0
317 0 : pSil_sk = c0
318 0 : phum_sk = c0
319 0 : pDMSPp_sk = c0
320 0 : pDMSPd_sk = c0
321 0 : pDMS_sk = c0
322 0 : pN_sk (:) = c0
323 0 : pflux_N(:) = c0
324 0 : pDOC_sk(:) = c0
325 0 : pDON_sk(:) = c0
326 0 : pFed_sk(:) = c0
327 0 : pFep_sk(:) = c0
328 0 : pgrow_net = grow_net(n)
329 :
330 0 : do k = 1,n_algae
331 0 : pN_sk(k) = trcr (n, nt_bgc_N(k))
332 0 : pflux_N(k) = flux_bio(n,nlt_bgc_N(k))*mps_to_cmpdy/c100
333 : enddo
334 0 : if (tr_bgc_C) then
335 0 : do k = 1,n_doc
336 0 : pDOC_sk(k) = trcr (n,nt_bgc_DOC(k))
337 : enddo
338 : endif
339 0 : if (tr_bgc_DON) then
340 0 : do k = 1,n_don
341 0 : pDON_sk(k) = trcr (n,nt_bgc_DON(k))
342 : enddo
343 : endif
344 0 : if (tr_bgc_Fe ) then
345 0 : do k = 1,n_fed
346 0 : pFed_sk (k) = trcr (n,nt_bgc_Fed(k))
347 : enddo
348 0 : do k = 1,n_fep
349 0 : pFep_sk (k) = trcr (n,nt_bgc_Fep(k))
350 : enddo
351 : endif
352 0 : if (tr_bgc_Nit) then
353 0 : pNit_sk = trcr (n, nt_bgc_Nit)
354 0 : pflux_NO = flux_bio(n,nlt_bgc_Nit)*mps_to_cmpdy/c100
355 : endif
356 0 : if (tr_bgc_Am) then
357 0 : pAm_sk = trcr (n, nt_bgc_Am)
358 0 : pflux_Am = flux_bio(n,nlt_bgc_Am)*mps_to_cmpdy/c100
359 : endif
360 0 : if (tr_bgc_Sil) then
361 0 : pSil_sk = trcr (n, nt_bgc_Sil)
362 : endif
363 0 : if (tr_bgc_hum) then
364 0 : phum_sk = trcr (n, nt_bgc_hum)
365 0 : pflux_hum = flux_bio(n,nlt_bgc_hum)*mps_to_cmpdy/c100
366 : endif
367 0 : if (tr_bgc_DMS) then
368 0 : pDMSPp_sk = trcr (n,nt_bgc_DMSPp)
369 0 : pDMSPd_sk = trcr (n,nt_bgc_DMSPd)
370 0 : pDMS_sk = trcr (n,nt_bgc_DMS)
371 : endif
372 :
373 10108 : elseif (z_tracers) then ! zbgc
374 10108 : pflux_NO = c0
375 10108 : pN_tot (:) = c0
376 10108 : pflux_Am = c0
377 10108 : pflux_hum = c0
378 10108 : pflux_atm_Am = c0
379 10108 : pflux_snow_Am = c0
380 10108 : pflux_N (:) = c0
381 10108 : pflux_NO = c0
382 10108 : pflux_atm_NO = c0
383 10108 : pflux_snow_NO = c0
384 10108 : pflux_zaero (:) = c0
385 10108 : pflux_atm_zaero_s(:) = c0
386 10108 : pflux_atm_zaero (:) = c0
387 10108 : pflux_snow_zaero (:) = c0
388 :
389 10108 : if (tr_bgc_Nit) then
390 6088 : pflux_NO = flux_bio(n,nlt_bgc_Nit)*mps_to_cmpdy/c100
391 6088 : pflux_atm_NO = fbio_atmice(n,nlt_bgc_Nit)*mps_to_cmpdy/c100
392 6088 : pflux_snow_NO = fbio_snoice(n,nlt_bgc_Nit)*mps_to_cmpdy/c100
393 : endif
394 10108 : if (tr_bgc_Am) then
395 6088 : pflux_Am = flux_bio(n,nlt_bgc_Am)*mps_to_cmpdy/c100
396 6088 : pflux_atm_Am = fbio_atmice(n,nlt_bgc_Am)*mps_to_cmpdy/c100
397 6088 : pflux_snow_Am = fbio_snoice(n,nlt_bgc_Am)*mps_to_cmpdy/c100
398 : endif
399 10108 : if (tr_bgc_hum) then
400 6088 : pflux_hum = flux_bio(n,nlt_bgc_hum)*mps_to_cmpdy/c100
401 : endif
402 10108 : if (tr_bgc_N) then
403 24352 : do k = 1,n_algae
404 24352 : pflux_N(k) = flux_bio(n,nlt_bgc_N(k))*mps_to_cmpdy/c100
405 : enddo
406 : endif
407 10108 : if (tr_zaero) then
408 50500 : do k = 1,n_zaero
409 40392 : pflux_zaero(k) = flux_bio(n,nlt_zaero(k))*mps_to_cmpdy/c100
410 40392 : pflux_atm_zaero_s(k)= flux_bio_atm(n,nlt_zaero(k))*mps_to_cmpdy/c100 !*aice
411 40392 : pflux_atm_zaero(k) = fbio_atmice(n,nlt_zaero(k))*mps_to_cmpdy/c100
412 50500 : pflux_snow_zaero(k) = fbio_snoice(n,nlt_zaero(k))*mps_to_cmpdy/c100
413 : enddo
414 : endif
415 90972 : do k = 1, nblyr+1
416 80864 : pzfswin(k) = c0
417 80864 : pZoo (k) = c0
418 485184 : do nn = 1,ncat
419 404320 : pzfswin(k) = pzfswin(k) + zfswin(n,k,nn)*vicen(n,nn)
420 485184 : pZoo (k) = pZoo (k) + Zoo (n,k,nn)*vicen(n,nn)
421 : enddo !nn
422 80864 : if (vice(n) > c0) then
423 56968 : pzfswin(k) = pzfswin(k)/vice(n)
424 56968 : pZoo (k) = pZoo (k)/vice(n)
425 : endif !vice
426 80864 : pAm (k ) = c0
427 323456 : pN (k,:) = c0
428 323456 : pDOC (k,:) = c0
429 161728 : pDON (k,:) = c0
430 242592 : pFed (k,:) = c0
431 242592 : pFep (k,:) = c0
432 566048 : pzaero(k,:) = c0
433 80864 : pPON (k ) = c0
434 80864 : phum (k ) = c0
435 80864 : pNO (k ) = c0
436 80864 : if (tr_bgc_Nit) pNO(k) = trcr(n,nt_bgc_Nit+k-1)
437 80864 : if (tr_bgc_Am) pAm(k) = trcr(n,nt_bgc_Am+k-1)
438 80864 : if (tr_bgc_N) then
439 194816 : do nn = 1, n_algae
440 194816 : pN (k,nn) = trcr(n,nt_bgc_N(nn)+k-1)
441 : enddo
442 : endif
443 80864 : if (tr_bgc_C) then
444 146112 : do nn = 1, n_doc
445 146112 : pDOC (k,nn) = trcr(n,nt_bgc_DOC(nn)+k-1)
446 : enddo
447 : endif
448 80864 : if (tr_bgc_DON) then
449 97408 : do nn = 1, n_don
450 97408 : pDON (k,nn) = trcr(n,nt_bgc_DON(nn)+k-1)
451 : enddo
452 : endif
453 80864 : if (tr_bgc_Fe) then
454 97408 : do nn = 1, n_fed
455 97408 : pFed (k,nn) = trcr(n,nt_bgc_Fed(nn)+k-1)
456 : enddo
457 97408 : do nn = 1, n_fep
458 97408 : pFep (k,nn) = trcr(n,nt_bgc_Fep(nn)+k-1)
459 : enddo
460 : endif
461 80864 : if (tr_zaero) then
462 404000 : do nn = 1, n_zaero
463 404000 : pzaero(k,nn) = trcr(n,nt_zaero(nn)+k-1)
464 : enddo
465 : endif
466 80864 : if (tr_bgc_PON) pPON(k) = trcr(n,nt_bgc_PON+k-1)
467 90972 : if (tr_bgc_hum) phum(k) = trcr(n,nt_bgc_hum+k-1)
468 : enddo ! k
469 10108 : if (tr_bgc_N) then
470 24352 : do nn = 1,n_algae
471 24352 : pN_tot(nn) = ice_bio_net(n,nlt_bgc_N(nn))
472 : enddo
473 6088 : pgrow_net = grow_net(n)
474 : endif ! tr_bgc_N
475 30324 : do k = 1 , 2 ! snow concentration
476 20216 : pAms (k ) = c0
477 80864 : pNs (k,:) = c0
478 80864 : pDOCs (k,:) = c0
479 40432 : pDONs (k,:) = c0
480 60648 : pFeds (k,:)= c0
481 60648 : pFeps (k,:)= c0
482 141512 : pzaeros(k,:) = c0
483 20216 : pPONs (k ) = c0
484 20216 : phums (k ) = c0
485 20216 : pNOs (k ) = c0
486 20216 : if (tr_bgc_Nit) pNOs(k) = trcr(n,nt_bgc_Nit+nblyr+k)
487 20216 : if (tr_bgc_Am) pAms(k) = trcr(n,nt_bgc_Am +nblyr+k)
488 20216 : if (tr_bgc_N) then
489 48704 : do nn = 1, n_algae
490 48704 : pNs (k,nn) = trcr(n,nt_bgc_N(nn)+nblyr+k)
491 : enddo
492 : endif
493 20216 : if (tr_bgc_C) then
494 36528 : do nn = 1, n_doc
495 36528 : pDOCs (k,nn) = trcr(n,nt_bgc_DOC(nn)+nblyr+k)
496 : enddo
497 : endif
498 20216 : if (tr_bgc_DON) then
499 24352 : do nn = 1, n_don
500 24352 : pDONs (k,nn) = trcr(n,nt_bgc_DON(nn)+nblyr+k)
501 : enddo
502 : endif
503 20216 : if (tr_bgc_Fe ) then
504 24352 : do nn = 1, n_fed
505 24352 : pFeds (k,nn) = trcr(n,nt_bgc_Fed(nn)+nblyr+k)
506 : enddo
507 24352 : do nn = 1, n_fep
508 24352 : pFeps (k,nn) = trcr(n,nt_bgc_Fep(nn)+nblyr+k)
509 : enddo
510 : endif
511 20216 : if (tr_zaero) then
512 101000 : do nn = 1, n_zaero
513 101000 : pzaeros(k,nn) = trcr(n,nt_zaero(nn)+nblyr+k)
514 : enddo
515 : endif
516 20216 : if (tr_bgc_PON)pPONs(k) =trcr(n,nt_bgc_PON+nblyr+k)
517 30324 : if (tr_bgc_hum)phums(k) =trcr(n,nt_bgc_hum+nblyr+k)
518 : enddo ! k
519 : endif ! ztracers
520 10108 : pchlsw(:) = c0
521 10108 : pzaerosw(:,:) = c0
522 10108 : if (dEdd_algae) then
523 0 : do k = 0, klev
524 0 : if (tr_bgc_N) pchlsw(k+1) = trcrn_sw(n,nlt_chl_sw+k,1)
525 0 : if (tr_zaero) then
526 0 : do nn = 1,n_zaero
527 0 : pzaerosw(k+1,nn) = trcrn_sw(n,nlt_zaero_sw(nn) + k,1)
528 : enddo
529 : endif
530 : enddo
531 : endif ! dEdd_algae
532 :
533 : !-----------------------------------------------------------------
534 : ! start spewing
535 : !-----------------------------------------------------------------
536 :
537 10108 : if (z_tracers) then
538 10108 : write(nu_diag_out+n-1,803) 'zfswin PAR '
539 10108 : write(nu_diag_out+n-1,*) '---------------------------------------------------'
540 90972 : write(nu_diag_out+n-1,802) (pzfswin(k), k = 1,nblyr+1)
541 10108 : write(nu_diag_out+n-1,*) ' '
542 10108 : write(nu_diag_out+n-1,803) 'Losses: Zoo(mmol/m^3) '
543 10108 : write(nu_diag_out+n-1,803) ' Brine Conc. ',' Brine Conc'
544 10108 : write(nu_diag_out+n-1,*) '---------------------------------------------------'
545 90972 : write(nu_diag_out+n-1,802) (pZoo(k), k = 1,nblyr+1)
546 10108 : write(nu_diag_out+n-1,*) ' '
547 : endif
548 10108 : if (tr_bgc_Nit) then
549 6088 : write(nu_diag_out+n-1,*) '---------------------------------------------------'
550 6088 : write(nu_diag_out+n-1,*) ' nitrate conc. (mmol/m^3) or flux (mmol/m^2/d)'
551 6088 : write(nu_diag_out+n-1,900) 'Ocean conc = ',pNit_ac
552 6088 : write(nu_diag_out+n-1,900) 'ice-ocean flux = ',pflux_NO
553 6088 : if (skl_bgc) then
554 0 : write(nu_diag_out+n-1,900) 'Bulk ice conc. = ',pNit_sk
555 6088 : elseif (z_tracers) then
556 6088 : write(nu_diag_out+n-1,900) 'atm-ice flux = ',pflux_atm_NO
557 6088 : write(nu_diag_out+n-1,900) 'snow-ice flux = ',pflux_snow_NO
558 6088 : write(nu_diag_out+n-1,*) ' snow + ice conc'
559 6088 : write(nu_diag_out+n-1,803) ' nitrate'
560 18264 : write(nu_diag_out+n-1,802) (pNOs(k), k = 1,2)
561 54792 : write(nu_diag_out+n-1,802) (pNO(k), k = 1,nblyr+1)
562 6088 : write(nu_diag_out+n-1,*) ' '
563 : endif
564 : endif
565 10108 : if (tr_bgc_PON .and. z_tracers) then
566 6088 : write(nu_diag_out+n-1,*) '---------------------------------------------------'
567 6088 : write(nu_diag_out+n-1,*) ' PON snow + ice conc. (mmol/m^3)'
568 6088 : write(nu_diag_out+n-1,803) ' PON'
569 18264 : write(nu_diag_out+n-1,802) (pPONs(k), k = 1,2)
570 54792 : write(nu_diag_out+n-1,802) (pPON(k), k = 1,nblyr+1)
571 6088 : write(nu_diag_out+n-1,*) ' '
572 : endif
573 10108 : if (tr_bgc_hum) then
574 6088 : write(nu_diag_out+n-1,*) '---------------------------------------------------'
575 6088 : write(nu_diag_out+n-1,*) ' hum snow + ice conc. (mmolC/m^3)'
576 6088 : write(nu_diag_out+n-1,900) 'Ocean conc = ',phum_ac
577 6088 : write(nu_diag_out+n-1,900) 'ice-ocean flux = ',pflux_hum
578 6088 : if (skl_bgc) then
579 0 : write(nu_diag_out+n-1,900) 'Bulk ice conc. = ',phum_sk
580 6088 : elseif (z_tracers) then
581 6088 : write(nu_diag_out+n-1,803) ' hum'
582 18264 : write(nu_diag_out+n-1,802) (phums(k), k = 1,2)
583 54792 : write(nu_diag_out+n-1,802) (phum(k), k = 1,nblyr+1)
584 6088 : write(nu_diag_out+n-1,*) ' '
585 : endif
586 : endif
587 10108 : if (tr_bgc_Am) then
588 6088 : write(nu_diag_out+n-1,*) '---------------------------------------------------'
589 6088 : write(nu_diag_out+n-1,*) ' ammonium conc. (mmol/m^3) or flux (mmol/m^2/d)'
590 6088 : write(nu_diag_out+n-1,900) 'Ocean conc = ',pAm_ac
591 6088 : write(nu_diag_out+n-1,900) 'ice-ocean flux = ',pflux_Am
592 6088 : if (skl_bgc) then
593 0 : write(nu_diag_out+n-1,900) 'Bulk ice conc. = ',pAm_sk
594 6088 : elseif (z_tracers) then
595 6088 : write(nu_diag_out+n-1,900) 'atm-ice flux = ',pflux_atm_Am
596 6088 : write(nu_diag_out+n-1,900) 'snow-ice flux = ',pflux_snow_Am
597 6088 : write(nu_diag_out+n-1,*) ' snow + ice conc.'
598 6088 : write(nu_diag_out+n-1,803) ' ammonium'
599 18264 : write(nu_diag_out+n-1,802) (pAms(k), k = 1,2)
600 54792 : write(nu_diag_out+n-1,802) (pAm(k), k = 1,nblyr+1)
601 6088 : write(nu_diag_out+n-1,*) ' '
602 : endif
603 : endif
604 10108 : if (tr_bgc_N) then
605 6088 : write(nu_diag_out+n-1,*) '---------------------------------------------------'
606 6088 : write(nu_diag_out+n-1,900) 'tot algal growth (1/d) = ',pgrow_net
607 24352 : do kk = 1,n_algae
608 18264 : write(nu_diag_out+n-1,*) ' algal conc. (mmol N/m^3) or flux (mmol N/m^2/d)'
609 18264 : write(nu_diag_out+n-1,1020) ' type:', kk
610 18264 : write(nu_diag_out+n-1,900) 'Ocean conc = ',pN_ac(kk)
611 18264 : write(nu_diag_out+n-1,900) 'ice-ocean flux = ',pflux_N(kk)
612 24352 : if (skl_bgc) then
613 0 : write(nu_diag_out+n-1,900) 'Bulk ice conc. = ',pN_sk(kk)
614 18264 : elseif (z_tracers) then
615 18264 : write(nu_diag_out+n-1,900) 'Tot ice (mmolN/m^2) = ',pN_tot(kk)
616 18264 : write(nu_diag_out+n-1,*) ' snow + ice conc.'
617 18264 : write(nu_diag_out+n-1,803) ' algal N'
618 54792 : write(nu_diag_out+n-1,802) (pNs(k,kk), k = 1,2)
619 164376 : write(nu_diag_out+n-1,802) (pN(k,kk), k = 1,nblyr+1)
620 18264 : write(nu_diag_out+n-1,*) ' '
621 : endif
622 : enddo
623 : endif
624 10108 : if (tr_bgc_C) then
625 12176 : do kk = 1,1 !n_doc
626 6088 : write(nu_diag_out+n-1,*) '---------------------------------------------------'
627 6088 : write(nu_diag_out+n-1,*) ' DOC conc. (mmol C/m^3)'
628 6088 : write(nu_diag_out+n-1,1020) ' type:', kk
629 6088 : write(nu_diag_out+n-1,900) 'Ocean conc = ',pDOC_ac(kk)
630 12176 : if (skl_bgc) then
631 0 : write(nu_diag_out+n-1,900)'Bulk ice conc. = ',pDOC_sk(kk)
632 6088 : elseif (z_tracers) then
633 6088 : write(nu_diag_out+n-1,*) ' snow + ice conc.'
634 6088 : write(nu_diag_out+n-1,803) ' DOC'
635 18264 : write(nu_diag_out+n-1,802) (pDOCs(k,kk), k = 1,2)
636 54792 : write(nu_diag_out+n-1,802) (pDOC(k,kk), k = 1,nblyr+1)
637 6088 : write(nu_diag_out+n-1,*) ' '
638 : endif
639 : enddo
640 : endif
641 10108 : if (tr_bgc_DON) then
642 12176 : do kk = 1,n_don
643 6088 : write(nu_diag_out+n-1,*) '---------------------------------------------------'
644 6088 : write(nu_diag_out+n-1,*) ' DON conc. (mmol N/m^3)'
645 6088 : write(nu_diag_out+n-1,1020) ' type:', kk
646 6088 : write(nu_diag_out+n-1,900) 'Ocean conc = ',pDON_ac(kk)
647 12176 : if (skl_bgc) then
648 0 : write(nu_diag_out+n-1,900)'Bulk ice conc. = ',pDON_sk(kk)
649 6088 : elseif (z_tracers) then
650 6088 : write(nu_diag_out+n-1,*) ' snow + ice conc.'
651 6088 : write(nu_diag_out+n-1,803) ' DON'
652 18264 : write(nu_diag_out+n-1,802) (pDONs(k,kk), k = 1,2)
653 54792 : write(nu_diag_out+n-1,802) (pDON(k,kk), k = 1,nblyr+1)
654 6088 : write(nu_diag_out+n-1,*) ' '
655 : endif
656 : enddo
657 : endif
658 10108 : if (tr_bgc_Fe ) then
659 12176 : do kk = 1,n_fed
660 6088 : write(nu_diag_out+n-1,*) '---------------------------------------------------'
661 6088 : write(nu_diag_out+n-1,*) ' dFe conc. (nM)'
662 6088 : write(nu_diag_out+n-1,1020) ' type:', kk
663 6088 : write(nu_diag_out+n-1,900) 'Ocean conc = ',pFed_ac (kk)
664 12176 : if (skl_bgc) then
665 0 : write(nu_diag_out+n-1,900)'Bulk ice conc. = ',pFed_sk (kk)
666 6088 : elseif (z_tracers) then
667 6088 : write(nu_diag_out+n-1,*) ' snow + ice conc.'
668 6088 : write(nu_diag_out+n-1,803) ' Fed'
669 18264 : write(nu_diag_out+n-1,802) (pFeds (k,kk), k = 1,2)
670 54792 : write(nu_diag_out+n-1,802) (pFed (k,kk), k = 1,nblyr+1)
671 6088 : write(nu_diag_out+n-1,*) ' '
672 : endif
673 : enddo
674 12176 : do kk = 1,n_fep
675 6088 : write(nu_diag_out+n-1,*) '---------------------------------------------------'
676 6088 : write(nu_diag_out+n-1,*) ' pFe conc. (nM)'
677 6088 : write(nu_diag_out+n-1,1020) ' type:', kk
678 6088 : write(nu_diag_out+n-1,900) 'Ocean conc = ',pFep_ac (kk)
679 12176 : if (skl_bgc) then
680 0 : write(nu_diag_out+n-1,900)'Bulk ice conc. = ',pFep_sk (kk)
681 6088 : elseif (z_tracers) then
682 6088 : write(nu_diag_out+n-1,*) ' snow + ice conc.'
683 6088 : write(nu_diag_out+n-1,803) ' Fep'
684 18264 : write(nu_diag_out+n-1,802) (pFeps (k,kk), k = 1,2)
685 54792 : write(nu_diag_out+n-1,802) (pFep (k,kk), k = 1,nblyr+1)
686 6088 : write(nu_diag_out+n-1,*) ' '
687 : endif
688 : enddo
689 : endif
690 10108 : if (tr_bgc_DMS) then
691 6088 : write(nu_diag_out+n-1,*) '---------------------------------------------------'
692 6088 : write(nu_diag_out+n-1,*) ' DMS (mmol/m^3) '
693 6088 : write(nu_diag_out+n-1,900) 'Ocean DMSP = ',pDMSP_ac
694 6088 : write(nu_diag_out+n-1,900) 'Ocean DMS = ',pDMS_ac
695 6088 : if (skl_bgc) then
696 0 : write(nu_diag_out+n-1,900) 'Ice DMSPp = ',pDMSPp_sk
697 0 : write(nu_diag_out+n-1,900) 'Ice DMSPd = ',pDMSPd_sk
698 0 : write(nu_diag_out+n-1,900) 'Ice DMS = ',pDMS_sk
699 : endif
700 : endif
701 10108 : if (tr_zaero .and. z_tracers) then
702 50500 : do kk = 1,n_zaero
703 40392 : write(nu_diag_out+n-1,*) '---------------------------------------------------'
704 40392 : write(nu_diag_out+n-1,*) ' aerosol conc. (kg/m^3) or flux (kg/m^2/d)'
705 40392 : write(nu_diag_out+n-1,1020) ' type: ',kk
706 40392 : write(nu_diag_out+n-1,900) 'Atm source flux = ',pflux_atm_zaero_s(kk)
707 40392 : write(nu_diag_out+n-1,900) 'ice-ocean flux*aice = ',pflux_zaero(kk)
708 40392 : write(nu_diag_out+n-1,900) 'atm-ice flux*aice = ',pflux_atm_zaero(kk)
709 40392 : write(nu_diag_out+n-1,900) 'snow-ice flux*aice = ',pflux_snow_zaero(kk)
710 40392 : write(nu_diag_out+n-1,*) ' snow + ice conc.'
711 40392 : write(nu_diag_out+n-1,803) ' aerosol'
712 121176 : write(nu_diag_out+n-1,802) (pzaeros(k,kk), k = 1,2)
713 363528 : write(nu_diag_out+n-1,802) (pzaero(k,kk), k = 1,nblyr+1)
714 50500 : write(nu_diag_out+n-1,*) ' '
715 : enddo
716 : endif
717 12635 : if (dEdd_algae) then
718 0 : if (tr_zaero) then
719 0 : do kk = 1,n_zaero
720 0 : write(nu_diag_out+n-1,*) '---------------------------------------------------'
721 0 : write(nu_diag_out+n-1,*) ' Cat 1 aerosol conc. (kg/m^3) on delta-Eddington grid '
722 0 : write(nu_diag_out+n-1,802) (pzaerosw(k,kk), k = 1,klev +1)
723 : enddo
724 : endif
725 0 : if (tr_bgc_N) then
726 0 : write(nu_diag_out+n-1,*) '---------------------------------------------------'
727 0 : write(nu_diag_out+n-1,*) ' Cat 1 chl (mg/m^3) on delta-Eddington grid '
728 0 : write(nu_diag_out+n-1,802) (pchlsw(k), k = 1,klev +1)
729 : endif
730 : endif
731 : enddo ! nx
732 :
733 : 802 format (f24.17,2x)
734 : 803 format (a25,2x)
735 : 900 format (a25,2x,f24.17)
736 : 1020 format (a30,2x,i6) ! integer
737 :
738 2527 : end subroutine bgc_diags
739 :
740 : !=======================================================================
741 :
742 : end module icedrv_diagnostics_bgc
743 :
744 : !=======================================================================
|