Line data Source code
1 : !=======================================================================
2 : !
3 : ! Biogeochemistry variables
4 : !
5 : ! authors: Nicole Jeffery, LANL
6 : ! Scott Elliot, LANL
7 : ! Elizabeth C. Hunke, LANL
8 : !
9 : module icepack_zbgc_shared
10 :
11 : use icepack_kinds
12 : use icepack_parameters, only: p5, c0, c1, secday, puny
13 : use icepack_parameters, only: hs_ssl, sk_l
14 : use icepack_parameters, only: rhoi, cp_ocn, cp_ice, Lfresh
15 : use icepack_parameters, only: solve_zbgc
16 : use icepack_parameters, only: fr_resp
17 : use icepack_tracers, only: nbtrcr, ntrcr, nblyr, nilyr, nslyr
18 : use icepack_tracers, only: n_algae
19 : use icepack_tracers, only: max_nbtrcr, max_algae, max_doc, max_fe
20 : use icepack_tracers, only: max_don, max_aero, max_dic
21 : use icepack_tracers, only: nt_bgc_N, nt_fbri, nlt_bgc_N
22 : use icepack_warnings, only: warnstr, icepack_warnings_add
23 : use icepack_warnings, only: icepack_warnings_setabort, icepack_warnings_aborted
24 :
25 : implicit none
26 :
27 : private
28 : public :: calculate_qin_from_Sin, &
29 : remap_zbgc, & ! LCOV_EXCL_LINE
30 : zap_small_bgc, & ! LCOV_EXCL_LINE
31 : regrid_stationary, & ! LCOV_EXCL_LINE
32 : merge_bgc_fluxes, & ! LCOV_EXCL_LINE
33 : merge_bgc_fluxes_skl
34 :
35 : !-----------------------------------------------------------------
36 : ! Transport type
37 : !-----------------------------------------------------------------
38 : ! In delta Eddington, algal particles are assumed to cause no
39 : ! significant scattering (Brieglib and Light), only absorption
40 : ! in the visible spectral band (200-700 nm)
41 : ! Algal types: Diatoms, flagellates, Phaeocycstis
42 : ! DOC : Proteins, EPS, Lipids
43 : !-----------------------------------------------------------------
44 : !------------------------------------------------------------
45 : ! Aerosol order and type should be consistent with order/type
46 : ! specified in delta Eddington: 1) hydrophobic black carbon;
47 : ! 2) hydrophilic black carbon; 3) dust (0.05-0.5 micron);
48 : ! 4) dust (0.5-1.25 micron); 5) dust (1.25-2.5 micron);
49 : ! 6) dust (2.5-5 micron)
50 : !-------------------------------------------------------------
51 :
52 : ! bio parameters for algal_dyn
53 :
54 : real (kind=dbl_kind), dimension(max_algae), public :: &
55 : R_C2N , & ! algal C to N (mole/mole) ! LCOV_EXCL_LINE
56 : R_chl2N , & ! 3 algal chlorophyll to N (mg/mmol) ! LCOV_EXCL_LINE
57 : F_abs_chl ! to scale absorption in Dedd
58 :
59 : real (kind=dbl_kind), dimension(max_don), public :: & ! increase compare to algal R_Fe2C
60 : R_C2N_DON
61 :
62 : real (kind=dbl_kind), dimension(max_algae), public :: &
63 : R_Si2N , & ! algal Sil to N (mole/mole) ! LCOV_EXCL_LINE
64 : R_S2N , & ! algal S to N (mole/mole) ! LCOV_EXCL_LINE
65 : ! Marchetti et al 2006, 3 umol Fe/mol C for iron limited Pseudo-nitzschia
66 : R_Fe2C , & ! algal Fe to carbon (umol/mmol)
67 : R_Fe2N ! algal Fe to N (umol/mmol)
68 :
69 : real (kind=dbl_kind), dimension(max_don), public :: &
70 : R_Fe2DON ! Fe to N of DON (nmol/umol)
71 :
72 : real (kind=dbl_kind), dimension(max_doc), public :: &
73 : R_Fe2DOC ! Fe to C of DOC (nmol/umol)
74 :
75 : real (kind=dbl_kind), parameter, public :: &
76 : R_gC2molC = 12.01_dbl_kind ! mg/mmol C
77 :
78 : ! scavenging coefficient for tracers in snow
79 : ! bottom to last 6 are from Flanner et al., 2007
80 : ! very last one is for humic material
81 : real (kind=dbl_kind), parameter, dimension(max_nbtrcr), public :: &
82 : kscavz = (/ 0.03_dbl_kind, 0.03_dbl_kind, 0.03_dbl_kind, & ! LCOV_EXCL_LINE
83 : 0.03_dbl_kind, 0.03_dbl_kind, 0.03_dbl_kind, & ! LCOV_EXCL_LINE
84 : 0.03_dbl_kind, 0.03_dbl_kind, 0.03_dbl_kind, & ! LCOV_EXCL_LINE
85 : 0.03_dbl_kind, 0.03_dbl_kind, 0.03_dbl_kind, & ! LCOV_EXCL_LINE
86 : 0.03_dbl_kind, 0.03_dbl_kind, 0.03_dbl_kind, & ! LCOV_EXCL_LINE
87 : 0.03_dbl_kind, 0.03_dbl_kind, 0.03_dbl_kind, & ! LCOV_EXCL_LINE
88 : 0.03_dbl_kind, 0.03_dbl_kind, 0.03_dbl_kind, & ! LCOV_EXCL_LINE
89 : 0.03_dbl_kind, & ! LCOV_EXCL_LINE
90 : 0.03_dbl_kind, 0.20_dbl_kind, 0.02_dbl_kind, & ! LCOV_EXCL_LINE
91 : 0.02_dbl_kind, 0.01_dbl_kind, 0.01_dbl_kind, & ! LCOV_EXCL_LINE
92 : 0.03_dbl_kind /)
93 :
94 : !-----------------------------------------------------------------
95 : ! skeletal layer biogeochemistry
96 : !-----------------------------------------------------------------
97 :
98 : real (kind=dbl_kind), parameter, public :: &
99 : phi_sk = 0.30_dbl_kind ! skeletal layer porosity
100 :
101 : !-----------------------------------------------------------------
102 : ! general biogeochemistry
103 : !-----------------------------------------------------------------
104 :
105 : real (kind=dbl_kind), parameter, dimension(max_algae), public :: &
106 : graze_exponent = (/ 0.333_dbl_kind, c1, c1/) ! Implicit grazing exponent (Dunneet al. 2005)
107 :
108 : real (kind=dbl_kind), parameter, public :: &
109 : graze_conc = 1.36_dbl_kind, & ! (mmol N/m^3) converted from Dunne et al 2005 ! LCOV_EXCL_LINE
110 : ! data fit for phytoplankton (1.9 mmol C/m^3) to
111 : ! ice algal N with 20% porosity and C/N = 7
112 : large_bgc = 1.0e8_dbl_kind ! warning value for large bgc concentrations (mmol/m^3)
113 :
114 : real (kind=dbl_kind), dimension(max_nbtrcr), public :: &
115 : zbgc_frac_init,&! initializes mobile fraction ! LCOV_EXCL_LINE
116 : bgc_tracer_type ! described tracer in mobile or stationary phases
117 : ! < 0 is purely mobile (eg. nitrate)
118 : ! > 0 has timescales for transitions between
119 : ! phases based on whether the ice is melting or growing
120 :
121 : real (kind=dbl_kind), dimension(max_nbtrcr), public :: &
122 : zbgc_init_frac, & ! fraction of ocean tracer concentration in new ice ! LCOV_EXCL_LINE
123 : tau_ret, & ! retention timescale (s), mobile to stationary phase ! LCOV_EXCL_LINE
124 : tau_rel ! release timescale (s), stationary to mobile phase
125 :
126 : !-----------------------------------------------------------------
127 : ! From algal_dyn in icepack_algae.F90 but not in namelist
128 : !-----------------------------------------------------------------
129 :
130 : real (kind=dbl_kind), dimension(max_algae), public :: &
131 : chlabs , & ! chla absorption 1/m/(mg/m^3) ! LCOV_EXCL_LINE
132 : alpha2max_low , & ! light limitation (1/(W/m^2)) ! LCOV_EXCL_LINE
133 : beta2max , & ! light inhibition (1/(W/m^2)) ! LCOV_EXCL_LINE
134 : mu_max , & ! maximum growth rate (1/d) ! LCOV_EXCL_LINE
135 : grow_Tdep , & ! T dependence of growth (1/C) ! LCOV_EXCL_LINE
136 : fr_graze , & ! fraction of algae grazed ! LCOV_EXCL_LINE
137 : mort_pre , & ! mortality (1/day) ! LCOV_EXCL_LINE
138 : mort_Tdep , & ! T dependence of mortality (1/C) ! LCOV_EXCL_LINE
139 : k_exude , & ! algal carbon exudation rate (1/d) ! LCOV_EXCL_LINE
140 : K_Nit , & ! nitrate half saturation (mmol/m^3) ! LCOV_EXCL_LINE
141 : K_Am , & ! ammonium half saturation (mmol/m^3) ! LCOV_EXCL_LINE
142 : K_Sil , & ! silicon half saturation (mmol/m^3) ! LCOV_EXCL_LINE
143 : K_Fe ! iron half saturation or micromol/m^3
144 :
145 : real (kind=dbl_kind), dimension(max_DON), public :: &
146 : f_don , & ! fraction of spilled grazing to DON ! LCOV_EXCL_LINE
147 : kn_bac , & ! Bacterial degredation of DON (1/d) ! LCOV_EXCL_LINE
148 : f_don_Am ! fraction of remineralized DON to Am
149 :
150 : real (kind=dbl_kind), dimension(max_DOC), public :: &
151 : f_doc , & ! fraction of mort_N that goes to each doc pool ! LCOV_EXCL_LINE
152 : f_exude , & ! fraction of exuded carbon to each DOC pool ! LCOV_EXCL_LINE
153 : k_bac ! Bacterial degredation of DOC (1/d)
154 :
155 : ! polysaccharids, lipids, proteins+nucleic acids (Lonborg et al. 2020)
156 : real (kind=dbl_kind), dimension(max_doc), parameter, public :: &
157 : doc_pool_fractions = (/0.26_dbl_kind, 0.17_dbl_kind, 0.57_dbl_kind/)
158 :
159 : real (kind=dbl_kind), dimension(max_algae), public :: &
160 : algaltype ! mobility type for algae
161 :
162 : real (kind=dbl_kind), dimension(max_doc), public :: &
163 : doctype ! mobility type for DOC
164 :
165 : real (kind=dbl_kind), dimension(max_dic), public :: &
166 : dictype ! mobility type for DIC
167 :
168 : real (kind=dbl_kind), dimension(max_don), public :: &
169 : dontype ! mobility type for DON
170 :
171 : real (kind=dbl_kind), dimension(max_fe), public :: &
172 : fedtype, & ! mobility type for iron ! LCOV_EXCL_LINE
173 : feptype
174 :
175 : real (kind=dbl_kind), dimension(max_aero), public :: &
176 : zaerotype ! mobility type for aerosols
177 :
178 : !-----------------------------------------------------------------
179 : ! brine
180 : !-----------------------------------------------------------------
181 :
182 : integer (kind=int_kind), parameter, public :: &
183 : exp_h = 3 ! power law for hierarchical model
184 :
185 : real (kind=dbl_kind), parameter, public :: &
186 : k_o = 3.e-8_dbl_kind, & ! permeability scaling factor (m^2) ! LCOV_EXCL_LINE
187 : thinS = 0.05_dbl_kind ! minimum ice thickness for brine
188 :
189 : real (kind=dbl_kind), public :: &
190 : flood_frac ! fraction of ocean/meltwater that floods !*****
191 :
192 : real (kind=dbl_kind), parameter, public :: &
193 : bphimin = 0.03_dbl_kind ! minimum porosity for zbgc only
194 :
195 : real (kind=dbl_kind), parameter, public :: &
196 : viscos_dynamic = 2.2_dbl_kind , & ! 1.8e-3_dbl_kind (pure water at 0^oC) (kg/m/s) ! LCOV_EXCL_LINE
197 : Dm = 1.0e-9_dbl_kind, & ! molecular diffusion (m^2/s) ! LCOV_EXCL_LINE
198 : Ra_c = 0.05_dbl_kind ! critical Rayleigh number for bottom convection
199 :
200 : real (kind=dbl_kind), dimension (:), allocatable, public :: &
201 : bgrid , & ! biology nondimensional vertical grid points ! LCOV_EXCL_LINE
202 : igrid , & ! biology vertical interface points ! LCOV_EXCL_LINE
203 : cgrid , & ! CICE vertical coordinate ! LCOV_EXCL_LINE
204 : icgrid , & ! interface grid for CICE (shortwave variable) ! LCOV_EXCL_LINE
205 : swgrid ! grid for ice tracers used in dEdd scheme
206 :
207 : !=======================================================================
208 :
209 : contains
210 :
211 : !=======================================================================
212 : !
213 : ! Compute the internal ice enthalpy using new salinity and Tin
214 : !
215 :
216 0 : function calculate_qin_from_Sin (Tin, Tmltk) &
217 : result(qin)
218 :
219 : real (kind=dbl_kind), intent(in) :: &
220 : Tin ,& ! internal temperature ! LCOV_EXCL_LINE
221 : Tmltk ! melting temperature at one level
222 :
223 : ! local variables
224 :
225 : real (kind=dbl_kind) :: &
226 : qin ! melting temperature at one level
227 :
228 : character(len=*),parameter :: subname='(calculate_qin_from_Sin)'
229 :
230 0 : qin =-rhoi*(cp_ice*(Tmltk-Tin) + Lfresh*(c1-Tmltk/Tin) - cp_ocn*Tmltk)
231 :
232 0 : end function calculate_qin_from_Sin
233 :
234 : !=======================================================================
235 : !
236 : ! Remaps tracer fields in a given category from one set of layers to another.
237 : ! Grids can be very different and so can vertical spaces.
238 :
239 686163265 : subroutine remap_zbgc(nlyrn, &
240 : it, & ! LCOV_EXCL_LINE
241 1372326530 : trcrn, trtmp, & ! LCOV_EXCL_LINE
242 : nr0, nbyrn, & ! LCOV_EXCL_LINE
243 : hice, hinS, & ! LCOV_EXCL_LINE
244 686163265 : ice_grid, bio_grid, & ! LCOV_EXCL_LINE
245 : S_min )
246 :
247 : integer (kind=int_kind), intent(in) :: &
248 : it , & ! tracer index in top layer ! LCOV_EXCL_LINE
249 : nr0 , & ! receiver category ! LCOV_EXCL_LINE
250 : nlyrn , & ! number of ice layers ! LCOV_EXCL_LINE
251 : nbyrn ! number of biology layers
252 :
253 : real (kind=dbl_kind), dimension (:), intent(in) :: &
254 : trcrn ! ice tracers
255 :
256 : real (kind=dbl_kind), dimension (:), intent(inout) :: &
257 : trtmp ! temporary, remapped ice tracers
258 :
259 : real (kind=dbl_kind), dimension (:), intent(in) :: &
260 : ice_grid ! CICE grid cgrid(2:nilyr+1)
261 :
262 : real (kind=dbl_kind), dimension (:), intent(in) :: &
263 : bio_grid ! CICE grid grid(2:nbyrn+1)
264 :
265 : real(kind=dbl_kind), intent(in) :: &
266 : hice , & ! CICE ice thickness ! LCOV_EXCL_LINE
267 : hinS , & ! brine height ! LCOV_EXCL_LINE
268 : S_min ! for salinity on CICE grid
269 :
270 : ! local variables
271 :
272 : integer (kind=int_kind) :: &
273 : kd, kr, kdr , & ! more indices ! LCOV_EXCL_LINE
274 : kdi , & ! more indices ! LCOV_EXCL_LINE
275 : n_nd , & ! number of layers in donor ! LCOV_EXCL_LINE
276 : n_nr, n_plus ! number of layers in receiver
277 :
278 : real (kind=dbl_kind), dimension (nbyrn+3+nlyrn) :: &
279 1372326530 : trdr , & ! combined tracer ! LCOV_EXCL_LINE
280 1372326530 : trgrid ! combined grid
281 :
282 : real (kind=dbl_kind), dimension (nbyrn+nlyrn+3) :: &
283 1372326530 : tracer , & ! temporary, ice tracers values ! LCOV_EXCL_LINE
284 686163265 : dgrid , & ! temporary, donor grid dimensional ! LCOV_EXCL_LINE
285 686163265 : rgrid ! temporary, receiver grid dimensional
286 :
287 : character(len=*),parameter :: subname='(remap_zbgc)'
288 :
289 686163265 : if ((hinS < c0) .OR. (hice < c0)) then
290 0 : call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
291 0 : call icepack_warnings_add(subname//' ice: remap_layers_bgc error')
292 0 : return
293 : endif
294 :
295 686163265 : if (nr0 == 0) then ! cice to bio
296 :
297 517256541 : n_nd = nlyrn
298 517256541 : n_nr = nbyrn
299 517256541 : n_plus = 2
300 517256541 : dgrid (1) = min(-hice+hinS, -hinS+hice, c0)
301 517256541 : dgrid (nlyrn+2) = min(hinS, hice)
302 517256541 : tracer(1) = trcrn(it)
303 517256541 : tracer(nlyrn+2) = trcrn(it+nlyrn-1)
304 517256541 : rgrid (nbyrn+2) = min(hinS, hice)
305 517256541 : if (hice > hinS) then
306 393480428 : rgrid(1) = c0
307 3541323852 : do kr = 1,n_nr
308 3541323852 : rgrid(kr+1) = bio_grid(kr)*hinS
309 : enddo
310 3541323852 : do kd = 1,n_nd
311 3147843424 : dgrid(kd+1) = (ice_grid(kd)-c1)*hice+hinS
312 3541323852 : tracer(kd+1) = trcrn(it+kd-1)
313 : enddo
314 : else
315 123776113 : rgrid(1) = -hinS + hice
316 667954915 : do kr = 1,n_nr
317 667954915 : rgrid(kr+1) = (bio_grid(kr)-c1)*hinS + hice
318 : enddo
319 991190391 : do kd = 1,n_nd
320 867414278 : dgrid(kd+1) = ice_grid(kd)*hice
321 991190391 : tracer(kd+1) = trcrn(it+kd-1)
322 : enddo
323 : endif
324 :
325 : else ! bio to cice
326 :
327 168906724 : n_nd = nbyrn
328 168906724 : n_nr = nlyrn
329 168906724 : if (hice > hinS) then ! add S_min to top layer
330 168906724 : n_plus = 3
331 168906724 : tracer(1) = S_min
332 168906724 : tracer(2) = S_min
333 168906724 : rgrid (1) = -hice + hinS
334 168906724 : rgrid (nlyrn+n_plus-1) = hinS
335 1520160516 : do kr = 1,n_nr
336 1520160516 : rgrid(kr+1) = (ice_grid(kr)-c1)*hice+ hinS
337 : enddo
338 168906724 : dgrid (1) = -hice+hinS
339 168906724 : dgrid (2) = (hinS-hice)*p5
340 168906724 : dgrid (nbyrn+n_plus) = hinS
341 168906724 : tracer(nbyrn+n_plus) = trcrn(it+nbyrn-1)
342 1520160516 : do kd = 1,n_nd
343 1351253792 : dgrid(kd+2) = bio_grid(kd)*hinS
344 1520160516 : tracer(kd+2) = trcrn(it+kd-1)
345 : enddo
346 : tracer(n_plus) = (S_min*(hice-hinS) + &
347 : tracer(n_plus)*p5*(dgrid(n_plus+1)-dgrid(n_plus)))/ & ! LCOV_EXCL_LINE
348 168906724 : (hice-hinS+ p5*(dgrid(n_plus+1)-dgrid(n_plus)))
349 168906724 : tracer(1) = tracer(n_plus)
350 168906724 : tracer(2) = tracer(n_plus)
351 : else
352 0 : n_plus = 2
353 0 : tracer(1) = trcrn(it)
354 0 : tracer(nbyrn+2) = trcrn(it+nbyrn-1)
355 0 : dgrid (1) = hice-hinS
356 0 : dgrid (nbyrn+2) = hice
357 0 : rgrid (nlyrn+2) = hice
358 0 : rgrid (1) = c0
359 0 : do kd = 1,n_nd
360 0 : dgrid(kd+1) = (bio_grid(kd)-c1)*hinS + hice
361 0 : tracer(kd+1) = trcrn(it+kd-1)
362 : enddo
363 0 : do kr = 1,n_nr
364 0 : rgrid(kr+1) = ice_grid(kr)*hice
365 : enddo
366 : endif
367 :
368 : endif
369 :
370 686163265 : kdr = 0 ! combined indices
371 686163265 : kdi = 1
372 :
373 5729439283 : do kr = 1, n_nr
374 10689243080 : do kd = kdi, n_nd+n_plus
375 10003079815 : if (dgrid(kd) < rgrid(kr+1)) then
376 4959803797 : kdr = kdr+1
377 4959803797 : trgrid(kdr) = dgrid(kd)
378 4959803797 : trdr (kdr) = tracer(kd)
379 5043276018 : elseif (dgrid(kd) > rgrid(kr+1)) then
380 3944247406 : kdr = kdr + 1
381 3944247406 : kdi = kd
382 3944247406 : trgrid(kdr) = rgrid(kr+1)
383 : trtmp (it+kr-1) = trdr(kdr-1) &
384 : + (rgrid(kr+1) - trgrid(kdr-1)) & ! LCOV_EXCL_LINE
385 : * (tracer(kd) - trdr(kdr-1)) & ! LCOV_EXCL_LINE
386 3944247406 : / (dgrid(kd) - trgrid(kdr-1))
387 3944247406 : trdr(kdr) = trtmp(it+kr-1)
388 3944247406 : EXIT
389 : else
390 1099028612 : kdr = kdr+1
391 1099028612 : kdi = kd+1
392 1099028612 : trgrid(kdr) = rgrid(kr+1)
393 1099028612 : trtmp (it+kr-1) = tracer(kd)
394 1099028612 : trdr (kdr) = tracer(kd)
395 1099028612 : EXIT
396 : endif
397 : enddo
398 : enddo
399 :
400 : end subroutine remap_zbgc
401 :
402 : !=======================================================================
403 :
404 : ! remove tracer for very small fractional areas
405 :
406 35178660 : subroutine zap_small_bgc (zlevels, dflux_bio, &
407 35178660 : dt, zvol, btrcr)
408 :
409 : integer (kind=int_kind), intent(in) :: &
410 : zlevels ! number of vertical levels in ice
411 :
412 : real (kind=dbl_kind), intent(in) :: &
413 : dt ! time step (s)
414 :
415 : real (kind=dbl_kind), intent(inout) :: &
416 : dflux_bio ! zapped bio tracer flux from biology (mmol/m^2/s)
417 :
418 : real (kind=dbl_kind), dimension (zlevels), intent(in) :: &
419 : btrcr , & ! zapped bio tracer flux from biology (mmol/m^2/s) ! LCOV_EXCL_LINE
420 : zvol ! ice volume (m)
421 :
422 : ! local variables
423 :
424 : integer (kind=int_kind) :: &
425 : k ! layer index
426 :
427 : character(len=*),parameter :: subname='(zap_small_bgc)'
428 :
429 316607940 : do k = 1, zlevels
430 316607940 : dflux_bio = dflux_bio + btrcr(k)*zvol(k)/dt
431 : enddo
432 :
433 35178660 : end subroutine zap_small_bgc
434 :
435 : !=======================================================================
436 : !
437 : ! authors Nicole Jeffery, LANL
438 :
439 529533299 : subroutine regrid_stationary (C_stationary, hbri_old, &
440 : hbri, dt, & ! LCOV_EXCL_LINE
441 529533299 : top_conc, igrid, & ! LCOV_EXCL_LINE
442 : flux_bio, & ! LCOV_EXCL_LINE
443 : melt_b, con_gel)
444 :
445 : real (kind=dbl_kind), intent(inout) :: &
446 : flux_bio ! ocean tracer flux (mmol/m^2/s) positive into ocean
447 :
448 : real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: &
449 : C_stationary ! stationary bulk concentration*h (mmol/m^2)
450 :
451 : real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: &
452 : igrid ! CICE bio grid
453 :
454 : real(kind=dbl_kind), intent(in) :: &
455 : dt , & ! time step ! LCOV_EXCL_LINE
456 : top_conc , & ! c0 or frazil concentration ! LCOV_EXCL_LINE
457 : hbri_old , & ! previous timestep brine height ! LCOV_EXCL_LINE
458 : hbri ! brine height
459 :
460 : real(kind=dbl_kind), intent(in), optional :: &
461 : melt_b, & ! bottom melt (m) ! LCOV_EXCL_LINE
462 : con_gel ! bottom growth (m)
463 :
464 : ! local variables
465 :
466 : integer (kind=int_kind) :: k, nt, nr
467 :
468 : real (kind=dbl_kind), dimension (ntrcr+2) :: &
469 1059066598 : trtmp0, & ! temporary, remapped tracers ! LCOV_EXCL_LINE
470 529533299 : trtmp
471 :
472 : real (kind=dbl_kind):: &
473 : meltb, & ! ice bottom melt (m) ! LCOV_EXCL_LINE
474 : congel, & ! ice bottom growth (m) ! LCOV_EXCL_LINE
475 : htemp, & ! ice thickness after melt (m) ! LCOV_EXCL_LINE
476 : dflux, & ! regrid flux correction (mmol/m^2) ! LCOV_EXCL_LINE
477 : sum_i, & ! total tracer before melt loss ! LCOV_EXCL_LINE
478 : sum_f, & ! total tracer after melt ! LCOV_EXCL_LINE
479 : hice, & ! LCOV_EXCL_LINE
480 : hbio
481 :
482 : real (kind=dbl_kind), dimension(nblyr+1):: &
483 529533299 : zspace
484 :
485 : character(len=*),parameter :: subname='(regrid_stationary)'
486 :
487 : ! initialize
488 :
489 4765799691 : zspace(:) = c1/(real(nblyr,kind=dbl_kind))
490 529533299 : zspace(1) = p5*zspace(1)
491 529533299 : zspace(nblyr+1) = zspace(1)
492 >14004*10^7 : trtmp0(:) = c0
493 >14004*10^7 : trtmp(:) = c0
494 529533299 : meltb = c0
495 529533299 : nt = 1
496 529533299 : nr = 0
497 529533299 : sum_i = c0
498 529533299 : sum_f = c0
499 529533299 : meltb = c0
500 529533299 : congel = c0
501 529533299 : dflux = c0
502 :
503 : !---------------------
504 : ! compute initial sum
505 : !----------------------
506 :
507 4765799691 : do k = 1, nblyr+1
508 4765799691 : sum_i = sum_i + C_stationary(k)*zspace(k)
509 :
510 : enddo
511 :
512 529533299 : if (present(melt_b)) then
513 529533299 : meltb = melt_b
514 : endif
515 529533299 : if (present(con_gel)) then
516 529533299 : congel = con_gel
517 : endif
518 :
519 529533299 : if (hbri_old > c0) then
520 4765799691 : do k = 1, nblyr+1
521 4765799691 : trtmp0(nblyr+2-k) = C_stationary(k)/hbri_old ! reverse order
522 : enddo ! k
523 : endif
524 :
525 529533299 : htemp = c0
526 :
527 529533299 : if (meltb > c0) then
528 360626575 : htemp = hbri_old-meltb
529 360626575 : nr = 0
530 360626575 : hice = hbri_old
531 360626575 : hbio = htemp
532 168906724 : elseif (congel > c0) then
533 168906724 : htemp = hbri_old+congel
534 168906724 : nr = 1
535 168906724 : hice = htemp
536 168906724 : hbio = hbri_old
537 0 : elseif (hbri .gt. hbri_old) then
538 0 : htemp = hbri
539 0 : nr = 1
540 0 : hice = htemp
541 0 : hbio = hbri_old
542 : endif
543 :
544 : !-----------------------------------------------------------------
545 : ! Regrid C_stationary to add or remove bottom layer(s)
546 : !-----------------------------------------------------------------
547 529533299 : if (htemp > c0) then
548 : call remap_zbgc (nblyr+1, &
549 : nt, & ! LCOV_EXCL_LINE
550 : trtmp0(1:ntrcr), & ! LCOV_EXCL_LINE
551 : trtmp, & ! LCOV_EXCL_LINE
552 : nr, nblyr+1, & ! LCOV_EXCL_LINE
553 : hice, hbio, & ! LCOV_EXCL_LINE
554 : igrid(1:nblyr+1), & ! LCOV_EXCL_LINE
555 529533299 : igrid(1:nblyr+1), top_conc )
556 529533299 : if (icepack_warnings_aborted(subname)) return
557 :
558 >14004*10^7 : trtmp0(:) = c0
559 4765799691 : do k = 1,nblyr+1
560 4765799691 : trtmp0(nblyr+2-k) = trtmp(nt + k-1)
561 : enddo !k
562 :
563 4765799691 : do k = 1, nblyr+1
564 4236266392 : C_stationary(k) = trtmp0(k)*htemp
565 4765799691 : sum_f = sum_f + C_stationary(k)*zspace(k)
566 : enddo ! k
567 :
568 529533299 : if (congel > c0 .and. top_conc .le. c0 .and. abs(sum_i-sum_f) > puny) then
569 106622402 : dflux = sum_i - sum_f
570 106622402 : sum_f = c0
571 959601618 : do k = 1,nblyr+1
572 852979216 : C_stationary(k) = max(c0,C_stationary(k) + dflux)
573 959601618 : sum_f = sum_f + C_stationary(k)*zspace(k)
574 : enddo
575 : endif
576 :
577 529533299 : flux_bio = flux_bio + (sum_i -sum_f)/dt
578 : endif
579 :
580 : end subroutine regrid_stationary
581 :
582 : !=======================================================================
583 : !
584 : ! Aggregate flux information from all ice thickness categories
585 : ! for z layer biogeochemistry
586 : !
587 33835340 : subroutine merge_bgc_fluxes (dt, &
588 0 : bio_index, & ! LCOV_EXCL_LINE
589 : aicen, & ! LCOV_EXCL_LINE
590 : vicen, vsnon, & ! LCOV_EXCL_LINE
591 33835340 : iphin, & ! LCOV_EXCL_LINE
592 33835340 : trcrn, aice_init, & ! LCOV_EXCL_LINE
593 33835340 : flux_bion, flux_bio, & ! LCOV_EXCL_LINE
594 33835340 : upNOn, upNHn, & ! LCOV_EXCL_LINE
595 : upNO, upNH, & ! LCOV_EXCL_LINE
596 0 : zbgc_snown, zbgc_atmn, & ! LCOV_EXCL_LINE
597 67670680 : zbgc_snow, zbgc_atm, & ! LCOV_EXCL_LINE
598 33835340 : PP_net, ice_bio_net,& ! LCOV_EXCL_LINE
599 67670680 : snow_bio_net, grow_alg, & ! LCOV_EXCL_LINE
600 : grow_net, totalChla, & ! LCOV_EXCL_LINE
601 67670680 : iTin, iSin, & ! LCOV_EXCL_LINE
602 33835340 : bioPorosityIceCell, & ! LCOV_EXCL_LINE
603 33835340 : bioSalinityIceCell, & ! LCOV_EXCL_LINE
604 33835340 : bioTemperatureIceCell)
605 :
606 : real (kind=dbl_kind), intent(in) :: &
607 : dt ! timestep (s)
608 :
609 : integer (kind=int_kind), dimension(:), intent(in) :: &
610 : bio_index ! relates bio indices, ie. nlt_bgc_N to nt_bgc_N
611 :
612 : real (kind=dbl_kind), dimension (:), intent(in) :: &
613 : trcrn , & ! input tracer fields ! LCOV_EXCL_LINE
614 : iphin , & ! porosity ! LCOV_EXCL_LINE
615 : iTin , & ! temperature per cat on vertical bio interface points (oC) ! LCOV_EXCL_LINE
616 : iSin ! salinity per cat on vertical bio interface points (ppt)
617 :
618 : real (kind=dbl_kind), intent(in):: &
619 : aicen , & ! concentration of ice ! LCOV_EXCL_LINE
620 : vicen , & ! volume of ice (m) ! LCOV_EXCL_LINE
621 : vsnon , & ! volume of snow(m) ! LCOV_EXCL_LINE
622 : aice_init ! initial concentration of ice
623 :
624 : ! single category rates
625 : real (kind=dbl_kind), dimension(:), intent(in):: &
626 : zbgc_snown , & ! bio flux from snow to ice per cat (mmol/m^3*m) ! LCOV_EXCL_LINE
627 : zbgc_atmn , & ! bio flux from atm to ice per cat (mmol/m^3*m) ! LCOV_EXCL_LINE
628 : flux_bion
629 :
630 : ! single category rates
631 : real (kind=dbl_kind), dimension(:,:), intent(in):: &
632 : upNOn , & ! nitrate uptake rate per cat (mmol/m^3/s) ! LCOV_EXCL_LINE
633 : upNHn , & ! ammonium uptake rate per cat (mmol/m^3/s) ! LCOV_EXCL_LINE
634 : grow_alg ! algal growth rate per cat (mmolN/m^3/s)
635 :
636 : ! cumulative fluxes
637 : real (kind=dbl_kind), dimension(:), intent(inout):: &
638 : flux_bio , & ! ! LCOV_EXCL_LINE
639 : zbgc_snow , & ! bio flux from snow to ice per cat (mmol/m^2/s) ! LCOV_EXCL_LINE
640 : zbgc_atm , & ! bio flux from atm to ice per cat (mmol/m^2/s) ! LCOV_EXCL_LINE
641 : ice_bio_net, & ! integrated ice tracers mmol or mg/m^2) ! LCOV_EXCL_LINE
642 : snow_bio_net ! integrated snow tracers mmol or mg/m^2)
643 :
644 : real (kind=dbl_kind), optional, dimension(:), intent(inout):: &
645 : bioPorosityIceCell, & ! average cell porosity on interface points ! LCOV_EXCL_LINE
646 : bioSalinityIceCell, & ! average cell salinity on interface points (ppt) ! LCOV_EXCL_LINE
647 : bioTemperatureIceCell ! average cell temperature on interface points (oC)
648 :
649 : ! cumulative variables and rates
650 : real (kind=dbl_kind), intent(inout):: &
651 : PP_net , & ! net PP (mg C/m^2/d) times aice ! LCOV_EXCL_LINE
652 : grow_net , & ! net specific growth (m/d) times vice ! LCOV_EXCL_LINE
653 : upNO , & ! tot nitrate uptake rate (mmol/m^2/d) times aice ! LCOV_EXCL_LINE
654 : upNH ! tot ammonium uptake rate (mmol/m^2/d) times aice
655 :
656 : ! cumulative variables and rates
657 : real (kind=dbl_kind), optional, intent(inout):: &
658 : totalChla ! total Chla (mg chla/m^2)
659 :
660 : ! local variables
661 :
662 : real (kind=dbl_kind) :: &
663 : tmp , & ! temporary ! LCOV_EXCL_LINE
664 : dvssl , & ! volume of snow surface layer (m) ! LCOV_EXCL_LINE
665 : dvint ! volume of snow interior (m)
666 :
667 : integer (kind=int_kind) :: &
668 : k, mm ! tracer indice
669 :
670 : real (kind=dbl_kind), dimension (nblyr+1) :: &
671 67670680 : zspace
672 :
673 : character(len=*),parameter :: subname='(merge_bgc_fluxes)'
674 :
675 : !-----------------------------------------------------------------
676 : ! Column summation
677 : !-----------------------------------------------------------------
678 304518060 : zspace(:) = c1/real(nblyr,kind=dbl_kind)
679 33835340 : zspace(1) = p5/real(nblyr,kind=dbl_kind)
680 33835340 : zspace(nblyr+1) = p5/real(nblyr,kind=dbl_kind)
681 :
682 595877548 : do mm = 1, nbtrcr
683 5058379872 : do k = 1, nblyr+1
684 : ice_bio_net(mm) = ice_bio_net(mm) &
685 : + trcrn(bio_index(mm)+k-1) & ! LCOV_EXCL_LINE
686 : * trcrn(nt_fbri) & ! LCOV_EXCL_LINE
687 5058379872 : * vicen*zspace(k)
688 : enddo ! k
689 :
690 : !-----------------------------------------------------------------
691 : ! Merge fluxes
692 : !-----------------------------------------------------------------
693 562042208 : dvssl = p5*vsnon/real(nslyr,kind=dbl_kind) !snow surface layer
694 562042208 : dvint = vsnon - dvssl ! snow interior
695 : snow_bio_net(mm) = snow_bio_net(mm) &
696 : + trcrn(bio_index(mm)+nblyr+1)*dvssl & ! LCOV_EXCL_LINE
697 562042208 : + trcrn(bio_index(mm)+nblyr+2)*dvint
698 562042208 : flux_bio (mm) = flux_bio (mm) + flux_bion (mm)*aicen
699 562042208 : zbgc_snow (mm) = zbgc_snow(mm) + zbgc_snown(mm)*aicen/dt
700 595877548 : zbgc_atm (mm) = zbgc_atm (mm) + zbgc_atmn (mm)*aicen/dt
701 :
702 : enddo ! mm
703 : ! diagnostics : mean cell bio interface grid profiles
704 304518060 : do k = 1, nblyr+1
705 270682720 : if (present(bioPorosityIceCell)) bioPorosityIceCell(k) = bioPorosityIceCell(k) + iphin(k)*vicen
706 270682720 : if (present(bioSalinityIceCell)) bioSalinityIceCell(k) = bioSalinityIceCell(k) + iSin(k)*vicen
707 304518060 : if (present(bioTemperatureIceCell)) bioTemperatureIceCell(k) = bioTemperatureIceCell(k) + iTin(k)*vicen
708 : end do
709 33835340 : if (solve_zbgc) then
710 108361456 : do mm = 1, n_algae
711 81271092 : if (present(totalChla)) totalChla = totalChla + ice_bio_net(nlt_bgc_N(mm))*R_chl2N(mm)
712 758530192 : do k = 1, nblyr+1
713 650168736 : tmp = iphin(k)*trcrn(nt_fbri)*vicen*zspace(k)*secday
714 : PP_net = PP_net + grow_alg(k,mm)*tmp &
715 650168736 : * (c1-fr_resp)* R_C2N(mm)*R_gC2molC
716 : grow_net = grow_net + grow_alg(k,mm)*tmp &
717 650168736 : / (trcrn(nt_bgc_N(mm)+k-1)+puny)
718 650168736 : upNO = upNO + upNOn (k,mm)*tmp
719 731439828 : upNH = upNH + upNHn (k,mm)*tmp
720 : enddo ! k
721 : enddo ! mm
722 : endif
723 :
724 33835340 : end subroutine merge_bgc_fluxes
725 :
726 : !=======================================================================
727 :
728 : ! Aggregate flux information from all ice thickness categories
729 : ! for skeletal layer biogeochemistry
730 : !
731 : ! author: Elizabeth C. Hunke and William H. Lipscomb, LANL
732 :
733 0 : subroutine merge_bgc_fluxes_skl ( &
734 0 : aicen, trcrn, & ! LCOV_EXCL_LINE
735 0 : flux_bion, flux_bio, & ! LCOV_EXCL_LINE
736 0 : PP_net, upNOn, & ! LCOV_EXCL_LINE
737 0 : upNHn, upNO, & ! LCOV_EXCL_LINE
738 : upNH, grow_net, & ! LCOV_EXCL_LINE
739 0 : grow_alg)
740 :
741 : ! single category fluxes
742 : real (kind=dbl_kind), intent(in):: &
743 : aicen ! category ice area fraction
744 :
745 : real (kind=dbl_kind), dimension (:), intent(in) :: &
746 : trcrn ! Bulk tracer concentration (mmol N or mg/m^3)
747 :
748 : real (kind=dbl_kind), dimension(:), intent(in):: &
749 : flux_bion ! all bio fluxes to ocean, on categories
750 :
751 : real (kind=dbl_kind), dimension(:), intent(inout):: &
752 : flux_bio ! all bio fluxes to ocean, aggregated
753 :
754 : real (kind=dbl_kind), dimension(:), intent(in):: &
755 : grow_alg, & ! algal growth rate (mmol/m^3/s) ! LCOV_EXCL_LINE
756 : upNOn , & ! nitrate uptake rate per cat (mmol/m^3/s) ! LCOV_EXCL_LINE
757 : upNHn ! ammonium uptake rate per cat (mmol/m^3/s)
758 :
759 : ! history output
760 : real (kind=dbl_kind), intent(inout):: &
761 : PP_net , & ! Bulk net PP (mg C/m^2/d) ! LCOV_EXCL_LINE
762 : grow_net, & ! net specific growth (/d) ! LCOV_EXCL_LINE
763 : upNO , & ! tot nitrate uptake rate (mmol/m^2/d) ! LCOV_EXCL_LINE
764 : upNH ! tot ammonium uptake rate (mmol/m^2/d)
765 :
766 : ! local variables
767 :
768 : integer (kind=int_kind) :: &
769 : k, mm ! tracer indices
770 :
771 : real (kind=dbl_kind) :: &
772 : tmp ! temporary
773 :
774 : character(len=*),parameter :: subname='(merge_bgc_fluxes_skl)'
775 :
776 : !-----------------------------------------------------------------
777 : ! Merge fluxes
778 : !-----------------------------------------------------------------
779 :
780 0 : do k = 1,nbtrcr
781 0 : flux_bio (k) = flux_bio(k) + flux_bion(k)*aicen
782 : enddo
783 :
784 0 : do mm = 1, n_algae
785 0 : tmp = phi_sk * sk_l * aicen * secday
786 : PP_net = PP_net &
787 : + grow_alg(mm) * tmp & ! LCOV_EXCL_LINE
788 0 : * R_C2N(mm) * R_gC2molC * (c1-fr_resp)
789 : grow_net = grow_net &
790 : + grow_alg(mm) * tmp & ! LCOV_EXCL_LINE
791 0 : / (trcrn(nt_bgc_N(mm))+puny)
792 0 : upNO = upNO + upNOn(mm) * tmp
793 0 : upNH = upNH + upNHn(mm) * tmp
794 : enddo
795 :
796 0 : end subroutine merge_bgc_fluxes_skl
797 :
798 : !=======================================================================
799 :
800 : end module icepack_zbgc_shared
801 :
802 : !=======================================================================
|
