Line data Source code
1 : !=======================================================================
2 : !
3 : ! Compute sea ice biogeochemistry (vertical or skeletal layer)
4 : !
5 : ! authors: Nicole Jeffery, LANL
6 : ! Scott Elliot, LANL
7 : ! Elizabeth C. Hunke, LANL
8 : !
9 : module icepack_algae
10 :
11 : use icepack_kinds
12 :
13 : use icepack_parameters, only: p05, p5, c0, c1, c2, c6, c10
14 : use icepack_parameters, only: pi, secday, puny
15 : use icepack_parameters, only: hs_ssl, sk_l
16 :
17 : use icepack_parameters, only: dEdd_algae, solve_zbgc
18 : use icepack_parameters, only: R_dFe2dust, dustFe_sol, algal_vel
19 : use icepack_parameters, only: bgc_flux_type
20 : use icepack_parameters, only: grid_o
21 : use icepack_parameters, only: T_max, fsal , fr_resp
22 : use icepack_parameters, only: op_dep_min , fr_graze_s
23 : use icepack_parameters, only: fr_graze_e , fr_mort2min
24 : use icepack_parameters, only: fr_dFe , k_nitrif
25 : use icepack_parameters, only: t_iron_conv , max_loss
26 : use icepack_parameters, only: max_dfe_doc1 , fr_resp_s
27 : use icepack_parameters, only: y_sk_DMS , t_sk_conv
28 : use icepack_parameters, only: t_sk_ox
29 :
30 : use icepack_tracers, only: ntrcr, bio_index
31 : use icepack_tracers, only: nt_bgc_N, nt_fbri, nt_zbgc_frac
32 : use icepack_tracers, only: tr_brine
33 : use icepack_tracers, only: tr_bgc_Nit, tr_bgc_Am, tr_bgc_Sil
34 : use icepack_tracers, only: tr_bgc_DMS, tr_bgc_PON
35 : use icepack_tracers, only: tr_bgc_N, tr_bgc_C, tr_bgc_chl
36 : use icepack_tracers, only: tr_bgc_DON, tr_bgc_Fe, tr_zaero
37 : use icepack_tracers, only: nlt_bgc_Nit, nlt_bgc_Am, nlt_bgc_Sil
38 : use icepack_tracers, only: nlt_bgc_DMS, nlt_bgc_PON
39 : use icepack_tracers, only: nlt_bgc_N, nlt_bgc_C, nlt_bgc_chl
40 : use icepack_tracers, only: nlt_bgc_DOC, nlt_bgc_DON, nlt_bgc_DIC
41 : use icepack_tracers, only: nlt_zaero , nlt_bgc_DMSPp,nlt_bgc_DMSPd
42 : use icepack_tracers, only: nlt_bgc_Fed, nlt_bgc_Fep
43 :
44 : use icepack_zbgc_shared, only: remap_zbgc, regrid_stationary
45 : use icepack_zbgc_shared, only: merge_bgc_fluxes
46 : use icepack_zbgc_shared, only: merge_bgc_fluxes_skl
47 : use icepack_zbgc_shared, only: phi_sk, bgc_tracer_type
48 : use icepack_zbgc_shared, only: zbgc_init_frac
49 : use icepack_zbgc_shared, only: zbgc_frac_init
50 : use icepack_zbgc_shared, only: tau_rel, tau_ret, thinS
51 : use icepack_zbgc_shared, only: r_Si2N, R_Fe2N, R_S2N, R_chl2N
52 : use icepack_zbgc_shared, only: chlabs, alpha2max_low, beta2max, mu_max
53 : use icepack_zbgc_shared, only: k_exude, K_Nit, K_Am, K_Sil, K_Fe
54 : use icepack_zbgc_shared, only: grow_Tdep, fr_graze, mort_pre, mort_Tdep
55 : use icepack_zbgc_shared, only: f_don, kn_bac, f_don_Am
56 : use icepack_zbgc_shared, only: f_doc, f_exude, k_bac, R_chl2N, R_C2N
57 :
58 : use icepack_warnings, only: warnstr, icepack_warnings_add
59 : use icepack_warnings, only: icepack_warnings_setabort, icepack_warnings_aborted
60 :
61 : use icepack_aerosol, only: update_snow_bgc
62 :
63 : implicit none
64 :
65 : private
66 : public :: zbio, sklbio
67 :
68 : real (kind=dbl_kind), parameter :: &
69 : exp_argmax = c10 ! maximum argument of exponential
70 :
71 : !=======================================================================
72 :
73 : contains
74 :
75 : !=======================================================================
76 :
77 29795903 : subroutine zbio (dt, nblyr, &
78 : nslyr, nilyr, & ! LCOV_EXCL_LINE
79 : meltt, melts, & ! LCOV_EXCL_LINE
80 : meltb, congel, & ! LCOV_EXCL_LINE
81 : snoice, nbtrcr, & ! LCOV_EXCL_LINE
82 : fsnow, ntrcr, & ! LCOV_EXCL_LINE
83 : trcrn, bio_index, & ! LCOV_EXCL_LINE
84 : aice_old, & ! LCOV_EXCL_LINE
85 : vice_old, vsno_old, & ! LCOV_EXCL_LINE
86 : vicen, vsnon, & ! LCOV_EXCL_LINE
87 : aicen, flux_bio_atm,& ! LCOV_EXCL_LINE
88 : n_cat, n_algae, & ! LCOV_EXCL_LINE
89 : n_doc, n_dic, & ! LCOV_EXCL_LINE
90 : n_don, & ! LCOV_EXCL_LINE
91 : n_fed, n_fep, & ! LCOV_EXCL_LINE
92 : n_zaero, first_ice, & ! LCOV_EXCL_LINE
93 : hice_old, ocean_bio, & ! LCOV_EXCL_LINE
94 : bphin, iphin, & ! LCOV_EXCL_LINE
95 : iDin, & ! LCOV_EXCL_LINE
96 : fswthrul, & ! LCOV_EXCL_LINE
97 : dh_top, dh_bot, & ! LCOV_EXCL_LINE
98 : zfswin, & ! LCOV_EXCL_LINE
99 : hbri, hbri_old, & ! LCOV_EXCL_LINE
100 : ! darcy_V, darcy_V_chl, & ! LCOV_EXCL_LINE
101 : darcy_V, & ! LCOV_EXCL_LINE
102 : bgrid, & ! LCOV_EXCL_LINE
103 : igrid, icgrid, & ! LCOV_EXCL_LINE
104 : bphi_min, & ! LCOV_EXCL_LINE
105 : iTin, & ! LCOV_EXCL_LINE
106 : Zoo, & ! LCOV_EXCL_LINE
107 : flux_bio, dh_direct, & ! LCOV_EXCL_LINE
108 : upNO, upNH, & ! LCOV_EXCL_LINE
109 : fbio_snoice, fbio_atmice, & ! LCOV_EXCL_LINE
110 : PP_net, ice_bio_net, & ! LCOV_EXCL_LINE
111 29795903 : snow_bio_net, grow_net )
112 :
113 : integer (kind=int_kind), intent(in) :: &
114 : nblyr, & ! number of bio layers ! LCOV_EXCL_LINE
115 : nslyr, & ! number of snow layers ! LCOV_EXCL_LINE
116 : nilyr, & ! number of ice layers ! LCOV_EXCL_LINE
117 : nbtrcr, & ! number of distinct bio tracers ! LCOV_EXCL_LINE
118 : n_cat, & ! category number ! LCOV_EXCL_LINE
119 : n_algae, & ! number of autotrophs ! LCOV_EXCL_LINE
120 : n_zaero, & ! number of aerosols ! LCOV_EXCL_LINE
121 : n_doc, n_dic, n_don, n_fed, n_fep, & ! LCOV_EXCL_LINE
122 : ntrcr ! number of tracers
123 :
124 : integer (kind=int_kind), dimension (nbtrcr), intent(in) :: &
125 : bio_index
126 :
127 : real (kind=dbl_kind), intent(in) :: &
128 : dt, & ! time step ! LCOV_EXCL_LINE
129 : hbri, & ! brine height (m) ! LCOV_EXCL_LINE
130 : bphi_min, & ! surface porosity ! LCOV_EXCL_LINE
131 : meltt, & ! thermodynamic melt/growth rates in dt (m) ! LCOV_EXCL_LINE
132 : melts, & ! LCOV_EXCL_LINE
133 : meltb, & ! LCOV_EXCL_LINE
134 : congel, & ! LCOV_EXCL_LINE
135 : snoice, & ! LCOV_EXCL_LINE
136 : fsnow, & ! snowfall rate (kg/m^2 s) ! LCOV_EXCL_LINE
137 : hice_old, & ! ice height (m) ! LCOV_EXCL_LINE
138 : vicen, & ! ice volume (m) ! LCOV_EXCL_LINE
139 : vsnon, & ! snow volume (m) ! LCOV_EXCL_LINE
140 : aicen, & ! ice area fraction ! LCOV_EXCL_LINE
141 : aice_old, & ! values prior to thermodynamic changes ! LCOV_EXCL_LINE
142 : vice_old, & ! LCOV_EXCL_LINE
143 : vsno_old, & ! LCOV_EXCL_LINE
144 : darcy_V, & ! darcy velocity ! LCOV_EXCL_LINE
145 : ! darcy_V_chl,& ! darcy velocity for algae ! LCOV_EXCL_LINE
146 : dh_bot, & ! change in brine bottom (m) ! LCOV_EXCL_LINE
147 : dh_top, & ! change in brine top (m) ! LCOV_EXCL_LINE
148 : dh_direct ! surface flooding or surface runoff (m)
149 :
150 : real (kind=dbl_kind), dimension (nbtrcr), intent(inout) :: &
151 : snow_bio_net,& ! net bio tracer in snow (mmol/m^2) ! LCOV_EXCL_LINE
152 : ice_bio_net, & ! net bio tracer in ice (mmol/m^2) ! LCOV_EXCL_LINE
153 : fbio_atmice, & ! bio flux from atm to ice (mmol/m^2/s) ! LCOV_EXCL_LINE
154 : fbio_snoice, & ! bio flux from snow to ice (mmol/m^2/s) ! LCOV_EXCL_LINE
155 : flux_bio ! total ocean tracer flux (mmol/m^2/s)
156 :
157 : real (kind=dbl_kind), intent(inout) :: &
158 : hbri_old ! brine height (m)
159 :
160 : real (kind=dbl_kind), dimension (nblyr+2), intent(inout) :: &
161 : bgrid ! biology nondimensional vertical grid points
162 :
163 : real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: &
164 : igrid , & ! biology vertical interface points ! LCOV_EXCL_LINE
165 : iTin , & ! salinity vertical interface points ! LCOV_EXCL_LINE
166 : iphin , & ! Porosity on the igrid ! LCOV_EXCL_LINE
167 : iDin ! Diffusivity/h on the igrid (1/s)
168 :
169 : real (kind=dbl_kind), dimension (nilyr+1), intent(in) :: &
170 : icgrid , & ! CICE interface coordinate ! LCOV_EXCL_LINE
171 : fswthrul ! visible short wave radiation on icgrid (W/m^2)
172 :
173 : real (kind=dbl_kind), dimension(nbtrcr), &
174 : intent(in) :: & ! LCOV_EXCL_LINE
175 : flux_bio_atm ! aerosol/bgc deposition rate (mmol/m^2 s)
176 :
177 : real (kind=dbl_kind), dimension(ntrcr), &
178 : intent(inout) :: & ! LCOV_EXCL_LINE
179 : trcrn
180 :
181 : real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: &
182 : zfswin ! visible Short wave flux on igrid (W/m^2)
183 :
184 : real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: &
185 : Zoo ! N losses to the system from reaction terms
186 : ! (ie. zooplankton/bacteria) (mmol/m^3)
187 :
188 : real (kind=dbl_kind), dimension (nbtrcr), intent(in) :: &
189 : !change to inout when updating ocean fields
190 : ocean_bio ! ocean concentrations (mmol/m^3)
191 :
192 : real (kind=dbl_kind), dimension (nblyr+2), intent(in) :: &
193 : bphin ! Porosity on the bgrid
194 :
195 : real (kind=dbl_kind), intent(inout):: &
196 : PP_net , & ! net PP (mg C/m^2/d) times aice ! LCOV_EXCL_LINE
197 : grow_net , & ! net specific growth (m/d) times vice ! LCOV_EXCL_LINE
198 : upNO , & ! tot nitrate uptake rate (mmol/m^2/d) times aice ! LCOV_EXCL_LINE
199 : upNH ! tot ammonium uptake rate (mmol/m^2/d) times aice
200 :
201 : logical (kind=log_kind), intent(in) :: &
202 : first_ice ! initialized values should be used
203 :
204 : ! local variables
205 :
206 : integer (kind=int_kind) :: &
207 : mm ! thickness category index
208 :
209 : real (kind=dbl_kind), dimension (nblyr+1,n_algae) :: &
210 : upNOn , & ! algal nitrate uptake rate (mmol/m^3/s) ! LCOV_EXCL_LINE
211 : upNHn , & ! algal ammonium uptake rate (mmol/m^3/s) ! LCOV_EXCL_LINE
212 61935784 : grow_alg ! algal growth rate (mmol/m^3/s)
213 :
214 : real (kind=dbl_kind), dimension (nbtrcr) :: &
215 61214560 : flux_bion !tracer flux to ocean
216 :
217 : real (kind=dbl_kind),dimension(nbtrcr) :: &
218 : zbgc_snown, & ! aerosol contribution from snow to ice ! LCOV_EXCL_LINE
219 61214560 : zbgc_atmn ! and atm to ice concentration * volume (mmol/m^3*m)
220 :
221 : real (kind=dbl_kind), dimension(nbtrcr) :: &
222 : Tot_BGC_i, & ! initial column sum, ice + snow, of BGC tracer (mmol/m^2) ! LCOV_EXCL_LINE
223 : Tot_BGC_f, & ! final column sum ! LCOV_EXCL_LINE
224 31689116 : flux_bio_sno !
225 :
226 : real (kind=dbl_kind) :: &
227 : hsnow_i, & ! initial snow thickness (m) ! LCOV_EXCL_LINE
228 90153 : hsnow_f ! final snow thickness (m)
229 :
230 : logical (kind=log_kind) :: &
231 : write_flux_diag
232 :
233 : real (kind=dbl_kind) :: &
234 90153 : a_ice
235 :
236 : character(len=*),parameter :: subname='(zbio)'
237 :
238 595918060 : zbgc_snown(:) = c0
239 595918060 : zbgc_atmn (:) = c0
240 595918060 : flux_bion (:) = c0
241 595918060 : flux_bio_sno(:) = c0
242 595918060 : Tot_BGC_i (:) = c0
243 595918060 : Tot_BGC_f (:) = c0
244 29795903 : hsnow_i = c0
245 29795903 : hsnow_f = c0
246 29795903 : write_flux_diag = .false.
247 :
248 29795903 : if (write_flux_diag) then
249 0 : if (aice_old > c0) then
250 0 : hsnow_i = vsno_old/aice_old
251 0 : do mm = 1,nbtrcr
252 : call bgc_column_sum (nblyr, nslyr, hsnow_i, hbri_old, &
253 : trcrn(bio_index(mm):bio_index(mm)+nblyr+2), & ! LCOV_EXCL_LINE
254 0 : Tot_BGC_i(mm))
255 0 : if (icepack_warnings_aborted(subname)) return
256 : enddo
257 : endif
258 : endif
259 :
260 : call update_snow_bgc (dt, nblyr, &
261 : nslyr, & ! LCOV_EXCL_LINE
262 : meltt, melts, & ! LCOV_EXCL_LINE
263 : meltb, congel, & ! LCOV_EXCL_LINE
264 : snoice, nbtrcr, & ! LCOV_EXCL_LINE
265 : fsnow, ntrcr, & ! LCOV_EXCL_LINE
266 : trcrn, bio_index, & ! LCOV_EXCL_LINE
267 : aice_old, zbgc_snown, & ! LCOV_EXCL_LINE
268 : vice_old, vsno_old, & ! LCOV_EXCL_LINE
269 : vicen, vsnon, & ! LCOV_EXCL_LINE
270 : aicen, flux_bio_atm, & ! LCOV_EXCL_LINE
271 29795903 : zbgc_atmn, flux_bio_sno)
272 29795903 : if (icepack_warnings_aborted(subname)) return
273 :
274 : call z_biogeochemistry (n_cat, dt, &
275 : nilyr, & ! LCOV_EXCL_LINE
276 : nblyr, nbtrcr, & ! LCOV_EXCL_LINE
277 : n_algae, n_doc, & ! LCOV_EXCL_LINE
278 : n_dic, n_don, & ! LCOV_EXCL_LINE
279 : n_fed, n_fep, & ! LCOV_EXCL_LINE
280 : n_zaero, first_ice, & ! LCOV_EXCL_LINE
281 : aicen, vicen, & ! LCOV_EXCL_LINE
282 : hice_old, ocean_bio, & ! LCOV_EXCL_LINE
283 : flux_bion, bphin, & ! LCOV_EXCL_LINE
284 : iphin, trcrn, & ! LCOV_EXCL_LINE
285 : iDin, & ! LCOV_EXCL_LINE
286 : fswthrul, grow_alg, & ! LCOV_EXCL_LINE
287 : upNOn, upNHn, & ! LCOV_EXCL_LINE
288 : dh_top, dh_bot, & ! LCOV_EXCL_LINE
289 : zfswin, hbri, & ! LCOV_EXCL_LINE
290 : hbri_old, darcy_V, & ! LCOV_EXCL_LINE
291 : ! darcy_V_chl, bgrid, & ! LCOV_EXCL_LINE
292 : bgrid, & ! LCOV_EXCL_LINE
293 : igrid, icgrid, & ! LCOV_EXCL_LINE
294 : bphi_min, zbgc_snown,& ! LCOV_EXCL_LINE
295 : zbgc_atmn, & ! LCOV_EXCL_LINE
296 : iTin, dh_direct, & ! LCOV_EXCL_LINE
297 : Zoo, meltb, & ! LCOV_EXCL_LINE
298 29795903 : congel )
299 29795903 : if (icepack_warnings_aborted(subname)) return
300 :
301 595918060 : do mm = 1,nbtrcr
302 595918060 : flux_bion(mm) = flux_bion(mm) + flux_bio_sno(mm)
303 : enddo
304 :
305 29795903 : if (write_flux_diag) then
306 0 : if (aicen > c0) then
307 0 : hsnow_f = vsnon/aicen
308 0 : do mm = 1,nbtrcr
309 : call bgc_column_sum (nblyr, nslyr, hsnow_f, hbri, &
310 : trcrn(bio_index(mm):bio_index(mm)+nblyr+2), & ! LCOV_EXCL_LINE
311 0 : Tot_BGC_f(mm))
312 0 : write(warnstr,*) subname, 'mm, Tot_BGC_i(mm), Tot_BGC_f(mm)'
313 0 : call icepack_warnings_add(warnstr)
314 0 : write(warnstr,*) subname, mm, Tot_BGC_i(mm), Tot_BGC_f(mm)
315 0 : call icepack_warnings_add(warnstr)
316 0 : write(warnstr,*) subname, 'flux_bion(mm), flux_bio_atm(mm)'
317 0 : call icepack_warnings_add(warnstr)
318 0 : write(warnstr,*) subname, flux_bion(mm), flux_bio_atm(mm)
319 0 : call icepack_warnings_add(warnstr)
320 0 : write(warnstr,*) subname, 'zbgc_snown(mm),zbgc_atmn(mm)'
321 0 : call icepack_warnings_add(warnstr)
322 0 : write(warnstr,*) subname, zbgc_snown(mm),zbgc_atmn(mm)
323 0 : call icepack_warnings_add(warnstr)
324 0 : write(warnstr,*) subname, 'Tot_BGC_i(mm) + flux_bio_atm(mm)*dt - flux_bion(mm)*dt'
325 0 : call icepack_warnings_add(warnstr)
326 0 : write(warnstr,*) subname, Tot_BGC_i(mm) + flux_bio_atm(mm)*dt - flux_bion(mm)*dt
327 0 : call icepack_warnings_add(warnstr)
328 : enddo
329 : endif
330 : endif
331 :
332 29795903 : if (icepack_warnings_aborted(subname)) return
333 :
334 : call merge_bgc_fluxes (dt, nblyr, &
335 : bio_index, n_algae, & ! LCOV_EXCL_LINE
336 : nbtrcr, aicen, & ! LCOV_EXCL_LINE
337 : vicen, vsnon, & ! LCOV_EXCL_LINE
338 : iphin, & ! LCOV_EXCL_LINE
339 : trcrn, & ! LCOV_EXCL_LINE
340 : flux_bion, flux_bio, & ! LCOV_EXCL_LINE
341 : upNOn, upNHn, & ! LCOV_EXCL_LINE
342 : upNO, upNH, & ! LCOV_EXCL_LINE
343 : zbgc_snown, zbgc_atmn, & ! LCOV_EXCL_LINE
344 : fbio_snoice, fbio_atmice,& ! LCOV_EXCL_LINE
345 : PP_net, ice_bio_net,& ! LCOV_EXCL_LINE
346 : snow_bio_net, grow_alg, & ! LCOV_EXCL_LINE
347 29795903 : grow_net)
348 29795903 : if (icepack_warnings_aborted(subname)) return
349 :
350 29795903 : if (write_flux_diag) then
351 0 : if (aicen > c0) then
352 0 : if (n_cat .eq. 1) a_ice = c0
353 0 : a_ice = a_ice + aicen
354 0 : write(warnstr,*) subname, 'after merge_bgc_fluxes, n_cat:', n_cat
355 0 : call icepack_warnings_add(warnstr)
356 0 : do mm = 1,nbtrcr
357 0 : write(warnstr,*) subname, 'mm, flux_bio(mm):',mm,flux_bio(mm)
358 0 : call icepack_warnings_add(warnstr)
359 0 : write(warnstr,*) subname, 'fbio_snoice(mm)',fbio_snoice(mm)
360 0 : call icepack_warnings_add(warnstr)
361 0 : write(warnstr,*) subname, 'fbio_atmice(mm)',fbio_atmice(mm)
362 0 : call icepack_warnings_add(warnstr)
363 0 : write(warnstr,*) subname, 'flux_bio_atm(mm)', flux_bio_atm(mm)
364 0 : call icepack_warnings_add(warnstr)
365 0 : write(warnstr,*) subname, 'flux_bio_atm(mm)*a_ice', flux_bio_atm(mm)*a_ice
366 0 : call icepack_warnings_add(warnstr)
367 : enddo
368 : endif
369 : endif
370 :
371 : end subroutine zbio
372 :
373 : !=======================================================================
374 :
375 29615597 : subroutine sklbio (dt, ntrcr, &
376 : nbtrcr, n_algae, & ! LCOV_EXCL_LINE
377 : n_doc, & ! LCOV_EXCL_LINE
378 : n_dic, n_don, & ! LCOV_EXCL_LINE
379 : n_fed, n_fep, & ! LCOV_EXCL_LINE
380 : flux_bio, ocean_bio, & ! LCOV_EXCL_LINE
381 : aicen, & ! LCOV_EXCL_LINE
382 : meltb, congel, & ! LCOV_EXCL_LINE
383 : fswthru, first_ice, & ! LCOV_EXCL_LINE
384 : trcrn, & ! LCOV_EXCL_LINE
385 : PP_net, upNO, & ! LCOV_EXCL_LINE
386 : upNH, grow_net )
387 :
388 : integer (kind=int_kind), intent(in) :: &
389 : nbtrcr, & ! number of distinct bio tracers ! LCOV_EXCL_LINE
390 : n_algae, & ! number of autotrophs ! LCOV_EXCL_LINE
391 : n_doc, n_dic, & ! number of dissolved organic, inorganic carbon ! LCOV_EXCL_LINE
392 : n_don, & ! number of dissolved organic nitrogen ! LCOV_EXCL_LINE
393 : n_fed, n_fep, & ! number of iron ! LCOV_EXCL_LINE
394 : ntrcr ! number of tracers
395 :
396 : logical (kind=log_kind), intent(in) :: &
397 : first_ice ! initialized values should be used
398 :
399 : real (kind=dbl_kind), intent(in) :: &
400 : dt, & ! time step ! LCOV_EXCL_LINE
401 : ! hmix, & ! mixed layer depth (m) ! LCOV_EXCL_LINE
402 : aicen, & ! ice area fraction ! LCOV_EXCL_LINE
403 : meltb, & ! bottom melt (m) ! LCOV_EXCL_LINE
404 : congel, & ! bottom growth (m) ! LCOV_EXCL_LINE
405 : fswthru ! visible shortwave passing to ocean(W/m^2)
406 :
407 : real (kind=dbl_kind), dimension(ntrcr), intent(inout) :: &
408 : trcrn ! bulk concentration per m^3
409 :
410 : real (kind=dbl_kind), dimension (nbtrcr), intent(inout) :: &
411 : flux_bio ! ocean tracer flux (mmol/m^2/s) positive into ocean
412 :
413 : real (kind=dbl_kind), dimension (nbtrcr), intent(in) :: &
414 : ocean_bio ! ocean tracer concentration (mmol/m^3)
415 :
416 : ! history output
417 : real (kind=dbl_kind), intent(inout):: &
418 : PP_net , & ! Bulk net PP (mg C/m^2/s) ! LCOV_EXCL_LINE
419 : grow_net, & ! net specific growth (/s) ! LCOV_EXCL_LINE
420 : upNO , & ! tot nitrate uptake rate (mmol/m^2/s) ! LCOV_EXCL_LINE
421 : upNH ! tot ammonium uptake rate (mmol/m^2/s)
422 :
423 : ! local variables
424 :
425 : real (kind=dbl_kind), dimension (n_algae) :: &
426 : upNOn , & ! algal nitrate uptake rate (mmol/m^3/s) ! LCOV_EXCL_LINE
427 : upNHn , & ! algal ammonium uptake rate (mmol/m^3/s) ! LCOV_EXCL_LINE
428 59411500 : grow_alg ! algal growth rate (mmol/m^3/s)
429 :
430 : real (kind=dbl_kind), dimension (nbtrcr) :: &
431 31238351 : flux_bion !tracer flux to ocean
432 :
433 : character(len=*),parameter :: subname='(sklbio)'
434 :
435 503465149 : flux_bion (:) = c0
436 118462388 : upNOn (:) = c0
437 118462388 : upNHn (:) = c0
438 118462388 : grow_alg (:) = c0
439 :
440 : call skl_biogeochemistry (dt, &
441 : n_doc, & ! LCOV_EXCL_LINE
442 : n_dic, n_don, & ! LCOV_EXCL_LINE
443 : n_fed, n_fep, & ! LCOV_EXCL_LINE
444 : nbtrcr, n_algae, & ! LCOV_EXCL_LINE
445 : flux_bion, ocean_bio, & ! LCOV_EXCL_LINE
446 : ! hmix, aicen, & ! LCOV_EXCL_LINE
447 : meltb, congel, & ! LCOV_EXCL_LINE
448 : fswthru, first_ice, & ! LCOV_EXCL_LINE
449 : trcrn, upNOn, & ! LCOV_EXCL_LINE
450 29615597 : upNHn, grow_alg)
451 29615597 : if (icepack_warnings_aborted(subname)) return
452 :
453 : call merge_bgc_fluxes_skl (nbtrcr, n_algae, &
454 : aicen, trcrn, & ! LCOV_EXCL_LINE
455 : flux_bion, flux_bio, & ! LCOV_EXCL_LINE
456 : PP_net, upNOn, & ! LCOV_EXCL_LINE
457 : upNHn, upNO, & ! LCOV_EXCL_LINE
458 : upNH, grow_net, & ! LCOV_EXCL_LINE
459 29615597 : grow_alg)
460 29615597 : if (icepack_warnings_aborted(subname)) return
461 :
462 : end subroutine sklbio
463 :
464 : !=======================================================================
465 : !
466 : ! skeletal layer biochemistry
467 : !
468 29615597 : subroutine skl_biogeochemistry (dt, &
469 : n_doc, & ! LCOV_EXCL_LINE
470 : n_dic, n_don, & ! LCOV_EXCL_LINE
471 : n_fed, n_fep, & ! LCOV_EXCL_LINE
472 : nbtrcr, n_algae, & ! LCOV_EXCL_LINE
473 : flux_bio, ocean_bio, & ! LCOV_EXCL_LINE
474 : ! hmix, aicen, & ! LCOV_EXCL_LINE
475 : meltb, congel, & ! LCOV_EXCL_LINE
476 : fswthru, first_ice, & ! LCOV_EXCL_LINE
477 : trcrn, upNOn, & ! LCOV_EXCL_LINE
478 59231194 : upNHn, grow_alg_skl)
479 :
480 : integer (kind=int_kind), intent(in) :: &
481 : n_doc, n_dic, n_don, n_fed, n_fep, & ! LCOV_EXCL_LINE
482 : nbtrcr , n_algae ! number of bgc tracers and number algae
483 :
484 : real (kind=dbl_kind), intent(in) :: &
485 : dt , & ! time step ! LCOV_EXCL_LINE
486 : ! hmix , & ! mixed layer depth ! LCOV_EXCL_LINE
487 : ! aicen , & ! ice area ! LCOV_EXCL_LINE
488 : meltb , & ! bottom ice melt ! LCOV_EXCL_LINE
489 : congel , & ! bottom ice growth ! LCOV_EXCL_LINE
490 : fswthru ! shortwave passing through ice to ocean
491 :
492 : logical (kind=log_kind), intent(in) :: &
493 : first_ice ! initialized values should be used
494 :
495 : real (kind=dbl_kind), dimension(:), intent(inout) :: &
496 : trcrn ! bulk concentration per m^3
497 :
498 : ! history variables
499 :
500 : real (kind=dbl_kind), dimension (:), intent(out) :: &
501 : flux_bio ! ocean tracer flux (mmol/m^2/s) positive into ocean
502 :
503 : real (kind=dbl_kind), dimension (:), intent(in) :: &
504 : ocean_bio ! ocean tracer concentration (mmol/m^3)
505 :
506 : real (kind=dbl_kind), dimension (:), intent(out) :: &
507 : grow_alg_skl, & ! tot algal growth rate (mmol/m^3/s) ! LCOV_EXCL_LINE
508 : upNOn , & ! algal NO uptake rate (mmol/m^3/s) ! LCOV_EXCL_LINE
509 : upNHn ! algal NH uptake rate (mmol/m^3/s)
510 :
511 : ! local variables
512 :
513 : integer (kind=int_kind) :: nn
514 :
515 : real (kind=dbl_kind), dimension(nbtrcr):: &
516 : react , & ! biological sources and sinks (mmol/m^3) ! LCOV_EXCL_LINE
517 : cinit , & ! initial brine concentration*sk_l (mmol/m^2) ! LCOV_EXCL_LINE
518 : cinit_v , & ! initial brine concentration (mmol/m^3) ! LCOV_EXCL_LINE
519 : congel_alg , & ! congelation flux contribution to ice algae (mmol/m^2 s) ! LCOV_EXCL_LINE
520 : ! (used as initialization)
521 60583489 : f_meltn , & ! vertical melt fraction of skeletal layer in dt
522 : flux_bio_temp, & ! tracer flux to ocean (mmol/m^2 s) ! LCOV_EXCL_LINE
523 : PVflag , & ! 1 for tracers that flow with the brine, 0 otherwise ! LCOV_EXCL_LINE
524 31148198 : cling ! 1 for tracers that cling, 0 otherwise
525 :
526 : real (kind=dbl_kind) :: &
527 : Zoo_skl , & ! N losses from zooplankton/bacteria ... (mmol/m^3) ! LCOV_EXCL_LINE
528 : iTin , & ! LCOV_EXCL_LINE
529 : PVt , & ! type 'Jin2006' piston velocity (m/s) ! LCOV_EXCL_LINE
530 : ice_growth , & ! Jin2006 definition: either congel rate or bottom melt rate (m/s) ! LCOV_EXCL_LINE
531 : grow_val , & ! (m/x) ! LCOV_EXCL_LINE
532 : rphi_sk , & ! 1 / skeletal layer porosity ! LCOV_EXCL_LINE
533 : cinit_tmp , & ! temporary variable for concentration (mmol/m^2) ! LCOV_EXCL_LINE
534 90153 : Nerror ! change in total nitrogen from reactions
535 :
536 : real (kind=dbl_kind), parameter :: &
537 : PVc = 1.e-6_dbl_kind , & ! type 'constant' piston velocity for interface (m/s) ! LCOV_EXCL_LINE
538 : PV_scale_growth = p5 , & ! scale factor in Jin code PV during ice growth ! LCOV_EXCL_LINE
539 : PV_scale_melt = p05 , & ! scale factor in Jin code PV during ice melt ! LCOV_EXCL_LINE
540 : growth_max = 1.85e-5_dbl_kind , & ! PVt function reaches maximum here. (m/s) ! LCOV_EXCL_LINE
541 : Tin_bot = -1.8_dbl_kind , & ! temperature of the ice bottom (oC) ! LCOV_EXCL_LINE
542 : MJ1 = 9.667e-9_dbl_kind , & ! (m/s) coefficients in Jin2008 ! LCOV_EXCL_LINE
543 : MJ2 = 38.8_dbl_kind , & ! (1) from:4.49e-4_dbl_kind*secday ! LCOV_EXCL_LINE
544 : MJ3 = 1.04e7_dbl_kind , & ! 1/(m/s) from: 1.39e-3_dbl_kind*secday^2 ! LCOV_EXCL_LINE
545 : PV_frac_max = 0.9_dbl_kind ! Maximum Piston velocity is 90% of skeletal layer/dt
546 :
547 : logical (kind=log_kind) :: conserve_N
548 :
549 : character(len=*),parameter :: subname='(skl_biogeochemistry)'
550 :
551 : !-----------------------------------------------------------------
552 : ! Initialize
553 : !-----------------------------------------------------------------
554 :
555 29615597 : conserve_N = .true.
556 29615597 : Zoo_skl = c0
557 29615597 : rphi_sk = c1/phi_sk
558 29615597 : PVt = c0
559 29615597 : iTin = Tin_bot
560 :
561 503465149 : do nn = 1, nbtrcr
562 473849552 : cinit (nn) = c0
563 473849552 : cinit_v (nn) = c0
564 473849552 : congel_alg(nn) = c0
565 473849552 : f_meltn (nn) = c0
566 473849552 : react (nn) = c0
567 473849552 : PVflag (nn) = c1
568 473849552 : cling (nn) = c0
569 :
570 : !-----------------------------------------------------------------
571 : ! only the dominant tracer_type affects behavior
572 : ! < 0 is purely mobile: > 0 stationary behavior
573 : ! NOTE: retention times are not used in skl model
574 : !-----------------------------------------------------------------
575 :
576 473849552 : if (bgc_tracer_type(nn) >= c0) then
577 325771567 : PVflag(nn) = c0
578 325771567 : cling (nn) = c1
579 : endif
580 :
581 473849552 : ice_growth = (congel-meltb)/dt
582 473849552 : if (first_ice) then
583 1593840 : trcrn(bio_index(nn)) = ocean_bio(nn) ! * sk_l*rphi_sk
584 : endif ! first_ice
585 473849552 : cinit (nn) = trcrn(bio_index(nn)) * sk_l * rphi_sk
586 473849552 : cinit_v(nn) = cinit(nn)/sk_l
587 503465149 : if (cinit(nn) < c0) then
588 0 : write(warnstr,*) subname,'initial sk_bgc < 0, nn,nbtrcr,cinit(nn)', &
589 0 : nn,nbtrcr,cinit(nn)
590 0 : call icepack_warnings_add(warnstr)
591 0 : call icepack_warnings_add(subname//' cinit < c0')
592 0 : call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
593 0 : return
594 : endif
595 : enddo ! nbtrcr
596 :
597 29615597 : if (icepack_warnings_aborted(subname)) return
598 :
599 29615597 : if (trim(bgc_flux_type) == 'Jin2006') then
600 :
601 : !-----------------------------------------------------------------
602 : ! 'Jin2006':
603 : ! 1. congel/melt dependent piston velocity (PV) for growth and melt
604 : ! 2. If congel > melt use 'congel'; if melt > congel use 'melt'
605 : ! 3. For algal N, PV for ice growth only provides a seeding concentration
606 : ! 4. Melt affects nutrients and algae in the same manner through PV(melt)
607 : !-----------------------------------------------------------------
608 :
609 29615597 : if (ice_growth > c0) then ! ice_growth = congel/dt
610 10207639 : grow_val = min(ice_growth,growth_max)
611 : PVt = -min(abs(PV_scale_growth*(MJ1 + MJ2*grow_val &
612 : - MJ3*grow_val**2)), & ! LCOV_EXCL_LINE
613 10207639 : PV_frac_max*sk_l/dt)
614 : else ! ice_growth = -meltb/dt
615 : PVt = min(abs(PV_scale_melt *( MJ2*ice_growth &
616 : - MJ3*ice_growth**2)), & ! LCOV_EXCL_LINE
617 19407958 : PV_frac_max*sk_l/dt)
618 : endif
619 503465149 : do nn = 1, nbtrcr
620 503465149 : if (bgc_tracer_type(nn) >= c0) then
621 325771567 : if (ice_growth < c0) then ! flux from ice to ocean
622 : ! Algae and clinging tracers melt like nutrients
623 213487538 : f_meltn(nn) = PVt*cinit_v(nn) ! for algae only
624 113137299 : elseif (ice_growth > c0 .AND. &
625 853270 : cinit(nn) < ocean_bio(nn)*sk_l/phi_sk) then
626 : ! Growth only contributes to seeding from ocean
627 70452193 : congel_alg(nn) = (ocean_bio(nn)*sk_l/phi_sk - cinit(nn))/dt
628 : endif ! PVt > c0
629 : endif
630 : enddo
631 :
632 : else ! bgc_flux_type = 'constant'
633 :
634 : !-----------------------------------------------------------------
635 : ! 'constant':
636 : ! 1. Constant PV for congel > melt
637 : ! 2. For algae, PV for ice growth only provides a seeding concentration
638 : ! 3. Melt loss (f_meltn) affects algae only and is proportional to melt
639 : !-----------------------------------------------------------------
640 :
641 0 : if (ice_growth > c0) PVt = -PVc
642 0 : do nn = 1, nbtrcr
643 0 : if (bgc_tracer_type(nn) >= c0 ) then
644 0 : if (ice_growth >= c0 .AND. cinit_v(nn) < ocean_bio(nn)/phi_sk) then
645 0 : congel_alg(nn) = (ocean_bio(nn)*sk_l/phi_sk - cinit(nn))/dt
646 0 : elseif (ice_growth < c0) then
647 0 : f_meltn(nn) = min(c1, meltb/sk_l)*cinit(nn)/dt
648 : endif
649 : endif
650 : enddo ! nn
651 :
652 : endif ! bgc_flux_type
653 :
654 : !-----------------------------------------------------------------
655 : ! begin building biogeochemistry terms
656 : !-----------------------------------------------------------------
657 :
658 503465149 : react(:) = c0
659 118462388 : grow_alg_skl(:) = c0
660 :
661 : call algal_dyn (dt, &
662 : n_doc, n_dic, n_don, n_fed, n_fep, & ! LCOV_EXCL_LINE
663 : dEdd_algae, & ! LCOV_EXCL_LINE
664 : fswthru, react, & ! LCOV_EXCL_LINE
665 : cinit_v, & ! LCOV_EXCL_LINE
666 : grow_alg_skl(:), n_algae, & ! LCOV_EXCL_LINE
667 : iTin, & ! LCOV_EXCL_LINE
668 : upNOn(:), upNHn(:), & ! LCOV_EXCL_LINE
669 : Zoo_skl, & ! LCOV_EXCL_LINE
670 29615597 : Nerror, conserve_N)
671 29615597 : if (icepack_warnings_aborted(subname)) return
672 :
673 : !-----------------------------------------------------------------
674 : ! compute new tracer concencentrations
675 : !-----------------------------------------------------------------
676 :
677 503465149 : do nn = 1, nbtrcr
678 :
679 : !-----------------------------------------------------------------
680 : ! if PVt > 0, ie melt, then ocean_bio term drops out (MJ2006)
681 : ! Combine boundary fluxes
682 : !-----------------------------------------------------------------
683 :
684 473849552 : PVflag(nn) = SIGN(PVflag(nn),PVt)
685 473849552 : cinit_tmp = max(c0, cinit_v(nn) + react(nn))
686 1442448 : flux_bio_temp(nn) = (PVflag(nn)*PVt*cinit_tmp &
687 : - PVflag(nn)*min(c0,PVt)*ocean_bio(nn)) & ! LCOV_EXCL_LINE
688 475292000 : + f_meltn(nn)*cling(nn) - congel_alg(nn)
689 :
690 473849552 : if (cinit_tmp*sk_l < flux_bio_temp(nn)*dt) then
691 1737 : flux_bio_temp(nn) = cinit_tmp*sk_l/dt*(c1-puny)
692 : endif
693 :
694 473849552 : cinit(nn) = cinit_tmp*sk_l - flux_bio_temp(nn)*dt
695 473849552 : flux_bio(nn) = flux_bio(nn) + flux_bio_temp(nn)*phi_sk
696 :
697 : ! Uncomment to update ocean concentration
698 : ! Currently not coupled with ocean biogeochemistry
699 : ! ocean_bio(nn) = ocean_bio(nn) + flux_bio(nn)/hmix*aicen
700 :
701 473849552 : if (.not. conserve_N) then
702 0 : write(warnstr,*) subname, 'N not conserved in skl_bgc, Nerror:',Nerror
703 0 : call icepack_warnings_add(warnstr)
704 0 : write(warnstr,*) subname, 'sk_bgc < 0 after algal fluxes, nn,cinit,flux_bio',&
705 0 : nn,cinit(nn),flux_bio(nn)
706 0 : call icepack_warnings_add(warnstr)
707 0 : write(warnstr,*) subname, 'cinit_tmp,flux_bio_temp,f_meltn,congel_alg,PVt,PVflag: '
708 0 : call icepack_warnings_add(warnstr)
709 0 : write(warnstr,*) subname, cinit_tmp,flux_bio_temp(nn),f_meltn(nn), &
710 0 : congel_alg(nn),PVt,PVflag(nn)
711 0 : call icepack_warnings_add(warnstr)
712 0 : write(warnstr,*) subname, 'congel, meltb: ',congel,meltb
713 0 : call icepack_warnings_add(warnstr)
714 0 : call icepack_warnings_add(subname//' N not conserved in skl_bgc')
715 0 : call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
716 473849552 : elseif (cinit(nn) < c0) then
717 0 : write(warnstr,*) subname, 'sk_bgc < 0 after algal fluxes, nn,cinit,flux_bio',&
718 0 : nn,cinit(nn),flux_bio(nn)
719 0 : call icepack_warnings_add(warnstr)
720 0 : write(warnstr,*) subname, 'cinit_tmp,flux_bio_temp,f_meltn,congel_alg,PVt,PVflag: '
721 0 : call icepack_warnings_add(warnstr)
722 0 : write(warnstr,*) subname, cinit_tmp,flux_bio_temp(nn),f_meltn(nn), &
723 0 : congel_alg(nn),PVt,PVflag(nn)
724 0 : call icepack_warnings_add(warnstr)
725 0 : write(warnstr,*) subname, 'congel, meltb: ',congel,meltb
726 0 : call icepack_warnings_add(warnstr)
727 0 : call icepack_warnings_add(subname//'sk_bgc < 0 after algal fluxes')
728 0 : call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
729 : endif
730 :
731 473849552 : if (icepack_warnings_aborted(subname)) return
732 :
733 : !-----------------------------------------------------------------
734 : ! reload tracer array: Bulk tracer concentration (mmol or mg per m^3)
735 : !-----------------------------------------------------------------
736 :
737 503465149 : trcrn(bio_index(nn)) = cinit(nn) * phi_sk/sk_l
738 :
739 : enddo !nbtrcr
740 :
741 : end subroutine skl_biogeochemistry
742 :
743 : !=======================================================================
744 : !
745 : ! Solve the scalar vertical diffusion equation implicitly using
746 : ! tridiag_solver. Calculate the diffusivity from temperature and salinity.
747 : !
748 : ! NOTE: In this subroutine, trcrn(nt_fbri) is the volume fraction of ice with
749 : ! dynamic salinity or the height ratio == hinS/vicen*aicen, where hinS is the
750 : ! height of the brine surface relative to the bottom of the ice. This volume fraction
751 : ! may be > 1 in which case there is brine above the ice surface (meltponds).
752 : !
753 :
754 29795903 : subroutine z_biogeochemistry (n_cat, dt, &
755 : nilyr, & ! LCOV_EXCL_LINE
756 : nblyr, nbtrcr, & ! LCOV_EXCL_LINE
757 : n_algae, n_doc, & ! LCOV_EXCL_LINE
758 : n_dic, n_don, & ! LCOV_EXCL_LINE
759 : n_fed, n_fep, & ! LCOV_EXCL_LINE
760 : n_zaero, first_ice, & ! LCOV_EXCL_LINE
761 : aicen, vicen, & ! LCOV_EXCL_LINE
762 : hice_old, ocean_bio, & ! LCOV_EXCL_LINE
763 : flux_bio, bphin, & ! LCOV_EXCL_LINE
764 : iphin, trcrn, & ! LCOV_EXCL_LINE
765 : iDin, & ! LCOV_EXCL_LINE
766 : fswthrul, grow_alg, & ! LCOV_EXCL_LINE
767 : upNOn, upNHn, & ! LCOV_EXCL_LINE
768 : dh_top, dh_bot, & ! LCOV_EXCL_LINE
769 : zfswin, hbri, & ! LCOV_EXCL_LINE
770 : hbri_old, darcy_V, & ! LCOV_EXCL_LINE
771 : ! darcy_V_chl, bgrid, & ! LCOV_EXCL_LINE
772 : bgrid, & ! LCOV_EXCL_LINE
773 : i_grid, ic_grid, & ! LCOV_EXCL_LINE
774 : bphi_min, zbgc_snow, & ! LCOV_EXCL_LINE
775 : zbgc_atm, & ! LCOV_EXCL_LINE
776 : iTin, dh_direct, & ! LCOV_EXCL_LINE
777 : Zoo, meltb, & ! LCOV_EXCL_LINE
778 : congel )
779 :
780 : integer (kind=int_kind), intent(in) :: &
781 : n_cat, & ! category number ! LCOV_EXCL_LINE
782 : nilyr, & ! number of ice layers ! LCOV_EXCL_LINE
783 : nblyr, & ! number of bio layers ! LCOV_EXCL_LINE
784 : nbtrcr, n_algae, & ! number of bgc tracers, number of autotrophs ! LCOV_EXCL_LINE
785 : n_zaero, & ! number of aerosols ! LCOV_EXCL_LINE
786 : n_doc, n_dic, n_don, n_fed, n_fep
787 :
788 : logical (kind=log_kind), intent(in) :: &
789 : first_ice ! initialized values should be used
790 :
791 : real (kind=dbl_kind), intent(in) :: &
792 : dt , & ! time step ! LCOV_EXCL_LINE
793 : hbri , & ! brine height (m) ! LCOV_EXCL_LINE
794 : bphi_min , & ! surface porosity ! LCOV_EXCL_LINE
795 : aicen , & ! concentration of ice ! LCOV_EXCL_LINE
796 : vicen , & ! volume per unit area of ice (m) ! LCOV_EXCL_LINE
797 : hice_old , & ! ice height (m) ! LCOV_EXCL_LINE
798 : meltb , & ! bottom melt in dt (m) ! LCOV_EXCL_LINE
799 : congel , & ! bottom growth in dt (m) ! LCOV_EXCL_LINE
800 : darcy_V , & ! darcy velocity ! LCOV_EXCL_LINE
801 : ! darcy_V_chl, & ! darcy velocity for algae ! LCOV_EXCL_LINE
802 : dh_bot , & ! change in brine bottom (m) ! LCOV_EXCL_LINE
803 : dh_top , & ! change in brine top (m) ! LCOV_EXCL_LINE
804 : dh_direct ! surface flooding or runoff (m)
805 :
806 : real (kind=dbl_kind), dimension (:), intent(inout) :: &
807 : bgrid , & ! biology nondimensional vertical grid points ! LCOV_EXCL_LINE
808 : flux_bio , & ! total ocean tracer flux (mmol/m^2/s) ! LCOV_EXCL_LINE
809 : zfswin , & ! visible Short wave flux on igrid (W/m^2) ! LCOV_EXCL_LINE
810 : Zoo , & ! N losses to the system from reaction terms ! LCOV_EXCL_LINE
811 : ! (ie. zooplankton/bacteria) (mmol/m^3)
812 : trcrn ! bulk tracer concentration (mmol/m^3)
813 :
814 : real (kind=dbl_kind), dimension (:), intent(in) :: &
815 : i_grid , & ! biology vertical interface points ! LCOV_EXCL_LINE
816 : iTin , & ! salinity vertical interface points ! LCOV_EXCL_LINE
817 : iphin , & ! Porosity on the igrid ! LCOV_EXCL_LINE
818 : iDin , & ! Diffusivity/h on the igrid (1/s) ! LCOV_EXCL_LINE
819 : ic_grid , & ! CICE interface coordinate ! LCOV_EXCL_LINE
820 : fswthrul , & ! visible short wave radiation on icgrid (W/m^2) ! LCOV_EXCL_LINE
821 : zbgc_snow , & ! tracer input from snow (mmol/m^3*m) ! LCOV_EXCL_LINE
822 : zbgc_atm , & ! tracer input from atm (mmol/m^3 *m) ! LCOV_EXCL_LINE
823 : ocean_bio , & ! ocean concentrations (mmol/m^3) ! LCOV_EXCL_LINE
824 : bphin ! Porosity on the bgrid
825 :
826 : real (kind=dbl_kind), intent(inout) :: &
827 : hbri_old ! brine height (m)
828 :
829 : real (kind=dbl_kind), dimension (:,:), intent(out) :: &
830 : upNOn , & ! algal nitrate uptake rate (mmol/m^3/s) ! LCOV_EXCL_LINE
831 : upNHn , & ! algal ammonium uptake rate (mmol/m^3/s) ! LCOV_EXCL_LINE
832 : grow_alg ! algal growth rate (mmol/m^3/s)
833 :
834 : !-----------------------------------------------------------------------------
835 : ! algae absorption coefficient for 0.5 m thick layer
836 : ! Grenfell (1991): SA = specific absorption coefficient= 0.004 m^2/mg Chla
837 : ! generalizing kalg_bio(k) = SA*\sum R_chl2N(m)*trcrn(i,j,nt_bgc_N(m)+k-1)
838 : ! output kalg on the icgrid
839 : !-----------------------------------------------------------------------------
840 :
841 : ! local variables
842 :
843 : integer (kind=int_kind) :: &
844 : k, m, mm ! vertical biology layer index
845 :
846 : real (kind=dbl_kind) :: &
847 : hin , & ! ice thickness (m) ! LCOV_EXCL_LINE
848 : hin_old , & ! ice thickness before current melt/growth (m) ! LCOV_EXCL_LINE
849 : ice_conc , & ! algal concentration in ice above hin > hinS ! LCOV_EXCL_LINE
850 : sum_old , & ! ! LCOV_EXCL_LINE
851 : sum_new , & ! ! LCOV_EXCL_LINE
852 : sum_tot , & ! ! LCOV_EXCL_LINE
853 : zspace , & ! 1/nblyr ! LCOV_EXCL_LINE
854 : darcyV , & ! ! LCOV_EXCL_LINE
855 : dhtop , & ! ! LCOV_EXCL_LINE
856 : dhbot , & ! ! LCOV_EXCL_LINE
857 90153 : dhflood ! >=0 (m) surface flooding from the ocean
858 :
859 : real (kind=dbl_kind), dimension (nblyr+2) :: &
860 60313030 : bphin_N ! porosity for tracer model has minimum
861 : ! bphin_N >= bphimin
862 :
863 : real (kind=dbl_kind), dimension (nblyr+1) :: &
864 : iphin_N , & ! tracer porosity on the igrid ! LCOV_EXCL_LINE
865 : sbdiagz , & ! sub-diagonal matrix elements ! LCOV_EXCL_LINE
866 : diagz , & ! diagonal matrix elements ! LCOV_EXCL_LINE
867 : spdiagz , & ! super-diagonal matrix elements ! LCOV_EXCL_LINE
868 : rhsz , & ! rhs of tri-diagonal matrix equation ! LCOV_EXCL_LINE
869 : ML_diag , & ! lumped mass matrix ! LCOV_EXCL_LINE
870 : D_spdiag , & ! artificial diffusion matrix ! LCOV_EXCL_LINE
871 : D_sbdiag , & ! artificial diffusion matrix ! LCOV_EXCL_LINE
872 : biomat_low , & ! Low order solution ! LCOV_EXCL_LINE
873 60222877 : Nerror ! Change in N after reactions
874 :
875 : real (kind=dbl_kind), dimension(nblyr+1,nbtrcr):: &
876 74917816 : react ! biological sources and sinks for equation matrix
877 :
878 : real (kind=dbl_kind), dimension(nblyr+1,nbtrcr):: &
879 : in_init_cons , & ! Initial bulk concentration*h (mmol/m^2) ! LCOV_EXCL_LINE
880 : biomat_cons , & ! Matrix output of (mmol/m^2) ! LCOV_EXCL_LINE
881 74917816 : biomat_brine ! brine concentration (mmol/m^3)
882 :
883 : real (kind=dbl_kind), dimension(nbtrcr):: &
884 : C_top, & ! bulk top tracer source: h phi C(meltwater) (mmol/m^2) ! LCOV_EXCL_LINE
885 : C_bot, & ! bulk bottom tracer source: h phi C(ocean) (mmol/m^2) ! LCOV_EXCL_LINE
886 : Source_top, & ! For cons: (+) top tracer source into ice (mmol/m^2/s) ! LCOV_EXCL_LINE
887 : Source_bot, & ! For cons: (+) bottom tracer source into ice (mmol/m^2/s) ! LCOV_EXCL_LINE
888 : Sink_bot, & ! For cons: (+ or -) remaining bottom flux into ice(mmol/m^2/s) ! LCOV_EXCL_LINE
889 : Sink_top, & ! For cons: (+ or -) remaining bottom flux into ice(mmol/m^2/s) ! LCOV_EXCL_LINE
890 : exp_ret, & ! exp dt/retention frequency ! LCOV_EXCL_LINE
891 : exp_rel, & ! exp dt/release frequency ! LCOV_EXCL_LINE
892 : atm_add_cons , & ! zbgc_snow+zbgc_atm (mmol/m^3*m) ! LCOV_EXCL_LINE
893 : dust_Fe , & ! contribution of dust surface flux to dFe (umol/m*3*m) ! LCOV_EXCL_LINE
894 61214560 : source ! mmol/m^2 surface input from snow/atmosphere
895 :
896 : real (kind=dbl_kind), dimension (ntrcr+2) :: &
897 : trtmp0 , & ! temporary, remapped tracers ! LCOV_EXCL_LINE
898 80777761 : trtmp ! temporary, remapped tracers
899 :
900 : logical (kind=log_kind), dimension(nblyr+1) :: &
901 59591806 : conserve_N
902 :
903 : real (kind=dbl_kind), dimension(nblyr+1):: & ! temporary variables for
904 : Diff , & ! diffusivity ! LCOV_EXCL_LINE
905 : initcons , & ! initial concentration ! LCOV_EXCL_LINE
906 : biocons , & ! new concentration ! LCOV_EXCL_LINE
907 : dmobile , & ! ! LCOV_EXCL_LINE
908 : initcons_mobile,&! ! LCOV_EXCL_LINE
909 60222877 : initcons_stationary
910 :
911 : real (kind=dbl_kind):: &
912 90153 : top_conc ! 1% (min_bgc) of surface concentration
913 : ! when hin > hbri: just used in sw calculation
914 :
915 : real (kind=dbl_kind):: &
916 : bio_tmp, & ! temporary variable ! LCOV_EXCL_LINE
917 90153 : exp_min ! temporary exp var
918 :
919 : real (kind=dbl_kind):: &
920 : Sat_conc , & ! adsorbing saturation concentration (mmols/m^3) ! LCOV_EXCL_LINE
921 : phi_max , & ! maximum porosity ! LCOV_EXCL_LINE
922 : S_col , & ! surface area of collector (um^2) ! LCOV_EXCL_LINE
923 : P_b , & ! projected area of diatoms (um^2) ! LCOV_EXCL_LINE
924 : V_c , & ! volume of collector (um^3) ! LCOV_EXCL_LINE
925 90153 : V_alg ! volume of algae (um^3)
926 :
927 : real (kind=dbl_kind), dimension(nbtrcr) :: &
928 31689116 : mobile ! c1 if mobile, c0 otherwise
929 :
930 : ! local parameters
931 :
932 : real (kind=dbl_kind), parameter :: &
933 : accuracy = 1.0e-14_dbl_kind, & ! LCOV_EXCL_LINE
934 : r_c = 3.0e3_dbl_kind , & ! ice crystal radius (um) ! LCOV_EXCL_LINE
935 : r_bac= 15.0_dbl_kind , & ! diatom large radius (um) ! LCOV_EXCL_LINE
936 : r_alg= 10.0_dbl_kind , & ! diatom small radius (um) ! LCOV_EXCL_LINE
937 : N_vol = 0.04e-12_dbl_kind , & ! (g) Nitrogen per um^3 ! LCOV_EXCL_LINE
938 : Ng_to_mmol =0.0140067_dbl_kind , & ! (g/mmol) Nitrogen ! LCOV_EXCL_LINE
939 : f_s = c1 , & ! fracton of sites available for saturation ! LCOV_EXCL_LINE
940 : f_a = c1 , & ! fraction of collector available for attachment ! LCOV_EXCL_LINE
941 : f_v = 0.7854 ! fraction of algal coverage on area availabel for attachment
942 : ! 4(pi r^2)/(4r)^2 [Johnson et al, 1995, water res. research]
943 :
944 : integer, parameter :: &
945 : nt_zfswin = 1 ! for interpolation of short wave to bgrid
946 :
947 : character(len=*),parameter :: subname='(z_biogeochemistry)'
948 :
949 : !-------------------------------------
950 : ! Initialize
951 : !-----------------------------------
952 :
953 29795903 : zspace = c1/real(nblyr,kind=dbl_kind)
954 5124895316 : in_init_cons(:,:) = c0
955 595918060 : atm_add_cons(:) = c0
956 29795903 : dhtop = c0
957 29795903 : dhbot = c0
958 29795903 : darcyV = c0
959 595918060 : C_top(:) = c0
960 595918060 : mobile(:) = c0
961 268163127 : conserve_N(:) = .true.
962 :
963 595918060 : do m = 1, nbtrcr
964 5124895316 : do k = 1, nblyr+1
965 :
966 4528977256 : bphin_N(nblyr+2) =c1
967 4528977256 : bphin_N(k) = bphin(k)
968 4528977256 : iphin_N(k) = iphin(k)
969 4528977256 : bphin_N(1) = bphi_min
970 :
971 4528977256 : if (first_ice) then
972 16542312 : trcrn(bio_index(m) + k-1) = ocean_bio(m)*zbgc_init_frac(m)
973 16542312 : in_init_cons(k,m) = trcrn(bio_index(m) + k-1)*hbri_old
974 4512434944 : elseif (abs(trcrn(bio_index(m) + k-1)) < puny) then
975 397076129 : trcrn(bio_index(m) + k-1) = c0
976 397076129 : in_init_cons(k,m) = c0
977 : else
978 4115358815 : in_init_cons(k,m) = trcrn(bio_index(m) + k-1)* hbri_old
979 : endif ! first_ice
980 :
981 4528977256 : if (trcrn(bio_index(m) + k-1) < c0 ) then
982 0 : write(warnstr,*) subname,'zbgc initialization error, first ice = ', first_ice
983 0 : call icepack_warnings_add(warnstr)
984 0 : write(warnstr,*) subname,'Category,m:',n_cat,m
985 0 : call icepack_warnings_add(warnstr)
986 0 : write(warnstr,*) subname,'hbri,hbri_old'
987 0 : call icepack_warnings_add(warnstr)
988 0 : write(warnstr,*) subname, hbri,hbri_old
989 0 : call icepack_warnings_add(warnstr)
990 0 : write(warnstr,*) subname,'trcrn(bio_index(m) + k-1)'
991 0 : call icepack_warnings_add(warnstr)
992 0 : write(warnstr,*) subname, trcrn(bio_index(m) + k-1)
993 0 : call icepack_warnings_add(warnstr)
994 0 : call icepack_warnings_add(subname//' zbgc initialization error')
995 0 : call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
996 : endif
997 5095099413 : if (icepack_warnings_aborted(subname)) return
998 : enddo !k
999 : enddo !m
1000 :
1001 : !-----------------------------------------------------------------
1002 : ! boundary conditions
1003 : !-----------------------------------------------------------------
1004 :
1005 29795903 : ice_conc = c0
1006 29795903 : hin = vicen/aicen
1007 29795903 : hin_old = hice_old
1008 :
1009 : !-----------------------------------------------------------------
1010 : ! calculate the saturation concentration for attachment: Sat_conc
1011 : !-----------------------------------------------------------------
1012 :
1013 268163127 : phi_max = maxval(bphin_N(2:nblyr+1))
1014 29795903 : S_col = 4.0_dbl_kind*pi*r_c**2
1015 29795903 : P_b = pi*r_bac**2 !*10-6 for colloids
1016 29795903 : V_c = 4.0_dbl_kind*pi*r_c**3/3.0_dbl_kind*(1.0e-6_dbl_kind)**3 ! (m^3) sphere
1017 29795903 : V_alg = pi/6.0_dbl_kind*r_bac*r_alg**2 ! prolate spheroid (*10-9 for colloids)
1018 29795903 : Sat_conc= f_s*f_a*f_v*(c1-phi_max)/V_c*S_col/P_b*N_vol*V_alg/Ng_to_mmol
1019 : !mmol/m^3 (algae, don, hum...) and umols/m^3 for colloids
1020 :
1021 : !-----------------------------------------------------------------
1022 : ! convert surface dust flux (n_zaero > 2) to dFe(1) flux
1023 : !-----------------------------------------------------------------
1024 :
1025 595918060 : dust_Fe(:) = c0
1026 :
1027 29795903 : if (tr_zaero .and. n_zaero > 2 .and. tr_bgc_Fe) then
1028 59591806 : do m = 3,n_zaero
1029 180306 : dust_Fe(nlt_bgc_Fed(1)) = dust_Fe(nlt_bgc_Fed(1)) + &
1030 : (zbgc_snow(nlt_zaero(m)) + zbgc_atm(nlt_zaero(m))) * & ! LCOV_EXCL_LINE
1031 59952418 : R_dFe2dust * dustFe_sol
1032 : ! dust_Fe(nlt_zaero(m)) = -(zbgc_snow(nlt_zaero(m)) + zbgc_atm(nlt_zaero(m))) * &
1033 : ! dustFe_sol
1034 : enddo
1035 : endif
1036 :
1037 595918060 : do m = 1,nbtrcr
1038 : !-----------------------------------------------------------------
1039 : ! time constants for mobile/stationary phase changes
1040 : !-----------------------------------------------------------------
1041 :
1042 566122157 : exp_rel(m) = c0
1043 566122157 : exp_ret(m) = c0
1044 566122157 : if (tau_ret(m) > c0) then
1045 566122157 : exp_min = min(dt/tau_ret(m),exp_argmax)
1046 566122157 : exp_ret(m) = exp(-exp_min)
1047 : endif
1048 566122157 : if (tau_rel(m) > c0) then
1049 566122157 : exp_min = min(dt/tau_rel(m),exp_argmax)
1050 566122157 : exp_rel(m) = exp(-exp_min)
1051 : endif
1052 566122157 : if (m .ne. nlt_bgc_N(1)) then
1053 536326254 : if (hin_old > hin) then !melting
1054 353499120 : exp_ret(m) = c1
1055 : else !not melting
1056 182827134 : exp_rel(m) = c1
1057 : endif
1058 29795903 : elseif (tr_bgc_N .and. hin_old > hin + algal_vel*dt) then
1059 11395275 : exp_ret(m) = c1
1060 18400628 : elseif (tr_bgc_N) then
1061 18400628 : exp_rel(m) = c1
1062 : endif
1063 :
1064 566122157 : dhtop = dh_top
1065 566122157 : dhbot = dh_bot
1066 566122157 : darcyV = darcy_V
1067 566122157 : C_top(m) = in_init_cons(1,m)*trcrn(nt_zbgc_frac+m-1)!mobile fraction
1068 566122157 : source(m) = abs(zbgc_snow(m) + zbgc_atm(m) + dust_Fe(m))
1069 566122157 : dhflood = max(c0,-dh_direct) ! ocean water flooding surface
1070 :
1071 566122157 : if (dhtop+darcyV/bphin_N(1)*dt < -puny) then !snow/top ice melt
1072 95494 : C_top(m) = (zbgc_snow(m)+zbgc_atm(m) + dust_Fe(m))/abs(dhtop &
1073 133936187 : + darcyV/bphin_N(1)*dt + puny)*hbri_old
1074 433803383 : elseif (dhtop+darcyV/bphin_N(1)*dt >= -puny .and. &
1075 : abs((zbgc_snow(m)+zbgc_atm(m) + dust_Fe(m)) + & ! LCOV_EXCL_LINE
1076 1617413 : ocean_bio(m)*bphin_N(1)*dhflood) > puny) then
1077 142070 : atm_add_cons(m) = abs(zbgc_snow(m) + zbgc_atm(m)+ dust_Fe(m)) + &
1078 16685026 : ocean_bio(m)*bphin_N(1)*dhflood
1079 : else ! only positive fluxes
1080 415500944 : atm_add_cons(m) = abs(zbgc_snow(m) + zbgc_atm(m)+ dust_Fe(m))
1081 : endif
1082 :
1083 595918060 : C_bot(m) = ocean_bio(m)*hbri_old*iphin_N(nblyr+1)
1084 :
1085 : enddo ! m
1086 :
1087 : !-----------------------------------------------------------------
1088 : ! Interpolate shortwave flux, fswthrul (defined at top to bottom with nilyr+1
1089 : ! evenly spaced with spacing = (1/nilyr) to grid variable zfswin:
1090 : !-----------------------------------------------------------------
1091 :
1092 7061629011 : trtmp(:) = c0
1093 7061629011 : trtmp0(:)= c0
1094 268163127 : zfswin(:) = c0
1095 :
1096 268163127 : do k = 1, nilyr+1
1097 : ! contains cice values (fswthrul(1) is surface value)
1098 : ! and fwsthrul(nilyr+1) is output
1099 268163127 : trtmp0(nt_zfswin+k-1) = fswthrul(k)
1100 : enddo !k
1101 :
1102 : call remap_zbgc(nilyr+1, &
1103 : nt_zfswin, & ! LCOV_EXCL_LINE
1104 : trtmp0(1:ntrcr), trtmp(1:ntrcr+2), & ! LCOV_EXCL_LINE
1105 : 0, nblyr+1, & ! LCOV_EXCL_LINE
1106 : hin, hbri, & ! LCOV_EXCL_LINE
1107 : ic_grid(1:nilyr+1), & ! LCOV_EXCL_LINE
1108 29795903 : i_grid(1:nblyr+1),ice_conc )
1109 :
1110 29795903 : if (icepack_warnings_aborted(subname)) return
1111 :
1112 268163127 : do k = 1,nblyr+1
1113 268163127 : zfswin(k) = trtmp(nt_zfswin+k-1)
1114 : enddo
1115 :
1116 : !-----------------------------------------------------------------
1117 : ! Initialze Biology
1118 : !-----------------------------------------------------------------
1119 :
1120 595918060 : do mm = 1, nbtrcr
1121 566122157 : mobile(mm) = c0
1122 566122157 : if (bgc_tracer_type(mm) .GE. c0) mobile(mm) = c1
1123 :
1124 5124895316 : do k = 1, nblyr+1
1125 5095099413 : biomat_cons(k,mm) = in_init_cons(k,mm)
1126 : enddo !k
1127 : enddo !mm
1128 :
1129 : !-----------------------------------------------------------------
1130 : ! Compute FCT
1131 : !-----------------------------------------------------------------
1132 :
1133 595918060 : do mm = 1, nbtrcr
1134 :
1135 566122157 : if (hbri_old > thinS .and. hbri > thinS) then
1136 4938705207 : do k = 1,nblyr+1
1137 4389960184 : initcons_mobile(k) = in_init_cons(k,mm)*trcrn(nt_zbgc_frac+mm-1)
1138 4389960184 : initcons_stationary(k) = mobile(mm)*(in_init_cons(k,mm)-initcons_mobile(k))
1139 12320664 : dmobile(k) = mobile(mm)*(initcons_mobile(k)*(exp_ret(mm)-c1) + &
1140 4389960184 : initcons_stationary(k)*(c1-exp_rel(mm)))
1141 4389960184 : initcons_mobile(k) = max(c0,initcons_mobile(k) + dmobile(k))
1142 4389960184 : initcons_stationary(k) = max(c0,initcons_stationary(k) - dmobile(k))
1143 4389960184 : if (initcons_stationary(k)/hbri_old > Sat_conc) then
1144 0 : initcons_mobile(k) = initcons_mobile(k) + initcons_stationary(k) - Sat_conc*hbri_old
1145 0 : initcons_stationary(k) = Sat_conc*hbri_old
1146 : endif
1147 :
1148 4389960184 : Diff(k) = iDin(k)
1149 4389960184 : initcons(k) = initcons_mobile(k)
1150 4938705207 : biocons(k) = initcons_mobile(k)
1151 : enddo
1152 :
1153 : call compute_FCT_matrix &
1154 : (initcons,sbdiagz, dt, nblyr, & ! LCOV_EXCL_LINE
1155 : diagz, spdiagz, rhsz, bgrid, & ! LCOV_EXCL_LINE
1156 : darcyV, dhtop, & ! LCOV_EXCL_LINE
1157 : dhbot, iphin_N, & ! LCOV_EXCL_LINE
1158 : Diff, hbri_old, & ! LCOV_EXCL_LINE
1159 : atm_add_cons(mm), bphin_N, & ! LCOV_EXCL_LINE
1160 : C_top(mm), C_bot(mm), & ! LCOV_EXCL_LINE
1161 : Source_bot(mm), Source_top(mm),& ! LCOV_EXCL_LINE
1162 : Sink_bot(mm),Sink_top(mm), & ! LCOV_EXCL_LINE
1163 550285106 : D_sbdiag, D_spdiag, ML_diag)
1164 548745023 : if (icepack_warnings_aborted(subname)) return
1165 :
1166 : call tridiag_solverz &
1167 : (nblyr+1, sbdiagz, & ! LCOV_EXCL_LINE
1168 : diagz, spdiagz, & ! LCOV_EXCL_LINE
1169 548745023 : rhsz, biocons)
1170 548745023 : if (icepack_warnings_aborted(subname)) return
1171 :
1172 : call check_conservation_FCT &
1173 : (initcons, & ! LCOV_EXCL_LINE
1174 : biocons, & ! LCOV_EXCL_LINE
1175 : biomat_low, & ! LCOV_EXCL_LINE
1176 : Source_top(mm), & ! LCOV_EXCL_LINE
1177 : Source_bot(mm), & ! LCOV_EXCL_LINE
1178 : Sink_bot(mm), & ! LCOV_EXCL_LINE
1179 : Sink_top(mm), & ! LCOV_EXCL_LINE
1180 : dt, flux_bio(mm), & ! LCOV_EXCL_LINE
1181 : nblyr, & ! LCOV_EXCL_LINE
1182 548745023 : source(mm))
1183 548745023 : if (icepack_warnings_aborted(subname)) return
1184 :
1185 : call compute_FCT_corr &
1186 : (initcons, & ! LCOV_EXCL_LINE
1187 : biocons, dt, nblyr, & ! LCOV_EXCL_LINE
1188 548745023 : D_sbdiag, D_spdiag, ML_diag)
1189 548745023 : if (icepack_warnings_aborted(subname)) return
1190 :
1191 548745023 : top_conc = c0 ! or frazil ice concentration
1192 :
1193 : ! assume diatoms actively maintain there relative position in the ice
1194 :
1195 548745023 : if (mm .ne. nlt_bgc_N(1)) then
1196 :
1197 : call regrid_stationary &
1198 : (initcons_stationary, hbri_old, & ! LCOV_EXCL_LINE
1199 : hbri, dt, & ! LCOV_EXCL_LINE
1200 : ntrcr, & ! LCOV_EXCL_LINE
1201 : nblyr, top_conc, & ! LCOV_EXCL_LINE
1202 : i_grid, flux_bio(mm),& ! LCOV_EXCL_LINE
1203 521322732 : meltb, congel)
1204 519863706 : if (icepack_warnings_aborted(subname)) return
1205 :
1206 28881317 : elseif (tr_bgc_N .and. mm .eq. nlt_bgc_N(1)) then
1207 28881317 : if (meltb > algal_vel*dt .or. aicen < 0.001_dbl_kind) then
1208 :
1209 : call regrid_stationary &
1210 : (initcons_stationary, hbri_old, & ! LCOV_EXCL_LINE
1211 : hbri, dt, & ! LCOV_EXCL_LINE
1212 : ntrcr, & ! LCOV_EXCL_LINE
1213 : nblyr, top_conc, & ! LCOV_EXCL_LINE
1214 : i_grid, flux_bio(mm),& ! LCOV_EXCL_LINE
1215 18298519 : meltb, congel)
1216 18235243 : if (icepack_warnings_aborted(subname)) return
1217 :
1218 : endif
1219 : endif
1220 :
1221 4938705207 : biomat_cons(:,mm) = biocons(:) + initcons_stationary(:)
1222 :
1223 548745023 : sum_old = (biomat_low(1) + biomat_low(nblyr+1))*zspace/c2
1224 548745023 : sum_new = (biocons(1)+ biocons(nblyr+1))*zspace/c2
1225 548745023 : sum_tot = (biomat_cons(1,mm) + biomat_cons(nblyr+1,mm))*zspace/c2
1226 3841215161 : do k = 2,nblyr
1227 3292470138 : sum_old = sum_old + biomat_low(k)*zspace
1228 3292470138 : sum_new = sum_new + biocons(k)*zspace
1229 3841215161 : sum_tot = sum_tot + biomat_cons(k,mm)*zspace
1230 : enddo
1231 548745023 : trcrn(nt_zbgc_frac+mm-1) = zbgc_frac_init(mm)
1232 548745023 : if (sum_tot > c0 .and. mobile(mm) > c0) trcrn(nt_zbgc_frac+mm-1) = sum_new/sum_tot
1233 :
1234 : if (abs(sum_new-sum_old) > accuracy*sum_old .or. &
1235 : minval(biocons(:)) < c0 .or. minval(initcons_stationary(:)) < c0 & ! LCOV_EXCL_LINE
1236 10426155437 : .or. icepack_warnings_aborted()) then
1237 0 : write(warnstr,*) subname,'zbgc FCT tracer solution failed'
1238 0 : call icepack_warnings_add(warnstr)
1239 0 : write(warnstr,*) subname,'sum_new,sum_old:',sum_new,sum_old
1240 0 : call icepack_warnings_add(warnstr)
1241 0 : write(warnstr,*) subname,'mm,biocons(:):',mm,biocons(:)
1242 0 : call icepack_warnings_add(warnstr)
1243 0 : write(warnstr,*) subname,'biomat_low:',biomat_low
1244 0 : call icepack_warnings_add(warnstr)
1245 0 : write(warnstr,*) subname,'Diff(:):',Diff(:)
1246 0 : call icepack_warnings_add(warnstr)
1247 0 : write(warnstr,*) subname,'dmobile(:):',dmobile(:)
1248 0 : call icepack_warnings_add(warnstr)
1249 0 : write(warnstr,*) subname,'mobile(mm):',mobile(mm)
1250 0 : call icepack_warnings_add(warnstr)
1251 0 : write(warnstr,*) subname,'initcons_stationary(:):',initcons_stationary(:)
1252 0 : call icepack_warnings_add(warnstr)
1253 0 : write(warnstr,*) subname, 'trcrn(nt_zbgc_frac+mm-1):',trcrn(nt_zbgc_frac+mm-1)
1254 0 : call icepack_warnings_add(warnstr)
1255 0 : write(warnstr,*) subname, 'in_init_cons(:,mm):',in_init_cons(:,mm)
1256 0 : call icepack_warnings_add(warnstr)
1257 0 : write(warnstr,*) subname, 'exp_ret( mm),exp_rel( mm)',exp_ret( mm),exp_rel( mm)
1258 0 : call icepack_warnings_add(warnstr)
1259 0 : write(warnstr,*) subname,'darcyV,dhtop,dhbot'
1260 0 : call icepack_warnings_add(warnstr)
1261 0 : write(warnstr,*) subname,darcyV,dhtop,dhbot
1262 0 : call icepack_warnings_add(warnstr)
1263 0 : write(warnstr,*) subname,'Category,mm:',n_cat,mm
1264 0 : call icepack_warnings_add(warnstr)
1265 0 : call icepack_warnings_add(subname//'zbgc FCT tracer solution failed')
1266 0 : call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
1267 : endif
1268 548745023 : if (icepack_warnings_aborted(subname)) return
1269 :
1270 : else
1271 :
1272 0 : call thin_ice_flux(hbri,hbri_old,biomat_cons(:,mm), &
1273 : flux_bio(mm),source(mm), & ! LCOV_EXCL_LINE
1274 17549958 : dt, nblyr,ocean_bio(mm))
1275 17377134 : if (icepack_warnings_aborted(subname)) return
1276 :
1277 : endif ! thin or not
1278 :
1279 5124895316 : do k = 1,nblyr+1
1280 5095099413 : biomat_brine(k,mm) = biomat_cons(k,mm)/hbri/iphin_N(k)
1281 : enddo ! k
1282 : enddo ! mm
1283 :
1284 5124895316 : react(:,:) = c0
1285 834285284 : grow_alg(:,:) = c0
1286 :
1287 29795903 : if (solve_zbgc) then
1288 268163127 : do k = 1, nblyr+1
1289 : call algal_dyn (dt, &
1290 : n_doc, n_dic, n_don, n_fed, n_fep, & ! LCOV_EXCL_LINE
1291 : dEdd_algae, & ! LCOV_EXCL_LINE
1292 : zfswin(k), react(k,:), & ! LCOV_EXCL_LINE
1293 : biomat_brine(k,:), & ! LCOV_EXCL_LINE
1294 : grow_alg(k,:), n_algae, & ! LCOV_EXCL_LINE
1295 : iTin(k), & ! LCOV_EXCL_LINE
1296 : upNOn(k,:), upNHn(k,:), & ! LCOV_EXCL_LINE
1297 : Zoo(k), & ! LCOV_EXCL_LINE
1298 239809672 : Nerror(k), conserve_N(k))
1299 268163127 : if (icepack_warnings_aborted(subname)) return
1300 :
1301 : enddo ! k
1302 : endif ! solve_zbgc
1303 :
1304 : !-----------------------------------------------------------------
1305 : ! Update the tracer variable
1306 : !-----------------------------------------------------------------
1307 :
1308 595918060 : do m = 1,nbtrcr
1309 5124895316 : do k = 1,nblyr+1 ! back to bulk quantity
1310 4528977256 : bio_tmp = (biomat_brine(k,m) + react(k,m))*iphin_N(k)
1311 :
1312 4528977256 : if (.not. conserve_N(k)) then
1313 0 : write(warnstr,*) subname, 'N in algal_dyn not conserved'
1314 0 : call icepack_warnings_add(warnstr)
1315 0 : write(warnstr,*) subname, 'Nerror(k):', Nerror(k)
1316 0 : call icepack_warnings_add(warnstr)
1317 0 : write(warnstr,*) subname, 'k,m,hbri,hbri_old,bio_tmp,biomat_cons(k,m),ocean_bio(m)'
1318 0 : call icepack_warnings_add(warnstr)
1319 0 : write(warnstr,*) subname, k,m,hbri,hbri_old,bio_tmp,biomat_cons(k,m),ocean_bio(m)
1320 0 : call icepack_warnings_add(warnstr)
1321 0 : write(warnstr,*) subname, 'react(k,m),iphin_N(k),biomat_brine(k,m)'
1322 0 : call icepack_warnings_add(warnstr)
1323 0 : write(warnstr,*) subname, react(k,m),iphin_N(k),biomat_brine(k,m)
1324 0 : call icepack_warnings_add(warnstr)
1325 0 : call icepack_warnings_add(subname//' N in algal_dyn not conserved')
1326 0 : call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
1327 4528977256 : elseif (abs(bio_tmp) < puny) then
1328 399357234 : bio_tmp = c0
1329 4129620022 : elseif (bio_tmp > 1.0e6_dbl_kind) then
1330 0 : write(warnstr,*) subname, 'very large bgc value'
1331 0 : call icepack_warnings_add(warnstr)
1332 0 : write(warnstr,*) subname, 'k,m,hbri,hbri_old,bio_tmp,biomat_cons(k,m),ocean_bio(m)'
1333 0 : call icepack_warnings_add(warnstr)
1334 0 : write(warnstr,*) subname, k,m,hbri,hbri_old,bio_tmp,biomat_cons(k,m),ocean_bio(m)
1335 0 : call icepack_warnings_add(warnstr)
1336 0 : write(warnstr,*) subname, 'react(k,m),iphin_N(k),biomat_brine(k,m)'
1337 0 : call icepack_warnings_add(warnstr)
1338 0 : write(warnstr,*) subname, react(k,m),iphin_N(k),biomat_brine(k,m)
1339 0 : call icepack_warnings_add(warnstr)
1340 0 : call icepack_warnings_add(subname//' very large bgc value')
1341 0 : call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
1342 4129620022 : elseif (bio_tmp < c0) then
1343 0 : write(warnstr,*) subname, 'negative bgc'
1344 0 : call icepack_warnings_add(warnstr)
1345 0 : write(warnstr,*) subname, 'k,m,nlt_bgc_Nit,hbri,hbri_old'
1346 0 : call icepack_warnings_add(warnstr)
1347 0 : write(warnstr,*) subname, k,m,nlt_bgc_Nit,hbri,hbri_old
1348 0 : call icepack_warnings_add(warnstr)
1349 0 : write(warnstr,*) subname, 'bio_tmp,biomat_cons(k,m),ocean_bio(m)'
1350 0 : call icepack_warnings_add(warnstr)
1351 0 : write(warnstr,*) subname, bio_tmp,biomat_cons(k,m),ocean_bio(m)
1352 0 : call icepack_warnings_add(warnstr)
1353 0 : write(warnstr,*) subname, 'react(k,m),iphin_N(k),biomat_brine(k,m)'
1354 0 : call icepack_warnings_add(warnstr)
1355 0 : write(warnstr,*) subname, react(k,m),iphin_N(k),biomat_brine(k,m)
1356 0 : call icepack_warnings_add(warnstr)
1357 0 : write(warnstr,*) subname, 'exp_ret( m),exp_ret( m)',exp_ret( m),exp_ret( m)
1358 0 : call icepack_warnings_add(warnstr)
1359 0 : call icepack_warnings_add(subname//'negative bgc')
1360 0 : call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
1361 : endif
1362 4528977256 : if (icepack_warnings_aborted()) then
1363 0 : write(warnstr,*) subname, 'trcrn(nt_zbgc_frac+m-1):',trcrn(nt_zbgc_frac+m-1)
1364 0 : call icepack_warnings_add(warnstr)
1365 0 : write(warnstr,*) subname, 'in_init_cons(k,m):',in_init_cons(k,m)
1366 0 : call icepack_warnings_add(warnstr)
1367 0 : write(warnstr,*) subname, 'trcrn(bio_index(m) + k-1)'
1368 0 : call icepack_warnings_add(warnstr)
1369 0 : write(warnstr,*) subname, trcrn(bio_index(m) + k-1)
1370 0 : call icepack_warnings_add(warnstr)
1371 0 : write(warnstr,*) subname, 'Category,m:',n_cat,m
1372 0 : call icepack_warnings_add(warnstr)
1373 0 : return
1374 : endif
1375 4528977256 : trcrn(bio_index(m)+k-1) = max(c0, bio_tmp)
1376 5095099413 : if (ocean_bio(m) .le. c0 .and. flux_bio(m) < c0) then
1377 : ! if (flux_bio(m) < -1.0e-12_dbl_kind) then
1378 : ! write(warnstr,*) subname, 'no ocean_bio but flux_bio < c0'
1379 : ! call icepack_warnings_add(warnstr)
1380 : ! write(warnstr,*) subname, 'm,ocean_bio(m),flux_bio(m)'
1381 : ! call icepack_warnings_add(warnstr)
1382 : ! write(warnstr,*) subname, m,ocean_bio(m),flux_bio(m)
1383 : ! call icepack_warnings_add(warnstr)
1384 : ! write(warnstr,*) subname, 'setting flux_bio(m) = c0'
1385 : ! call icepack_warnings_add(warnstr)
1386 : ! call icepack_warnings_add(subname//' flux_bio < 0 when ocean_bio = 0')
1387 : ! call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
1388 : ! endif
1389 69767259 : flux_bio(m) = max(c0,flux_bio(m))
1390 : endif
1391 : enddo ! k
1392 : enddo ! m
1393 :
1394 : 770 format (I6,D16.6)
1395 : 781 format (I6,I6,I6)
1396 : 790 format (I6,I6)
1397 : 791 format (f24.17)
1398 : 792 format (2D16.6)
1399 : 793 format (3D16.6)
1400 : 794 format (4D15.5)
1401 : 800 format (F10.4)
1402 :
1403 : end subroutine z_biogeochemistry
1404 :
1405 : !=======================================================================
1406 : !
1407 : ! Do biogeochemistry from subroutine algal_dynamics
1408 : ! authors: Scott Elliott, LANL
1409 : ! Nicole Jeffery, LANL
1410 :
1411 267982821 : subroutine algal_dyn (dt, &
1412 : n_doc, n_dic, n_don, n_fed, n_fep, & ! LCOV_EXCL_LINE
1413 : dEdd_algae, & ! LCOV_EXCL_LINE
1414 : fswthru, reactb, & ! LCOV_EXCL_LINE
1415 : ltrcrn, & ! LCOV_EXCL_LINE
1416 : grow_alg, n_algae, & ! LCOV_EXCL_LINE
1417 : T_bot, & ! LCOV_EXCL_LINE
1418 : upNOn, upNHn, & ! LCOV_EXCL_LINE
1419 : Zoo, & ! LCOV_EXCL_LINE
1420 : Nerror, conserve_N)
1421 :
1422 : integer (kind=int_kind), intent(in) :: &
1423 : n_doc, n_dic, n_don, n_fed, n_fep, & ! LCOV_EXCL_LINE
1424 : n_algae ! number of autotrophic types
1425 :
1426 : real (kind=dbl_kind), intent(in) :: &
1427 : dt , & ! time step ! LCOV_EXCL_LINE
1428 : T_bot , & ! ice temperature (oC) ! LCOV_EXCL_LINE
1429 : fswthru ! average shortwave passing through current ice layer (W/m^2)
1430 :
1431 : real (kind=dbl_kind), intent(inout) :: &
1432 : Zoo, & ! N losses from zooplankton/bacteria... (mmol/m^3) ! LCOV_EXCL_LINE
1433 : Nerror ! Change in N after reactions (mmol/m^3)
1434 :
1435 : real (kind=dbl_kind), dimension (:), intent(out) :: &
1436 : grow_alg,& ! algal growth rate (mmol/m^3/s) ! LCOV_EXCL_LINE
1437 : upNOn, & ! algal NO uptake rate (mmol/m^3/s) ! LCOV_EXCL_LINE
1438 : upNHn ! algal NH uptake rate (mmol/m^3/s)
1439 :
1440 : real (kind=dbl_kind), dimension(:), intent(inout) :: &
1441 : reactb ! biological reaction terms (mmol/m3)
1442 :
1443 : real (kind=dbl_kind), dimension(:), intent(in) :: &
1444 : ltrcrn ! brine concentrations in layer (mmol/m^3)
1445 :
1446 : logical (kind=log_kind), intent(inout) :: &
1447 : conserve_N
1448 :
1449 : logical (kind=log_kind), intent(in) :: &
1450 : dEdd_algae ! .true. chla impact on shortwave computed in dEdd
1451 :
1452 : ! local variables
1453 : !------------------------------------------------------------------------------------
1454 : ! 3 possible autotrophs nt_bgc_N(1:3): diatoms, flagellates, phaeocystis
1455 : ! 2 types of dissolved organic carbon nt_bgc_DOC(1:2):
1456 : ! polysaccharids, lipids
1457 : ! 1 DON (proteins)
1458 : ! 1 particulate iron (nt_bgc_Fe) n_fep
1459 : ! 1 dossp;ved orpm m+fed
1460 : ! Limiting macro/micro nutrients: nt_bgc_Nit -> nitrate, nt_bgc_NH -> ammonium,
1461 : ! nt_bgc_Sil -> silicate, nt_bgc_Fe -> dissolved iron
1462 : ! --------------------------------------------------------------------------------------
1463 :
1464 : ! real (kind=dbl_kind), parameter, dimension(max_algae) :: &
1465 : ! alpha2max_high = (/ 0.25_dbl_kind, 0.25_dbl_kind, 0.25_dbl_kind/) ! light limitation (1/(W/m^2))
1466 :
1467 : integer (kind=int_kind) :: k, n
1468 :
1469 : real (kind=dbl_kind), dimension(n_algae) :: &
1470 : Nin , & ! algal nitrogen concentration on volume (mmol/m^3) ! LCOV_EXCL_LINE
1471 : ! Cin , & ! algal carbon concentration on volume (mmol/m^3) ! LCOV_EXCL_LINE
1472 537588396 : chlin ! algal chlorophyll concentration on volume (mg/m^3)
1473 :
1474 : real (kind=dbl_kind), dimension(n_doc) :: &
1475 536777019 : DOCin ! dissolved organic carbon concentration on volume (mmolC/m^3)
1476 :
1477 : ! real (kind=dbl_kind), dimension(n_dic) :: &
1478 : ! DICin ! dissolved inorganic carbon concentration on volume (mmolC/m^3)
1479 :
1480 : real (kind=dbl_kind), dimension(n_don) :: & !proteins
1481 535965642 : DONin ! dissolved organic nitrogen concentration on volume (mmolN/m^3)
1482 :
1483 : real (kind=dbl_kind), dimension(n_fed) :: & !iron
1484 535965642 : Fedin ! dissolved iron concentration on volume (umol/m^3)
1485 :
1486 : real (kind=dbl_kind), dimension(n_fep) :: & !iron
1487 535965642 : Fepin ! algal nitrogen concentration on volume (umol/m^3)
1488 :
1489 : real (kind=dbl_kind) :: &
1490 : Nitin , & ! nitrate concentration on volume (mmol/m^3) ! LCOV_EXCL_LINE
1491 : Amin , & ! ammonia/um concentration on volume (mmol/m^3) ! LCOV_EXCL_LINE
1492 : Silin , & ! silicon concentration on volume (mmol/m^3) ! LCOV_EXCL_LINE
1493 : ! DMSPpin , & ! DMSPp concentration on volume (mmol/m^3) ! LCOV_EXCL_LINE
1494 : DMSPdin , & ! DMSPd concentration on volume (mmol/m^3) ! LCOV_EXCL_LINE
1495 : DMSin , & ! DMS concentration on volume (mmol/m^3) ! LCOV_EXCL_LINE
1496 : ! PONin , & ! PON concentration on volume (mmol/m^3) ! LCOV_EXCL_LINE
1497 : op_dep , & ! bottom layer attenuation exponent (optical depth) ! LCOV_EXCL_LINE
1498 811377 : Iavg_loc ! bottom layer attenuated Fswthru (W/m^2)
1499 :
1500 : real (kind=dbl_kind), dimension(n_algae) :: &
1501 : L_lim , & ! overall light limitation ! LCOV_EXCL_LINE
1502 : Nit_lim , & ! overall nitrate limitation ! LCOV_EXCL_LINE
1503 : Am_lim , & ! overall ammonium limitation ! LCOV_EXCL_LINE
1504 : N_lim , & ! overall nitrogen species limitation ! LCOV_EXCL_LINE
1505 : Sil_lim , & ! overall silicon limitation ! LCOV_EXCL_LINE
1506 : Fe_lim , & ! overall iron limitation ! LCOV_EXCL_LINE
1507 : fr_Nit , & ! fraction of local ecological growth as nitrate ! LCOV_EXCL_LINE
1508 : fr_Am , & ! fraction of local ecological growth as ammonia ! LCOV_EXCL_LINE
1509 : growmax_N, & ! maximum growth rate in N currency (mmol/m^3/s) ! LCOV_EXCL_LINE
1510 : grow_N , & ! true growth rate in N currency (mmol/m^3/s) ! LCOV_EXCL_LINE
1511 : ! potU_Nit , & ! potential nitrate uptake (mmol/m^3/s) ! LCOV_EXCL_LINE
1512 : potU_Am , & ! potential ammonium uptake (mmol/m^3/s) ! LCOV_EXCL_LINE
1513 : U_Nit , & ! actual nitrate uptake (mmol/m^3/s) ! LCOV_EXCL_LINE
1514 : U_Am , & ! actual ammonium uptake (mmol/m^3/s) ! LCOV_EXCL_LINE
1515 : U_Sil , & ! actual silicon uptake (mmol/m^3/s) ! LCOV_EXCL_LINE
1516 : U_Fe , & ! actual iron uptake (umol/m^3/s) ! LCOV_EXCL_LINE
1517 : U_Nit_f , & ! fraction of Nit uptake due to each algal species ! LCOV_EXCL_LINE
1518 : U_Am_f , & ! fraction of Am uptake due to each algal species ! LCOV_EXCL_LINE
1519 : U_Sil_f , & ! fraction of Sil uptake due to each algal species ! LCOV_EXCL_LINE
1520 537588396 : U_Fe_f ! fraction of Fe uptake due to each algal species
1521 :
1522 : real (kind=dbl_kind) :: &
1523 : dTemp , & ! sea ice temperature minus sst (oC) < 0 ! LCOV_EXCL_LINE
1524 : U_Nit_tot , & ! actual nitrate uptake (mmol/m^3/s) ! LCOV_EXCL_LINE
1525 : U_Am_tot , & ! actual ammonium uptake (mmol/m^3/s) ! LCOV_EXCL_LINE
1526 : U_Sil_tot , & ! actual silicon uptake (mmol/m^3/s) ! LCOV_EXCL_LINE
1527 : U_Fe_tot , & ! actual iron uptake (umol/m^3/s) ! LCOV_EXCL_LINE
1528 : nitrif , & ! nitrification (mmol/m^3/s) ! LCOV_EXCL_LINE
1529 : mort_N , & ! total algal mortality (mmol N/m^3) ! LCOV_EXCL_LINE
1530 : mort_C , & ! total algal mortality (mmol C/m^3) ! LCOV_EXCL_LINE
1531 : graze_N , & ! total algae grazed (mmol N/m^3) ! LCOV_EXCL_LINE
1532 : graze_C , & ! total algae grazed (mmol C/m^3) ! LCOV_EXCL_LINE
1533 : exude_C , & ! total carbon exuded by algae (mmol C/m^3) ! LCOV_EXCL_LINE
1534 : resp_N , & ! total N in respiration (mmol N/m^3) ! LCOV_EXCL_LINE
1535 811377 : growth_N ! total algal growth (mmol N/m^3)
1536 : ! fr_graze_p , & ! fraction of N grazed that becomes protein
1537 : ! ! (rest is assimilated) < (1-fr_graze_a)
1538 : ! ! and fr_graze_a*fr_graze_e becomes ammonia
1539 : ! fr_mort_p ! fraction of N mortality that becomes protein
1540 : ! ! < (1-fr_mort2min)
1541 :
1542 : real (kind=dbl_kind), dimension(n_algae) :: &
1543 : resp , & ! respiration (mmol/m^3/s) ! LCOV_EXCL_LINE
1544 : graze , & ! grazing (mmol/m^3/s) ! LCOV_EXCL_LINE
1545 537588396 : mort ! sum of mortality and excretion (mmol/m^3/s)
1546 :
1547 : ! source terms underscore s, removal underscore r
1548 :
1549 : real (kind=dbl_kind), dimension(n_algae) :: &
1550 : N_s , & ! net algal nitrogen sources (mmol/m^3) ! LCOV_EXCL_LINE
1551 537588396 : N_r ! net algal nitrogen removal (mmol/m^3)
1552 :
1553 : real (kind=dbl_kind), dimension(n_doc) :: &
1554 : DOC_r , & ! net DOC removal (mmol/m^3) ! LCOV_EXCL_LINE
1555 536777019 : DOC_s ! net DOC sources (mmol/m^3)
1556 :
1557 : real (kind=dbl_kind), dimension(n_don) :: &
1558 : DON_r , & ! net DON removal (mmol/m^3) ! LCOV_EXCL_LINE
1559 535965642 : DON_s ! net DON sources (mmol/m^3)
1560 :
1561 : real (kind=dbl_kind), dimension(n_fed) :: &
1562 : Fed_r_l , & ! removal due to loss of binding saccharids (nM) ! LCOV_EXCL_LINE
1563 : Fed_r , & ! net Fed removal (nM) ! LCOV_EXCL_LINE
1564 : Fed_s , & ! net Fed sources (nM) ! LCOV_EXCL_LINE
1565 535965642 : rFed ! ratio of dissolved Fe to tot Fed
1566 :
1567 : real (kind=dbl_kind), dimension(n_fep) :: &
1568 : Fep_r , & ! net Fep removal (nM) ! LCOV_EXCL_LINE
1569 : Fep_s , & ! net Fep sources (nM) ! LCOV_EXCL_LINE
1570 535965642 : rFep ! ratio of particulate Fe to tot Fep
1571 :
1572 : real (kind=dbl_kind) :: &
1573 : dN , & ! change in N (mmol/m^3) ! LCOV_EXCL_LINE
1574 : ! N_s_p , & ! algal nitrogen photosynthesis (mmol/m^3) ! LCOV_EXCL_LINE
1575 : ! N_r_g , & ! algal nitrogen losses to grazing (mmol/m^3) ! LCOV_EXCL_LINE
1576 : ! N_r_r , & ! algal nitrogen losses to respiration (mmol/m^3) ! LCOV_EXCL_LINE
1577 : ! N_r_mo , & ! algal nitrogen losses to mortality (mmol/m^3) ! LCOV_EXCL_LINE
1578 : Nit_s_n , & ! nitrate from nitrification (mmol/m^3) ! LCOV_EXCL_LINE
1579 : ! Nit_s_r , & ! nitrate from respiration (mmol/m^3) ! LCOV_EXCL_LINE
1580 : Nit_r_p , & ! nitrate uptake by algae (mmol/m^3) ! LCOV_EXCL_LINE
1581 : Nit_s , & ! net nitrate sources (mmol/m^3) ! LCOV_EXCL_LINE
1582 : Nit_r , & ! net nitrate removal (mmol/m^3) ! LCOV_EXCL_LINE
1583 : Am_s_e , & ! ammonium source from excretion (mmol/m^3) ! LCOV_EXCL_LINE
1584 : Am_s_r , & ! ammonium source from respiration (mmol/m^3) ! LCOV_EXCL_LINE
1585 : Am_s_mo , & ! ammonium source from mort/remin (mmol/m^3) ! LCOV_EXCL_LINE
1586 : Am_r_p , & ! ammonium uptake by algae (mmol/m^3) ! LCOV_EXCL_LINE
1587 : Am_s , & ! net ammonium sources (mmol/m^3) ! LCOV_EXCL_LINE
1588 : Am_r , & ! net ammonium removal (mmol/m^3) ! LCOV_EXCL_LINE
1589 : Sil_r_p , & ! silicon uptake by algae (mmol/m^3) ! LCOV_EXCL_LINE
1590 : Sil_r , & ! net silicon removal (mmol/m^3) ! LCOV_EXCL_LINE
1591 811377 : Fe_r_p ! iron uptake by algae (nM)
1592 : ! DOC_r_c , & ! net doc removal from bacterial consumption (mmol/m^3)
1593 : ! doc_s_m , & ! protein source due to algal mortality (mmol/m^3) ! LCOV_EXCL_LINE
1594 : ! doc_s_g ! protein source due to grazing (mmol/m^3)
1595 :
1596 : real (kind=dbl_kind) :: &
1597 : DMSPd_s_r , & ! skl dissolved DMSP from respiration (mmol/m^3) ! LCOV_EXCL_LINE
1598 : DMSPd_s_mo, & ! skl dissolved DMSP from MBJ algal mortexc (mmol/m^3) ! LCOV_EXCL_LINE
1599 : DMSPd_r , & ! skl dissolved DMSP conversion (mmol/m^3) DMSPD_sk_r ! LCOV_EXCL_LINE
1600 : DMSPd_s , & ! net skl dissolved DMSP sources (mmol/m^3) ! LCOV_EXCL_LINE
1601 : DMS_s_c , & ! skl DMS source via conversion (mmol/m^3) ! LCOV_EXCL_LINE
1602 : DMS_r_o , & ! skl DMS losses due to oxidation (mmol/m^3) ! LCOV_EXCL_LINE
1603 : DMS_s , & ! net skl DMS sources (mmol/m^3) ! LCOV_EXCL_LINE
1604 : DMS_r , & ! net skl DMS removal (mmol/m^3) ! LCOV_EXCL_LINE
1605 : Fed_tot , & ! total dissolved iron from all sources (nM) ! LCOV_EXCL_LINE
1606 : Fed_tot_r , & ! total dissolved iron losses (nM) ! LCOV_EXCL_LINE
1607 : Fed_tot_s , & ! total dissolved iron sources (nM) ! LCOV_EXCL_LINE
1608 : Fep_tot , & ! total particulate iron from all sources (nM) ! LCOV_EXCL_LINE
1609 : ! Fep_tot_r , & ! total particulate iron losses (nM) ! LCOV_EXCL_LINE
1610 : Fep_tot_s , & ! total particulate iron sources (nM) ! LCOV_EXCL_LINE
1611 : Zoo_s_a , & ! N Losses due to zooplankton assimilation (mmol/m^3) ! LCOV_EXCL_LINE
1612 : Zoo_s_s , & ! N Losses due to grazing spillage (mmol/m^3) ! LCOV_EXCL_LINE
1613 : Zoo_s_m , & ! N Losses due to algal mortality (mmol/m^3) ! LCOV_EXCL_LINE
1614 811377 : Zoo_s_b ! N losses due to bacterial recycling of DON (mmol/m^3)
1615 :
1616 : character(len=*),parameter :: subname='(algal_dyn)'
1617 :
1618 : !-----------------------------------------------------------------------
1619 : ! Initialize
1620 : !-----------------------------------------------------------------------
1621 :
1622 267982821 : conserve_N = .true.
1623 1071931284 : Nin(:) = c0
1624 : ! Cin(:) = c0
1625 1071931284 : chlin(:) = c0
1626 803948463 : DOCin(:) = c0
1627 : ! DICin(:) = c0
1628 535965642 : DONin(:) = c0
1629 535965642 : Fedin(:) = c0
1630 535965642 : Fepin(:) = c0
1631 267982821 : Nitin = c0
1632 267982821 : Amin = c0
1633 267982821 : Silin = c0
1634 : ! DMSPpin = c0
1635 267982821 : DMSPdin = c0
1636 267982821 : DMSin = c0
1637 267982821 : U_Am_tot = c0
1638 267982821 : U_Nit_tot = c0
1639 267982821 : U_Sil_tot = c0
1640 267982821 : U_Fe_tot = c0
1641 1071931284 : U_Am_f(:) = c0
1642 1071931284 : U_Nit_f(:) = c0
1643 1071931284 : U_Sil_f(:) = c0
1644 1071931284 : U_Fe_f(:) = c0
1645 803948463 : DOC_s(:) = c0
1646 803948463 : DOC_r(:) = c0
1647 : ! DOC_r_c = c0
1648 267982821 : nitrif = c0
1649 267982821 : mort_N = c0
1650 267982821 : mort_C = c0
1651 267982821 : graze_N = c0
1652 267982821 : graze_C = c0
1653 267982821 : exude_C = c0
1654 267982821 : resp_N = c0
1655 267982821 : growth_N = c0
1656 267982821 : Nit_r = c0
1657 267982821 : Am_s = c0
1658 267982821 : Am_r = c0
1659 267982821 : Sil_r = c0
1660 535965642 : Fed_r(:) = c0
1661 535965642 : Fed_s(:) = c0
1662 535965642 : Fep_r(:) = c0
1663 535965642 : Fep_s(:) = c0
1664 267982821 : DMSPd_s = c0
1665 267982821 : dTemp = min(T_bot-T_max,c0)
1666 267982821 : Fed_tot = c0
1667 267982821 : Fed_tot_r = c0
1668 267982821 : Fed_tot_s = c0
1669 535965642 : rFed(:) = c0
1670 267982821 : Fep_tot = c0
1671 : ! Fep_tot_r = c0
1672 267982821 : Fep_tot_s = c0
1673 535965642 : rFep(:) = c0
1674 :
1675 267982821 : Nitin = ltrcrn(nlt_bgc_Nit)
1676 267982821 : op_dep = c0
1677 1071931284 : do k = 1, n_algae
1678 803948463 : Nin(k) = ltrcrn(nlt_bgc_N(k))
1679 803948463 : chlin(k) = R_chl2N(k)* Nin(k)
1680 1071931284 : op_dep = op_dep + chlabs(k)*chlin(k)
1681 : enddo
1682 267982821 : if (tr_bgc_C) then
1683 : ! do k = 1, n_algae
1684 : ! Cin(k)= ltrcrn(nlt_bgc_C(k))
1685 : ! enddo
1686 803948463 : do k = 1, n_doc
1687 803948463 : DOCin(k)= ltrcrn(nlt_bgc_DOC(k))
1688 : enddo
1689 : ! do k = 1, n_dic
1690 : ! DICin(k)= ltrcrn(nlt_bgc_DIC(k))
1691 : ! enddo
1692 : endif
1693 267982821 : if (tr_bgc_Am) Amin = ltrcrn(nlt_bgc_Am)
1694 267982821 : if (tr_bgc_Sil) Silin = ltrcrn(nlt_bgc_Sil)
1695 267982821 : if (tr_bgc_DMS) then
1696 : ! DMSPpin = ltrcrn(nlt_bgc_DMSPp)
1697 267982821 : DMSPdin = ltrcrn(nlt_bgc_DMSPd)
1698 267982821 : DMSin = ltrcrn(nlt_bgc_DMS)
1699 : endif
1700 : ! if (tr_bgc_PON) then
1701 : ! PONin = c0
1702 : ! PONin = ltrcrn(nlt_bgc_PON)
1703 : ! endif
1704 267982821 : if (tr_bgc_DON) then
1705 535965642 : do k = 1, n_don
1706 535965642 : DONin(k) = ltrcrn(nlt_bgc_DON(k))
1707 : enddo
1708 : endif
1709 267982821 : if (tr_bgc_Fe ) then
1710 535965642 : do k = 1, n_fed
1711 535965642 : Fedin(k) = ltrcrn(nlt_bgc_Fed(k))
1712 : enddo
1713 535965642 : do k = 1, n_fep
1714 535965642 : Fepin(k) = ltrcrn(nlt_bgc_Fep(k))
1715 : enddo
1716 : endif
1717 :
1718 : !-----------------------------------------------------------------------
1719 : ! Total iron from all pools
1720 : !-----------------------------------------------------------------------
1721 :
1722 535965642 : do k = 1,n_fed
1723 535965642 : Fed_tot = Fed_tot + Fedin(k)
1724 : enddo
1725 535965642 : do k = 1,n_fep
1726 535965642 : Fep_tot = Fep_tot + Fepin(k)
1727 : enddo
1728 267982821 : if (Fed_tot > puny) then
1729 535503760 : do k = 1,n_fed
1730 535503760 : rFed(k) = Fedin(k)/Fed_tot
1731 : enddo
1732 : endif
1733 267982821 : if (Fep_tot > puny) then
1734 535552496 : do k = 1,n_fep
1735 535552496 : rFep(k) = Fepin(k)/Fep_tot
1736 : enddo
1737 : endif
1738 :
1739 : !-----------------------------------------------------------------------
1740 : ! Light limitation (op_dep) defined above
1741 : !-----------------------------------------------------------------------
1742 :
1743 267982821 : if (op_dep > op_dep_min .and. .not. dEdd_algae) then
1744 241080709 : Iavg_loc = fswthru * (c1 - exp(-op_dep)) / op_dep
1745 : else
1746 26902112 : Iavg_loc = fswthru
1747 : endif
1748 :
1749 1071931284 : do k = 1, n_algae
1750 : ! With light inhibition ! Maybe include light inhibition for diatoms but phaeocystis
1751 3215793852 : L_lim = (c1 - exp(-alpha2max_low(k)*Iavg_loc)) * exp(-beta2max(k)*Iavg_loc)
1752 :
1753 : ! Without light inhibition
1754 : ! L_lim(k) = (c1 - exp(-alpha2max_low(k)*Iavg_loc))
1755 :
1756 : !-----------------------------------------------------------------------
1757 : ! Nutrient limitation
1758 : !-----------------------------------------------------------------------
1759 :
1760 803948463 : Nit_lim(k) = Nitin/(Nitin + K_Nit(k))
1761 803948463 : Am_lim(k) = c0
1762 803948463 : N_lim(k) = Nit_lim(k)
1763 803948463 : if (tr_bgc_Am) then
1764 803948463 : Am_lim(k) = Amin/(Amin + K_Am(k))
1765 803948463 : N_lim(k) = min(c1, Nit_lim(k) + Am_lim(k))
1766 : endif
1767 803948463 : Sil_lim(k) = c1
1768 803948463 : if (tr_bgc_Sil .and. K_Sil(k) > c0) Sil_lim(k) = Silin/(Silin + K_Sil(k))
1769 :
1770 : !-----------------------------------------------------------------------
1771 : ! Iron limitation
1772 : !-----------------------------------------------------------------------
1773 :
1774 803948463 : Fe_lim(k) = c1
1775 803948463 : if (tr_bgc_Fe .and. K_Fe (k) > c0) Fe_lim (k) = Fed_tot/(Fed_tot + K_Fe(k))
1776 :
1777 : !----------------------------------------------------------------------------
1778 : ! Growth and uptake computed within the bottom layer
1779 : ! Note here per A93 discussions and MBJ model, salinity is a universal
1780 : ! restriction. Comparison with available column nutrients inserted
1781 : ! but in tests had no effect.
1782 : ! Primary production reverts to SE form, see MBJ below and be careful
1783 : !----------------------------------------------------------------------------
1784 :
1785 803948463 : growmax_N(k) = mu_max(k) / secday * exp(grow_Tdep(k) * dTemp)* Nin(k) *fsal
1786 803948463 : grow_N(k) = min(L_lim(k), N_lim(k), Sil_lim(k), Fe_lim(k)) * growmax_N(k)
1787 : ! potU_Nit(k) = Nit_lim(k)* growmax_N(k)
1788 803948463 : potU_Am(k) = Am_lim(k)* growmax_N(k)
1789 803948463 : U_Am(k) = min(grow_N(k), potU_Am(k))
1790 803948463 : U_Nit(k) = grow_N(k) - U_Am(k)
1791 803948463 : U_Sil(k) = R_Si2N(k) * grow_N(k)
1792 803948463 : U_Fe (k) = R_Fe2N(k) * grow_N(k)
1793 :
1794 803948463 : U_Am_tot = U_Am_tot + U_Am(k)
1795 803948463 : U_Nit_tot = U_Nit_tot + U_Nit(k)
1796 803948463 : U_Sil_tot = U_Sil_tot + U_Sil(k)
1797 1071931284 : U_Fe_tot = U_Fe_tot + U_Fe(k)
1798 : enddo
1799 1071931284 : do k = 1, n_algae
1800 803948463 : if (U_Am_tot > c0) U_Am_f(k) = U_Am(k)/U_Am_tot
1801 803948463 : if (U_Nit_tot > c0) U_Nit_f(k) = U_Nit(k)/U_Nit_tot
1802 803948463 : if (U_Sil_tot > c0) U_Sil_f(k) = U_Sil(k)/U_Sil_tot
1803 1071931284 : if (U_Fe_tot > c0) U_Fe_f(k) = U_Fe(k)/U_Fe_tot
1804 : enddo
1805 :
1806 267982821 : if (tr_bgc_Sil) U_Sil_tot = min(U_Sil_tot, max_loss * Silin/dt)
1807 267982821 : if (tr_bgc_Fe) U_Fe_tot = min(U_Fe_tot, max_loss * Fed_tot/dt)
1808 267982821 : U_Nit_tot = min(U_Nit_tot, max_loss * Nitin/dt)
1809 267982821 : U_Am_tot = min(U_Am_tot, max_loss * Amin/dt)
1810 :
1811 1071931284 : do k = 1, n_algae
1812 803948463 : U_Am(k) = U_Am_f(k)*U_Am_tot
1813 803948463 : U_Nit(k) = U_Nit_f(k)*U_Nit_tot
1814 803948463 : U_Sil(k) = U_Sil_f(k)*U_Sil_tot
1815 803948463 : U_Fe(k) = U_Fe_f(k)*U_Fe_tot
1816 :
1817 803948463 : if (R_Si2N(k) > c0) then
1818 267982821 : grow_N(k) = min(U_Sil(k)/R_Si2N(k),U_Nit(k) + U_Am(k), U_Fe(k)/R_Fe2N(k))
1819 : else
1820 535965642 : grow_N(k) = min(U_Nit(k) + U_Am(k),U_Fe(k)/R_Fe2N(k))
1821 : endif
1822 :
1823 803948463 : fr_Am(k) = c0
1824 803948463 : if (tr_bgc_Am) then
1825 803948463 : fr_Am(k) = p5
1826 803948463 : if (grow_N(k) > c0) fr_Am(k) = min(U_Am(k)/grow_N(k), c1)
1827 : endif
1828 803948463 : fr_Nit(k) = c1 - fr_Am(k)
1829 803948463 : U_Nit(k) = fr_Nit(k) * grow_N(k)
1830 803948463 : U_Am(k) = fr_Am(k) * grow_N(k)
1831 803948463 : U_Sil(k) = R_Si2N(k) * grow_N(k)
1832 803948463 : U_Fe (k) = R_Fe2N(k) * grow_N(k)
1833 :
1834 : !-----------------------------------------------------------------------
1835 : ! Define reaction terms
1836 : !-----------------------------------------------------------------------
1837 :
1838 : ! Since the framework remains incomplete at this point,
1839 : ! it is assumed as a starting expedient that
1840 : ! DMSP loss to melting results in 10% conversion to DMS
1841 : ! which is then given a ten day removal constant.
1842 : ! Grazing losses are channeled into rough spillage and assimilation
1843 : ! then following ammonia there is some recycling.
1844 :
1845 : !--------------------------------------------------------------------
1846 : ! Algal reaction term
1847 : ! N_react = (grow_N*(c1 - fr_graze-fr_resp) - mort)*dt
1848 : !--------------------------------------------------------------------
1849 :
1850 803948463 : resp(k) = fr_resp * grow_N(k)
1851 803948463 : graze(k) = fr_graze(k) * grow_N(k)
1852 2434131 : mort(k) = min(max_loss * Nin(k)/dt, &
1853 803948463 : mort_pre(k)*exp(mort_Tdep(k)*dTemp) * Nin(k)/secday)
1854 :
1855 : ! history variables
1856 803948463 : grow_alg(k) = grow_N(k)
1857 803948463 : upNOn(k) = U_Nit(k)
1858 803948463 : upNHn(k) = U_Am(k)
1859 :
1860 : ! N_s_p = grow_N(k) * dt
1861 : ! N_r_g = graze(k) * dt
1862 : ! N_r_r = resp(k) * dt
1863 : ! N_r_mo = mort(k) * dt
1864 803948463 : N_s(k) = (c1- fr_resp - fr_graze(k)) * grow_N(k) *dt !N_s_p
1865 803948463 : N_r(k) = mort(k) * dt !N_r_g + N_r_mo + N_r_r
1866 :
1867 803948463 : graze_N = graze_N + graze(k)
1868 803948463 : graze_C = graze_C + R_C2N(k)*graze(k)
1869 803948463 : mort_N = mort_N + mort(k)
1870 803948463 : mort_C = mort_C + R_C2N(k)*mort(k)
1871 803948463 : resp_N = resp_N + resp(k)
1872 1071931284 : growth_N = growth_N + grow_N(k)
1873 :
1874 : enddo ! n_algae
1875 : !--------------------------------------------------------------------
1876 : ! Ammonium source: algal grazing, respiration, and mortality
1877 : !--------------------------------------------------------------------
1878 :
1879 267982821 : Am_s_e = graze_N*(c1-fr_graze_s)*fr_graze_e*dt
1880 267982821 : Am_s_mo = mort_N*fr_mort2min*dt
1881 267982821 : Am_s_r = resp_N*dt
1882 267982821 : Am_s = Am_s_r + Am_s_e + Am_s_mo
1883 :
1884 : !--------------------------------------------------------------------
1885 : ! Nutrient net loss terms: algal uptake
1886 : !--------------------------------------------------------------------
1887 :
1888 1071931284 : do k = 1, n_algae
1889 803948463 : Am_r_p = U_Am(k) * dt
1890 803948463 : Am_r = Am_r + Am_r_p
1891 803948463 : Nit_r_p = U_Nit(k) * dt
1892 803948463 : Nit_r = Nit_r + Nit_r_p
1893 803948463 : Sil_r_p = U_Sil(k) * dt
1894 803948463 : Sil_r = Sil_r + Sil_r_p
1895 803948463 : Fe_r_p = U_Fe (k) * dt
1896 803948463 : Fed_tot_r = Fed_tot_r + Fe_r_p
1897 1071931284 : exude_C = exude_C + k_exude(k)* R_C2N(k)*Nin(k) / secday
1898 : enddo
1899 :
1900 : !--------------------------------------------------------------------
1901 : ! nitrification
1902 : !--------------------------------------------------------------------
1903 :
1904 267982821 : nitrif = k_nitrif /secday * Amin
1905 267982821 : Am_r = Am_r + nitrif*dt
1906 267982821 : Nit_s_n = nitrif * dt ! source from NH4
1907 267982821 : Nit_s = Nit_s_n
1908 :
1909 : !--------------------------------------------------------------------
1910 : ! PON: currently using PON to shadow nitrate
1911 : !
1912 : ! N Losses are counted in Zoo. These arise from mortality not
1913 : ! remineralized (Zoo_s_m), assimilated grazing not excreted (Zoo_s_a),
1914 : !spilled N not going to DON (Zoo_s_s) and bacterial recycling
1915 : ! of DON (Zoo_s_b).
1916 : !--------------------------------------------------------------------
1917 :
1918 267982821 : if (tr_bgc_Am) then
1919 267982821 : Zoo_s_a = graze_N*(c1-fr_graze_e)*(c1-fr_graze_s) *dt
1920 267982821 : Zoo_s_s = graze_N*fr_graze_s*dt
1921 267982821 : Zoo_s_m = mort_N*dt - Am_s_mo
1922 : else
1923 0 : Zoo_s_a = graze_N*dt*(c1-fr_graze_s)
1924 0 : Zoo_s_s = graze_N*fr_graze_s*dt
1925 0 : Zoo_s_m = mort_N*dt
1926 : endif
1927 :
1928 267982821 : Zoo_s_b = c0
1929 :
1930 : !--------------------------------------------------------------------
1931 : ! DON (n_don = 1)
1932 : ! Proteins
1933 : !--------------------------------------------------------------------
1934 :
1935 535965642 : DON_r(:) = c0
1936 535965642 : DON_s(:) = c0
1937 :
1938 267982821 : if (tr_bgc_DON) then
1939 535965642 : do n = 1, n_don
1940 267982821 : DON_r(n) = kn_bac(n)/secday * DONin(n) * dt
1941 267982821 : DON_s(n) = graze_N*f_don(n)*fr_graze_s * dt
1942 267982821 : Zoo_s_s = Zoo_s_s - DON_s(n)
1943 535965642 : Zoo_s_b = Zoo_s_b + DON_r(n)*(c1-f_don_Am(n))
1944 : !Am_s = Am_s + DON_r(n)*f_don_Am(n)
1945 : enddo
1946 : endif
1947 :
1948 267982821 : Zoo = Zoo_s_a + Zoo_s_s + Zoo_s_m + Zoo_s_b
1949 :
1950 : !--------------------------------------------------------------------
1951 : ! DOC
1952 : ! polysaccharids, lipids
1953 : !--------------------------------------------------------------------
1954 :
1955 803948463 : do n = 1, n_doc
1956 :
1957 535965642 : DOC_r(n) = k_bac(n)/secday * DOCin(n) * dt
1958 1622754 : DOC_s(n) = f_doc(n)*(fr_graze_s *graze_C + mort_C)*dt &
1959 803948463 : + f_exude(n)*exude_C
1960 : enddo
1961 :
1962 : !--------------------------------------------------------------------
1963 : ! Iron sources from remineralization (follows ammonium but reduced)
1964 : ! only Fed_s(1) has remineralized sources
1965 : !--------------------------------------------------------------------
1966 :
1967 267982821 : Fed_s(1) = Fed_s(1) + Am_s * R_Fe2N(1) * fr_dFe ! remineralization source
1968 :
1969 : !--------------------------------------------------------------------
1970 : ! Conversion to dissolved Fe from Particulate requires DOC(1)
1971 : ! Otherwise the only source of dFe is from remineralization
1972 : !--------------------------------------------------------------------
1973 :
1974 267982821 : if (tr_bgc_C .and. tr_bgc_Fe) then
1975 267982821 : if (DOCin(1) > c0) then
1976 535965642 : if (Fed_tot/DOCin(1) > max_dfe_doc1) then
1977 0 : do n = 1,n_fed ! low saccharid:dFe ratio leads to
1978 0 : Fed_r_l(n) = Fedin(n)/t_iron_conv*dt/secday ! loss of bioavailable Fe to particulate fraction
1979 0 : Fep_tot_s = Fep_tot_s + Fed_r_l(n)
1980 0 : Fed_r(n) = Fed_r_l(n) ! removal due to particulate scavenging
1981 : enddo
1982 0 : do n = 1,n_fep
1983 0 : Fep_s(n) = rFep(n)* Fep_tot_s ! source from dissolved Fe
1984 : enddo
1985 267982821 : elseif (Fed_tot/DOCin(1) < max_dfe_doc1) then
1986 535965642 : do n = 1,n_fep ! high saccharid:dFe ratio leads to
1987 267982821 : Fep_r(n) = Fepin(n)/t_iron_conv*dt/secday ! gain of bioavailable Fe from particulate fraction
1988 535965642 : Fed_tot_s = Fed_tot_s + Fep_r(n)
1989 : enddo
1990 535965642 : do n = 1,n_fed
1991 535965642 : Fed_s(n) = Fed_s(n) + rFed(n)* Fed_tot_s ! source from particulate Fe
1992 : enddo
1993 : endif
1994 : endif !Docin(1) > c0
1995 0 : elseif (tr_bgc_Fe) then
1996 0 : do n = 1,n_fed
1997 0 : Fed_r(n) = Fed_r(n) + rFed(n)*Fed_tot_r ! scavenging + uptake
1998 : enddo
1999 :
2000 : ! source from algal mortality/grazing and fraction of remineralized nitrogen that does
2001 : ! not become immediately bioavailable
2002 :
2003 0 : do n = 1,n_fep
2004 0 : Fep_s(n) = Fep_s(n) + rFep(n)* (Am_s * R_Fe2N(1) * (c1-fr_dFe))
2005 : enddo ! losses not direct to Fed
2006 : endif
2007 :
2008 : !--------------------------------------------------------------------
2009 : ! Sulfur cycle begins here
2010 : !--------------------------------------------------------------------
2011 : ! Grazing losses are channeled into rough spillage and assimilation
2012 : ! then onward and the MBJ mortality channel is included
2013 : ! It is assumed as a starting expedient that
2014 : ! DMSP loss to melting gives partial conversion to DMS in product layer
2015 : ! which then undergoes Stefels removal.
2016 :
2017 : !--------------------------------------------------------------------
2018 : ! DMSPd reaction term (DMSPd conversion is outside the algal loop)
2019 : ! DMSPd_react = R_S2N*((fr_graze_s+fr_excrt_2S*fr_graze_e*fr_graze_a)
2020 : ! *fr_graze*grow_N + fr_mort2min*mort)*dt
2021 : ! - [\DMSPd]/t_sk_conv*dt
2022 : !--------------------------------------------------------------------
2023 1071931284 : do k = 1,n_algae
2024 803948463 : DMSPd_s_r = fr_resp_s * R_S2N(k) * resp(k) * dt !respiration fraction to DMSPd
2025 803948463 : DMSPd_s_mo= fr_mort2min * R_S2N(k)* mort(k) * dt !mortality and extracellular excretion
2026 1071931284 : DMSPd_s = DMSPd_s + DMSPd_s_r + DMSPd_s_mo
2027 : enddo
2028 267982821 : DMSPd_r = (c1/t_sk_conv) * (c1/secday) * (DMSPdin) * dt
2029 :
2030 : !--------------------------------------------------------------------
2031 : ! DMS reaction term + DMSPd loss term
2032 : ! DMS_react = ([\DMSPd]*y_sk_DMS/t_sk_conv - c1/t_sk_ox *[\DMS])*dt
2033 : !--------------------------------------------------------------------
2034 :
2035 267982821 : DMS_s_c = y_sk_DMS * DMSPd_r
2036 267982821 : DMS_r_o = DMSin * dt / (t_sk_ox * secday)
2037 267982821 : DMS_s = DMS_s_c
2038 267982821 : DMS_r = DMS_r_o
2039 :
2040 : !-----------------------------------------------------------------------
2041 : ! Load reaction array
2042 : !-----------------------------------------------------------------------
2043 :
2044 267982821 : dN = c0
2045 1071931284 : do k = 1,n_algae
2046 803948463 : reactb(nlt_bgc_N(k)) = N_s(k) - N_r(k)
2047 1071931284 : dN = dN + reactb(nlt_bgc_N(k))
2048 : enddo
2049 267982821 : if (tr_bgc_C) then
2050 : ! do k = 1,n_algae
2051 : ! reactb(nlt_bgc_C(k)) = R_C2N(k)*reactb(nlt_bgc_N(k))
2052 : ! enddo
2053 803948463 : do k = 1,n_doc
2054 803948463 : reactb(nlt_bgc_DOC(k))= DOC_s(k) - DOC_r(k)
2055 : enddo
2056 : endif
2057 267982821 : reactb(nlt_bgc_Nit) = Nit_s - Nit_r
2058 267982821 : dN = dN + reactb(nlt_bgc_Nit)
2059 267982821 : if (tr_bgc_Am) then
2060 267982821 : reactb(nlt_bgc_Am) = Am_s - Am_r
2061 267982821 : dN = dN + reactb(nlt_bgc_Am)
2062 : endif
2063 267982821 : if (tr_bgc_Sil) then
2064 267982821 : reactb(nlt_bgc_Sil) = - Sil_r
2065 : endif
2066 267982821 : if (tr_bgc_DON) then
2067 535965642 : do k = 1,n_don
2068 267982821 : reactb(nlt_bgc_DON(k))= DON_s(k) - DON_r(k)
2069 535965642 : dN = dN + reactb(nlt_bgc_DON(k))
2070 : enddo
2071 : endif
2072 267982821 : if (tr_bgc_Fe ) then
2073 535965642 : do k = 1,n_fed
2074 535965642 : reactb(nlt_bgc_Fed(k))= Fed_s (k) - Fed_r (k)
2075 : enddo
2076 535965642 : do k = 1,n_fep
2077 535965642 : reactb(nlt_bgc_Fep(k))= Fep_s (k) - Fep_r (k)
2078 : enddo
2079 : endif
2080 267982821 : if (tr_bgc_DMS) then
2081 267982821 : reactb(nlt_bgc_DMSPd) = DMSPd_s - DMSPd_r
2082 267982821 : reactb(nlt_bgc_DMS) = DMS_s - DMS_r
2083 : endif
2084 267982821 : Nerror = dN + Zoo
2085 : ! if (abs(Nerror) > max(reactb(:))*1.0e-5) then
2086 : ! conserve_N = .false.
2087 : ! write(warnstr,*) subname, 'Conservation error!'
2088 : ! call icepack_warnings_add(warnstr)
2089 : ! write(warnstr,*) subname, 'Nerror,dN, DONin(1),kn_bac(1),secday,dt,n_doc'
2090 : ! call icepack_warnings_add(warnstr)
2091 : ! write(warnstr,*) subname, Nerror,dN, DONin(1),kn_bac(1),secday,dt,n_doc
2092 : ! call icepack_warnings_add(warnstr)
2093 : ! write(warnstr,*) subname, 'reactb(nlt_bgc_Nit),reactb(nlt_bgc_N(1)),reactb(nlt_bgc_N(2)'
2094 : ! call icepack_warnings_add(warnstr)
2095 : ! write(warnstr,*) subname, reactb(nlt_bgc_Nit),reactb(nlt_bgc_N(1)),reactb(nlt_bgc_N(2))
2096 : ! call icepack_warnings_add(warnstr)
2097 : ! write(warnstr,*) subname, 'reactb(nlt_bgc_Am),reactb(nlt_bgc_DON(1)), DON_r(1),DON_s(1)'
2098 : ! call icepack_warnings_add(warnstr)
2099 : ! write(warnstr,*) subname, reactb(nlt_bgc_Am),reactb(nlt_bgc_DON(1)),DON_r(1),DON_s(1)
2100 : ! call icepack_warnings_add(warnstr)
2101 : ! write(warnstr,*) subname, 'Zoo:',Zoo
2102 : ! endif
2103 :
2104 267982821 : end subroutine algal_dyn
2105 :
2106 : !=======================================================================
2107 : !
2108 : ! Find ice-ocean flux when ice is thin and internal dynamics/reactions are
2109 : ! assumed to be zero
2110 : !
2111 : ! authors Nicole Jeffery, LANL
2112 :
2113 17377134 : subroutine thin_ice_flux (hin, hin_old, Cin, flux_o_tot, &
2114 : source, dt, nblyr, & ! LCOV_EXCL_LINE
2115 : ocean_bio)
2116 :
2117 : integer (kind=int_kind), intent(in) :: &
2118 : nblyr ! number of bio layers
2119 :
2120 : real (kind=dbl_kind), dimension(nblyr+1), intent(inout) :: &
2121 : Cin ! initial concentration*hin_old*phin
2122 :
2123 : real (kind=dbl_kind), intent(in) :: &
2124 : hin_old , & ! brine thickness (m) ! LCOV_EXCL_LINE
2125 : hin , & ! new brine thickness (m) ! LCOV_EXCL_LINE
2126 : dt , & ! time step ! LCOV_EXCL_LINE
2127 : source , & ! atm, ocean, dust flux (mmol/m^2) ! LCOV_EXCL_LINE
2128 : ocean_bio ! ocean tracer concentration (mmol/m^3)
2129 :
2130 : real (kind=dbl_kind), intent(inout) :: &
2131 : flux_o_tot ! tracer flux, gravity+molecular drainage flux ,
2132 : ! and boundary flux to ocean (mmol/m^2/s)
2133 : ! positive into the ocean
2134 :
2135 : ! local variables
2136 :
2137 : integer (kind=int_kind) :: &
2138 : k ! vertical biology layer index
2139 :
2140 : real (kind=dbl_kind) :: &
2141 : sum_bio, & ! initial bio mass (mmol/m^2) ! LCOV_EXCL_LINE
2142 : zspace, & ! 1/nblyr ! LCOV_EXCL_LINE
2143 : dC, & ! added ocean bio mass (mmol/m^2) ! LCOV_EXCL_LINE
2144 172824 : dh ! change in thickness (m)
2145 :
2146 : character(len=*),parameter :: subname='(thin_ice_flux)'
2147 :
2148 17377134 : zspace = c1/real(nblyr,kind=dbl_kind)
2149 :
2150 17377134 : dC = c0
2151 17377134 : sum_bio = c0
2152 17377134 : dh = hin-hin_old
2153 :
2154 17377134 : if (dh .le. c0) then ! keep the brine concentration fixed
2155 14818556 : sum_bio = (Cin(1)+Cin(nblyr+1))/hin_old*zspace*p5
2156 14818556 : Cin(1) = Cin(1)/hin_old*hin
2157 14818556 : Cin(nblyr+1) = Cin(nblyr+1)/hin_old*hin
2158 103729892 : do k = 2, nblyr
2159 88911336 : sum_bio = sum_bio + Cin(k)/hin_old*zspace
2160 103729892 : Cin(k) = Cin(k)/hin_old*hin + dC
2161 : enddo
2162 : else
2163 2558578 : dC = dh*ocean_bio
2164 23027202 : do k = 1, nblyr+1
2165 23027202 : Cin(k) = Cin(k) + dC
2166 : enddo
2167 : endif
2168 :
2169 17377134 : flux_o_tot = - dh*sum_bio/dt - dC/dt + source/dt
2170 :
2171 17377134 : end subroutine thin_ice_flux
2172 :
2173 : !=======================================================================
2174 : !
2175 : ! Compute matrix elements for the low order solution of FEM-FCT scheme
2176 : ! Predictor step
2177 : !
2178 : ! July, 2014 by N. Jeffery
2179 : !
2180 1646235069 : subroutine compute_FCT_matrix (C_in, sbdiag, dt, nblyr, &
2181 : diag, spdiag, rhs, bgrid, & ! LCOV_EXCL_LINE
2182 : darcyV, dhtop, dhbot, & ! LCOV_EXCL_LINE
2183 : iphin_N, iDin, hbri_old, & ! LCOV_EXCL_LINE
2184 : atm_add, bphin_N, & ! LCOV_EXCL_LINE
2185 : C_top, C_bot, Qbot, Qtop, & ! LCOV_EXCL_LINE
2186 : Sink_bot, Sink_top, & ! LCOV_EXCL_LINE
2187 548745023 : D_sbdiag, D_spdiag, ML)
2188 :
2189 : integer (kind=int_kind), intent(in) :: &
2190 : nblyr ! number of bio layers
2191 :
2192 : real (kind=dbl_kind), dimension(nblyr+1), intent(in) :: &
2193 : C_in ! Initial (bulk) concentration*hbri_old (mmol/m^2)
2194 : ! conserved quantity on i_grid
2195 :
2196 : real (kind=dbl_kind), intent(in) :: &
2197 : dt ! time step
2198 :
2199 : real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: &
2200 : iDin ! Diffusivity on the igrid (1/s)
2201 :
2202 : real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: &
2203 : iphin_N ! Porosity with min condition on igrid
2204 :
2205 : real (kind=dbl_kind), dimension (nblyr+2), intent(in) :: &
2206 : bphin_N, & ! Porosity with min condition on igrid ! LCOV_EXCL_LINE
2207 : bgrid
2208 :
2209 : real (kind=dbl_kind), dimension (nblyr+1), &
2210 : intent(out) :: & ! LCOV_EXCL_LINE
2211 : sbdiag , & ! sub-diagonal matrix elements ! LCOV_EXCL_LINE
2212 : diag , & ! diagonal matrix elements ! LCOV_EXCL_LINE
2213 : spdiag , & ! super-diagonal matrix elements ! LCOV_EXCL_LINE
2214 : rhs , & ! rhs of tri-diagonal matrix eqn. ! LCOV_EXCL_LINE
2215 : ML, & ! lumped mass matrix ! LCOV_EXCL_LINE
2216 : D_spdiag, D_sbdiag ! artificial diffusion matrix
2217 :
2218 : real (kind=dbl_kind), intent(in) :: &
2219 : dhtop , & ! Change in brine top (m) ! LCOV_EXCL_LINE
2220 : dhbot , & ! Change in brine bottom (m) ! LCOV_EXCL_LINE
2221 : hbri_old , & ! brine height (m) ! LCOV_EXCL_LINE
2222 : atm_add , & ! atm-ice flux ! LCOV_EXCL_LINE
2223 : C_top , & ! bulk surface source (mmol/m^2) ! LCOV_EXCL_LINE
2224 : C_bot , & ! bulk bottom source (mmol/m^2) ! LCOV_EXCL_LINE
2225 : darcyV ! Darcy velocity (m/s
2226 :
2227 : real (kind=dbl_kind), intent(inout) :: & ! positive into ice
2228 : Qtop , & ! top flux source (mmol/m^2/s) ! LCOV_EXCL_LINE
2229 : Qbot , & ! bottom flux source (mmol/m^2/s) ! LCOV_EXCL_LINE
2230 : Sink_bot , & ! rest of bottom flux (sink or source) (mmol/m^2/s) ! LCOV_EXCL_LINE
2231 : Sink_top ! rest oftop flux (sink or source) (mmol/m^2/s)
2232 :
2233 : ! local variables
2234 :
2235 : real (kind=dbl_kind) :: &
2236 3080166 : vel, vel2, dphi_dx, zspace
2237 :
2238 : integer (kind=int_kind) :: &
2239 : k ! vertical index
2240 :
2241 : real (kind=dbl_kind), dimension (nblyr+1) :: &
2242 : Q_top, Q_bot, & ! surface and bottom source ! LCOV_EXCL_LINE
2243 : K_diag, K_spdiag, K_sbdiag, & ! advection matrix ! LCOV_EXCL_LINE
2244 : S_diag, S_spdiag, S_sbdiag, & ! diffusion matrix ! LCOV_EXCL_LINE
2245 1120591291 : D_diag, iDin_phi
2246 :
2247 : real (kind=dbl_kind), dimension (nblyr) :: &
2248 1119051208 : kvector1, kvectorn1
2249 :
2250 : character(len=*),parameter :: subname='(compute_FCT_matrix)'
2251 :
2252 : !---------------------------------------------------------------------
2253 : ! Diag (jj) solve for j = 1:nblyr+1
2254 : ! spdiag(j) == (j,j+1) solve for j = 1:nblyr otherwise 0
2255 : ! sbdiag(j) == (j,j-1) solve for j = 2:nblyr+1 otherwise 0
2256 : !---------------------------------------------------------------------
2257 4389960184 : kvector1(:) = c0
2258 548745023 : kvector1(1) = c1
2259 4389960184 : kvectorn1(:) = c1
2260 548745023 : kvectorn1(1) = c0
2261 :
2262 548745023 : zspace = c1/real(nblyr,kind=dbl_kind)
2263 548745023 : Qbot = c0
2264 548745023 : Qtop = c0
2265 548745023 : Sink_bot = c0
2266 548745023 : Sink_top = c0
2267 :
2268 : ! compute the lumped mass matrix
2269 :
2270 4938705207 : ML(:) = zspace
2271 548745023 : ML(1) = zspace/c2
2272 548745023 : ML(nblyr+1) = zspace/c2
2273 :
2274 : ! compute matrix K: K_diag , K_sbdiag, K_spdiag
2275 : ! compute matrix S: S_diag, S_sbdiag, S_spdiag
2276 :
2277 4938705207 : K_diag(:) = c0
2278 4938705207 : D_diag(:) = c0
2279 4938705207 : D_spdiag(:) = c0
2280 4938705207 : D_sbdiag(:) = c0
2281 4938705207 : K_spdiag(:) = c0
2282 4938705207 : K_sbdiag(:) = c0
2283 4938705207 : S_diag(:) = c0
2284 4938705207 : S_spdiag(:) = c0
2285 4938705207 : S_sbdiag(:) = c0
2286 4938705207 : iDin_phi(:) = c0
2287 :
2288 548745023 : iDin_phi(1) = c0 !element 1
2289 548745023 : iDin_phi(nblyr+1) = iDin(nblyr+1)/iphin_N(nblyr+1) !outside ice at bottom
2290 548745023 : iDin_phi(nblyr) = p5*(iDin(nblyr+1)/iphin_N(nblyr+1)+iDin(nblyr)/iphin_N(nblyr))
2291 :
2292 548745023 : vel = (bgrid(2)*dhbot - (bgrid(2)-c1)*dhtop)/dt+darcyV/bphin_N(2)
2293 548745023 : K_diag(1) = p5*vel/hbri_old
2294 548745023 : dphi_dx = (iphin_N(nblyr+1) - iphin_N(nblyr))/(zspace)
2295 548745023 : vel = (bgrid(nblyr+1)*dhbot - (bgrid(nblyr+1)-c1)*dhtop)/dt +darcyV/bphin_N(nblyr+1)
2296 548745023 : vel = vel/hbri_old
2297 548745023 : vel2 = (dhbot/hbri_old/dt +darcyV/hbri_old)
2298 3080166 : K_diag(nblyr+1) = min(c0, vel2) - iDin_phi(nblyr+1)/(zspace+ grid_o/hbri_old) &
2299 551825189 : + p5*(-vel + iDin_phi(nblyr)/bphin_N(nblyr+1)*dphi_dx)
2300 :
2301 3841215161 : do k = 1, nblyr-1
2302 3292470138 : vel = (bgrid(k+1)*dhbot - (bgrid(k+1)-c1)*dhtop)/dt+darcyV/bphin_N(k+1)
2303 3292470138 : iDin_phi(k+1) = p5*(iDin(k+2)/iphin_N(k+2) + iDin(k+1)/iphin_N(k+1))
2304 3292470138 : dphi_dx = (iphin_N(k+1) - iphin_N(k))/(zspace)
2305 9240498 : K_spdiag(k)= p5*(vel/hbri_old - &
2306 3292470138 : iDin_phi(k)/(bphin_N(k+1))*dphi_dx)
2307 :
2308 3292470138 : vel = (bgrid(k+1)*dhbot - (bgrid(k+1)-c1)*dhtop)/dt +darcyV/bphin_N(k+1)
2309 3292470138 : dphi_dx = c0
2310 3292470138 : dphi_dx = kvectorn1(k)*(iphin_N(k+1) - iphin_N(k))/(zspace)
2311 9240498 : K_sbdiag(k+1)= -p5*(vel/hbri_old- &
2312 3301710636 : iDin_phi(k)/bphin_N(k+1)*dphi_dx)
2313 3292470138 : K_diag(k) = K_diag(1)*kvector1(k) + (K_spdiag(k) + K_sbdiag(k))*kvectorn1(k)
2314 :
2315 3292470138 : S_diag(k+1) = -(iDin_phi(k)+ iDin_phi(k+1))/zspace
2316 3292470138 : S_spdiag(k) = iDin_phi(k)/zspace
2317 3841215161 : S_sbdiag(k+1) = iDin_phi(k)/zspace
2318 : enddo
2319 :
2320 : ! k = nblyr
2321 :
2322 548745023 : vel = (bgrid(nblyr+1)*dhbot - (bgrid(nblyr+1)-c1)*dhtop)/dt+darcyV/bphin_N(nblyr+1)
2323 548745023 : dphi_dx = (iphin_N(nblyr+1) - iphin_N(nblyr))/(zspace)
2324 1540083 : K_spdiag(nblyr)= p5*(vel/hbri_old - &
2325 550285106 : iDin_phi(nblyr)/(bphin_N(nblyr+1))*dphi_dx)
2326 548745023 : vel = (bgrid(nblyr+1)*dhbot - (bgrid(nblyr+1)-c1)*dhtop)/dt +darcyV/bphin_N(nblyr+1)
2327 548745023 : dphi_dx = kvectorn1(nblyr)*(iphin_N(nblyr+1) - iphin_N(nblyr))/(zspace)
2328 1540083 : K_sbdiag(nblyr+1)= -p5*(vel/hbri_old- &
2329 550285106 : iDin_phi(nblyr)/bphin_N(nblyr+1)*dphi_dx)
2330 548745023 : K_diag(nblyr) = K_spdiag(nblyr) + K_sbdiag(nblyr)
2331 548745023 : S_diag(nblyr+1) = -iDin_phi(nblyr)/zspace
2332 548745023 : S_spdiag(nblyr) = iDin_phi(nblyr)/zspace
2333 548745023 : S_sbdiag(nblyr+1) = iDin_phi(nblyr)/zspace
2334 :
2335 : ! compute matrix artificial D: D_spdiag, D_diag (D_spdiag(k) = D_sbdiag(k+1))
2336 :
2337 4389960184 : do k = 1,nblyr
2338 3841215161 : D_spdiag(k) = max(-K_spdiag(k), c0, -K_sbdiag(k+1))
2339 4389960184 : D_sbdiag(k+1) = D_spdiag(k)
2340 : enddo
2341 4938705207 : do k = 1,nblyr+1
2342 4938705207 : D_diag(k) = D_diag(k) - D_spdiag(k) - D_sbdiag(k)
2343 : enddo
2344 :
2345 : ! compute Q_top and Q_bot: top and bottom sources
2346 :
2347 548745023 : vel2 = -(dhtop/hbri_old/dt +darcyV/bphin_N(1)/hbri_old)
2348 :
2349 4938705207 : Q_top(:) = c0
2350 548745023 : Q_top(1) = max(c0,vel2*C_top + atm_add/dt)
2351 548745023 : Qtop = Q_top(1)
2352 :
2353 548745023 : vel = (dhbot/hbri_old/dt +darcyV/hbri_old) ! going from iphin_N(nblyr+1) to c1 makes a difference
2354 :
2355 4938705207 : Q_bot(:) = c0
2356 3080166 : Q_bot(nblyr+1) = max(c0,vel*C_bot) + iDin_phi(nblyr+1)*C_bot&
2357 550285106 : /(zspace + grid_o/hbri_old)
2358 :
2359 548745023 : Qbot = Q_bot(nblyr+1)
2360 :
2361 548745023 : Sink_bot = K_diag(nblyr+1) + K_spdiag(nblyr)
2362 548745023 : Sink_top = K_diag(1) + K_sbdiag(2)
2363 :
2364 : !compute matrix elements (1 to nblyr+1)
2365 :
2366 4938705207 : spdiag = -dt * (D_spdiag + K_spdiag + S_spdiag)
2367 4938705207 : sbdiag = -dt * (D_sbdiag + K_sbdiag + S_sbdiag)
2368 4938705207 : diag = ML - dt * (D_diag + K_diag + S_diag)
2369 4938705207 : rhs = ML * C_in + dt * Q_top + dt* Q_bot
2370 :
2371 548745023 : end subroutine compute_FCT_matrix
2372 :
2373 : !=======================================================================
2374 : !
2375 : ! Compute matrices for final solution FCT for passive tracers
2376 : ! Corrector step
2377 : !
2378 : ! July, 2014 by N. Jeffery
2379 : !
2380 548745023 : subroutine compute_FCT_corr (C_in, C_low, dt, nblyr, &
2381 548745023 : D_sbdiag, D_spdiag, ML)
2382 :
2383 : integer (kind=int_kind), intent(in) :: &
2384 : nblyr ! number of bio layers
2385 :
2386 : real (kind=dbl_kind), dimension(nblyr+1), intent(in) :: &
2387 : C_in ! Initial (bulk) concentration*hbri_old (mmol/m^2)
2388 : ! conserved quantity on igrid
2389 :
2390 : real (kind=dbl_kind), dimension(nblyr+1), intent(inout) :: &
2391 : C_low ! Low order solution (mmol/m^2) corrected
2392 :
2393 : real (kind=dbl_kind), intent(in) :: &
2394 : dt ! time step
2395 :
2396 : real (kind=dbl_kind), dimension (nblyr+1), &
2397 : intent(in) :: & ! LCOV_EXCL_LINE
2398 : D_sbdiag , & ! sub-diagonal artificial diffusion matrix elements ! LCOV_EXCL_LINE
2399 : ML , & ! Lumped mass diagonal matrix elements ! LCOV_EXCL_LINE
2400 : D_spdiag ! super-diagonal artificial diffusion matrix elements
2401 :
2402 : ! local variables
2403 :
2404 : real (kind=dbl_kind) :: &
2405 1540083 : zspace
2406 :
2407 : integer (kind=int_kind) :: &
2408 : k ! vertical index
2409 :
2410 : real (kind=dbl_kind), dimension (nblyr+1) :: &
2411 : M_spdiag, M_sbdiag, & ! mass matrix ! LCOV_EXCL_LINE
2412 : F_diag, F_spdiag, F_sbdiag, & ! anti-diffusive matrix ! LCOV_EXCL_LINE
2413 : Pplus, Pminus, & ! ! LCOV_EXCL_LINE
2414 : Qplus, Qminus, & ! ! LCOV_EXCL_LINE
2415 : Rplus, Rminus, & ! ! LCOV_EXCL_LINE
2416 1122131374 : a_spdiag, a_sbdiag ! weightings of F
2417 :
2418 : character(len=*),parameter :: subname='(compute_FCT_corr)'
2419 :
2420 : !---------------------------------------------------------------------
2421 : ! Diag (jj) solve for j = 1:nblyr+1
2422 : ! spdiag(j) == (j,j+1) solve for j = 1:nblyr otherwise 0
2423 : ! sbdiag(j) == (j,j-1) solve for j = 2:nblyr+1 otherwise 0
2424 : !---------------------------------------------------------------------
2425 :
2426 548745023 : zspace = c1/real(nblyr,kind=dbl_kind)
2427 :
2428 : ! compute the mass matrix
2429 :
2430 4938705207 : M_spdiag(:) = zspace/c6
2431 548745023 : M_spdiag(nblyr+1) = c0
2432 4938705207 : M_sbdiag(:) = zspace/c6
2433 548745023 : M_sbdiag(1) = c0
2434 :
2435 : ! compute off matrix F:
2436 :
2437 4938705207 : F_diag(:) = c0
2438 4938705207 : F_spdiag(:) = c0
2439 4938705207 : F_sbdiag(:) = c0
2440 :
2441 4389960184 : do k = 1, nblyr
2442 32341743 : F_spdiag(k) = M_spdiag(k)*(C_low(k)-C_in(k) - C_low(k+1)+ C_in(k+1))/dt &
2443 3862776323 : + D_spdiag(k)*(C_low(k)-C_low(k+1))
2444 43122324 : F_sbdiag(k+1) = M_sbdiag(k+1)*(C_low(k+1)-C_in(k+1) - C_low(k)+ C_in(k))/dt &
2445 3884337485 : + D_sbdiag(k+1)*(C_low(k+1)-C_low(k))
2446 :
2447 3841215161 : if (F_spdiag(k)*(C_low(k) - C_low(k+1)) > c0) F_spdiag(k) = c0
2448 4389960184 : if (F_sbdiag(k+1)*(C_low(k+1) - C_low(k)) > c0) F_sbdiag(k+1) = c0
2449 : enddo
2450 :
2451 4938705207 : if (maxval(abs(F_spdiag)) > c0) then
2452 :
2453 : ! compute the weighting factors: a_spdiag, a_sbdiag
2454 :
2455 3477662586 : a_spdiag(:) = c0
2456 3477662586 : a_sbdiag(:) = c0
2457 :
2458 386406954 : Pplus(1) = max(c0, F_spdiag(1))
2459 386406954 : Pminus(1) = min(c0, F_spdiag(1))
2460 386406954 : Pplus(nblyr+1) = max(c0, F_sbdiag(nblyr+1))
2461 386406954 : Pminus(nblyr+1) = min(c0, F_sbdiag(nblyr+1))
2462 386406954 : Qplus(1) = max(c0,C_low(2)-C_low(1))
2463 386406954 : Qminus(1)= min(c0,C_low(2)-C_low(1))
2464 386406954 : Qplus(nblyr+1) = max(c0,C_low(nblyr)-C_low(nblyr+1))
2465 386406954 : Qminus(nblyr+1)= min(c0,C_low(nblyr)-C_low(nblyr+1))
2466 386406954 : Rplus(1) = min(c1, ML(1)*Qplus(1)/dt/(Pplus(1)+puny))
2467 386406954 : Rminus(1) = min(c1, ML(1)*Qminus(1)/dt/(Pminus(1)-puny))
2468 386406954 : Rplus(nblyr+1) = min(c1, ML(nblyr+1)*Qplus(nblyr+1)/dt/(Pplus(nblyr+1)+puny))
2469 386406954 : Rminus(nblyr+1) = min(c1, ML(nblyr+1)*Qminus(nblyr+1)/dt/(Pminus(nblyr+1)-puny))
2470 2704848678 : do k = 2,nblyr
2471 2318441724 : Pplus(k) = max(c0,F_spdiag(k)) + max(c0,F_sbdiag(k))
2472 2318441724 : Pminus(k) = min(c0,F_spdiag(k)) + min(c0,F_sbdiag(k))
2473 2318441724 : Qplus(k) = max(c0, max(C_low(k+1)-C_low(k),C_low(k-1)-C_low(k)))
2474 2318441724 : Qminus(k) = min(c0, min(C_low(k+1)-C_low(k),C_low(k-1)-C_low(k)))
2475 2318441724 : Rplus(k) = min(c1, ML(k)*Qplus(k)/dt/(Pplus(k)+puny))
2476 2704848678 : Rminus(k) = min(c1, ML(k)*Qminus(k)/dt/(Pminus(k)-puny))
2477 : enddo
2478 :
2479 3091255632 : do k = 1, nblyr
2480 2704848678 : a_spdiag(k) = min(Rminus(k),Rplus(k+1))
2481 2704848678 : if (F_spdiag(k) > c0) a_spdiag(k) = min(Rplus(k),Rminus(k+1))
2482 2704848678 : a_sbdiag(k+1) = min(Rminus(k+1),Rplus(k))
2483 3091255632 : if (F_sbdiag(k+1) > c0) a_sbdiag(k+1) = min(Rplus(k+1),Rminus(k))
2484 : enddo
2485 :
2486 : !compute F_diag:
2487 :
2488 386406954 : F_diag(1) = a_spdiag(1)*F_spdiag(1)
2489 386406954 : F_diag(nblyr+1) = a_sbdiag(nblyr+1)* F_sbdiag(nblyr+1)
2490 386406954 : C_low(1) = C_low(1) + dt*F_diag(1)/ML(1)
2491 386406954 : C_low(nblyr+1) = C_low(nblyr+1) + dt*F_diag(nblyr+1)/ML(nblyr+1)
2492 :
2493 2704848678 : do k = 2,nblyr
2494 2318441724 : F_diag(k) = a_spdiag(k)*F_spdiag(k) + a_sbdiag(k)*F_sbdiag(k)
2495 2704848678 : C_low(k) = C_low(k) + dt*F_diag(k)/ML(k)
2496 : enddo
2497 :
2498 : endif !F_spdiag is nonzero
2499 :
2500 548745023 : end subroutine compute_FCT_corr
2501 :
2502 : !=======================================================================
2503 : !
2504 : ! Tridiagonal matrix solver-- for salinity
2505 : !
2506 : ! authors William H. Lipscomb, LANL
2507 : ! C. M. Bitz, UW
2508 : !
2509 1097490046 : subroutine tridiag_solverz (nmat, sbdiag, &
2510 : diag, spdiag, & ! LCOV_EXCL_LINE
2511 548745023 : rhs, xout)
2512 :
2513 : integer (kind=int_kind), intent(in) :: &
2514 : nmat ! matrix dimension
2515 :
2516 : real (kind=dbl_kind), dimension (nmat), intent(in) :: &
2517 : sbdiag , & ! sub-diagonal matrix elements ! LCOV_EXCL_LINE
2518 : diag , & ! diagonal matrix elements ! LCOV_EXCL_LINE
2519 : spdiag , & ! super-diagonal matrix elements ! LCOV_EXCL_LINE
2520 : rhs ! rhs of tri-diagonal matrix eqn.
2521 :
2522 : real (kind=dbl_kind), dimension (nmat), intent(inout) :: &
2523 : xout ! solution vector
2524 :
2525 : ! local variables
2526 :
2527 : integer (kind=int_kind) :: &
2528 : k ! row counter
2529 :
2530 : real (kind=dbl_kind) :: &
2531 1540083 : wbeta ! temporary matrix variable
2532 :
2533 : real (kind=dbl_kind), dimension(nmat):: &
2534 1108270627 : wgamma ! temporary matrix variable
2535 :
2536 : character(len=*),parameter :: subname='(tridiag_solverz)'
2537 :
2538 548745023 : wbeta = diag(1)
2539 548745023 : xout(1) = rhs(1) / wbeta
2540 :
2541 4389960184 : do k = 2, nmat
2542 3841215161 : wgamma(k) = spdiag(k-1) / wbeta
2543 3841215161 : wbeta = diag(k) - sbdiag(k)*wgamma(k)
2544 4389960184 : xout(k) = (rhs(k) - sbdiag(k)*xout(k-1)) / wbeta
2545 : enddo ! k
2546 :
2547 4389960184 : do k = nmat-1, 1, -1
2548 4389960184 : xout(k) = xout(k) - wgamma(k+1)*xout(k+1)
2549 : enddo ! k
2550 :
2551 548745023 : end subroutine tridiag_solverz
2552 :
2553 : !=======================================================================
2554 : !
2555 : ! authors Nicole Jeffery, LANL
2556 :
2557 548745023 : subroutine check_conservation_FCT (C_init, C_new, C_low, S_top, &
2558 : S_bot, L_bot, L_top, dt, & ! LCOV_EXCL_LINE
2559 : fluxbio, nblyr, & ! LCOV_EXCL_LINE
2560 : source)
2561 :
2562 : integer (kind=int_kind), intent(in) :: &
2563 : nblyr ! number of bio layers
2564 :
2565 : real (kind=dbl_kind), dimension(nblyr+1), intent(in) :: &
2566 : C_init , & ! initial bulk concentration * h_old (mmol/m^2) ! LCOV_EXCL_LINE
2567 : C_new ! new bulk concentration * h_new (mmol/m^2)
2568 :
2569 : real (kind=dbl_kind), dimension(nblyr+1), intent(out) :: &
2570 : C_low ! define low order solution = C_new
2571 :
2572 : real (kind=dbl_kind), intent(in) :: &
2573 : S_top , & ! surface flux into ice (mmol/m^2/s) ! LCOV_EXCL_LINE
2574 : S_bot , & ! bottom flux into ice (mmol/m^2/s) ! LCOV_EXCL_LINE
2575 : L_bot , & ! remaining bottom flux into ice (mmol/m^2/s) ! LCOV_EXCL_LINE
2576 : L_top , & ! remaining top flux into ice (mmol/m^2/s) ! LCOV_EXCL_LINE
2577 : dt , & ! LCOV_EXCL_LINE
2578 : source ! nutrient source from snow and atmosphere (mmol/m^2)
2579 :
2580 : real (kind=dbl_kind), intent(inout) :: &
2581 : fluxbio ! (mmol/m^2/s) positive down (into the ocean)
2582 :
2583 : ! local variables
2584 :
2585 : integer (kind=int_kind) :: &
2586 : k
2587 :
2588 : real (kind=dbl_kind) :: &
2589 : diff_dt , & ! LCOV_EXCL_LINE
2590 : C_init_tot , & ! LCOV_EXCL_LINE
2591 : C_new_tot , & ! LCOV_EXCL_LINE
2592 : zspace , & !1/nblyr ! LCOV_EXCL_LINE
2593 1540083 : accuracy ! centered difference is Order(zspace^2)
2594 :
2595 : character(len=*),parameter :: subname='(check_conservation_FCT)'
2596 :
2597 548745023 : zspace = c1/real(nblyr,kind=dbl_kind)
2598 :
2599 : !-------------------------------------
2600 : ! Ocean flux: positive into the ocean
2601 : !-------------------------------------
2602 548745023 : C_init_tot = (C_init(1) + C_init(nblyr+1))*zspace*p5
2603 548745023 : C_new_tot = (C_new(1) + C_new(nblyr+1))*zspace*p5
2604 548745023 : C_low(1) = C_new(1)
2605 548745023 : C_low(nblyr+1) = C_new(nblyr+1)
2606 :
2607 3841215161 : do k = 2, nblyr
2608 3292470138 : C_init_tot = C_init_tot + C_init(k)*zspace
2609 3292470138 : C_new_tot = C_new_tot + C_new(k)*zspace
2610 3841215161 : C_low(k) = C_new(k)
2611 : enddo
2612 :
2613 548745023 : accuracy = 1.0e-14_dbl_kind*max(c1, C_init_tot, C_new_tot)
2614 548745023 : fluxbio = (C_init_tot - C_new_tot + source)/dt
2615 548745023 : diff_dt =C_new_tot - C_init_tot - (S_top+S_bot+L_bot*C_new(nblyr+1)+L_top*C_new(1))*dt
2616 :
2617 4938705207 : if (minval(C_low) < c0) then
2618 0 : write(warnstr,*) subname, 'Positivity of zbgc low order solution failed: C_low:',C_low
2619 0 : call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
2620 : endif
2621 :
2622 548745023 : if (abs(diff_dt) > accuracy ) then
2623 0 : call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
2624 0 : write(warnstr,*) subname, 'Conservation of zbgc low order solution failed: diff_dt:',&
2625 0 : diff_dt
2626 0 : write(warnstr,*) subname, 'Total initial tracer', C_init_tot
2627 0 : write(warnstr,*) subname, 'Total final1 tracer', C_new_tot
2628 0 : write(warnstr,*) subname, 'bottom final tracer', C_new(nblyr+1)
2629 0 : write(warnstr,*) subname, 'top final tracer', C_new(1)
2630 0 : write(warnstr,*) subname, 'Near bottom final tracer', C_new(nblyr)
2631 0 : write(warnstr,*) subname, 'Near top final tracer', C_new(2)
2632 0 : write(warnstr,*) subname, 'Top flux*dt into ice:', S_top*dt
2633 0 : write(warnstr,*) subname, 'Bottom flux*dt into ice:', S_bot*dt
2634 0 : write(warnstr,*) subname, 'Remaining bot flux*dt into ice:', L_bot*C_new(nblyr+1)*dt
2635 0 : write(warnstr,*) subname, 'S_bot*dt + L_bot*C_new(nblyr+1)*dt'
2636 0 : write(warnstr,*) subname, S_bot*dt + L_bot*C_new(nblyr+1)*dt
2637 0 : write(warnstr,*) subname, 'fluxbio*dt:', fluxbio*dt
2638 0 : write(warnstr,*) subname, 'fluxbio:', fluxbio
2639 0 : write(warnstr,*) subname, 'Remaining top flux*dt into ice:', L_top*C_new(1)*dt
2640 : endif
2641 :
2642 548745023 : end subroutine check_conservation_FCT
2643 :
2644 : !=======================================================================
2645 :
2646 : ! For each grid cell, sum field over all ice and snow layers
2647 : !
2648 : ! author: Nicole Jeffery, LANL
2649 :
2650 0 : subroutine bgc_column_sum (nblyr, nslyr, hsnow, hbrine, xin, xout)
2651 :
2652 : integer (kind=int_kind), intent(in) :: &
2653 : nblyr, & ! number of ice layers ! LCOV_EXCL_LINE
2654 : nslyr ! number of snow layers
2655 :
2656 : real (kind=dbl_kind), dimension(nblyr+3), intent(in) :: &
2657 : xin ! input field
2658 :
2659 : real (kind=dbl_kind), intent(in) :: &
2660 : hsnow, & ! snow thickness ! LCOV_EXCL_LINE
2661 : hbrine ! brine height
2662 :
2663 : real (kind=dbl_kind), intent(out) :: &
2664 : xout ! output field
2665 :
2666 : ! local variables
2667 :
2668 : real (kind=dbl_kind) :: &
2669 : dzssl, & ! snow surface layer (m) ! LCOV_EXCL_LINE
2670 : dzint, & ! snow interior depth (m) ! LCOV_EXCL_LINE
2671 : hslyr, & ! snow layer thickness (m) ! LCOV_EXCL_LINE
2672 0 : zspace ! brine layer thickness/hbrine
2673 :
2674 : integer (kind=int_kind) :: &
2675 : n ! category/layer index
2676 :
2677 : character(len=*),parameter :: subname='(bgc_column_sum)'
2678 :
2679 0 : hslyr = hsnow/real(nslyr,kind=dbl_kind)
2680 0 : dzssl = min(hslyr*p5, hs_ssl)
2681 0 : dzint = max(c0,hsnow - dzssl)
2682 0 : zspace = c1/real(nblyr,kind=dbl_kind)
2683 :
2684 0 : xout = c0
2685 0 : xout = (xin(1) + xin(nblyr+1))*hbrine*p5*zspace
2686 0 : do n = 2, nblyr
2687 0 : xout = xout + xin(n)*zspace*hbrine
2688 : enddo ! n
2689 0 : xout = xout + dzssl*xin(nblyr+2) + dzint*xin(nblyr+3)
2690 :
2691 0 : end subroutine bgc_column_sum
2692 :
2693 : !=======================================================================
2694 :
2695 : end module icepack_algae
2696 :
2697 : !=======================================================================
|
