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 1030798563 : subroutine remap_zbgc(nlyrn, &
203 : it, &
204 2061597126 : trcrn, trtmp, &
205 : nr0, nbyrn, &
206 : hice, hinS, &
207 1030798563 : 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 2111726403 : trdr , & ! combined tracer
243 2111726403 : trgrid ! combined grid
244 :
245 : real (kind=dbl_kind), dimension (nbyrn+nlyrn+3) :: &
246 2111726403 : tracer , & ! temporary, ice tracers values
247 2117481111 : dgrid , & ! temporary, donor grid dimensional
248 1089559902 : rgrid ! temporary, receiver grid dimensional
249 :
250 : character(len=*),parameter :: subname='(remap_zbgc)'
251 :
252 1030798563 : 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 1030798563 : if (nr0 == 0) then ! cice to bio
259 :
260 492552318 : n_nd = nlyrn
261 492552318 : n_nr = nbyrn
262 492552318 : n_plus = 2
263 492552318 : dgrid (1) = min(-hice+hinS, -hinS+hice, c0)
264 492552318 : dgrid (nlyrn+2) = min(hinS, hice)
265 492552318 : tracer(1) = trcrn(it)
266 492552318 : tracer(nlyrn+2) = trcrn(it+nlyrn-1)
267 492552318 : rgrid (nbyrn+2) = min(hinS, hice)
268 492552318 : if (hice > hinS) then
269 373330799 : rgrid(1) = c0
270 3359977191 : do kr = 1,n_nr
271 3359977191 : rgrid(kr+1) = bio_grid(kr)*hinS
272 : enddo
273 3359977191 : do kd = 1,n_nd
274 2986646392 : dgrid(kd+1) = (ice_grid(kd)-c1)*hice+hinS
275 3359977191 : tracer(kd+1) = trcrn(it+kd-1)
276 : enddo
277 : else
278 119221519 : rgrid(1) = -hinS + hice
279 604590955 : do kr = 1,n_nr
280 604590955 : rgrid(kr+1) = (bio_grid(kr)-c1)*hinS + hice
281 : enddo
282 954522244 : do kd = 1,n_nd
283 835300725 : dgrid(kd+1) = ice_grid(kd)*hice
284 954522244 : tracer(kd+1) = trcrn(it+kd-1)
285 : enddo
286 : endif
287 :
288 : else ! bio to cice
289 :
290 538246245 : n_nd = nbyrn
291 538246245 : n_nr = nlyrn
292 538246245 : if (hice > hinS) then ! add S_min to top layer
293 538246245 : n_plus = 3
294 538246245 : tracer(1) = S_min
295 538246245 : tracer(2) = S_min
296 538246245 : rgrid (1) = -hice + hinS
297 538246245 : rgrid (nlyrn+n_plus-1) = hinS
298 4844216205 : do kr = 1,n_nr
299 4844216205 : rgrid(kr+1) = (ice_grid(kr)-c1)*hice+ hinS
300 : enddo
301 538246245 : dgrid (1) = -hice+hinS
302 538246245 : dgrid (2) = (hinS-hice)*p5
303 538246245 : dgrid (nbyrn+n_plus) = hinS
304 538246245 : tracer(nbyrn+n_plus) = trcrn(it+nbyrn-1)
305 4844216205 : do kd = 1,n_nd
306 4305969960 : dgrid(kd+2) = bio_grid(kd)*hinS
307 4844216205 : tracer(kd+2) = trcrn(it+kd-1)
308 : enddo
309 2353158 : tracer(n_plus) = (S_min*(hice-hinS) + &
310 4706316 : tracer(n_plus)*p5*(dgrid(n_plus+1)-dgrid(n_plus)))/ &
311 540599403 : (hice-hinS+ p5*(dgrid(n_plus+1)-dgrid(n_plus)))
312 538246245 : tracer(1) = tracer(n_plus)
313 538246245 : 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 1030798563 : kdr = 0 ! combined indices
334 1030798563 : kdi = 1
335 :
336 8808784351 : do kr = 1, n_nr
337 16549111722 : do kd = kdi, n_nd+n_plus
338 15518313159 : if (dgrid(kd) < rgrid(kr+1)) then
339 7740327371 : kdr = kdr+1
340 7740327371 : trgrid(kdr) = dgrid(kd)
341 7740327371 : trdr (kdr) = tracer(kd)
342 7777985788 : elseif (dgrid(kd) > rgrid(kr+1)) then
343 5997198033 : kdr = kdr + 1
344 5997198033 : kdi = kd
345 5997198033 : trgrid(kdr) = rgrid(kr+1)
346 31755248 : trtmp (it+kr-1) = trdr(kdr-1) &
347 31755248 : + (rgrid(kr+1) - trgrid(kdr-1)) &
348 31755248 : * (tracer(kd) - trdr(kdr-1)) &
349 6076586153 : / (dgrid(kd) - trgrid(kdr-1))
350 5997198033 : trdr(kdr) = trtmp(it+kr-1)
351 5997198033 : EXIT
352 : else
353 1780787755 : kdr = kdr+1
354 1780787755 : kdi = kd+1
355 1780787755 : trgrid(kdr) = rgrid(kr+1)
356 1780787755 : trtmp (it+kr-1) = tracer(kd)
357 1780787755 : trdr (kdr) = tracer(kd)
358 1780787755 : 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 53423161 : subroutine zap_small_bgc (zlevels, dflux_bio, &
370 53423161 : 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 312128497 : do k = 1, zlevels
393 312128497 : dflux_bio = dflux_bio + btrcr(k)*zvol(k)/dt
394 : enddo
395 :
396 53423161 : end subroutine zap_small_bgc
397 :
398 : !=======================================================================
399 : !
400 : ! authors Nicole Jeffery, LANL
401 :
402 882911457 : subroutine regrid_stationary (C_stationary, hbri_old, &
403 : hbri, dt, &
404 : ntrcr, nblyr, &
405 882911457 : 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 2334199554 : trtmp0, & ! temporary, remapped tracers
438 2339036802 : trtmp
439 :
440 : real (kind=dbl_kind):: &
441 2418624 : meltb, & ! ice bottom melt (m)
442 2418624 : congel, & ! ice bottom growth (m)
443 2418624 : htemp, & ! ice thickness after melt (m)
444 2418624 : dflux, & ! regrid flux correction (mmol/m^2)
445 2418624 : sum_i, & ! total tracer before melt loss
446 2418624 : sum_f, & ! total tracer after melt
447 2418624 : hice, &
448 2418624 : hbio
449 :
450 : real (kind=dbl_kind), dimension(nblyr+1):: &
451 904679073 : zspace
452 :
453 : character(len=*),parameter :: subname='(regrid_stationary)'
454 :
455 : ! initialize
456 :
457 7946203113 : zspace(:) = c1/(real(nblyr,kind=dbl_kind))
458 882911457 : zspace(1) = p5*zspace(1)
459 882911457 : zspace(nblyr+1) = zspace(1)
460 >20925*10^7 : trtmp0(:) = c0
461 >20925*10^7 : trtmp(:) = c0
462 882911457 : meltb = c0
463 882911457 : nt = 1
464 882911457 : nr = 0
465 882911457 : sum_i = c0
466 882911457 : sum_f = c0
467 882911457 : meltb = c0
468 882911457 : congel = c0
469 882911457 : dflux = c0
470 :
471 : !---------------------
472 : ! compute initial sum
473 : !----------------------
474 :
475 7946203113 : do k = 1, nblyr+1
476 7946203113 : sum_i = sum_i + C_stationary(k)*zspace(k)
477 :
478 : enddo
479 :
480 882911457 : if (present(melt_b)) then
481 532629376 : meltb = melt_b
482 : endif
483 882911457 : if (present(con_gel)) then
484 532629376 : congel = con_gel
485 : endif
486 :
487 882911457 : if (hbri_old > c0) then
488 7946203113 : do k = 1, nblyr+1
489 7946203113 : trtmp0(nblyr+2-k) = C_stationary(k)/hbri_old ! reverse order
490 : enddo ! k
491 : endif
492 :
493 882911457 : htemp = c0
494 :
495 882911457 : if (meltb > c0) then
496 344665212 : htemp = hbri_old-meltb
497 344665212 : nr = 0
498 344665212 : hice = hbri_old
499 344665212 : hbio = htemp
500 538246245 : elseif (congel > c0) then
501 187964164 : htemp = hbri_old+congel
502 187964164 : nr = 1
503 187964164 : hice = htemp
504 187964164 : hbio = hbri_old
505 350282081 : elseif (hbri .gt. hbri_old) then
506 350282081 : htemp = hbri
507 350282081 : nr = 1
508 350282081 : hice = htemp
509 350282081 : hbio = hbri_old
510 : endif
511 :
512 : !-----------------------------------------------------------------
513 : ! Regrid C_stationary to add or remove bottom layer(s)
514 : !-----------------------------------------------------------------
515 882911457 : 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 882911457 : igrid(1:nblyr+1), top_conc )
524 882911457 : if (icepack_warnings_aborted(subname)) return
525 :
526 >20925*10^7 : trtmp0(:) = c0
527 7946203113 : do k = 1,nblyr+1
528 7946203113 : trtmp0(nblyr+2-k) = trtmp(nt + k-1)
529 : enddo !k
530 :
531 7946203113 : do k = 1, nblyr+1
532 7063291656 : C_stationary(k) = trtmp0(k)*htemp
533 7946203113 : sum_f = sum_f + C_stationary(k)*zspace(k)
534 : enddo ! k
535 :
536 882911457 : if (congel > c0 .and. top_conc .le. c0 .and. abs(sum_i-sum_f) > puny) then
537 115738211 : dflux = sum_i - sum_f
538 115738211 : sum_f = c0
539 1041643899 : do k = 1,nblyr+1
540 925905688 : C_stationary(k) = max(c0,C_stationary(k) + dflux)
541 1041643899 : sum_f = sum_f + C_stationary(k)*zspace(k)
542 : enddo
543 : endif
544 :
545 882911457 : 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 29415679 : subroutine merge_bgc_fluxes (dt, nblyr, &
556 29415679 : bio_index, n_algae, &
557 : nbtrcr, aicen, &
558 : vicen, vsnon, &
559 29415679 : iphin, &
560 29415679 : trcrn, &
561 29415679 : flux_bion, flux_bio, &
562 29415679 : upNOn, upNHn, &
563 : upNO, upNH, &
564 58831358 : zbgc_snown, zbgc_atmn, &
565 58831358 : zbgc_snow, zbgc_atm, &
566 29415679 : PP_net, ice_bio_net,&
567 58831358 : 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 80291 : tmp , & ! temporary
621 80291 : dvssl , & ! volume of snow surface layer (m)
622 80291 : 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 59393395 : zspace
629 :
630 : character(len=*),parameter :: subname='(merge_bgc_fluxes)'
631 :
632 : !-----------------------------------------------------------------
633 : ! Column summation
634 : !-----------------------------------------------------------------
635 264741111 : zspace(:) = c1/real(nblyr,kind=dbl_kind)
636 29415679 : zspace(1) = p5/real(nblyr,kind=dbl_kind)
637 29415679 : zspace(nblyr+1) = p5/real(nblyr,kind=dbl_kind)
638 :
639 588313580 : do mm = 1, nbtrcr
640 5030081109 : do k = 1, nblyr+1
641 12204232 : ice_bio_net(mm) = ice_bio_net(mm) &
642 24408464 : + trcrn(bio_index(mm)+k-1) &
643 12204232 : * trcrn(nt_fbri) &
644 5042285341 : * vicen*zspace(k)
645 : enddo ! k
646 :
647 : !-----------------------------------------------------------------
648 : ! Merge fluxes
649 : !-----------------------------------------------------------------
650 558897901 : dvssl = min(p5*vsnon, hs_ssl*aicen) ! snow surface layer
651 558897901 : dvint = vsnon - dvssl ! snow interior
652 1525529 : snow_bio_net(mm) = snow_bio_net(mm) &
653 3051058 : + trcrn(bio_index(mm)+nblyr+1)*dvssl &
654 560423430 : + trcrn(bio_index(mm)+nblyr+2)*dvint
655 558897901 : flux_bio (mm) = flux_bio (mm) + flux_bion (mm)*aicen
656 558897901 : zbgc_snow (mm) = zbgc_snow(mm) + zbgc_snown(mm)*aicen/dt
657 588313580 : zbgc_atm (mm) = zbgc_atm (mm) + zbgc_atmn (mm)*aicen/dt
658 : enddo ! mm
659 :
660 29415679 : if (solve_zbgc) then
661 117662716 : do mm = 1, n_algae
662 823639012 : do k = 1, nblyr+1
663 705976296 : tmp = iphin(k)*trcrn(nt_fbri)*vicen*zspace(k)*secday
664 1926984 : PP_net = PP_net + grow_alg(k,mm)*tmp &
665 705976296 : * (c1-fr_resp)* R_C2N(mm)*R_gC2molC
666 1926984 : grow_net = grow_net + grow_alg(k,mm)*tmp &
667 705976296 : / (trcrn(nt_bgc_N(mm)+k-1)+puny)
668 705976296 : upNO = upNO + upNOn (k,mm)*tmp
669 794223333 : upNH = upNH + upNHn (k,mm)*tmp
670 : enddo ! k
671 : enddo ! mm
672 : endif
673 :
674 29415679 : 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 29255097 : subroutine merge_bgc_fluxes_skl (nbtrcr, n_algae, &
684 29255097 : aicen, trcrn, &
685 29255097 : flux_bion, flux_bio, &
686 29255097 : PP_net, upNOn, &
687 29255097 : upNHn, upNO, &
688 : upNH, grow_net, &
689 29255097 : 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 80291 : tmp ! temporary
727 :
728 : character(len=*),parameter :: subname='(merge_bgc_fluxes_skl)'
729 :
730 : !-----------------------------------------------------------------
731 : ! Merge fluxes
732 : !-----------------------------------------------------------------
733 :
734 497336649 : do k = 1,nbtrcr
735 497336649 : flux_bio (k) = flux_bio(k) + flux_bion(k)*aicen
736 : enddo
737 :
738 117020388 : do mm = 1, n_algae
739 87765291 : tmp = phi_sk * sk_l * aicen * secday
740 : PP_net = PP_net &
741 240873 : + grow_alg(mm) * tmp &
742 87765291 : * R_C2N(mm) * R_gC2molC * (c1-fr_resp)
743 : grow_net = grow_net &
744 240873 : + grow_alg(mm) * tmp &
745 87765291 : / (trcrn(nt_bgc_N(mm))+puny)
746 87765291 : upNO = upNO + upNOn(mm) * tmp
747 117020388 : upNH = upNH + upNHn(mm) * tmp
748 : enddo
749 :
750 29255097 : end subroutine merge_bgc_fluxes_skl
751 :
752 : !=======================================================================
753 :
754 : end module icepack_zbgc_shared
755 :
756 : !=======================================================================
|
