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