ROMS
Loading...
Searching...
No Matches
ecosim.h
Go to the documentation of this file.
1 MODULE biology_mod
2!
3!git $Id$
4!================================================== Hernan G. Arango ===
5! Copyright (c) 2002-2025 The ROMS Group !
6! Licensed under a MIT/X style license !
7! See License_ROMS.md !
8!=================================================== W. Paul Bissett ===
9! Copyright (c) 1997 W. Paul Bissett, FERI !
10!=======================================================================
11! !
12! The EcoSim code has been developed for research purposes only. It !
13! consists of unpublished, proprietary formulations protected under !
14! U.S. copyright law. It is freely available on request from the !
15! Florida Environmental Research Institute (FERI). Commercial usage !
16! of these formulations is forbidden without express written !
17! permission from FERI. All rights reserved. !
18! !
19!***********************************************************************
20! !
21! This routine computes the EcoSim sources and sinks and adds them !
22! to the global biological fields. !
23! !
24! Reference: !
25! !
26! Bissett, W.P., J.J. Walsh, D.A. Dieterle, K.L. Carder, 1999: !
27! Carbon cycling in the upper waters of the Sargasso Sea: I. !
28! Numerical simulation of differential carbon and nitrogen !
29! fluxes, Deep-Sea Res., 46, 205-269. !
30! !
31! Bissett, W.P., K.L. Carder, J.J. Walsh, D.A. Dieterle, 1999: !
32! Carbon cycling in the upper waters of the Sargasso Sea: II. !
33! Numerical simulation of apparent and inherent optical !
34! properties, Deep-Sea Res., 46, 271-317 !
35! !
36! NOTES to EcoSim: !
37! !
38! * This version uses a descending index for depth that is different !
39! than the original coding. !
40! !
41! * This version of the code has been modified by Bronwyn Cahill and !
42! includes a semi-Lagrangian vertical sinking flux algorithm for !
43! fecal material and bio_sediment subroutine which remineralizes !
44! particulate nitrogen and returns it into dissolved nitrate pool. !
45! !
46!=======================================================================
47!
48 implicit none
49!
50 PRIVATE
51 PUBLIC :: biology
52!
53 CONTAINS
54!
55!***********************************************************************
56 SUBROUTINE biology (ng, tile)
57!***********************************************************************
58!
59 USE mod_param
60#ifdef DIAGNOSTICS_BIO
61 USE mod_diags
62#endif
63 USE mod_forces
64 USE mod_grid
65 USE mod_ncparam
66 USE mod_ocean
67 USE mod_stepping
68!
69! Imported variable declarations.
70!
71 integer, intent(in) :: ng, tile
72!
73! Local variable declarations.
74!
75 character (len=*), parameter :: myfile = &
76 & __FILE__
77!
78#include "tile.h"
79!
80! Set header file name.
81!
82#ifdef DISTRIBUTE
83 IF (lbiofile(inlm)) THEN
84#else
85 IF (lbiofile(inlm).and.(tile.eq.0)) THEN
86#endif
87 lbiofile(inlm)=.false.
88 bioname(inlm)=myfile
89 END IF
90!
91#ifdef PROFILE
92 CALL wclock_on (ng, inlm, 15, __line__, myfile)
93#endif
94 CALL ecosim_tile (ng, tile, &
95 & lbi, ubi, lbj, ubj, n(ng), nt(ng), &
96 & imins, imaxs, jmins, jmaxs, &
97 & nstp(ng), nnew(ng), &
98#ifdef MASKING
99 & grid(ng) % rmask, &
100# if defined WET_DRY && defined DIAGNOSTICS_BIO
101 & grid(ng) % rmask_full, &
102# endif
103#endif
104 & grid(ng) % Hz, &
105 & grid(ng) % z_r, &
106 & grid(ng) % z_w, &
107 & forces(ng) % SpecIr, &
108 & forces(ng) % avcos, &
109#ifdef DIAGNOSTICS_BIO
110 & diags(ng) % DiaBio3d, &
111 & diags(ng) % DiaBio4d, &
112#endif
113 & ocean(ng) % t)
114#ifdef PROFILE
115 CALL wclock_off (ng, inlm, 15, __line__, myfile)
116#endif
117!
118 RETURN
119 END SUBROUTINE biology
120!
121!***********************************************************************
122 SUBROUTINE ecosim_tile (ng, tile, &
123 & LBi, UBi, LBj, UBj, UBk, UBt, &
124 & IminS, ImaxS, JminS, JmaxS, &
125 & nstp, nnew, &
126#ifdef MASKING
127 & rmask, &
128# if defined WET_DRY && defined DIAGNOSTICS_BIO
129 & rmask_full, &
130# endif
131#endif
132 & Hz, z_r, z_w, &
133 & SpecIr, avcos, &
134#ifdef DIAGNOSTICS_BIO
135 & DiaBio3d, &
136 & DiaBio4d, &
137#endif
138 & t)
139!***********************************************************************
140!
141 USE mod_param
142 USE mod_biology
143 USE mod_eclight
144 USE mod_scalars
145 USE mod_iounits
146!
147! Imported variable declarations.
148!
149 integer, intent(in) :: ng, tile
150 integer, intent(in) :: LBi, UBi, LBj, UBj, UBk, UBt
151 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
152 integer, intent(in) :: nstp, nnew
153
154#ifdef ASSUMED_SHAPE
155# ifdef MASKING
156 real(r8), intent(in) :: rmask(LBi:,LBj:)
157# if defined WET_DRY && defined DIAGNOSTICS_BIO
158 real(r8), intent(in) :: rmask_full(LBi:,LBj:)
159# endif
160# endif
161 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
162 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
163 real(r8), intent(in) :: z_w(LBi:,LBj:,0:)
164 real(r8), intent(in) :: SpecIr(LBi:,LBj:,:)
165 real(r8), intent(in) :: avcos(LBi:,LBj:,:)
166# ifdef DIAGNOSTICS_BIO
167 real(r8), intent(inout) :: DiaBio3d(LBi:,LBj:,:,:)
168 real(r8), intent(inout) :: DiaBio4d(LBi:,LBj:,:,:,:)
169# endif
170 real(r8), intent(inout) :: t(LBi:,LBj:,:,:,:)
171#else
172# ifdef MASKING
173 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
174# if defined WET_DRY && defined DIAGNOSTICS_BIO
175 real(r8), intent(in) :: rmask_full(LBi:UBi,LBj:UBj)
176# endif
177# endif
178 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,UBk)
179 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,UBk)
180 real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:UBk)
181 real(r8), intent(in) :: SpecIr(LBi:UBi,LBj:UBj,NBands)
182 real(r8), intent(in) :: avcos(LBi:UBi,LBj:UBj,NBands)
183# ifdef DIAGNOSTICS_BIO
184 real(r8), intent(inout) :: DiaBio3d(LBi:UBi,LBj:UBj, &
185 & NDbands,NDbio3d)
186 real(r8), intent(inout) :: DiaBio4d(LBi:UBi,LBj:UBj,N(ng), &
187 & NDbands,NDbio4d)
188# endif
189 real(r8), intent(inout) :: t(LBi:UBi,LBj:UBj,UBk,3,UBt)
190#endif
191!
192! Local variable declarations.
193!
194 integer, parameter :: Msink = 30
195
196 integer :: i, j, k, ks
197 integer :: Iter, Tindex, ic, isink, ibio, id, itrc, ivar
198 integer :: ibac, iband, idom, ifec, iphy, ipig
199 integer :: Nsink
200
201 integer, dimension(Msink) :: idsink
202 integer, dimension(IminS:ImaxS,N(ng)) :: ksource
203
204 real(r8), parameter :: MinVal = 0.0_r8
205
206 real(r8) :: FV1, FV2, FV3, FV4, FV5, FV6, FV7, dtbio
207 real(r8) :: DOC_lab, Ed_tot, Nup_max, aph442, aPHYN_wa
208 real(r8) :: avgcos_min, par_b, par_s, photo_DIC, photo_DOC
209 real(r8) :: photo_decay, slope_AC, tChl, theta_m, total_photo
210 real(r8) :: WLE, factint
211
212 real(r8) :: Het_BAC
213 real(r8) :: N_quota, RelDOC1, RelDON1, RelDOP1, RelFe
214 real(r8) :: cff, cff1, cff2, cffL, cffR, cu, dltL, dltR
215#ifdef DIAGNOSTICS_BIO
216 real(r8) :: fiter
217#endif
218
219 real(r8), dimension(Msink) :: Wbio
220
221 real(r8), dimension(4) :: Bac_G
222
223 real(r8), dimension(NBands) :: dATT_sum
224
225 real(r8), dimension(N(ng),NBands) :: avgcos, dATT
226 real(r8), dimension(N(ng),NBands) :: specir_d
227 real(r8), dimension(N(ng),NBands) :: tot_ab, tot_b, tot_s
228#ifdef BIO_OPTIC
229 real(r8), dimension(0:N(ng),NBands) :: specir_w
230#endif
231 real(r8), dimension(N(ng),Nphy) :: C2CHL, C2CHL_w
232 real(r8), dimension(N(ng),Nphy) :: Gt_fl, Gt_ll, Gt_nl
233 real(r8), dimension(N(ng),Nphy) :: Gt_sl, Gt_pl
234 real(r8), dimension(N(ng),Nphy) :: alfa
235 real(r8), dimension(N(ng),Nphy) :: pac_eff
236
237 real(r8), dimension(N(ng),Nphy,Npig) :: Pigs_w
238
239 integer, dimension(IminS:ImaxS) :: Keuphotic
240
241 real(r8), dimension(IminS:ImaxS,N(ng)) :: E0_nz
242 real(r8), dimension(IminS:ImaxS,N(ng)) :: Ed_nz
243 real(r8), dimension(IminS:ImaxS,N(ng)) :: DOC_frac
244 real(r8), dimension(IminS:ImaxS,N(ng)) :: NitrBAC
245 real(r8), dimension(IminS:ImaxS,N(ng)) :: NH4toNO3
246 real(r8), dimension(IminS:ImaxS,N(ng)) :: NtoNBAC
247 real(r8), dimension(IminS:ImaxS,N(ng)) :: NtoPBAC
248 real(r8), dimension(IminS:ImaxS,N(ng)) :: NtoFeBAC
249 real(r8), dimension(IminS:ImaxS,N(ng)) :: totDOC_d
250 real(r8), dimension(IminS:ImaxS,N(ng)) :: totDON_d
251 real(r8), dimension(IminS:ImaxS,N(ng)) :: totDOP_d
252 real(r8), dimension(IminS:ImaxS,N(ng)) :: totFe_d
253 real(r8), dimension(IminS:ImaxS,N(ng)) :: totNH4_d
254 real(r8), dimension(IminS:ImaxS,N(ng)) :: totNO3_d
255 real(r8), dimension(IminS:ImaxS,N(ng)) :: totPO4_d
256 real(r8), dimension(IminS:ImaxS,N(ng)) :: totSiO_d
257
258 real(r8), dimension(IminS:ImaxS,N(ng),Nbac) :: GtBAC
259 real(r8), dimension(IminS:ImaxS,N(ng),Nbac) :: NupDOC_ba
260 real(r8), dimension(IminS:ImaxS,N(ng),Nbac) :: NupDON_ba
261 real(r8), dimension(IminS:ImaxS,N(ng),Nbac) :: NupDOP_ba
262 real(r8), dimension(IminS:ImaxS,N(ng),Nbac) :: NupFe_ba
263 real(r8), dimension(IminS:ImaxS,N(ng),Nbac) :: NupNH4_ba
264 real(r8), dimension(IminS:ImaxS,N(ng),Nbac) :: NupPO4_ba
265
266 real(r8), dimension(IminS:ImaxS,N(ng),Nphy) :: C2fALG
267 real(r8), dimension(IminS:ImaxS,N(ng),Nphy) :: C2nALG
268 real(r8), dimension(IminS:ImaxS,N(ng),Nphy) :: C2pALG
269 real(r8), dimension(IminS:ImaxS,N(ng),Nphy) :: C2sALG
270 real(r8), dimension(IminS:ImaxS,N(ng),Nphy) :: GtALG
271 real(r8), dimension(IminS:ImaxS,N(ng),Nphy) :: GtALG_r
272 real(r8), dimension(IminS:ImaxS,N(ng),Nphy) :: NupDOP
273 real(r8), dimension(IminS:ImaxS,N(ng),Nphy) :: NupDON
274 real(r8), dimension(IminS:ImaxS,N(ng),Nphy) :: NupFe
275 real(r8), dimension(IminS:ImaxS,N(ng),Nphy) :: NupNH4
276 real(r8), dimension(IminS:ImaxS,N(ng),Nphy) :: NupNO3
277 real(r8), dimension(IminS:ImaxS,N(ng),Nphy) :: NupPO4
278 real(r8), dimension(IminS:ImaxS,N(ng),Nphy) :: NupSiO
279 real(r8), dimension(IminS:ImaxS,N(ng),Nphy) :: graz_act
280 real(r8), dimension(IminS:ImaxS,N(ng),Nphy) :: mu_bar_f
281 real(r8), dimension(IminS:ImaxS,N(ng),Nphy) :: mu_bar_n
282 real(r8), dimension(IminS:ImaxS,N(ng),Nphy) :: mu_bar_p
283 real(r8), dimension(IminS:ImaxS,N(ng),Nphy) :: mu_bar_s
284 real(r8), dimension(IminS:ImaxS,N(ng),Nphy) :: refuge
285
286 real(r8), dimension(IminS:ImaxS,N(ng),Nfec) :: Regen_C
287 real(r8), dimension(IminS:ImaxS,N(ng),Nfec) :: Regen_F
288 real(r8), dimension(IminS:ImaxS,N(ng),Nfec) :: Regen_N
289 real(r8), dimension(IminS:ImaxS,N(ng),Nfec) :: Regen_P
290 real(r8), dimension(IminS:ImaxS,N(ng),Nfec) :: Regen_S
291
292 real(r8), dimension(IminS:ImaxS,N(ng),NBands) :: specir_scal
293 real(r8), dimension(IminS:ImaxS,N(ng),Nphy,NBands) :: aPHYN_al
294 real(r8), dimension(IminS:ImaxS,N(ng),Nphy,NBands) :: aPHYN_at
295 real(r8), dimension(IminS:ImaxS,N(ng),NBands) :: aDET
296 real(r8), dimension(IminS:ImaxS,N(ng),NBands) :: aCDC
297 real(r8), dimension(IminS:ImaxS,N(ng),NBands) :: b_phy
298 real(r8), dimension(IminS:ImaxS,N(ng),NBands) :: s_phy
299 real(r8), dimension(IminS:ImaxS,N(ng),NBands) :: b_tot
300 real(r8), dimension(IminS:ImaxS,N(ng),NBands) :: s_tot
301
302 real(r8), dimension(IminS:ImaxS,N(ng),NT(ng)) :: Bio
303 real(r8), dimension(IminS:ImaxS,N(ng),NT(ng)) :: Bio_old
304 real(r8), dimension(IminS:ImaxS,N(ng),NT(ng)) :: Bio_new
305
306 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: FC
307 real(r8), dimension(IminS:ImaxS,N(ng)) :: Hz_inv
308 real(r8), dimension(IminS:ImaxS,N(ng)) :: Hz_inv2
309 real(r8), dimension(IminS:ImaxS,N(ng)) :: Hz_inv3
310 real(r8), dimension(IminS:ImaxS,N(ng)) :: WL
311 real(r8), dimension(IminS:ImaxS,N(ng)) :: WR
312 real(r8), dimension(IminS:ImaxS,N(ng)) :: bL
313 real(r8), dimension(IminS:ImaxS,N(ng)) :: bR
314 real(r8), dimension(IminS:ImaxS,N(ng)) :: qc
315
316#include "set_bounds.h"
317#ifdef DIAGNOSTICS_BIO
318!
319!-----------------------------------------------------------------------
320! If appropriate, initialize time-averaged diagnostic arrays.
321!-----------------------------------------------------------------------
322!
323 IF (((iic(ng).gt.ntsdia(ng)).and. &
324 & (mod(iic(ng),ndia(ng)).eq.1)).or. &
325 & ((iic(ng).ge.ntsdia(ng)).and.(ndia(ng).eq.1)).or. &
326 & ((nrrec(ng).gt.0).and.(iic(ng).eq.ntstart(ng)))) THEN
327 DO ivar=1,ndbio3d
328 DO k=1,ndbands
329 DO j=jstr,jend
330 DO i=istr,iend
331 diabio3d(i,j,k,ivar)=0.0_r8
332 END DO
333 END DO
334 END DO
335 END DO
336 DO ivar=1,ndbio4d
337 DO iband=1,ndbands
338 DO k=1,n(ng)
339 DO j=jstr,jend
340 DO i=istr,iend
341 diabio4d(i,j,k,iband,ivar)=0.0_r8
342 END DO
343 END DO
344 END DO
345 END DO
346 END DO
347 END IF
348#endif
349!
350!=======================================================================
351! Add EcoSim Source/Sink terms.
352!=======================================================================
353!
354! Set internal time-stepping.
355!
356 dtbio=dt(ng)/real(bioiter(ng),r8)
357#ifdef DIAGNOSTICS_BIO
358!
359! A factor to account for the number of iterations in accumulating
360! diagnostic rate variables.
361!
362 fiter=1.0_r8/real(bioiter(ng),r8)
363#endif
364!
365! Set vertical sinking identification and associated sinking velocity
366! arrays.
367!
368 ic=1
369 DO ifec=1,nfec
370 idsink(ic)=ifecn(ifec)
371 wbio(ic)=wf(ifec,ng)
372 ic=ic+1
373 idsink(ic)=ifecc(ifec)
374 wbio(ic)=wf(ifec,ng)
375 ic=ic+1
376 idsink(ic)=ifecp(ifec)
377 wbio(ic)=wf(ifec,ng)
378 ic=ic+1
379 idsink(ic)=ifecs(ifec)
380 wbio(ic)=wf(ifec,ng)
381 ic=ic+1
382 idsink(ic)=ifecf(ifec)
383 wbio(ic)=wf(ifec,ng)
384 ic=ic+1
385 END DO
386
387 DO iphy=1,nphy
388 idsink(ic)=iphyn(iphy)
389 wbio(ic)=ws(iphy,ng)
390 ic=ic+1
391 idsink(ic)=iphyc(iphy)
392 wbio(ic)=ws(iphy,ng)
393 ic=ic+1
394 idsink(ic)=iphyp(iphy)
395 wbio(ic)=ws(iphy,ng)
396 IF (iphys(iphy).ne.0) THEN
397 ic=ic+1
398 idsink(ic)=iphys(iphy)
399 wbio(ic)=ws(iphy,ng)
400 END IF
401 ic=ic+1
402 idsink(ic)=iphyf(iphy)
403 wbio(ic)=ws(iphy,ng)
404 ic=ic+1
405 END DO
406 nsink=ic-1
407!
408!-----------------------------------------------------------------------
409! Compute inverse thickness to avoid repeated divisions.
410!-----------------------------------------------------------------------
411!
412 j_loop : DO j=jstr,jend
413 DO k=1,n(ng)
414 DO i=istr,iend
415 hz_inv(i,k)=1.0_r8/hz(i,j,k)
416 END DO
417 END DO
418 DO k=1,n(ng)-1
419 DO i=istr,iend
420 hz_inv2(i,k)=1.0_r8/(hz(i,j,k)+hz(i,j,k+1))
421 END DO
422 END DO
423 DO k=2,n(ng)-1
424 DO i=istr,iend
425 hz_inv3(i,k)=1.0_r8/(hz(i,j,k-1)+hz(i,j,k)+hz(i,j,k+1))
426 END DO
427 END DO
428!
429!-----------------------------------------------------------------------
430! Extract biological variables from tracer arrays, place them into
431! scratch arrays, and restrict their values to be positive definite.
432!-----------------------------------------------------------------------
433!
434! At input, all tracers (index nnew) from predictor step have
435! transport units (m Tunits) since we do not have yet the new
436! values for zeta and Hz. These are known after the 2D barotropic
437! time-stepping.
438!
439 DO ibio=1,nbt
440 itrc=idbio(ibio)
441 DO k=1,n(ng)
442 DO i=istr,iend
443 bio(i,k,itrc)=max(minval,t(i,j,k,nstp,itrc))
444 bio_old(i,k,itrc)=bio(i,k,itrc)
445!!
446!! HGA - The new tendency terms were not initialized. This gives
447!! unexpected behavior on different computers since a variable
448!! was used before it was assigned. This may explain earlier
449!! problems with the algorithm. Perhaps, this time-stepping can
450!! be modified latter to avoid unnecessary storage between
451!! Bio, Bio_old, and Bio_new.
452!!
453 bio_new(i,k,itrc)=0.0_r8
454 END DO
455 END DO
456 END DO
457!
458! Extract potential temperature and salinity.
459!
460 DO k=1,n(ng)
461 DO i=istr,iend
462 bio(i,k,itemp)=t(i,j,k,nstp,itemp)
463 bio(i,k,isalt)=t(i,j,k,nstp,isalt)
464 END DO
465 END DO
466!
467!-----------------------------------------------------------------------
468! Compute temperature and salinity dependent variables.
469!-----------------------------------------------------------------------
470!
471! Refuge depth calculation.
472!
473 DO iphy=1,nphy
474 DO k=1,n(ng)
475 DO i=istr,iend
476 refuge(i,k,iphy)=minrefuge(iphy,ng)
477 END DO
478 END DO
479 END DO
480!
481! Initialize fecal regeneration arrays (N, P, and Fe from Moore et al.,
482! DSRII 2001; silica is given by values from Bidle and Azam, Nature,
483! 1999).
484!
485 IF (regen_flag(ng)) THEN
486 DO ifec=1,nfec
487 DO k=1,n(ng)
488 DO i=istr,iend
489 fv1=exp(regtfac(ifec,ng)*(bio(i,k,itemp)- &
490 & regtbase(ifec,ng)))
491 regen_c(i,k,ifec)=regcr(ifec,ng)*fv1
492 regen_n(i,k,ifec)=regnr(ifec,ng)*fv1
493 regen_p(i,k,ifec)=regpr(ifec,ng)*fv1
494 regen_f(i,k,ifec)=regfr(ifec,ng)*fv1
495 regen_s(i,k,ifec)=regsr(ifec,ng)*fv1
496 END DO
497 END DO
498 END DO
499 END IF
500!
501! Calculate temperature dependent growth rate.
502!
503 DO iphy=1,nphy
504 DO k=1,n(ng)
505 DO i=istr,iend
506 gtalg(i,k,iphy)=gtalg_max(iphy,ng)* &
507 & exp(phytfac(iphy,ng)* &
508 & (bio(i,k,itemp)-phytbase(iphy,ng)))
509!
510! Calculate mu_bar for droop equation.
511!
512 fv1=maxc2nalg(iphy,ng)*(1.0_r8+gtalg(i,k,iphy))
513 mu_bar_n(i,k,iphy)=gtalg(i,k,iphy)* &
514 & fv1/(fv1-minc2nalg(iphy,ng))
515 IF (hssio(iphy,ng).lt.larger) THEN
516 fv1=maxc2sialg(iphy,ng)*(1.0_r8+gtalg(i,k,iphy))
517 mu_bar_s(i,k,iphy)=gtalg(i,k,iphy)* &
518 & fv1/(fv1-minc2sialg(iphy,ng))
519 ELSE
520 mu_bar_s(i,k,iphy)=larger
521 END IF
522 IF (hspo4(iphy,ng).lt.larger) THEN
523 fv1=maxc2palg(iphy,ng)*(1.0_r8+gtalg(i,k,iphy))
524 mu_bar_p(i,k,iphy)=gtalg(i,k,iphy)* &
525 & fv1/(fv1-minc2palg(iphy,ng))
526 ELSE
527 mu_bar_p(i,k,iphy)=larger
528 END IF
529 IF (hsfe(iphy,ng).lt.larger) THEN
530 fv1=maxc2fealg(iphy,ng)*(1.0_r8+gtalg(i,k,iphy))
531 mu_bar_f(i,k,iphy)=gtalg(i,k,iphy)* &
532 & fv1/(fv1-minc2fealg(iphy,ng))
533 ELSE
534 mu_bar_f(i,k,iphy)=larger
535 END IF
536 END DO
537 END DO
538 END DO
539!
540! Bacterial growth rate from Fasham et al., 1990.
541!
542 DO ibac=1,nbac
543 DO k=1,n(ng)
544 DO i=istr,iend
545 gtbac(i,k,ibac)=gtbac_max(ibac,ng)* &
546 & exp(bactfac(ibac,ng)* &
547 & (bio(i,k,itemp)-bactbase(ibac,ng)))
548 END DO
549 END DO
550 END DO
551!
552! Grazing rate calculation.
553! NOTE: ES1 included separation calculations for grazing beneath the
554! zone of refuge (250 m). This has been removed and may
555! result in differences in deeper waters.
556!! Revisions, WPB 10/20/02. New grazing formulation that is better
557!! representation of basal loss rates and biomass accumulations.
558!
559 DO iphy=1,nphy
560 DO k=1,n(ng)
561 DO i=istr,iend
562 fv1=max(1.0_r8,(bio(i,k,iphyc(iphy))/refuge(i,k,iphy)))
563 graz_act(i,k,iphy)=hsgrz(iphy,ng)*log(fv1)
564 END DO
565 END DO
566 END DO
567!
568!-----------------------------------------------------------------------
569! Iterate biology source and sink terms.
570!-----------------------------------------------------------------------
571!
572 iter_loop : DO iter=1,bioiter(ng)
573
574 DO k=1,n(ng)
575 DO i=istr,iend
576 totnh4_d(i,k)=0.0_r8
577 totno3_d(i,k)=0.0_r8
578 totpo4_d(i,k)=0.0_r8
579 totsio_d(i,k)=0.0_r8
580 totfe_d(i,k)=0.0_r8
581 totdoc_d(i,k)=0.0_r8
582 totdon_d(i,k)=0.0_r8
583 totdop_d(i,k)=0.0_r8
584 END DO
585 END DO
586 DO iphy=1,nphy
587 DO k=1,n(ng)
588 DO i=istr,iend
589 nupnh4(i,k,iphy)=0.0_r8
590 nupno3(i,k,iphy)=0.0_r8
591 nuppo4(i,k,iphy)=0.0_r8
592 nupsio(i,k,iphy)=0.0_r8
593 nupfe(i,k,iphy)=0.0_r8
594 nupdon(i,k,iphy)=0.0_r8
595 nupdop(i,k,iphy)=0.0_r8
596 END DO
597 END DO
598 END DO
599!
600! Compute Ratio Arrays.
601! (Calculating only those that are accessed more than once.)
602!
603 DO iphy=1,nphy
604 DO k=1,n(ng)
605 DO i=istr,iend
606 c2nalg(i,k,iphy)=0.0_r8
607 IF (bio(i,k,iphyn(iphy)).gt.0.0_r8) THEN
608 c2nalg(i,k,iphy)=bio(i,k,iphyc(iphy))/ &
609 & bio(i,k,iphyn(iphy))
610 END IF
611 c2palg(i,k,iphy)=0.0_r8
612 IF (bio(i,k,iphyp(iphy)).gt.0.0_r8) THEN
613 c2palg(i,k,iphy)=bio(i,k,iphyc(iphy))/ &
614 & bio(i,k,iphyp(iphy))
615 END IF
616 c2salg(i,k,iphy)=0.0_r8
617 IF (iphys(iphy).gt.0) THEN
618 IF (bio(i,k,iphys(iphy)).gt.0.0_r8) THEN
619 c2salg(i,k,iphy)=bio(i,k,iphyc(iphy))/ &
620 & bio(i,k,iphys(iphy))
621 END IF
622 END IF
623 c2falg(i,k,iphy)=0.0_r8
624 IF (bio(i,k,iphyf(iphy)).gt.0.0_r8) THEN
625 c2falg(i,k,iphy)=bio(i,k,iphyc(iphy))/ &
626 & bio(i,k,iphyf(iphy))
627 END IF
628 END DO
629 END DO
630 END DO
631!
632!-----------------------------------------------------------------------
633! Daylight Computations.
634!-----------------------------------------------------------------------
635!
636! Initialize.
637!
638 DO i=istr,iend
639 ed_nz(i,n(ng))=0.0_r8
640 e0_nz(i,n(ng))=0.0_r8
641 keuphotic(i)=n(ng)+1
642 IF (specir(i,j,21).gt.vsmall) THEN
643 DO k=1,n(ng)-1
644 ed_nz(i,k)=0.0_r8
645 e0_nz(i,k)=0.0_r8
646 END DO
647 DO iband=1,nbands
648 datt_sum(iband)=0.0_r8
649 DO k=1,n(ng)
650 avgcos(k,iband)=0.0_r8
651 datt(k,iband)=0.0_r8
652#ifdef DIAGNOSTICS_BIO
653 adet(i,k,iband)=0.0_r8
654 acdc(i,k,iband)=0.0_r8
655 b_phy(i,k,iband)=0.0_r8
656 s_phy(i,k,iband)=0.0_r8
657 b_tot(i,k,iband)=0.0_r8
658 s_tot(i,k,iband)=0.0_r8
659#endif
660 END DO
661 DO iphy=1,nphy
662 DO k=1,n(ng)
663 aphyn_at(i,k,iphy,iband)=0.0_r8
664 aphyn_al(i,k,iphy,iband)=0.0_r8
665 END DO
666 END DO
667 END DO
668!
669! Calculate average cosine zenith angle at surface.
670! (See equation 14 Morel, 1991 Prog. Ocean.)
671!
672 ed_tot=0.0_r8
673 DO iband=1,nbands
674 ed_tot=ed_tot+specir(i,j,iband)*dlam
675 avgcos(n(ng),iband)=avcos(i,j,iband)
676 END DO
677!
678! Total aph(442). adp(442) is set to 50% of aph(442).
679! NOTE: choosing sbands=9 which is band 442 using v8r16
680! sbands formulation. If spectral resolution changes, this
681! value must change!
682!
683 DO k=n(ng),1,-1
684 IF (ed_tot.ge.1.0_r8) THEN
685 aph442=0.0_r8
686 tchl=0.0_r8
687 DO iphy=1,nphy
688 IF (bio(i,k,iphyc(iphy)).gt.0.0_r8) THEN
689 tchl=tchl+bio(i,k,ipigs(iphy,ichl))
690 pac_eff(k,iphy)=1.0_r8
691 IF (b_paceff(iphy,ng).gt.small) THEN
692 fv2=bio(i,k,ipigs(iphy,ichl))/ &
693 & (bio(i,k,iphyc(iphy))*12.0_r8)
694 pac_eff(k,iphy)=max(0.5_r8, &
695 & (min(1.0_r8, &
696 & b_paceff(iphy,ng)+ &
697 & mxpaceff(iphy,ng)* &
698 & (fv2- &
699 & b_c2cl(iphy,ng)))))
700 END IF
701 iband=9
702 DO ipig=1,npig
703 IF (ipigs(iphy,ipig).gt.0) THEN
704 aph442=aph442+ &
705 & bio(i,k,ipigs(iphy,ipig))* &
706 & apigs(ipig,iband)*pac_eff(k,iphy)
707 END IF
708 END DO
709 END IF
710 END DO
711!
712! Calculate absorption.
713! Calculating phytoplankton absorption for attenuation calculation.
714! NOTE: 12 factor to convert to ugrams (mg m-3)
715!
716 aph442=0.5_r8*aph442
717 DO iband=1,nbands
718 tot_ab=0.0_r8
719 DO iphy=1,nphy
720 DO ipig=1,npig
721 IF (ipigs(iphy,ipig).gt.0) THEN
722 aphyn_at(i,k,iphy,iband)= &
723 & aphyn_at(i,k,iphy,iband)+ &
724 & bio(i,k,ipigs(iphy,ipig))* &
725 & apigs(ipig,iband)* &
726 & pac_eff(k,iphy)
727 END IF
728 END DO
729 tot_ab(k,iband)=tot_ab(k,iband)+ &
730 & aphyn_at(i,k,iphy,iband)
731#ifdef DIAGNOSTICS_BIO
732 diabio4d(i,j,k,iband,idaphy)=diabio4d(i,j,k,iband,&
733 & idaphy)+ &
734 & aphyn_at(i,k,iphy, &
735 & iband)
736#endif
737!
738! Removing absorption due to PPC for "alfa" calculation.
739!
740 ipig=5
741 IF (ipigs(iphy,ipig).gt.0) THEN
742 aphyn_al(i,k,iphy,iband)= &
743 & aphyn_at(i,k,iphy,iband)- &
744 & bio(i,k,ipigs(iphy,ipig))* &
745 & apigs(ipig,iband)* &
746 & pac_eff(k,iphy)
747 END IF
748 END DO
749!
750! Adding detrital absorption.
751!
752 cff=aph442*exp(0.011_r8* &
753 & (442.0_r8- &
754 & (397.0_r8+real(iband,r8)*dlam)))
755 tot_ab(k,iband)=tot_ab(k,iband)+cff
756#ifdef DIAGNOSTICS_BIO
757 adet(i,k,iband)=adet(i,k,iband)+cff
758 diabio4d(i,j,k,iband,idadet)=diabio4d(i,j,k,iband, &
759 & idadet)+ &
760 & adet(i,k,iband)
761#endif
762!
763! Calculate CDOC absorption.
764! NOTE: 12 factor is to convert ugrams per liter, and 0.001 converts
765! to mg/liter. Specific absorption
766! coefficients were calculated as m-1 / (mg DOC/liters sw).
767! net factor = (12*0.001) = 0.012
768!
769 cff=0.012_r8*(bio(i,k,icdmc(ilab))* &
770 & adoc(ilab,iband)+ &
771 & bio(i,k,icdmc(irct))* &
772 & adoc(irct,iband))
773 tot_ab(k,iband)=tot_ab(k,iband)+cff+awater(iband)
774#ifdef DIAGNOSTICS_BIO
775 acdc(i,k,iband)=acdc(i,k,iband)+cff
776 diabio4d(i,j,k,iband,idacdc)=diabio4d(i,j,k,iband, &
777 & idacdc)+ &
778 & acdc(i,k,iband)
779#endif
780!
781! Calculate scattering and backscattering (see equation 19 Morel, 1991,
782! Prog. Ocean). Morel, 1988 puts spectral dependency in backscattering.
783! Since Morel (1991) does not have a backscattering equation, use 1988
784! paper. Morel 2001 has slight adjustment 0.01, rather than 0.02.
785! This was altered, but never tested in ROMS 1.8 on 03/08/03.
786!
787 par_s=0.3_r8*(tchl**0.62_r8) ! scattering
788 par_b=0.0_r8 ! backscattering
789 IF (tchl.gt.0.0_r8) THEN
790 par_b=par_s*(0.002_r8+ &
791 & 0.01_r8* &
792 & (0.5_r8-0.25_r8*log10(tchl))* &
793 & wavedp(iband))
794 END IF
795 par_b=max(par_b,0.0_r8)
796#ifdef DIAGNOSTICS_BIO
797 s_phy(i,k,iband)=s_phy(i,k,iband)+par_s
798 b_phy(i,k,iband)=b_phy(i,k,iband)+par_b
799 diabio4d(i,j,k,iband,idsphy)=diabio4d(i,j,k,iband, &
800 & idsphy)+ &
801 & s_phy(i,k,iband)
802 diabio4d(i,j,k,iband,idbphy)=diabio4d(i,j,k,iband, &
803 & idbphy)+ &
804 & b_phy(i,k,iband)
805#endif
806!
807! However, for omega0 calculation, "par_s" must be spectral, so use
808! dependency from Sathy and Platt 1988.
809!
810 tot_s(k,iband)=bwater(iband)+par_s*wavedp(iband)
811#ifdef DIAGNOSTICS_BIO
812 s_tot(i,k,iband)=s_tot(i,k,iband)+tot_s(k,iband)
813#endif
814!
815! Morel, 1988 instead of 1991. See methods.
816!
817 tot_b(k,iband)=0.5_r8*bwater(iband)+par_b
818#ifdef DIAGNOSTICS_BIO
819 b_tot(i,k,iband)=b_tot(i,k,iband)+tot_b(k,iband)
820
821 diabio4d(i,j,k,iband,idstot)=diabio4d(i,j,k,iband, &
822 & idstot)+ &
823 & s_tot(i,k,iband)
824 diabio4d(i,j,k,iband,idbtot)=diabio4d(i,j,k,iband, &
825 & idbtot)+ &
826 & b_tot(i,k,iband)
827#endif
828#ifdef BIO_OPTIC
829!
830! Next statement is Eq. 11 of Lee et al. (2005) from Gallegos
831! equal to SPECKD in Gallegos. Notice that the in-water solar
832! angle in "cff1" is in degrees.
833!
834 cff1=1.0_r8+ &
835 & 0.005_r8*acos(avgcos(k,iband))*rad2deg
836 cff2=4.18_r8*(1.0_r8-0.52_r8* &
837 & exp(-10.8_r8*tot_ab(k,iband)))
838 datt(k,iband)=cff1*tot_ab(k,iband)+ &
839 & cff2*tot_b(k,iband)
840#else
841!
842! Sathy and Platt JGR 1988. This is set with the average cosine of
843! the box above, and used to calculate a new avgcos for this level.
844! This new average cosine is then used to recalculate the attenuation
845! coefficient.
846!
847 datt(k,iband)=(tot_ab(k,iband)+ &
848 & tot_b(k,iband))/avgcos(k,iband)
849#endif
850!
851! See Mobley, 1995 for graphical depiction of this equation.
852!
853 avgcos_min=avgcos(k,iband)+ &
854 & (0.5_r8-avgcos(k,iband))* &
855 & (tot_s(k,iband)/ &
856 & (tot_ab(k,iband)+tot_s(k,iband)))
857!
858! Calculate average cosine. Linear fit to average cosine versus optical
859! depth relationship. The FV1 calculation keeps the denominator of the
860! slope calculation from going negative and above 1.
861!
862 fv1=max(1.0_r8, &
863 & 7.0_r8-datt(k,iband)*abs(z_r(i,j,k)))
864 slope_ac =min(0.0_r8, &
865 & (avgcos_min-avgcos(k,iband))/fv1)
866 avgcos(k,iband)=avgcos(k,iband)+ &
867 & slope_ac*datt(k,iband)*hz(i,j,k)
868#ifdef BIO_OPTIC
869!
870! Next statement is Eq. 11 of Lee et al. (2005). Notice that "cff1" is
871! recomputed because "avgcos" changed and "cff2" is the same as above.
872!
873 cff1=1.0_r8+ &
874 & 0.005_r8*acos(avgcos(k,iband))*rad2deg
875 datt(k,iband)=cff1*tot_ab(k,iband)+ &
876 & cff2*tot_b(k,iband)
877#else
878 datt(k,iband)=(tot_ab(k,iband)+ &
879 & tot_b(k,iband))/avgcos(k,iband)
880#endif
881!
882! Set avgcos for next level.
883!
884 IF (k.ne.1) THEN
885 avgcos(k-1,iband)=avgcos(k,iband)
886 END IF
887!
888! Calculate spectral irradiance with depth.
889!
890 fv1=datt(k,iband)*hz(i,j,k)
891 fv2=datt_sum(iband)+0.5_r8*fv1
892 datt_sum(iband)=datt_sum(iband)+fv1
893 specir_d(k,iband)=specir(i,j,iband)* &
894 & exp(-fv2)*dlam
895!
896! Calculate spectral scalar irradiance. Morel, 1991 Prog. Ocean.
897!
898 specir_scal(i,k,iband)=specir_d(k,iband)* &
899 & (datt(k,iband)/ &
900 & tot_ab(k,iband))
901 e0_nz(i,k)=e0_nz(i,k)+specir_scal(i,k,iband)
902!
903! Calculate Ed_nz.
904!
905 ed_nz(i,k)=ed_nz(i,k)+specir_d(k,iband)
906#ifdef DIAGNOSTICS_BIO
907 diabio3d(i,j,iband,idspir)=diabio3d(i,j,iband, &
908 & idspir)+ &
909 & specir(i,j,iband)
910 diabio4d(i,j,k,iband,iddirr)=diabio4d(i,j,k,iband, &
911 & iddirr)+ &
912 & specir_d(k,iband)
913 diabio4d(i,j,k,iband,idsirr)=diabio4d(i,j,k,iband, &
914 & idsirr)+ &
915 & specir_scal(i,k,iband)
916 diabio4d(i,j,k,iband,idlatt)=diabio4d(i,j,k,iband, &
917 & idlatt)+ &
918 & datt(k,iband)
919 diabio4d(i,j,k,iband,idacos)=diabio4d(i,j,k,iband, &
920 & idacos)+ &
921 & avgcos(k,iband)
922#endif
923 END DO
924 ed_tot=e0_nz(i,k)
925!
926! Set bottom of the euphotic zone.
927!
928 keuphotic(i)=k
929 END IF
930 END DO
931 END IF
932 END DO
933!
934!-----------------------------------------------------------------------
935! Bacterial nutrient uptake.
936!-----------------------------------------------------------------------
937!
938 DO ibac=1,nbac
939 DO k=1,n(ng)
940 DO i=istr,iend
941!
942! DOM uptake.
943!
944 IF ((bio(i,k,idomc(ilab)).gt.0.0_r8).and. &
945 & (bio(i,k,idomn(ilab)).gt.0.0_r8).and. &
946 & (bio(i,k,idomp(ilab)).gt.0.0_r8)) THEN
947 nupdoc_ba(i,k,ibac)=gtbac(i,k,ibac)* &
948 & bio(i,k,ibacc(ibac))* &
949 & i_bac_ceff(ng)* &
950 & (bio(i,k,idomc(ilab))/ &
951 & (hsdoc_ba(ibac,ng)+ &
952 & bio(i,k,idomc(ilab))))
953 nupdon_ba(i,k,ibac)=nupdoc_ba(i,k,ibac)* &
954 & bio(i,k,idomn(ilab))/ &
955 & bio(i,k,idomc(ilab))
956 nupdop_ba(i,k,ibac)=nupdoc_ba(i,k,ibac)* &
957 & bio(i,k,idomp(ilab))/ &
958 & bio(i,k,idomc(ilab))
959 ELSE
960 nupdoc_ba(i,k,ibac)=0.0_r8
961 nupdon_ba(i,k,ibac)=0.0_r8
962 nupdop_ba(i,k,ibac)=0.0_r8
963 END IF
964 totdoc_d(i,k)=totdoc_d(i,k)+nupdoc_ba(i,k,ibac)
965 totdon_d(i,k)=totdon_d(i,k)+nupdon_ba(i,k,ibac)
966 totdop_d(i,k)=totdop_d(i,k)+nupdop_ba(i,k,ibac)
967!
968! NH4 uptake.
969!
970 nupnh4_ba(i,k,ibac)=gtbac(i,k,ibac)* &
971 & bio(i,k,ibacn(ibac))* &
972 & bio(i,k,inh4_)/ &
973 & (hsnh4_ba(ibac,ng)+bio(i,k,inh4_))
974 totnh4_d(i,k)=totnh4_d(i,k)+nupnh4_ba(i,k,ibac)
975!
976! PO4 uptake.
977!
978 nuppo4_ba(i,k,ibac)=gtbac(i,k,ibac)* &
979 & bio(i,k,ibacp(ibac))* &
980 & bio(i,k,ipo4_)/ &
981 & (hspo4_ba(ibac,ng)+bio(i,k,ipo4_))
982 totpo4_d(i,k)=totpo4_d(i,k)+nuppo4_ba(i,k,ibac)
983!
984! Fe uptake.
985!
986 nupfe_ba(i,k,ibac)=gtbac(i,k,ibac)* &
987 & bio(i,k,ibacf(ibac))* &
988 & bio(i,k,ifeo_)/ &
989 & (hsfe_ba(ibac,ng)+bio(i,k,ifeo_))
990 totfe_d(i,k)=totfe_d(i,k)+nupfe_ba(i,k,ibac)
991 END DO
992 END DO
993 END DO
994!
995!-----------------------------------------------------------------------
996! Phytoplankton dark nutrient uptake.
997!-----------------------------------------------------------------------
998!
999 DO iphy=1,nphy
1000 DO k=1,n(ng)
1001 DO i=istr,iend
1002 IF (c2nalg(i,k,iphy).gt.c2nalgminabs(iphy,ng)) THEN
1003!
1004! NOTE: these are being saved to test for total nutrient uptake.
1005! If nutrient uptake is greater than maximum nutrient, then
1006! each of the uptakes are reduced by their fractional contri-
1007! bution to the total.
1008!
1009 nup_max=gtalg(i,k,iphy)
1010 nupno3(i,k,iphy)=(bio(i,k,ino3_)/ &
1011 & (hsno3(iphy,ng)+bio(i,k,ino3_))* &
1012 & exp(-bet_(iphy,ng)*bio(i,k,inh4_)))
1013 nupnh4(i,k,iphy)=bio(i,k,inh4_)/ &
1014 & (hsnh4(iphy,ng)+bio(i,k,inh4_))
1015!
1016! Test that Wroblewski equation does not exceed 1.0.
1017!
1018 fv1=nupno3(i,k,iphy)+nupnh4(i,k,iphy)
1019 IF (fv1.gt.1.0_r8) THEN
1020 fv1=1.0_r8/fv1
1021 nupno3(i,k,iphy)=nupno3(i,k,iphy)*fv1
1022 nupnh4(i,k,iphy)=nupnh4(i,k,iphy)*fv1
1023 END IF
1024!
1025! Change from percentage of maximum to mass per second.
1026!
1027 fv1=nup_max*bio(i,k,iphyn(iphy))
1028 nupno3(i,k,iphy)=nupno3(i,k,iphy)*fv1
1029 nupnh4(i,k,iphy)=nupnh4(i,k,iphy)*fv1
1030!
1031! Test for DON uptake.
1032!
1033 IF (c2nalg(i,k,iphy).gt.c2nnupdon(iphy,ng)) THEN
1034 nupdon(i,k,iphy)=fv1* &
1035 & bio(i,k,idomn(ilab))/ &
1036 & (hsdon(iphy,ng)+ &
1037 & bio(i,k,idomn(ilab)))
1038 END IF
1039!
1040! Accumulate total demand for nutrients.
1041!
1042 totno3_d(i,k)=totno3_d(i,k)+nupno3(i,k,iphy)
1043 totnh4_d(i,k)=totnh4_d(i,k)+nupnh4(i,k,iphy)
1044 totdon_d(i,k)=totdon_d(i,k)+nupdon(i,k,iphy)
1045 END IF
1046!
1047! Dark silica uptake, min C2Si test.
1048! The LARGER test can be removed after testing phase.
1049!
1050 IF (hssio(iphy,ng).lt.larger) THEN
1051 IF (c2salg(i,k,iphy).gt.c2sialgminabs(iphy,ng)) THEN
1052 nup_max=gtalg(i,k,iphy)
1053 nupsio(i,k,iphy)=bio(i,k,isio_)/ &
1054 & (hssio(iphy,ng)+bio(i,k,isio_))
1055!
1056! Change from percentage of maximum to mass per second.
1057!
1058 IF (iphys(iphy).gt.0) THEN
1059 fv1=nup_max*bio(i,k,iphys(iphy))
1060 nupsio(i,k,iphy)=nupsio(i,k,iphy)*fv1
1061 ELSE
1062 nupsio(i,k,iphy)=0.0_r8
1063 END IF
1064!
1065! Accumulate total demand for nutrients.
1066!
1067 totsio_d(i,k)=totsio_d(i,k)+nupsio(i,k,iphy)
1068 END IF
1069 END IF
1070!
1071! Dark phophorus uptake, min C2P test.
1072! The LARGER test can be removed after testing phase.
1073!
1074 IF (hspo4(iphy,ng).lt.larger) THEN
1075 IF (c2palg(i,k,iphy).gt.c2palgminabs(iphy,ng)) THEN
1076 nup_max=gtalg(i,k,iphy)
1077 nuppo4(i,k,iphy)=bio(i,k,ipo4_)/ &
1078 & (hspo4(iphy,ng)+bio(i,k,ipo4_))
1079!
1080! Change from percentage of maximum to mass per second.
1081!
1082 fv1=nup_max*bio(i,k,iphyp(iphy))
1083 nuppo4(i,k,iphy)=nuppo4(i,k,iphy)*fv1
1084!
1085! Test for alk. phosphatase
1086!
1087 IF (c2palg(i,k,iphy).gt.c2palkphos(iphy,ng)) THEN
1088 nupdop(i,k,iphy)=fv1* &
1089 bio(i,k,idomp(ilab))/ &
1090 & (hsdop(iphy,ng)+ &
1091 & bio(i,k,idomp(ilab)))
1092 END IF
1093!
1094! Accumulate total demand for nutrients.
1095!
1096 totpo4_d(i,k)=totpo4_d(i,k)+nuppo4(i,k,iphy)
1097 totdop_d(i,k)=totdop_d(i,k)+nupdop(i,k,iphy)
1098 END IF
1099 END IF
1100!
1101! Dark iron uptake, min C2Fe test.
1102! The LARGER test can be removed after testing phase.
1103!
1104 IF (hsfe(iphy,ng).lt.larger) THEN
1105 IF (c2falg(i,k,iphy).gt.c2fealgminabs(iphy,ng)) THEN
1106 nup_max=gtalg(i,k,iphy)
1107 nupfe(i,k,iphy)=bio(i,k,ifeo_)/ &
1108 & (hsfe(iphy,ng)+bio(i,k,ifeo_))
1109!
1110! Change from percentage of maximum to mass per second.
1111!
1112 fv1=nup_max*bio(i,k,iphyf(iphy))
1113 nupfe(i,k,iphy)=nupfe(i,k,iphy)*fv1
1114!
1115! Accumulate total demand for nutrients.
1116!
1117 totfe_d(i,k)=totfe_d(i,k)+nupfe(i,k,iphy)
1118 END IF
1119 END IF
1120 END DO
1121 END DO
1122 END DO
1123!
1124! Calculate bacterial nitrification as a Michaelis-Menton function
1125! of ambient NH4 concentration, beneath the euphotic zone (light
1126! inhibits nitrification).
1127!
1128 DO k=1,n(ng)
1129 DO i=istr,iend
1130 nitrbac(i,k)=0.0_r8
1131 nh4tono3(i,k)=0.0_r8
1132 ntonbac(i,k)=0.0_r8
1133 ntopbac(i,k)=0.0_r8
1134 ntofebac(i,k)=0.0_r8
1135 IF (k.lt.keuphotic(i)) THEN
1136 nh4tono3(i,k)=rtnit(ng)* &
1137 & bio(i,k,inh4_)/(hsnit(ng)+bio(i,k,inh4_))
1138!
1139! Nitrification fixes DIC into POC.
1140! Conversion factor of 7.0 from Kaplan 1983 "Nitrogen in the Sea"
1141! factor equals (1.0 / (7.0 * C2nBAC)). Adds NH4 uptake as biomass.
1142!
1143 nitrbac(i,k)=nh4tono3(i,k)/7.0_r8
1144 ntonbac(i,k)=nitrbac(i,k)*n2cbac(ng)
1145 ntopbac(i,k)=nitrbac(i,k)*p2cbac(ng)
1146 ntofebac(i,k)=nitrbac(i,k)*fe2cbac(ng)
1147 totnh4_d(i,k)=totnh4_d(i,k)+nh4tono3(i,k)+ntonbac(i,k)
1148 totpo4_d(i,k)=totpo4_d(i,k)+ntopbac(i,k)
1149 totfe_d(i,k)=totfe_d(i,k)+ntofebac(i,k)
1150 END IF
1151 END DO
1152 END DO
1153!
1154!-----------------------------------------------------------------------
1155! Test that total nutrient demand does not exceed supply. If it does
1156! total demand is normalized to the total supply. Each species demand
1157! is reduced to its weighted average percentage of the supply.
1158!-----------------------------------------------------------------------
1159!
1160 DO k=1,n(ng)
1161 DO i=istr,iend
1162 fv2=totno3_d(i,k)*dtbio
1163 IF (fv2.gt.bio(i,k,ino3_)) THEN
1164 fv1=(bio(i,k,ino3_)-vsmall)/fv2
1165 DO iphy=1,nphy
1166 nupno3(i,k,iphy)=nupno3(i,k,iphy)*fv1
1167 END DO
1168 END IF
1169!
1170 fv2=totnh4_d(i,k)*dtbio
1171 IF (fv2.gt.bio(i,k,inh4_)) THEN
1172 fv1=(bio(i,k,inh4_)-vsmall)/fv2
1173 DO iphy=1,nphy
1174 nupnh4(i,k,iphy)=nupnh4(i,k,iphy)*fv1
1175 END DO
1176 DO ibac=1,nbac
1177 nupnh4_ba(i,k,ibac)=nupnh4_ba(i,k,ibac)*fv1
1178 END DO
1179 nh4tono3(i,k)=nh4tono3(i,k)*fv1
1180 ntonbac(i,k)=ntonbac(i,k)*fv1
1181 END IF
1182!
1183 fv2=totsio_d(i,k)*dtbio
1184 IF (fv2.gt.bio(i,k,isio_)) THEN
1185 fv1=(bio(i,k,isio_)-vsmall)/fv2
1186 DO iphy=1,nphy
1187 nupsio(i,k,iphy)=nupsio(i,k,iphy)*fv1
1188 END DO
1189 END IF
1190!
1191 fv2=totpo4_d(i,k)*dtbio
1192 IF (fv2.gt.bio(i,k,ipo4_)) THEN
1193 fv1=(bio(i,k,ipo4_)-vsmall)/fv2
1194 DO iphy=1,nphy
1195 nuppo4(i,k,iphy)=nuppo4(i,k,iphy)*fv1
1196 END DO
1197 DO ibac=1,nbac
1198 nuppo4_ba(i,k,ibac)=nuppo4_ba(i,k,ibac)*fv1
1199 END DO
1200 ntopbac(i,k)=ntopbac(i,k)*fv1
1201 END IF
1202!
1203 fv2=totfe_d(i,k)*dtbio
1204 IF (fv2.gt.bio(i,k,ifeo_)) THEN
1205 fv1=(bio(i,k,ifeo_)-vsmall)/fv2
1206 DO iphy=1,nphy
1207 nupfe(i,k,iphy)=nupfe(i,k,iphy)*fv1
1208 END DO
1209 DO ibac=1,nbac
1210 nupfe_ba(i,k,ibac)=nupfe_ba(i,k,ibac)*fv1
1211 END DO
1212 ntofebac(i,k)=ntofebac(i,k)*fv1
1213 END IF
1214!
1215! Bacteria are the only group to take up DOC. Remove BAC DON and
1216! BAC DOP uptake from total uptake; adjust uptake and add back.
1217!
1218 fv2=totdoc_d(i,k)*dtbio
1219 IF (fv2.gt.bio(i,k,idomc(ilab))) THEN
1220 fv1=(bio(i,k,idomc(ilab))-vsmall)/fv2
1221 totdoc_d(i,k)=totdoc_d(i,k)*fv1
1222 DO ibac=1,nbac
1223 nupdoc_ba(i,k,ibac)=nupdoc_ba(i,k,ibac)*fv1
1224 totdon_d(i,k)=totdon_d(i,k)-nupdon_ba(i,k,ibac)
1225 nupdon_ba(i,k,ibac)=nupdon_ba(i,k,ibac)*fv1
1226 totdon_d(i,k)=totdon_d(i,k)+nupdon_ba(i,k,ibac)
1227 totdop_d(i,k)=totdop_d(i,k)-nupdop_ba(i,k,ibac)
1228 nupdop_ba(i,k,ibac)=nupdop_ba(i,k,ibac)*fv1
1229 totdop_d(i,k)=totdop_d(i,k)+nupdop_ba(i,k,ibac)
1230 END DO
1231 END IF
1232!
1233! Remove BAC DON uptake from total uptake; adjust uptake and add back.
1234!
1235 fv2=totdon_d(i,k)*dtbio
1236 IF (fv2.gt.bio(i,k,idomn(ilab))) THEN
1237 fv1=(bio(i,k,idomn(ilab))-vsmall)/fv2
1238 totdon_d(i,k)=totdon_d(i,k)*fv1
1239 totdoc_d(i,k)=totdoc_d(i,k)*fv1
1240 DO iphy=1,nphy
1241 nupdon(i,k,iphy)=nupdon(i,k,iphy)*fv1
1242 END DO
1243 DO ibac=1,nbac
1244 nupdon_ba(i,k,ibac)=nupdon_ba(i,k,ibac)*fv1
1245 nupdoc_ba(i,k,ibac)=nupdoc_ba(i,k,ibac)*fv1
1246 totdop_d(i,k)=totdop_d(i,k)-nupdop_ba(i,k,ibac)
1247 nupdop_ba(i,k,ibac)=nupdop_ba(i,k,ibac)*fv1
1248 totdop_d(i,k)=totdop_d(i,k)+nupdop_ba(i,k,ibac)
1249 END DO
1250 END IF
1251!
1252! Remove BAC DOP uptake from total uptake; adjust uptake and add back.
1253!
1254 fv2=totdop_d(i,k)*dtbio
1255 IF (fv2.gt.bio(i,k,idomp(ilab))) THEN
1256 fv1=(bio(i,k,idomp(ilab))-vsmall)/fv2
1257 totdop_d(i,k)=totdop_d(i,k)*fv1
1258 totdoc_d(i,k)=totdoc_d(i,k)*fv1
1259 DO iphy=1,nphy
1260 nupdop(i,k,iphy)=nupdop(i,k,iphy)*fv1
1261 END DO
1262 DO ibac=1,nbac
1263 nupdop_ba(i,k,ibac)=nupdop_ba(i,k,ibac)*fv1
1264 totdon_d(i,k)=totdon_d(i,k)-nupdon_ba(i,k,ibac)
1265 nupdon_ba(i,k,ibac)=nupdon_ba(i,k,ibac)*fv1
1266 totdon_d(i,k)=totdon_d(i,k)+nupdon_ba(i,k,ibac)
1267 nupdoc_ba(i,k,ibac)=nupdoc_ba(i,k,ibac)*fv1
1268 END DO
1269 END IF
1270 END DO
1271 END DO
1272!
1273! Increase particulate nutrients by the amount of the uptake.
1274!
1275 DO iphy=1,nphy
1276 DO k=1,n(ng)
1277 DO i=istr,iend
1278 bio_new(i,k,iphyn(iphy))=bio_new(i,k,iphyn(iphy))+ &
1279 & nupno3(i,k,iphy)+ &
1280 & nupnh4(i,k,iphy)+ &
1281 & nupdon(i,k,iphy)
1282 bio_new(i,k,iphyp(iphy))=bio_new(i,k,iphyp(iphy))+ &
1283 & nuppo4(i,k,iphy)+ &
1284 & nupdop(i,k,iphy)
1285 bio_new(i,k,iphyf(iphy))=bio_new(i,k,iphyf(iphy))+ &
1286 & nupfe(i,k,iphy)
1287 IF (iphys(iphy).gt.0) THEN
1288 bio_new(i,k,iphys(iphy))=bio_new(i,k,iphys(iphy))+ &
1289 & nupsio(i,k,iphy)
1290 END IF
1291!
1292! Update nutrient arrays for growth and budgets. Bacterial uptake
1293! included below.
1294!
1295 bio_new(i,k,ino3_)=bio_new(i,k,ino3_)- &
1296 & nupno3(i,k,iphy)
1297 bio_new(i,k,inh4_)=bio_new(i,k,inh4_)- &
1298 & nupnh4(i,k,iphy)
1299 bio_new(i,k,isio_)=bio_new(i,k,isio_)- &
1300 & nupsio(i,k,iphy)
1301 bio_new(i,k,ipo4_)=bio_new(i,k,ipo4_)- &
1302 & nuppo4(i,k,iphy)
1303 bio_new(i,k,ifeo_)=bio_new(i,k,ifeo_)- &
1304 & nupfe(i,k,iphy)
1305 bio_new(i,k,idomn(ilab))=bio_new(i,k,idomn(ilab))- &
1306 & nupdon(i,k,iphy)
1307 bio_new(i,k,idomp(ilab))=bio_new(i,k,idomp(ilab))- &
1308 & nupdop(i,k,iphy)
1309 END DO
1310 END DO
1311 END DO
1312!
1313! Nitrification fixes DIC into DOC.
1314!
1315 DO k=1,n(ng)
1316 DO i=istr,iend
1317 bio_new(i,k,idic_)=bio_new(i,k,idic_)- &
1318 & nitrbac(i,k)
1319 END DO
1320 END DO
1321!
1322! Add nitrifying bacteria biomass to heterotrophic bacteria biomass.
1323! Adding PON, POP, POFe to BacC arrays at current C2_BAC ratios.
1324!
1325 DO ibac=1,nbac
1326 DO k=1,n(ng)
1327 DO i=istr,iend
1328 bio_new(i,k,ibacc(ibac))=bio_new(i,k,ibacc(ibac))+ &
1329 & nitrbac(i,k)
1330 bio_new(i,k,ibacn(ibac))=bio_new(i,k,ibacn(ibac))+ &
1331 & ntonbac(i,k)
1332 bio_new(i,k,ibacp(ibac))=bio_new(i,k,ibacp(ibac))+ &
1333 & ntopbac(i,k)
1334 bio_new(i,k,ibacf(ibac))=bio_new(i,k,ibacf(ibac))+ &
1335 & ntofebac(i,k)
1336 END DO
1337 END DO
1338 END DO
1339!
1340! Update nutrient arrays for nitrification.
1341!
1342 DO k=1,n(ng)
1343 DO i=istr,iend
1344 bio_new(i,k,ino3_)=bio_new(i,k,ino3_)+ &
1345 & nh4tono3(i,k)
1346 bio_new(i,k,inh4_)=bio_new(i,k,inh4_)- &
1347 & (nh4tono3(i,k)+ntonbac(i,k))
1348 bio_new(i,k,ipo4_)=bio_new(i,k,ipo4_)- &
1349 & ntopbac(i,k)
1350 bio_new(i,k,ifeo_)=bio_new(i,k,ifeo_)- &
1351 & ntofebac(i,k)
1352 END DO
1353 END DO
1354!
1355!-----------------------------------------------------------------------
1356! Light mediated carbon growth.
1357!-----------------------------------------------------------------------
1358!
1359 DO i=istr,iend
1360 DO k=n(ng),keuphotic(i),-1
1361 DO iphy=1,nphy
1362 IF (bio(i,k,iphyc(iphy)).gt.0.0_r8) THEN
1363!
1364! Calculate weighted average spectral absorption.
1365!
1366 aphyn_wa=0.0_r8
1367 DO iband=1,nbands
1368 aphyn_wa=aphyn_wa+(aphyn_al(i,k,iphy,iband)* &
1369 & specir_scal(i,k,iband))
1370 END DO
1371!
1372! If Keuphotic(i) < N+1, and E0_nz(i,k)=0, this will cause pigments to
1373! blow up. This should never happen, unless Keuphotic is not calcuated
1374! properly. WPB
1375!
1376 aphyn_wa=aphyn_wa/e0_nz(i,k)
1377!
1378! Calculate "alfa" for HTAN function of P vs. I.
1379! (conversion: Ein/microEin * 10e3)
1380!
1381 alfa(k,iphy)=(aphyn_wa/bio(i,k,iphyc(iphy)))* &
1382 & qu_yld(iphy,ng)*0.001_r8
1383!
1384! Light limited growth rate.
1385!
1386 fv1=max(0.0_r8,e0_nz(i,k)-e0_comp(iphy,ng))
1387 fv2=e0_nz(i,k)-e0_inhib(iphy,ng)
1388 IF (fv2.gt.0.0_r8) THEN
1389 gt_ll(k,iphy)=gtalg(i,k,iphy)* &
1390 & tanh(alfa(k,iphy)*fv1/ &
1391 & gtalg(i,k,iphy))* &
1392 & exp(-inhib_fac(iphy,ng)*fv2)
1393 ELSE
1394 gt_ll(k,iphy)=gtalg(i,k,iphy)* &
1395 & tanh(alfa(k,iphy)*fv1/ &
1396 & gtalg(i,k,iphy))
1397 END IF
1398!
1399! Nutrient limited growth rates.
1400!
1401! REMEMBER that sinking speed to be set by gradient of limiting
1402! nutrient, allowing for negative sinking. Try storing growth
1403! rate terms in an array and using MAXLOC for if test.
1404!
1405! Nitrogen limited growth rate.
1406!
1407 IF (bio(i,k,iphyn(iphy)).gt.0.0_r8) THEN
1408 fv1=bio(i,k,iphyc(iphy))/ &
1409 & (bio(i,k,iphyn(iphy))+bio_new(i,k,iphyn(iphy)))
1410 gt_nl(k,iphy)=mu_bar_n(i,k,iphy)* &
1411 & (1.0_r8-imaxc2nalg(iphy,ng)*fv1)
1412 gt_nl(k,iphy)=max(0.0_r8, &
1413 & min(gt_nl(k,iphy), &
1414 & gtalg(i,k,iphy)))
1415 END IF
1416!
1417! Silica limited growth rate.
1418! Testing for silica incorporation.
1419!
1420 IF (iphys(iphy).gt.0) THEN
1421 IF ((hssio(iphy,ng).lt.larger).and. &
1422 & (bio(i,k,iphys(iphy)).gt.0.0_r8)) THEN
1423 fv1=bio(i,k,iphyc(iphy))/ &
1424 & (bio(i,k,iphys(iphy))+ &
1425 & bio_new(i,k,iphys(iphy)))
1426 gt_sl(k,iphy)=mu_bar_s(i,k,iphy)* &
1427 & (1.0_r8-imaxc2sialg(iphy,ng)*fv1)
1428 gt_sl(k,iphy)=max(0.0_r8, &
1429 & min(gt_sl(k,iphy), &
1430 & gtalg(i,k,iphy)))
1431 ELSE
1432 gt_sl(k,iphy)=larger
1433 END IF
1434 ELSE
1435 gt_sl(k,iphy)=larger
1436 END IF
1437!
1438! Phosphorus limited growth rate.
1439!
1440 IF ((hspo4(iphy,ng).lt.larger).and. &
1441 & (bio(i,k,iphyp(iphy)).gt.0.0_r8)) THEN
1442 fv1=bio(i,k,iphyc(iphy))/ &
1443 & (bio(i,k,iphyp(iphy))+bio_new(i,k,iphyp(iphy)))
1444 gt_pl(k,iphy)=mu_bar_p(i,k,iphy)* &
1445 & (1.0_r8-imaxc2palg(iphy,ng)*fv1)
1446 gt_pl(k,iphy)=max(0.0_r8, &
1447 & min(gt_pl(k,iphy), &
1448 & gtalg(i,k,iphy)))
1449 ELSE
1450 gt_pl(k,iphy)=larger
1451 END IF
1452!
1453! Iron limited growth rate
1454!
1455 IF ((hsfe(iphy,ng).lt.larger).and. &
1456 & (bio(i,k,iphyf(iphy)).gt.0.0_r8)) THEN
1457 fv1=bio(i,k,iphyc(iphy))/ &
1458 & (bio(i,k,iphyf(iphy))+bio_new(i,k,iphyf(iphy)))
1459 gt_fl(k,iphy)=mu_bar_f(i,k,iphy)* &
1460 & (1.0_r8-imaxc2fealg(iphy,ng)*fv1)
1461 gt_fl(k,iphy)=max(0.0_r8, &
1462 & min(gt_fl(k,iphy), &
1463 & gtalg(i,k,iphy)))
1464 ELSE
1465 gt_fl(k,iphy)=larger
1466 END IF
1467!
1468! Realized growth rate is minimum of light or nutrient limited rate.
1469!
1470 gtalg_r(i,k,iphy)=min(gt_ll(k,iphy),gt_nl(k,iphy), &
1471 & gt_sl(k,iphy),gt_pl(k,iphy), &
1472 & gt_fl(k,iphy))
1473 IF (gtalg_r(i,k,iphy).ge.larger) THEN
1474 gtalg_r(i,k,iphy)=0.0_r8
1475 END IF
1476!
1477! Carbon growth calculations.
1478!
1479 fv1=bio(i,k,iphyc(iphy))*gtalg_r(i,k,iphy)
1480 bio_new(i,k,iphyc(iphy))=bio_new(i,k,iphyc(iphy))+ &
1481 & fv1
1482 bio_new(i,k,idic_)=bio_new(i,k,idic_)- &
1483 & fv1
1484!
1485! Pigment growth calculations.
1486!
1487 DO ipig=1,npig
1488 IF (ipigs(iphy,ipig).gt.0) THEN
1489 itrc=ipigs(iphy,ipig)
1490 IF (bio(i,k,iphyc(iphy)).gt.0.0_r8) THEN
1491 fv1=bio(i,k,itrc)*gtalg_r(i,k,iphy)
1492 bio_new(i,k,itrc)=bio_new(i,k,itrc)+fv1
1493 END IF
1494 END IF
1495 END DO
1496 END IF
1497 END DO
1498 END DO
1499 END DO
1500!
1501!-----------------------------------------------------------------------
1502! Bacterioplankton carbon growth terms.
1503!-----------------------------------------------------------------------
1504!
1505 DO k=1,n(ng)
1506 DO i=istr,iend
1507 het_bac=0.0_r8
1508 reldoc1=0.0_r8
1509 reldon1=0.0_r8
1510 reldop1=0.0_r8
1511 relfe=0.0_r8
1512!
1513! NOTE: Only DOC2/DON2 formation is in this section.
1514! Take colored excretion off the top. 03/18/00
1515! also, not excreting any DOP or Fe
1516! REMEMBER, if excreting DOP and Fe, must address changes in growth if
1517! tests. (see DON equations). 03/21/00.
1518!
1519 DO ibac=1,nbac
1520 fv1=nupdoc_ba(i,k,ibac)*exbac_c(ng)* &
1521 & (1.0_r8-cdocfrac_c(irct,ng))
1522 fv2=nupdoc_ba(i,k,ibac)*exbac_c(ng)* &
1523 & cdocfrac_c(irct,ng)
1524 fv3=nupdon_ba(i,k,ibac)*exbac_n(ng)
1525!
1526 bio_new(i,k,idomc(irct))=bio_new(i,k,idomc(irct))+ &
1527 & fv1
1528 bio_new(i,k,icdmc(irct))=bio_new(i,k,icdmc(irct))+ &
1529 & fv2
1530 bio_new(i,k,idomn(irct))=bio_new(i,k,idomn(irct))+ &
1531 & fv3
1532!
1533! As we are taking it off the top, must remove from DOMN1 now. No other
1534! organisms use DOMC1, so net term (totDOC_d) can be used in budgeting
1535! below. This saves cycles, but makes code difficult to read. WPB
1536!
1537 bio_new(i,k,idomn(ilab))=bio_new(i,k,idomn(ilab))- &
1538 & fv3
1539!
1540! Remove from uptake.
1541!
1542 nupdoc_ba(i,k,ibac)=nupdoc_ba(i,k,ibac)- &
1543 & (fv1+fv2)
1544 nupdon_ba(i,k,ibac)=nupdon_ba(i,k,ibac)- &
1545 & fv3
1546!
1547! Determine growth limitation. Assuming 100% efficiency for N, P, Fe.
1548! If DOMC=0, or DOMN=0, or DOMP=0, then NupDOC_ba = NupDON_ba =
1549! NupDOP_ba = 0 and none of the divisions below are accessed. WPB
1550!
1551 bac_g(1)=nupdoc_ba(i,k,ibac)*bac_ceff(ng)
1552 bac_g(2)=(nupdon_ba(i,k,ibac)+ &
1553 & nupnh4_ba(i,k,ibac))* &
1554 & c2nbac(ng)
1555 bac_g(3)=(nupdop_ba(i,k,ibac)+ &
1556 & nuppo4_ba(i,k,ibac))* &
1557 & c2pbac(ng)
1558 bac_g(4)=nupfe_ba(i,k,ibac)*c2febac(ng)
1559!
1560! Energy limited case. All excess nutrients returned in inorganic form.
1561!
1562 IF ((bac_g(1).le.bac_g(2)).and. &
1563 & (bac_g(1).le.bac_g(3)).and. &
1564 & (bac_g(1).le.bac_g(4))) THEN
1565 het_bac=bac_g(1)
1566 fv1=bac_g(1)*n2cbac(ng)
1567 fv2=bac_g(1)*p2cbac(ng)
1568 fv3=bac_g(1)*fe2cbac(ng)
1569 bio_new(i,k,ibacn(ibac))=bio_new(i,k,ibacn(ibac))+ &
1570 & fv1
1571 bio_new(i,k,ibacp(ibac))=bio_new(i,k,ibacp(ibac))+ &
1572 & fv2
1573 bio_new(i,k,ibacf(ibac))=bio_new(i,k,ibacf(ibac))+ &
1574 & fv3
1575!
1576! Uptake arrays should probably now be negative. If NH4 or PO4 is
1577! positive, then there is some uptake of inorganic forms, but this
1578! value will be less than the original Nup value because of IF test.
1579!
1580 nupnh4_ba(i,k,ibac)=fv1-nupdon_ba(i,k,ibac)
1581 nuppo4_ba(i,k,ibac)=fv2-nupdop_ba(i,k,ibac)
1582!
1583! Because Fe is considered to be all inorganic, only net uptake of Fe
1584! is needed.
1585!
1586 relfe=nupfe_ba(i,k,ibac)-fv3
1587 nupfe_ba(i,k,ibac)=fv3
1588!
1589! Nitrogen limited case. Excess nutrients returned in organic form
1590! first, inorganic second.
1591!
1592 ELSE IF ((bac_g(2).le.bac_g(3)).and. &
1593 & (bac_g(2).le.bac_g(4))) THEN
1594 het_bac=bac_g(2)
1595 fv2=bac_g(2)*p2cbac(ng)
1596 fv3=bac_g(2)*fe2cbac(ng)
1597 bio_new(i,k,ibacn(ibac))=bio_new(i,k,ibacn(ibac))+ &
1598 & (nupdon_ba(i,k,ibac)+ &
1599 & nupnh4_ba(i,k,ibac))
1600 bio_new(i,k,ibacp(ibac))=bio_new(i,k,ibacp(ibac))+ &
1601 & fv2
1602 bio_new(i,k,ibacf(ibac))=bio_new(i,k,ibacf(ibac))+ &
1603 & fv3
1604!
1605! Uptake arrays will now reflect release of inorganic and organic
1606! revision of uptake.
1607!
1608 fv1=(bac_g(1)-bac_g(2))*i_bac_ceff(ng)
1609 nupdoc_ba(i,k,ibac)=nupdoc_ba(i,k,ibac)-fv1
1610 reldoc1=fv1
1611!
1612! To get accurate DOP from C2pDOC, must add back excreted DOC.
1613!
1614 fv4=fv1*r_exbac_c(ng)* &
1615!! & DOC_frac(i,k)* &
1616 & bio(i,k,idomp(ilab))/ &
1617 & bio(i,k,idomc(ilab))
1618 fv5=fv2-(nupdop_ba(i,k,ibac)+ &
1619 nuppo4_ba(i,k,ibac)-fv4)
1620!
1621! If FV5 is positive then released DOP is required for bacteria growth.
1622!
1623 IF (fv5.lt.0.0_r8) THEN
1624 reldop1=fv4
1625 nuppo4_ba(i,k,ibac)=nuppo4_ba(i,k,ibac)+fv5
1626 ELSE
1627 reldop1=fv4-fv5
1628 END IF
1629 nupdop_ba(i,k,ibac)=nupdop_ba(i,k,ibac)-reldop1
1630!
1631! Release Fe.
1632!
1633 relfe=nupfe_ba(i,k,ibac)-fv3
1634 nupfe_ba(i,k,ibac)=fv3
1635!
1636! Phosphorous limited case. Excess nutrients returned in organic form
1637! first, inorganic second.
1638!
1639 ELSE IF (bac_g(3).le.bac_g(4)) THEN
1640 het_bac=bac_g(3)
1641 fv2=bac_g(3)*n2cbac(ng)
1642 fv3=bac_g(3)*fe2cbac(ng)
1643 bio_new(i,k,ibacn(ibac))=bio_new(i,k,ibacn(ibac))+ &
1644 & fv2
1645 bio_new(i,k,ibacp(ibac))=bio_new(i,k,ibacp(ibac))+ &
1646 & (nupdop_ba(i,k,ibac)+ &
1647 & nuppo4_ba(i,k,ibac))
1648 bio_new(i,k,ibacf(ibac))=bio_new(i,k,ibacf(ibac))+ &
1649 & fv3
1650!
1651! Uptake arrays will now reflect release of inorganic and organic
1652! revision of uptake.
1653!
1654 fv1=(bac_g(1)-bac_g(3))*i_bac_ceff(ng)
1655 nupdoc_ba(i,k,ibac)=nupdoc_ba(i,k,ibac)-fv1
1656 reldoc1=fv1
1657!
1658! To get accurate DON from C2nDOC, must add back excreted DOC.
1659!
1660 fv4=fv1*r_exbac_c(ng)* &
1661!! & DOC_frac(i,k)* &
1662 & (bio(i,k,idomn(ilab))/ &
1663 & bio(i,k,idomc(ilab)))*frac_exbac_n(ng)
1664 fv5=fv2-(nupdon_ba(i,k,ibac)+ &
1665 & nupnh4_ba(i,k,ibac)-fv4)
1666!
1667! If FV5 is positive then released DON is required for bacteria growth.
1668!
1669 IF (fv5.lt.0.0_r8) THEN
1670 reldon1=fv4
1671 nupnh4_ba(i,k,ibac)=nupnh4_ba(i,k,ibac)+fv5
1672 ELSE
1673 reldon1=fv4-fv5
1674 END IF
1675 nupdon_ba(i,k,ibac)=nupdon_ba(i,k,ibac)-reldon1
1676!
1677! Release Fe.
1678!
1679 relfe=nupfe_ba(i,k,ibac)-fv3
1680 nupfe_ba(i,k,ibac)=fv3
1681!
1682! Fe limited case. Excess nutrients returned in organic form
1683! first, inorganic second.
1684!
1685 ELSE
1686 het_bac=bac_g(4)
1687 fv2=bac_g(4)*n2cbac(ng)
1688 fv3=bac_g(4)*p2cbac(ng)
1689 bio_new(i,k,ibacn(ibac))=bio_new(i,k,ibacn(ibac))+ &
1690 & fv2
1691 bio_new(i,k,ibacp(ibac))=bio_new(i,k,ibacp(ibac))+ &
1692 & fv3
1693 bio_new(i,k,ibacf(ibac))=bio_new(i,k,ibacf(ibac))+ &
1694 & nupfe_ba(i,k,ibac)
1695!
1696! Uptake arrays will now reflect release of inorganic and organic
1697! revision of uptake.
1698!
1699 fv1=(bac_g(1)-bac_g(4))*i_bac_ceff(ng)
1700 nupdoc_ba(i,k,ibac)=nupdoc_ba(i,k,ibac)-fv1
1701 reldoc1=fv1
1702!
1703! To get accurate DON from C2nDOC, must add back excreted DOC.
1704!
1705 fv4=fv1*r_exbac_c(ng)* &
1706!! & DOC_frac(i,k)* &
1707 & bio(i,k,idomn(ilab))/ &
1708 & bio(i,k,idomc(ilab))*frac_exbac_n(ng)
1709 fv5=fv2-(nupdon_ba(i,k,ibac)+ &
1710 & nupnh4_ba(i,k,ibac)-fv4)
1711!
1712! If FV5 is positive then released DON is required for bacteria growth.
1713!
1714 IF (fv5.lt.0.0_r8) THEN
1715 reldon1=fv4
1716 nupnh4_ba(i,k,ibac)=nupnh4_ba(i,k,ibac)+fv5
1717 ELSE
1718 reldon1=fv4-fv5
1719 END IF
1720 nupdon_ba(i,k,ibac)=nupdon_ba(i,k,ibac)-reldon1
1721!
1722! To get accurate DOP from C2pDOC, must add back excreted DOC.
1723!
1724 fv4=fv1*r_exbac_c(ng)* &
1725!! & DOC_frac(i,k)* &
1726 & bio(i,k,idomp(ilab))/ &
1727 & bio(i,k,idomc(ilab))
1728 fv5=fv2-(nupdop_ba(i,k,ibac)+ &
1729 & nuppo4_ba(i,k,ibac)-fv4)
1730!
1731! If FV5 is positive then released DOP is required for bacteria growth.
1732!
1733 IF (fv5.lt.0.0_r8) THEN
1734 reldop1=fv4
1735 nuppo4_ba(i,k,ibac)=nuppo4_ba(i,k,ibac)+fv5
1736 ELSE
1737 reldop1=fv4-fv5
1738 END IF
1739 nupdop_ba(i,k,ibac)=nupdop_ba(i,k,ibac)-reldop1
1740 END IF
1741!
1742! Increment nutrient arrays.
1743!
1744 bio_new(i,k,ibacc(ibac))=bio_new(i,k,ibacc(ibac))+ &
1745 & het_bac
1746 fv1=nupdoc_ba(i,k,ibac)-het_bac
1747 bio_new(i,k,idic_)=bio_new(i,k,idic_)+ &
1748 & fv1
1749!
1750! NOTE: to be strictly accurate we should remove RelDOC1 from DOCNP1,
1751! and then add it back, since NupDOC_ba is a net term. This should
1752! wash out in the budgeting.
1753!
1754 bio_new(i,k,idomc(ilab))=bio_new(i,k,idomc(ilab))- &
1755 & (totdoc_d(i,k)-reldoc1)
1756!! & (totDOC_d(i,k)-RelDOC1)* &
1757!! & DOC_frac(i,k)
1758!! Bio_new(i,k,iCDMC(ilab))=Bio_new(i,k,iCDMC(ilab))- &
1759!! & (totDOC_d(i,k)-RelDOC1)* &
1760!! & (1.0_r8-DOC_frac(i,k))
1761!!
1762! This is inclusive of RelDOX1, excretion of DON1 removed above.
1763!
1764 bio_new(i,k,idomn(ilab))=bio_new(i,k,idomn(ilab))- &
1765 & nupdon_ba(i,k,ibac)
1766 bio_new(i,k,idomp(ilab))=bio_new(i,k,idomp(ilab))- &
1767 & nupdop_ba(i,k,ibac)
1768 bio_new(i,k,inh4_)=bio_new(i,k,inh4_)- &
1769 & nupnh4_ba(i,k,ibac)
1770 bio_new(i,k,ipo4_)=bio_new(i,k,ipo4_)- &
1771 & nuppo4_ba(i,k,ibac)
1772 bio_new(i,k,ifeo_)=bio_new(i,k,ifeo_)- &
1773 & nupfe_ba(i,k,ibac)
1774 END DO
1775 END DO
1776 END DO
1777!
1778!-----------------------------------------------------------------------
1779! Phytoplankton Losses.
1780!-----------------------------------------------------------------------
1781!
1782 DO iphy=1,nphy
1783 DO k=1,n(ng)
1784 DO i=istr,iend
1785!
1786! Excretion.
1787!
1788 IF ((c2nalg(i,k,iphy).ge. &
1789 & c2nalgminabs(iphy,ng)).and. &
1790 & (c2palg(i,k,iphy).ge. &
1791 & c2palgminabs(iphy,ng)).and. &
1792 & (hssio(iphy,ng).gt.larger)) THEN
1793 fv1=bio(i,k,iphyc(iphy))*exalg(iphy,ng)
1794 bio_new(i,k,iphyc(iphy))=bio_new(i,k,iphyc(iphy))- &
1795 & fv1
1796!
1797! No excretion of CDOC.
1798!
1799 bio_new(i,k,idomc(ilab))=bio_new(i,k,idomc(ilab))+ &
1800 & fv1
1801 ELSE IF ((c2nalg(i,k,iphy).ge. &
1802 & c2nalgminabs(iphy,ng)).and. &
1803 & (c2palg(i,k,iphy).ge. &
1804 & c2palgminabs(iphy,ng)).and. &
1805 & (c2salg(i,k,iphy).ge. &
1806 & c2sialgminabs(iphy,ng))) THEN
1807 fv1=bio(i,k,iphyc(iphy))*exalg(iphy,ng)
1808 bio_new(i,k,iphyc(iphy))=bio_new(i,k,iphyc(iphy))- &
1809 & fv1
1810!
1811! No excretion of CDOC.
1812!
1813 bio_new(i,k,idomc(ilab))=bio_new(i,k,idomc(ilab))+ &
1814 & fv1
1815 END IF
1816!
1817! Grazing.
1818!
1819 IF (bio(i,k,iphyc(iphy)).gt.refuge(i,k,iphy)) THEN
1820!
1821! Carbon calculations.
1822!
1823 fv1=graz_act(i,k,iphy)*bio(i,k,iphyc(iphy))
1824 bio_new(i,k,iphyc(iphy))=bio_new(i,k,iphyc(iphy))- &
1825 & fv1
1826 bio_new(i,k,ifecc(isfc))=bio_new(i,k,ifecc(isfc))+ &
1827 & fecpel(iphy,isfc,ng)*fv1
1828 bio_new(i,k,ifecc(iffc))=bio_new(i,k,ifecc(iffc))+ &
1829 & fecpel(iphy,iffc,ng)*fv1
1830 fv3=fecdoc(iphy,ng)*fv1
1831 bio_new(i,k,idomc(ilab))=bio_new(i,k,idomc(ilab))+ &
1832 & (1.0_r8-cdocfrac_c(ilab,ng))*&
1833 & fv3
1834 bio_new(i,k,icdmc(ilab))=bio_new(i,k,icdmc(ilab))+ &
1835 & cdocfrac_c(ilab,ng)*fv3
1836 bio_new(i,k,idic_)=bio_new(i,k,idic_)+ &
1837 & feccyc(iphy,ng)*fv1
1838!
1839! Nitrogen calculations.
1840!
1841 fv2=graz_act(i,k,iphy)*bio(i,k,iphyn(iphy))
1842 bio_new(i,k,iphyn(iphy))=bio_new(i,k,iphyn(iphy))- &
1843 & fv2
1844 bio_new(i,k,ifecn(isfc))=bio_new(i,k,ifecn(isfc))+ &
1845 & fecpel(iphy,isfc,ng)*fv2
1846 bio_new(i,k,ifecn(iffc))=bio_new(i,k,ifecn(iffc))+ &
1847 & fecpel(iphy,iffc,ng)*fv2
1848 bio_new(i,k,idomn(ilab))=bio_new(i,k,idomn(ilab))+ &
1849 & fecdoc(iphy,ng)*fv2
1850 bio_new(i,k,inh4_)=bio_new(i,k,inh4_)+ &
1851 & feccyc(iphy,ng)*fv2
1852!
1853! Silica calculations.
1854!
1855 IF (iphys(iphy).gt.0) THEN
1856 fv2=graz_act(i,k,iphy)*bio(i,k,iphys(iphy))
1857 bio_new(i,k,iphys(iphy))=bio_new(i,k,iphys(iphy))- &
1858 & fv2
1859!
1860! Assuming that the fraction of material lost via sloppy feeding/cell
1861! lysis also results in silica tests being put into FecS pool.
1862!
1863 bio_new(i,k,ifecs(isfc))=bio_new(i,k,ifecs(isfc))+ &
1864 & fecdoc(iphy,ng)*fv2
1865 bio_new(i,k,ifecs(iffc))=bio_new(i,k,ifecs(iffc))+ &
1866 & (1.0_r8-fecdoc(iphy,ng))* &
1867 & fv2
1868 END IF
1869!
1870! Phosphorus calculations.
1871!
1872 fv2=graz_act(i,k,iphy)*bio(i,k,iphyp(iphy))
1873 bio_new(i,k,iphyp(iphy))=bio_new(i,k,iphyp(iphy))- &
1874 & fv2
1875 bio_new(i,k,ifecp(isfc))=bio_new(i,k,ifecp(isfc))+ &
1876 & fecpel(iphy,isfc,ng)*fv2
1877 bio_new(i,k,ifecp(iffc))=bio_new(i,k,ifecp(iffc))+ &
1878 & fecpel(iphy,iffc,ng)*fv2
1879 bio_new(i,k,idomp(ilab))=bio_new(i,k,idomp(ilab))+ &
1880 & fecdoc(iphy,ng)*fv2
1881 bio_new(i,k,ipo4_)=bio_new(i,k,ipo4_)+ &
1882 & feccyc(iphy,ng)*fv2
1883!
1884! Iron calculations. Assuming no DOMF.
1885!
1886 fv2=graz_act(i,k,iphy)*bio(i,k,iphyf(iphy))
1887 bio_new(i,k,iphyf(iphy))=bio_new(i,k,iphyf(iphy))- &
1888 & fv2
1889 bio_new(i,k,ifecf(isfc))=bio_new(i,k,ifecf(isfc))+ &
1890 & fecpel(iphy,isfc,ng)*fv2
1891 bio_new(i,k,ifecf(iffc))=bio_new(i,k,ifecf(iffc))+ &
1892 & fecpel(iphy,iffc,ng)*fv2
1893 bio_new(i,k,ifeo_)=bio_new(i,k,ifeo_)+ &
1894 & (feccyc(iphy,ng)+ &
1895 & fecdoc(iphy,ng))*fv2
1896 END IF
1897 END DO
1898 END DO
1899 END DO
1900!
1901! Pigment Grazing. No fecal or dissolved terms for pigments.
1902!
1903 DO ipig=1,npig
1904 DO iphy=1,nphy
1905 IF (ipigs(iphy,ipig).gt.0) THEN
1906 itrc=ipigs(iphy,ipig)
1907 DO k=1,n(ng)
1908 DO i=istr,iend
1909 IF (bio(i,k,iphyc(iphy)).gt.refuge(i,k,iphy)) THEN
1910 fv1=graz_act(i,k,iphy)*bio(i,k,itrc)
1911 bio_new(i,k,itrc)=bio_new(i,k,itrc) - fv1
1912 END IF
1913 END DO
1914 END DO
1915 END IF
1916 END DO
1917 END DO
1918!
1919!-----------------------------------------------------------------------
1920! Bacterial losses.
1921!-----------------------------------------------------------------------
1922!
1923! NOTE: Bacterial growth is completely reminerialized.
1924!
1925 DO ibac=1,nbac
1926 DO k=1,n(ng)
1927 DO i=istr,iend
1928!
1929! Grazing calculation. (All fecal material to slow sinking pool.)
1930!
1931!! WPB - There appears to be some rounding errors that cause bacteria
1932!! populations to drop just below initialization values. Once
1933!! they do, they never recover and the new lower values propagate
1934!! through the model. Only evident in Bac_P1 at the moment.
1935!!
1936!! FV1=BacCYC(ng)*Bio_new(i,k,iBacC(ibac))
1937!! FV2=BacPEL(ng)*Bio_new(i,k,iBacC(ibac))
1938!! FV3=BacDOC(ng)*Bio_new(i,k,iBacC(ibac))
1939!! FV4=FV1+FV2+FV3
1940!
1941! Carbon calculations.
1942!
1943 bio_new(i,k,ibacc(ibac))=bio_new(i,k,ibacc(ibac))- &
1944!! & FV4
1945 & bio_new(i,k,ibacc(ibac))
1946 bio_new(i,k,ifecc(isfc))=bio_new(i,k,ifecc(isfc))+ &
1947!! & FV2
1948 & bio_new(i,k,ibacc(ibac))* &
1949 & bacpel(ng)
1950 bio_new(i,k,idomc(ilab))=bio_new(i,k,idomc(ilab))+ &
1951 & (1.0_r8-cdocfrac_c(ilab,ng))* &
1952!! & FV3
1953 & bio_new(i,k,ibacc(ibac))* &
1954 & bacdoc(ng)
1955 bio_new(i,k,icdmc(ilab))=bio_new(i,k,icdmc(ilab))+ &
1956 & cdocfrac_c(ilab,ng)* &
1957!! & FV3
1958 & bio_new(i,k,ibacc(ibac))* &
1959 & bacdoc(ng)
1960 bio_new(i,k,idic_)=bio_new(i,k,idic_)+ &
1961!! & FV1
1962 & bio_new(i,k,ibacc(ibac))* &
1963 & baccyc(ng)
1964!
1965! Nitrogen calculations.
1966!
1967 bio_new(i,k,ibacn(ibac))=bio_new(i,k,ibacn(ibac))- &
1968!! & N2cBAC(ng)*FV4
1969 & bio_new(i,k,ibacn(ibac))
1970 bio_new(i,k,ifecn(isfc))=bio_new(i,k,ifecn(isfc))+ &
1971!! & N2cBAC(ng)*FV2
1972 & bio_new(i,k,ibacn(ibac))* &
1973 & bacpel(ng)
1974 bio_new(i,k,idomn(ilab))=bio_new(i,k,idomn(ilab))+ &
1975!! & N2cBAC(ng)*FV3
1976 & bio_new(i,k,ibacn(ibac))* &
1977 & bacdoc(ng)
1978 bio_new(i,k,inh4_)=bio_new(i,k,inh4_)+ &
1979!! & N2cBAC(ng)*FV1
1980 & bio_new(i,k,ibacn(ibac))* &
1981 & baccyc(ng)
1982!
1983! Phosphorous calculations.
1984!
1985 bio_new(i,k,ibacp(ibac))=bio_new(i,k,ibacp(ibac))- &
1986!! & P2cBAC(ng)*FV4
1987 & bio_new(i,k,ibacp(ibac))
1988 bio_new(i,k,ifecp(isfc))=bio_new(i,k,ifecp(isfc))+ &
1989!! & P2cBAC(ng)*FV2
1990 & bio_new(i,k,ibacp(ibac))* &
1991 & bacpel(ng)
1992 bio_new(i,k,idomp(ilab))=bio_new(i,k,idomp(ilab))+ &
1993!! & P2cBAC(ng)*FV3
1994 & bio_new(i,k,ibacp(ibac))* &
1995 & bacdoc(ng)
1996 bio_new(i,k,ipo4_)=bio_new(i,k,ipo4_)+ &
1997!! & P2cBAC(ng)*FV1
1998 & bio_new(i,k,ibacp(ibac))* &
1999 & baccyc(ng)
2000!
2001! Iron calculations.
2002!
2003 bio_new(i,k,ibacf(ibac))=bio_new(i,k,ibacf(ibac))- &
2004!! & Fe2cBAC(ng)*FV4
2005 & bio_new(i,k,ibacf(ibac))
2006 bio_new(i,k,ifecf(isfc))=bio_new(i,k,ifecf(isfc))+ &
2007!! & Fe2cBAC(ng)*FV2
2008 & bio_new(i,k,ibacf(ibac))* &
2009 & bacpel(ng)
2010 bio_new(i,k,ifeo_)=bio_new(i,k,ifeo_)+ &
2011!! & Fe2cBAC(ng)*(FV1+FV3)
2012 & bio_new(i,k,ibacf(ibac))* &
2013 & (bacdoc(ng)+baccyc(ng))
2014 END DO
2015 END DO
2016 END DO
2017!
2018!-----------------------------------------------------------------------
2019! Fecal pellet remineralization.
2020!-----------------------------------------------------------------------
2021!
2022 DO ifec=1,nfec
2023 DO k=1,n(ng)
2024 DO i=istr,iend
2025!
2026! Carbon calculations. All carbon goes to CO2.
2027!
2028 fv3=regen_c(i,k,ifec)*bio(i,k,ifecc(ifec))
2029 bio_new(i,k,ifecc(ifec))=bio_new(i,k,ifecc(ifec))- &
2030 & fv3
2031 bio_new(i,k,idic_)=bio_new(i,k,idic_)+ &
2032 & fv3
2033!
2034! Nitrogen calculations. Nitrogen goes to NH4.
2035!
2036 fv2=regen_n(i,k,ifec)*bio(i,k,ifecn(ifec))
2037 bio_new(i,k,ifecn(ifec))=bio_new(i,k,ifecn(ifec))- &
2038 & fv2
2039 bio_new(i,k,inh4_)=bio_new(i,k,inh4_)+ &
2040 & fv2
2041!
2042! Silica calculations.
2043!
2044 fv2=regen_s(i,k,ifec)*bio(i,k,ifecs(ifec))
2045 bio_new(i,k,ifecs(ifec))=bio_new(i,k,ifecs(ifec))- &
2046 & fv2
2047 bio_new(i,k,isio_)=bio_new(i,k,isio_)+ &
2048 & fv2
2049!
2050! Phosphorous calculations.
2051!
2052 fv2=regen_p(i,k,ifec)*bio(i,k,ifecp(ifec))
2053 bio_new(i,k,ifecp(ifec))=bio_new(i,k,ifecp(ifec))- &
2054 & fv2
2055 bio_new(i,k,ipo4_)=bio_new(i,k,ipo4_)+ &
2056 & fv2
2057!
2058! Iron calculations.
2059!
2060 fv2=regen_f(i,k,ifec)*bio(i,k,ifecf(ifec))
2061 bio_new(i,k,ifecf(ifec))=bio_new(i,k,ifecf(ifec))- &
2062 & fv2
2063 bio_new(i,k,ifeo_)=bio_new(i,k,ifeo_)+ &
2064 & fv2
2065 END DO
2066 END DO
2067 END DO
2068!
2069!-----------------------------------------------------------------------
2070! CDMC photolysis calculations.
2071!-----------------------------------------------------------------------
2072!
2073 IF (rtuvr_flag(ng)) THEN
2074 DO i=istr,iend
2075!
2076! If Ed_nz(i,N(ng)) > zero, then there is sunlight. Standardizing rate
2077! to 1500 umol quanta m-2 s-1.
2078!
2079 IF (ed_nz(i,n(ng)).ge.0.01) THEN
2080!
2081 fv1=rtuvr_dic(ng)*ed_nz(i,n(ng))/1500.0_r8
2082 fv2=rtuvr_doc(ng)*ed_nz(i,n(ng))/1500.0_r8
2083
2084!
2085! FV4 equals the CDMC1 absorption at 410 nm. 0.012 converts to g m-3.
2086! FV5 equals the CDMC2 absorption at 410 nm.
2087! Weighted average attenuation of UVB of water at 300 nm = 0.2 m-1.
2088!
2089 fv4=bio(i,n(ng),icdmc(ilab))*0.012_r8*adoc410(ilab)
2090 fv5=bio(i,n(ng),icdmc(irct))*0.012_r8*adoc410(irct)
2091 photo_decay=0.5_r8*hz(i,j,n(ng))* &
2092 & (0.2_r8+(fv4+fv5)*adoc300(ilab))
2093 fv3=exp(-photo_decay)
2094 photo_decay=2.0_r8*photo_decay
2095!
2096! Do not photolyze below the euphotic zone.
2097!
2098 DO k=n(ng),keuphotic(i),-1
2099 IF (fv3.gt.0.01_r8) THEN
2100 fv6=fv5+fv4
2101 IF (fv6.gt.0.0_r8) THEN
2102 fv7=fv4/fv6
2103 photo_dic=fv3*fv1*fv6
2104 photo_doc=fv3*fv2*fv6
2105 total_photo=photo_dic+photo_doc
2106!
2107! NOTE: not testing for excess photolysis (CDOC going negative).
2108!
2109 fv4=(1.0_r8-fv7)*total_photo
2110 bio_new(i,k,icdmc(irct))=bio_new(i,k,icdmc(irct))-&
2111 & fv4
2112 bio_new(i,k,idomc(ilab))=bio_new(i,k,idomc(ilab))+&
2113 & photo_doc
2114 bio_new(i,k,icdmc(ilab))=bio_new(i,k,icdmc(ilab))-&
2115 & fv7*total_photo
2116 bio_new(i,k,idic_)=bio_new(i,k,idic_)+ &
2117 & photo_dic
2118 END IF
2119!
2120! FV4 equals the CDMC1 absorption at 410 nm. 0.012 converts to g m-3.
2121! FV5 equals the CDMC2 absorption at 410 nm.
2122! Weighted average attenuation of UVB of water at 300 nm = 0.2 m-1.
2123!
2124 fv4=bio(i,k,icdmc(ilab))*0.012_r8*adoc410(ilab)
2125 fv5=bio(i,k,icdmc(irct))*0.012_r8*adoc410(irct)
2126 fv7=photo_decay+ &
2127 & 0.5_r8*hz(i,j,k)*(0.2_r8+(fv4+fv5)*adoc300(ilab))
2128!
2129! If k is greater than the bottom of the euphotic zone (and by
2130! by extension the bottom boundary) or the decay constant is
2131! greater than 4.61 (or < 1% photolysis zone) then exit do loop.
2132!
2133 fv3=exp(-fv7)
2134!
2135! Store value for passage through entire Hz(i,j,k).
2136!
2137 photo_decay=photo_decay+2.0_r8*fv7
2138 END IF
2139 END DO
2140 END IF
2141 END DO
2142 END IF
2143!
2144!-----------------------------------------------------------------------
2145! Create optimal pigment ratios.
2146!-----------------------------------------------------------------------
2147!
2148 DO i=istr,iend
2149 IF (keuphotic(i).le.n(ng)) THEN
2150 DO iphy=1,nphy
2151!
2152! Carbon to chlorophyll a ratio
2153! This statement says that nutrient limitation of C2CHL ratio overides
2154! light adaptation. Minimum of two functions may be more ecologically
2155! accurate?
2156!
2157 DO k=n(ng),keuphotic(i),-1
2158 IF (b_c2cn(iphy,ng).lt.0.0_r8+small) THEN
2159 c2chl_w(k,iphy)=min((b_c2cl(iphy,ng)+ &
2160 & mxc2cl(iphy,ng)*e0_nz(i,k)), &
2161 & c2chl_max(iphy,ng))
2162 ELSE IF (c2nalg(i,k,iphy).gt. &
2163 & minc2nalg(iphy,ng)+small) THEN
2164 c2chl_w(k,iphy)=b_c2cn(iphy,ng)+ &
2165 & mxc2cn(iphy,ng)* &
2166 & (c2nalg(i,k,iphy)- &
2167 & minc2nalg(iphy,ng))
2168 ELSE
2169 c2chl_w(k,iphy)=min((b_c2cl(iphy,ng)+ &
2170 & mxc2cl(iphy,ng)*e0_nz(i,k)), &
2171 & c2chl_max(iphy,ng))
2172 END IF
2173 END DO
2174!
2175! Chlorophyll a concentation per species. form g CHL a / g C
2176!
2177 DO k=n(ng),keuphotic(i),-1
2178 pigs_w(k,iphy,ichl)=1.0_r8/c2chl_w(k,iphy)
2179 END DO
2180!
2181! Chlorophyll b concentration per species. form g CHL b / g C
2182!
2183 IF (ipigs(iphy,2).gt.0) THEN
2184 DO k=n(ng),keuphotic(i),-1
2185 pigs_w(k,iphy,2)=b_chlb(iphy,ng)+ &
2186 & mxchlb(iphy,ng)* &
2187 & (c2chl_w(k,iphy)- &
2188 & b_c2cl(iphy,ng))
2189 pigs_w(k,iphy,2)=pigs_w(k,iphy,2)* &
2190 & pigs_w(k,iphy,ichl)
2191 END DO
2192 END IF
2193!
2194! Chlorophyll c concentration per species. form g CHL c / g C
2195!
2196 IF (ipigs(iphy,3).gt.0) THEN
2197 DO k=n(ng),keuphotic(i),-1
2198 pigs_w(k,iphy,3)=b_chlc(iphy,ng)+ &
2199 & mxchlc(iphy,ng)* &
2200 & (c2chl_w(k,iphy)- &
2201 & b_c2cl(iphy,ng))
2202 pigs_w(k,iphy,3)=pigs_w(k,iphy,3)* &
2203 & pigs_w(k,iphy,ichl)
2204 END DO
2205 END IF
2206!
2207! Photosynthetic caroteniods per species. form g PSC / g C
2208!
2209 IF (ipigs(iphy,4).gt.0) THEN
2210 DO k=n(ng),keuphotic(i),-1
2211 pigs_w(k,iphy,4)=b_psc(iphy,ng)+ &
2212 & mxpsc(iphy,ng)* &
2213 & (c2chl_w(k,iphy)- &
2214 & b_c2cl(iphy,ng))
2215 pigs_w(k,iphy,4)=pigs_w(k,iphy,4)* &
2216 & pigs_w(k,iphy,ichl)
2217 END DO
2218 END IF
2219!
2220! Photoprotective caroteniods per species. form g PPC / g C
2221!
2222 IF (ipigs(iphy,5).gt.0) THEN
2223 DO k=n(ng),keuphotic(i),-1
2224 pigs_w(k,iphy,5)=b_ppc(iphy,ng)+ &
2225 & mxppc(iphy,ng)* &
2226 & (c2chl_w(k,iphy)- &
2227 & b_c2cl(iphy,ng))
2228 pigs_w(k,iphy,5)=pigs_w(k,iphy,5)* &
2229 & pigs_w(k,iphy,ichl)
2230 END DO
2231 END IF
2232!
2233! Low Urobilin Phycoeurythin concentration per species. g LPUB / g C
2234!
2235 IF (ipigs(iphy,6).gt.0) THEN
2236 DO k=n(ng),keuphotic(i),-1
2237 pigs_w(k,iphy,6)=b_lpub(iphy,ng)+ &
2238 & mxlpub(iphy,ng)* &
2239 & (c2chl_w(k,iphy)- &
2240 & b_c2cl(iphy,ng))
2241 pigs_w(k,iphy,6)=pigs_w(k,iphy,6)* &
2242 & pigs_w(k,iphy,ichl)
2243 END DO
2244 END IF
2245!
2246! High Urobilin Phycoeurythin concentration per species (g HPUB / g C).
2247!
2248 IF (ipigs(iphy,7).gt.0) THEN
2249 DO k=n(ng),keuphotic(i),-1
2250 pigs_w(k,iphy,7)=b_hpub(iphy,ng)+ &
2251 & mxhpub(iphy,ng)* &
2252 & (c2chl_w(k,iphy)- &
2253 & b_c2cl(iphy,ng))
2254 pigs_w(k,iphy,7)=pigs_w(k,iphy,7)* &
2255 & pigs_w(k,iphy,ichl)
2256 END DO
2257 END IF
2258 END DO
2259!
2260! Calculate pigment ratio changes.
2261! NOTE: 12 factor to convert to ugrams (mg m-3)
2262!
2263 DO ipig=1,npig
2264 DO iphy=1,nphy
2265 IF (ipigs(iphy,ipig).gt.0) THEN
2266 itrc=ipigs(iphy,ipig)
2267 DO k=n(ng),keuphotic(i),-1
2268 IF ((bio(i,k,iphyc(iphy)).gt.0.0_r8).and. &
2269 & (bio(i,k,itrc).gt.0.0_r8)) THEN
2270 fv1=bio(i,k,iphyc(iphy))*12.0_r8
2271 fv2=gtalg_r(i,k,iphy)
2272 fv3=fv1/ &
2273 & (fv2/pigs_w(k,iphy,ipig)+ &
2274 & fv1*(1.0_r8-fv2)/ &
2275 & bio(i,k,itrc))
2276 bio_new(i,k,itrc)=bio_new(i,k,itrc)+ &
2277 & (fv3-bio(i,k,itrc))
2278 END IF
2279 END DO
2280 END IF
2281 END DO
2282 END DO
2283 END IF
2284 END DO
2285!
2286!-----------------------------------------------------------------------
2287! Vertical sinking terms.
2288!-----------------------------------------------------------------------
2289!
2290! Reconstruct vertical profile of selected biological constituents
2291! "Bio(:,:,isink)" in terms of a set of parabolic segments within each
2292! grid box. Then, compute semi-Lagrangian flux due to sinking.
2293!
2294 sink_loop: DO isink=1,nsink
2295 itrc=idsink(isink)
2296!
2297! Copy concentration of biological particulates into scratch array
2298! "qc" (q-central, restrict it to be positive) which is hereafter
2299! interpreted as a set of grid-box averaged values for biogeochemical
2300! constituent concentration.
2301!
2302 DO k=1,n(ng)
2303 DO i=istr,iend
2304 qc(i,k)=bio(i,k,itrc)
2305 END DO
2306 END DO
2307!
2308 DO k=n(ng)-1,1,-1
2309 DO i=istr,iend
2310 fc(i,k)=(qc(i,k+1)-qc(i,k))*hz_inv2(i,k)
2311 END DO
2312 END DO
2313 DO k=2,n(ng)-1
2314 DO i=istr,iend
2315 dltr=hz(i,j,k)*fc(i,k)
2316 dltl=hz(i,j,k)*fc(i,k-1)
2317 cff=hz(i,j,k-1)+2.0_r8*hz(i,j,k)+hz(i,j,k+1)
2318 cffr=cff*fc(i,k)
2319 cffl=cff*fc(i,k-1)
2320!
2321! Apply PPM monotonicity constraint to prevent oscillations within the
2322! grid box.
2323!
2324 IF ((dltr*dltl).le.0.0_r8) THEN
2325 dltr=0.0_r8
2326 dltl=0.0_r8
2327 ELSE IF (abs(dltr).gt.abs(cffl)) THEN
2328 dltr=cffl
2329 ELSE IF (abs(dltl).gt.abs(cffr)) THEN
2330 dltl=cffr
2331 END IF
2332!
2333! Compute right and left side values (bR,bL) of parabolic segments
2334! within grid box Hz(k); (WR,WL) are measures of quadratic variations.
2335!
2336! NOTE: Although each parabolic segment is monotonic within its grid
2337! box, monotonicity of the whole profile is not guaranteed,
2338! because bL(k+1)-bR(k) may still have different sign than
2339! qc(i,k+1)-qc(i,k). This possibility is excluded,
2340! after bL and bR are reconciled using WENO procedure.
2341!
2342 cff=(dltr-dltl)*hz_inv3(i,k)
2343 dltr=dltr-cff*hz(i,j,k+1)
2344 dltl=dltl+cff*hz(i,j,k-1)
2345 br(i,k)=qc(i,k)+dltr
2346 bl(i,k)=qc(i,k)-dltl
2347 wr(i,k)=(2.0_r8*dltr-dltl)**2
2348 wl(i,k)=(dltr-2.0_r8*dltl)**2
2349 END DO
2350 END DO
2351 cff=1.0e-14_r8
2352 DO k=2,n(ng)-2
2353 DO i=istr,iend
2354 dltl=max(cff,wl(i,k ))
2355 dltr=max(cff,wr(i,k+1))
2356 br(i,k)=(dltr*br(i,k)+dltl*bl(i,k+1))/(dltr+dltl)
2357 bl(i,k+1)=br(i,k)
2358 END DO
2359 END DO
2360 DO i=istr,iend
2361 fc(i,n(ng))=0.0_r8 ! NO-flux boundary condition
2362#if defined LINEAR_CONTINUATION
2363 bl(i,n(ng))=br(i,n(ng)-1)
2364 br(i,n(ng))=2.0_r8*qc(i,n(ng))-bl(i,n(ng))
2365#elif defined NEUMANN
2366 bl(i,n(ng))=br(i,n(ng)-1)
2367 br(i,n(ng))=1.5_r8*qc(i,n(ng))-0.5_r8*bl(i,n(ng))
2368#else
2369 br(i,n(ng))=qc(i,n(ng)) ! default strictly monotonic
2370 bl(i,n(ng))=qc(i,n(ng)) ! conditions
2371 br(i,n(ng)-1)=qc(i,n(ng))
2372#endif
2373#if defined LINEAR_CONTINUATION
2374 br(i,1)=bl(i,2)
2375 bl(i,1)=2.0_r8*qc(i,1)-br(i,1)
2376#elif defined NEUMANN
2377 br(i,1)=bl(i,2)
2378 bl(i,1)=1.5_r8*qc(i,1)-0.5_r8*br(i,1)
2379#else
2380 bl(i,2)=qc(i,1) ! bottom grid boxes are
2381 br(i,1)=qc(i,1) ! re-assumed to be
2382 bl(i,1)=qc(i,1) ! piecewise constant.
2383#endif
2384 END DO
2385!
2386! Apply monotonicity constraint again, since the reconciled interfacial
2387! values may cause a non-monotonic behavior of the parabolic segments
2388! inside the grid box.
2389!
2390 DO k=1,n(ng)
2391 DO i=istr,iend
2392 dltr=br(i,k)-qc(i,k)
2393 dltl=qc(i,k)-bl(i,k)
2394 cffr=2.0_r8*dltr
2395 cffl=2.0_r8*dltl
2396 IF ((dltr*dltl).lt.0.0_r8) THEN
2397 dltr=0.0_r8
2398 dltl=0.0_r8
2399 ELSE IF (abs(dltr).gt.abs(cffl)) THEN
2400 dltr=cffl
2401 ELSE IF (abs(dltl).gt.abs(cffr)) THEN
2402 dltl=cffr
2403 END IF
2404 br(i,k)=qc(i,k)+dltr
2405 bl(i,k)=qc(i,k)-dltl
2406 END DO
2407 END DO
2408!
2409! After this moment reconstruction is considered complete. The next
2410! stage is to compute vertical advective fluxes, FC. It is expected
2411! that sinking may occurs relatively fast, the algorithm is designed
2412! to be free of CFL criterion, which is achieved by allowing
2413! integration bounds for semi-Lagrangian advective flux to use as
2414! many grid boxes in upstream direction as necessary.
2415!
2416! In the two code segments below, WL is the z-coordinate of the
2417! departure point for grid box interface z_w with the same indices;
2418! FC is the finite volume flux; ksource(:,k) is index of vertical
2419! grid box which contains the departure point (restricted by N(ng)).
2420! During the search: also add in content of whole grid boxes
2421! participating in FC.
2422!
2423 cff=dtbio*abs(wbio(isink))
2424 DO k=1,n(ng)
2425 DO i=istr,iend
2426 fc(i,k-1)=0.0_r8
2427 wl(i,k)=z_w(i,j,k-1)+cff
2428 wr(i,k)=hz(i,j,k)*qc(i,k)
2429 ksource(i,k)=k
2430 END DO
2431 END DO
2432 DO k=1,n(ng)
2433 DO ks=k,n(ng)-1
2434 DO i=istr,iend
2435 IF (wl(i,k).gt.z_w(i,j,ks)) THEN
2436 ksource(i,k)=ks+1
2437 fc(i,k-1)=fc(i,k-1)+wr(i,ks)
2438 END IF
2439 END DO
2440 END DO
2441 END DO
2442!
2443! Finalize computation of flux: add fractional part.
2444!
2445 DO k=1,n(ng)
2446 DO i=istr,iend
2447 ks=ksource(i,k)
2448 cu=min(1.0_r8,(wl(i,k)-z_w(i,j,ks-1))*hz_inv(i,ks))
2449 fc(i,k-1)=fc(i,k-1)+ &
2450 & hz(i,j,ks)*cu* &
2451 & (bl(i,ks)+ &
2452 & cu*(0.5_r8*(br(i,ks)-bl(i,ks))- &
2453 & (1.5_r8-cu)* &
2454 & (br(i,ks)+bl(i,ks)- &
2455 & 2.0_r8*qc(i,ks))))
2456 END DO
2457 END DO
2458 DO k=1,n(ng)
2459 DO i=istr,iend
2460 bio(i,k,itrc)=qc(i,k)+(fc(i,k)-fc(i,k-1))*hz_inv(i,k)
2461 END DO
2462 END DO
2463
2464#ifdef BIO_SEDIMENT
2465!
2466! Particulate flux reaching the seafloor is remineralized and returned
2467! to the dissolved nitrate pool. Without this conversion, particulate
2468! material falls out of the system. This is a temporary fix to restore
2469! total nitrogen conservation. It will be replaced later by a
2470! parameterization that includes the time delay of remineralization
2471! and dissolved oxygen.
2472!
2473 DO ifec=1,nfec
2474 IF (itrc.eq.ifecn(ifec)) THEN
2475 DO i=istr,iend
2476 cff1=fc(i,0)*hz_inv(i,1)
2477 bio(i,1,ino3_)=bio(i,1,ino3_)+cff1
2478 END DO
2479 ELSE IF (itrc.eq.ifecc(ifec)) THEN
2480 DO i=istr,iend
2481 cff1=fc(i,0)*hz_inv(i,1)
2482 bio(i,1,idic_)=bio(i,1,idic_)+cff1
2483 END DO
2484 ELSE IF (itrc.eq.ifecp(ifec)) THEN
2485 DO i=istr,iend
2486 cff1=fc(i,0)*hz_inv(i,1)
2487 bio(i,1,ipo4_)=bio(i,1,ipo4_)+cff1
2488 END DO
2489 ELSE IF (itrc.eq.ifecs(ifec)) THEN
2490 DO i=istr,iend
2491 cff1=fc(i,0)*hz_inv(i,1)
2492 bio(i,1,isio_)=bio(i,1,isio_)+cff1
2493 END DO
2494 ELSE IF (itrc.eq.ifecf(ifec)) THEN
2495 DO i=istr,iend
2496 cff1=fc(i,0)*hz_inv(i,1)
2497 bio(i,1,ifeo_)=bio(i,1,ifeo_)+cff1
2498 END DO
2499 END IF
2500 END DO
2501 DO iphy=1,nphy
2502 IF (itrc.eq.iphyn(iphy)) THEN
2503 DO i=istr,iend
2504 cff1=fc(i,0)*hz_inv(i,1)
2505 bio(i,1,ino3_)=bio(i,1,ino3_)+cff1
2506 END DO
2507 ELSE IF (itrc.eq.iphyc(iphy)) THEN
2508 DO i=istr,iend
2509 cff1=fc(i,0)*hz_inv(i,1)
2510 bio(i,1,idic_)=bio(i,1,idic_)+cff1
2511 END DO
2512 ELSE IF (itrc.eq.iphyp(iphy)) THEN
2513 DO i=istr,iend
2514 cff1=fc(i,0)*hz_inv(i,1)
2515 bio(i,1,ipo4_)=bio(i,1,ipo4_)+cff1
2516 END DO
2517 ELSE IF (itrc.eq.iphys(iphy)) THEN
2518 DO i=istr,iend
2519 cff1=fc(i,0)*hz_inv(i,1)
2520 bio(i,1,isio_)=bio(i,1,isio_)+cff1
2521 END DO
2522 ELSE IF (itrc.eq.iphyf(iphy)) THEN
2523 DO i=istr,iend
2524 cff1=fc(i,0)*hz_inv(i,1)
2525 bio(i,1,ifeo_)=bio(i,1,ifeo_)+cff1
2526 END DO
2527 END IF
2528 END DO
2529#endif
2530 END DO sink_loop
2531!
2532!-----------------------------------------------------------------------
2533! Update the tendency arrays
2534!-----------------------------------------------------------------------
2535!
2536 DO ibio=1,nbt
2537 itrc=idbio(ibio)
2538 DO k=1,n(ng)
2539 DO i=istr,iend
2540 bio(i,k,itrc)=bio(i,k,itrc)+dtbio*bio_new(i,k,itrc)
2541 END DO
2542 END DO
2543 END DO
2544
2545 END DO iter_loop
2546!
2547!-----------------------------------------------------------------------
2548! Update global tracer variables: Add increment due to BGC processes
2549! to tracer array in time index "nnew". Index "nnew" is solution after
2550! advection and mixing and has transport units (m Tunits) hence the
2551! increment is multiplied by Hz. Notice that we need to subtract
2552! original values "Bio_old" at the top of the routine to just account
2553! for the concentractions affected by BGC processes. This also takes
2554! into account any constraints (non-negative concentrations, carbon
2555! concentration range) specified before entering BGC kernel. If "Bio"
2556! were unchanged by BGC processes, the increment would be exactly
2557! zero. Notice that final tracer values, t(:,:,:,nnew,:) are not
2558! bounded >=0 so that we can preserve total inventory of nutrients
2559! when advection causes tracer concentration to go negative.
2560!-----------------------------------------------------------------------
2561!
2562 DO ibio=1,nbt
2563 itrc=idbio(ibio)
2564 DO k=1,n(ng)
2565 DO i=istr,iend
2566 cff=bio(i,k,itrc)-bio_old(i,k,itrc)
2567 t(i,j,k,nnew,itrc)=t(i,j,k,nnew,itrc)+cff*hz(i,j,k)
2568 END DO
2569 END DO
2570 END DO
2571 END DO j_loop
2572!
2573 RETURN
2574 END SUBROUTINE ecosim_tile
2575
2576 END MODULE biology_mod
biology_mod
Definition biology.F:120
biology_mod::biology
subroutine, public biology(ng, tile)
Definition ecosim.h:57
biology_mod::ecosim_tile
subroutine ecosim_tile(ng, tile, lbi, ubi, lbj, ubj, ubk, ubt, imins, imaxs, jmins, jmaxs, nstp, nnew, rmask, rmask_full, hz, z_r, z_w, specir, avcos, diabio3d, diabio4d, t)
Definition ecosim.h:139
mod_biology
Definition ecosim_mod.h:1
mod_biology::rtuvr_flag
logical, dimension(:), allocatable rtuvr_flag
Definition ecosim_mod.h:347
mod_biology::rtnit
real(r8), dimension(:), allocatable rtnit
Definition ecosim_mod.h:427
mod_biology::iphyn
integer, dimension(nphy) iphyn
Definition ecosim_mod.h:272
mod_biology::b_c2cl
real(r8), dimension(:,:), allocatable b_c2cl
Definition ecosim_mod.h:380
mod_biology::e0_comp
real(r8), dimension(:,:), allocatable e0_comp
Definition ecosim_mod.h:375
mod_biology::inhib_fac
real(r8), dimension(:,:), allocatable inhib_fac
Definition ecosim_mod.h:377
mod_biology::mxpaceff
real(r8), dimension(:,:), allocatable mxpaceff
Definition ecosim_mod.h:383
mod_biology::mxppc
real(r8), dimension(:,:), allocatable mxppc
Definition ecosim_mod.h:391
mod_biology::hspo4
real(r8), dimension(:,:), allocatable hspo4
Definition ecosim_mod.h:356
mod_biology::idstot
integer idstot
Definition ecosim_mod.h:316
mod_biology::regcr
real(r8), dimension(:,:), allocatable regcr
Definition ecosim_mod.h:441
mod_biology::idspir
integer idspir
Definition ecosim_mod.h:300
mod_biology::frac_exbac_n
real(r8), dimension(:), allocatable frac_exbac_n
Definition ecosim_mod.h:487
mod_biology::mxchlc
real(r8), dimension(:,:), allocatable mxchlc
Definition ecosim_mod.h:387
mod_biology::nfec
integer, parameter nfec
Definition ecosim_mod.h:204
mod_biology::bacpel
real(r8), dimension(:), allocatable bacpel
Definition ecosim_mod.h:422
mod_biology::mxpsc
real(r8), dimension(:,:), allocatable mxpsc
Definition ecosim_mod.h:389
mod_biology::mxc2cl
real(r8), dimension(:,:), allocatable mxc2cl
Definition ecosim_mod.h:379
mod_biology::nbac
integer, parameter nbac
Definition ecosim_mod.h:202
mod_biology::b_chlc
real(r8), dimension(:,:), allocatable b_chlc
Definition ecosim_mod.h:388
mod_biology::hsfe
real(r8), dimension(:,:), allocatable hsfe
Definition ecosim_mod.h:357
mod_biology::maxc2sialg
real(r8), dimension(:,:), allocatable maxc2sialg
Definition ecosim_mod.h:365
mod_biology::ibacc
integer, dimension(nbac) ibacc
Definition ecosim_mod.h:258
mod_biology::r_exbac_c
real(r8), dimension(:), allocatable r_exbac_c
Definition ecosim_mod.h:485
mod_biology::idacdc
integer idacdc
Definition ecosim_mod.h:311
mod_biology::bactbase
real(r8), dimension(:,:), allocatable bactbase
Definition ecosim_mod.h:416
mod_biology::hspo4_ba
real(r8), dimension(:,:), allocatable hspo4_ba
Definition ecosim_mod.h:483
mod_biology::wavedp
real(r8), dimension(nbands) wavedp
Definition ecosim_mod.h:492
mod_biology::hsfe_ba
real(r8), dimension(:,:), allocatable hsfe_ba
Definition ecosim_mod.h:484
mod_biology::hsdon
real(r8), dimension(:,:), allocatable hsdon
Definition ecosim_mod.h:409
mod_biology::mxchlb
real(r8), dimension(:,:), allocatable mxchlb
Definition ecosim_mod.h:385
mod_biology::regpr
real(r8), dimension(:,:), allocatable regpr
Definition ecosim_mod.h:444
mod_biology::b_psc
real(r8), dimension(:,:), allocatable b_psc
Definition ecosim_mod.h:390
mod_biology::ifecf
integer, dimension(nfec) ifecf
Definition ecosim_mod.h:269
mod_biology::idomn
integer, dimension(ndom) idomn
Definition ecosim_mod.h:264
mod_biology::bioiter
integer, dimension(:), allocatable bioiter
Definition ecosim_mod.h:343
mod_biology::iffc
integer, parameter iffc
Definition ecosim_mod.h:468
mod_biology::idadet
integer idadet
Definition ecosim_mod.h:310
mod_biology::regtbase
real(r8), dimension(:,:), allocatable regtbase
Definition ecosim_mod.h:439
mod_biology::fecpel
real(r8), dimension(:,:,:), allocatable fecpel
Definition ecosim_mod.h:398
mod_biology::bac_ceff
real(r8), dimension(:), allocatable bac_ceff
Definition ecosim_mod.h:426
mod_biology::ibacp
integer, dimension(nbac) ibacp
Definition ecosim_mod.h:260
mod_biology::ifecp
integer, dimension(nfec) ifecp
Definition ecosim_mod.h:268
mod_biology::hsnh4_ba
real(r8), dimension(:,:), allocatable hsnh4_ba
Definition ecosim_mod.h:482
mod_biology::qu_yld
real(r8), dimension(:,:), allocatable qu_yld
Definition ecosim_mod.h:374
mod_biology::ifecc
integer, dimension(nfec) ifecc
Definition ecosim_mod.h:266
mod_biology::hsno3
real(r8), dimension(:,:), allocatable hsno3
Definition ecosim_mod.h:353
mod_biology::ino3_
integer ino3_
Definition ecosim_mod.h:277
mod_biology::iphyp
integer, dimension(nphy) iphyp
Definition ecosim_mod.h:273
mod_biology::rtuvr_dic
real(r8), dimension(:), allocatable rtuvr_dic
Definition ecosim_mod.h:433
mod_biology::exalg
real(r8), dimension(:,:), allocatable exalg
Definition ecosim_mod.h:400
mod_biology::b_c2cn
real(r8), dimension(:,:), allocatable b_c2cn
Definition ecosim_mod.h:382
mod_biology::mxc2cn
real(r8), dimension(:,:), allocatable mxc2cn
Definition ecosim_mod.h:381
mod_biology::ipo4_
integer ipo4_
Definition ecosim_mod.h:279
mod_biology::p2cbac
real(r8), dimension(:), allocatable p2cbac
Definition ecosim_mod.h:480
mod_biology::maxc2fealg
real(r8), dimension(:,:), allocatable maxc2fealg
Definition ecosim_mod.h:371
mod_biology::minc2sialg
real(r8), dimension(:,:), allocatable minc2sialg
Definition ecosim_mod.h:366
mod_biology::hsdoc_ba
real(r8), dimension(:,:), allocatable hsdoc_ba
Definition ecosim_mod.h:414
mod_biology::ifecs
integer, dimension(nfec) ifecs
Definition ecosim_mod.h:270
mod_biology::regsr
real(r8), dimension(:,:), allocatable regsr
Definition ecosim_mod.h:443
mod_biology::npig
integer, parameter npig
Definition ecosim_mod.h:206
mod_biology::icdmc
integer, dimension(ndom) icdmc
Definition ecosim_mod.h:262
mod_biology::phytbase
real(r8), dimension(:,:), allocatable phytbase
Definition ecosim_mod.h:359
mod_biology::fecdoc
real(r8), dimension(:,:), allocatable fecdoc
Definition ecosim_mod.h:397
mod_biology::imaxc2palg
real(r8), dimension(:,:), allocatable imaxc2palg
Definition ecosim_mod.h:474
mod_biology::b_hpub
real(r8), dimension(:,:), allocatable b_hpub
Definition ecosim_mod.h:396
mod_biology::bet_
real(r8), dimension(:,:), allocatable bet_
Definition ecosim_mod.h:361
mod_biology::isfc
integer, parameter isfc
Definition ecosim_mod.h:467
mod_biology::n2cbac
real(r8), dimension(:), allocatable n2cbac
Definition ecosim_mod.h:479
mod_biology::larger
real(r8), parameter larger
Definition ecosim_mod.h:459
mod_biology::ndbands
integer ndbands
Definition ecosim_mod.h:212
mod_biology::imaxc2sialg
real(r8), dimension(:,:), allocatable imaxc2sialg
Definition ecosim_mod.h:473
mod_biology::mxlpub
real(r8), dimension(:,:), allocatable mxlpub
Definition ecosim_mod.h:393
mod_biology::b_chlb
real(r8), dimension(:,:), allocatable b_chlb
Definition ecosim_mod.h:386
mod_biology::ichl
integer, parameter ichl
Definition ecosim_mod.h:466
mod_biology::baccyc
real(r8), dimension(:), allocatable baccyc
Definition ecosim_mod.h:423
mod_biology::dlam
real(r8), parameter dlam
Definition ecosim_mod.h:453
mod_biology::maxc2nalg
real(r8), dimension(:,:), allocatable maxc2nalg
Definition ecosim_mod.h:362
mod_biology::iphyc
integer, dimension(nphy) iphyc
Definition ecosim_mod.h:271
mod_biology::wf
real(r8), dimension(:,:), allocatable wf
Definition ecosim_mod.h:438
mod_biology::mxhpub
real(r8), dimension(:,:), allocatable mxhpub
Definition ecosim_mod.h:395
mod_biology::ibacf
integer, dimension(nbac) ibacf
Definition ecosim_mod.h:261
mod_biology::c2nalgminabs
real(r8), dimension(:,:), allocatable c2nalgminabs
Definition ecosim_mod.h:364
mod_biology::regen_flag
logical, dimension(:), allocatable regen_flag
Definition ecosim_mod.h:349
mod_biology::hsnh4
real(r8), dimension(:,:), allocatable hsnh4
Definition ecosim_mod.h:354
mod_biology::idacos
integer idacos
Definition ecosim_mod.h:312
mod_biology::feccyc
real(r8), dimension(:,:), allocatable feccyc
Definition ecosim_mod.h:399
mod_biology::b_ppc
real(r8), dimension(:,:), allocatable b_ppc
Definition ecosim_mod.h:392
mod_biology::bacdoc
real(r8), dimension(:), allocatable bacdoc
Definition ecosim_mod.h:421
mod_biology::b_paceff
real(r8), dimension(:,:), allocatable b_paceff
Definition ecosim_mod.h:384
mod_biology::minrefuge
real(r8), dimension(:,:), allocatable minrefuge
Definition ecosim_mod.h:403
mod_biology::c2nnupdon
real(r8), dimension(:,:), allocatable c2nnupdon
Definition ecosim_mod.h:410
mod_biology::ipigs
integer, dimension(nphy, npig) ipigs
Definition ecosim_mod.h:276
mod_biology::minc2nalg
real(r8), dimension(:,:), allocatable minc2nalg
Definition ecosim_mod.h:363
mod_biology::c2febac
real(r8), dimension(:), allocatable c2febac
Definition ecosim_mod.h:420
mod_biology::idlatt
integer idlatt
Definition ecosim_mod.h:308
mod_biology::idsphy
integer idsphy
Definition ecosim_mod.h:314
mod_biology::vsmall
real(r8), parameter vsmall
Definition ecosim_mod.h:458
mod_biology::imaxc2fealg
real(r8), dimension(:,:), allocatable imaxc2fealg
Definition ecosim_mod.h:475
mod_biology::maxc2palg
real(r8), dimension(:,:), allocatable maxc2palg
Definition ecosim_mod.h:368
mod_biology::regtfac
real(r8), dimension(:,:), allocatable regtfac
Definition ecosim_mod.h:440
mod_biology::c2fealgminabs
real(r8), dimension(:,:), allocatable c2fealgminabs
Definition ecosim_mod.h:373
mod_biology::c2pbac
real(r8), dimension(:), allocatable c2pbac
Definition ecosim_mod.h:419
mod_biology::inh4_
integer inh4_
Definition ecosim_mod.h:278
mod_biology::phytfac
real(r8), dimension(:,:), allocatable phytfac
Definition ecosim_mod.h:360
mod_biology::idbio
integer, dimension(:), allocatable idbio
Definition ecosim_mod.h:256
mod_biology::idomp
integer, dimension(ndom) idomp
Definition ecosim_mod.h:265
mod_biology::nphy
integer, parameter nphy
Definition ecosim_mod.h:205
mod_biology::ws
real(r8), dimension(:,:), allocatable ws
Definition ecosim_mod.h:401
mod_biology::cdocfrac_c
real(r8), dimension(:,:), allocatable cdocfrac_c
Definition ecosim_mod.h:432
mod_biology::ibacn
integer, dimension(nbac) ibacn
Definition ecosim_mod.h:259
mod_biology::hsdop
real(r8), dimension(:,:), allocatable hsdop
Definition ecosim_mod.h:407
mod_biology::regnr
real(r8), dimension(:,:), allocatable regnr
Definition ecosim_mod.h:442
mod_biology::small
real(r8), parameter small
Definition ecosim_mod.h:457
mod_biology::idic_
integer idic_
Definition ecosim_mod.h:282
mod_biology::imaxc2nalg
real(r8), dimension(:,:), allocatable imaxc2nalg
Definition ecosim_mod.h:472
mod_biology::exbac_c
real(r8), dimension(:), allocatable exbac_c
Definition ecosim_mod.h:424
mod_biology::idomc
integer, dimension(ndom) idomc
Definition ecosim_mod.h:263
mod_biology::hssio
real(r8), dimension(:,:), allocatable hssio
Definition ecosim_mod.h:355
mod_biology::adoc410
real(r8), dimension(ndom) adoc410
Definition ecosim_mod.h:493
mod_biology::b_lpub
real(r8), dimension(:,:), allocatable b_lpub
Definition ecosim_mod.h:394
mod_biology::rtuvr_doc
real(r8), dimension(:), allocatable rtuvr_doc
Definition ecosim_mod.h:434
mod_biology::gtbac_max
real(r8), dimension(:,:), allocatable gtbac_max
Definition ecosim_mod.h:415
mod_biology::iddirr
integer iddirr
Definition ecosim_mod.h:306
mod_biology::c2sialgminabs
real(r8), dimension(:,:), allocatable c2sialgminabs
Definition ecosim_mod.h:367
mod_biology::iphyf
integer, dimension(nphy) iphyf
Definition ecosim_mod.h:274
mod_biology::idsirr
integer idsirr
Definition ecosim_mod.h:307
mod_biology::ilab
integer, parameter ilab
Definition ecosim_mod.h:464
mod_biology::exbac_n
real(r8), dimension(:), allocatable exbac_n
Definition ecosim_mod.h:486
mod_biology::i_bac_ceff
real(r8), dimension(:), allocatable i_bac_ceff
Definition ecosim_mod.h:488
mod_biology::ifeo_
integer ifeo_
Definition ecosim_mod.h:280
mod_biology::minc2palg
real(r8), dimension(:,:), allocatable minc2palg
Definition ecosim_mod.h:369
mod_biology::iphys
integer, dimension(nphy) iphys
Definition ecosim_mod.h:275
mod_biology::idbtot
integer idbtot
Definition ecosim_mod.h:315
mod_biology::minc2fealg
real(r8), dimension(:,:), allocatable minc2fealg
Definition ecosim_mod.h:372
mod_biology::c2nbac
real(r8), dimension(:), allocatable c2nbac
Definition ecosim_mod.h:418
mod_biology::hsgrz
real(r8), dimension(:,:), allocatable hsgrz
Definition ecosim_mod.h:402
mod_biology::ifecn
integer, dimension(nfec) ifecn
Definition ecosim_mod.h:267
mod_biology::gtalg_max
real(r8), dimension(:,:), allocatable gtalg_max
Definition ecosim_mod.h:358
mod_biology::bactfac
real(r8), dimension(:,:), allocatable bactfac
Definition ecosim_mod.h:417
mod_biology::fe2cbac
real(r8), dimension(:), allocatable fe2cbac
Definition ecosim_mod.h:481
mod_biology::c2chl_max
real(r8), dimension(:,:), allocatable c2chl_max
Definition ecosim_mod.h:378
mod_biology::adoc300
real(r8), dimension(ndom) adoc300
Definition ecosim_mod.h:494
mod_biology::e0_inhib
real(r8), dimension(:,:), allocatable e0_inhib
Definition ecosim_mod.h:376
mod_biology::idbphy
integer idbphy
Definition ecosim_mod.h:313
mod_biology::irct
integer, parameter irct
Definition ecosim_mod.h:465
mod_biology::hsnit
real(r8), dimension(:), allocatable hsnit
Definition ecosim_mod.h:428
mod_biology::regfr
real(r8), dimension(:,:), allocatable regfr
Definition ecosim_mod.h:445
mod_biology::c2palkphos
real(r8), dimension(:,:), allocatable c2palkphos
Definition ecosim_mod.h:408
mod_biology::c2palgminabs
real(r8), dimension(:,:), allocatable c2palgminabs
Definition ecosim_mod.h:370
mod_biology::isio_
integer isio_
Definition ecosim_mod.h:281
mod_biology::idaphy
integer idaphy
Definition ecosim_mod.h:309
mod_diags
Definition mod_diags.F:2
mod_diags::diags
type(t_diags), dimension(:), allocatable diags
Definition mod_diags.F:100
mod_eclight
Definition mod_eclight.F:2
mod_forces
Definition mod_forces.F:2
mod_forces::forces
type(t_forces), dimension(:), allocatable forces
Definition mod_forces.F:554
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
mod_iounits
Definition mod_iounits.F:2
mod_ncparam
Definition mod_ncparam.F:2
mod_ocean
Definition mod_ocean.F:2
mod_ocean::ocean
type(t_ocean), dimension(:), allocatable ocean
Definition mod_ocean.F:351
mod_param
Definition mod_param.F:2
mod_param::inlm
integer, parameter inlm
Definition mod_param.F:662
mod_param::n
integer, dimension(:), allocatable n
Definition mod_param.F:479
mod_param::ndbio4d
integer ndbio4d
Definition mod_param.F:586
mod_param::nbt
integer nbt
Definition mod_param.F:509
mod_param::nt
integer, dimension(:), allocatable nt
Definition mod_param.F:489
mod_param::ndbio3d
integer ndbio3d
Definition mod_param.F:585
mod_scalars
Definition mod_scalars.F:2
mod_scalars::nrrec
integer, dimension(:), allocatable nrrec
Definition mod_scalars.F:1171
mod_scalars::iic
integer, dimension(:), allocatable iic
Definition mod_scalars.F:249
mod_scalars::dt
real(dp), dimension(:), allocatable dt
Definition mod_scalars.F:269
mod_scalars::isalt
integer isalt
Definition mod_scalars.F:127
mod_scalars::itemp
integer itemp
Definition mod_scalars.F:126
mod_scalars::rad2deg
real(dp), parameter rad2deg
Definition mod_scalars.F:815
mod_scalars::ntstart
integer, dimension(:), allocatable ntstart
Definition mod_scalars.F:378
mod_scalars::ndia
integer, dimension(:), allocatable ndia
Definition mod_scalars.F:1074
mod_scalars::ntsdia
integer, dimension(:), allocatable ntsdia
Definition mod_scalars.F:1068
mod_stepping
Definition mod_stepping.F:2
mod_stepping::nnew
integer, dimension(:), allocatable nnew
Definition mod_stepping.F:69
mod_stepping::nstp
integer, dimension(:), allocatable nstp
Definition mod_stepping.F:71
wclock_off
recursive subroutine wclock_off(ng, model, region, line, routine)
Definition timers.F:148
wclock_on
recursive subroutine wclock_on(ng, model, region, line, routine)
Definition timers.F:3