ROMS
Loading...
Searching...
No Matches
Functions/Subroutines
biology_mod Module Reference

Functions/Subroutines

subroutine, public biology (ng, 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)
 
subroutine fennel_tile (ng, tile, lbi, ubi, lbj, ubj, ubk, ubt, imins, imaxs, jmins, jmaxs, nstp, nnew, rmask, rmask_wet, rmask_full, hz, z_r, z_w, srflx, uwind, vwind, sustr, svstr, ph, diabio2d, diabio3d, t)
 
subroutine pco2_water_rz (istr, iend, lbi, ubi, lbj, ubj, imins, imaxs, j, donewton, rmask, t, s, tic, talk, ph, pco2)
 
subroutine pco2_water (istr, iend, lbi, ubi, lbj, ubj, imins, imaxs, j, donewton, rmask, t, s, tic, talk, po4b, sio3, ph, pco2)
 
subroutine hypoxia_srm_tile (ng, tile, lbi, ubi, lbj, ubj, ubk, ubt, imins, imaxs, jmins, jmaxs, nstp, nnew, rmask, rmask_full, hz, uwind, vwind, sustr, svstr, respiration, diabio2d, t)
 
subroutine nemuro_tile (ng, tile, lbi, ubi, lbj, ubj, ubk, ubt, imins, imaxs, jmins, jmaxs, nstp, nnew, rmask, hz, z_r, z_w, srflx, t)
 
subroutine npzd_franks_tile (ng, tile, lbi, ubi, lbj, ubj, ubk, ubt, imins, imaxs, jmins, jmaxs, nstp, nnew, rmask, hz, z_r, z_w, t)
 
subroutine npzd_iron_tile (ng, tile, lbi, ubi, lbj, ubj, ubk, ubt, imins, imaxs, jmins, jmaxs, nstp, nnew, rmask, h, hz, z_r, z_w, srflx, t)
 
subroutine npzd_powell_tile (ng, tile, lbi, ubi, lbj, ubj, ubk, ubt, imins, imaxs, jmins, jmaxs, nstp, nnew, rmask, hz, z_r, z_w, srflx, t)
 
subroutine red_tide_tile (ng, tile, lbi, ubi, lbj, ubj, ubk, ubt, imins, imaxs, jmins, jmaxs, nstp, nnew, rmask, hz, z_r, z_w, srflx_avg, srflx, cystini, din_obs, t)
 

Function/Subroutine Documentation

◆ biology()

subroutine public biology_mod::biology ( integer, intent(in) ng,
integer, intent(in) tile )

Definition at line 56 of file ecosim.h.

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
mod_diags
Definition mod_diags.F:2
mod_diags::diags
type(t_diags), dimension(:), allocatable diags
Definition mod_diags.F:100
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_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::nt
integer, dimension(:), allocatable nt
Definition mod_param.F:489
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

References mod_diags::diags, ecosim_tile(), mod_forces::forces, mod_grid::grid, mod_param::inlm, mod_param::n, mod_stepping::nnew, mod_stepping::nstp, mod_param::nt, mod_ocean::ocean, wclock_off(), and wclock_on().

Referenced by main3d().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ecosim_tile()

subroutine biology_mod::ecosim_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) ubk,
integer, intent(in) ubt,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) nstp,
integer, intent(in) nnew,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) rmask,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) rmask_full,
real(r8), dimension(lbi:ubi,lbj:ubj,ubk), intent(in) hz,
real(r8), dimension(lbi:ubi,lbj:ubj,ubk), intent(in) z_r,
real(r8), dimension(lbi:ubi,lbj:ubj,0:ubk), intent(in) z_w,
real(r8), dimension(lbi:ubi,lbj:ubj,nbands), intent(in) specir,
real(r8), dimension(lbi:ubi,lbj:ubj,nbands), intent(in) avcos,
real(r8), dimension(lbi:ubi,lbj:ubj, ndbands,ndbio3d), intent(inout) diabio3d,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng), ndbands,ndbio4d), intent(inout) diabio4d,
real(r8), dimension(lbi:ubi,lbj:ubj,ubk,3,ubt), intent(inout) t )
private

Definition at line 122 of file ecosim.h.

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
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::nbands
integer, parameter nbands
Definition ecosim_mod.h:201
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_eclight
Definition mod_eclight.F:2
mod_iounits
Definition mod_iounits.F:2
mod_param::ndbio4d
integer ndbio4d
Definition mod_param.F:586
mod_param::nbt
integer nbt
Definition mod_param.F:509
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

References mod_biology::adoc300, mod_biology::adoc410, mod_biology::b_c2cl, mod_biology::b_c2cn, mod_biology::b_chlb, mod_biology::b_chlc, mod_biology::b_hpub, mod_biology::b_lpub, mod_biology::b_paceff, mod_biology::b_ppc, mod_biology::b_psc, mod_biology::bac_ceff, mod_biology::baccyc, mod_biology::bacdoc, mod_biology::bacpel, mod_biology::bactbase, mod_biology::bactfac, mod_biology::bet_, mod_biology::bioiter, mod_biology::c2chl_max, mod_biology::c2fealgminabs, mod_biology::c2febac, mod_biology::c2nalgminabs, mod_biology::c2nbac, mod_biology::c2nnupdon, mod_biology::c2palgminabs, mod_biology::c2palkphos, mod_biology::c2pbac, mod_biology::c2sialgminabs, mod_biology::cdocfrac_c, mod_biology::dlam, mod_scalars::dt, mod_biology::e0_comp, mod_biology::e0_inhib, mod_biology::exalg, mod_biology::exbac_c, mod_biology::exbac_n, mod_biology::fe2cbac, mod_biology::feccyc, mod_biology::fecdoc, mod_biology::fecpel, mod_biology::frac_exbac_n, mod_biology::gtalg_max, mod_biology::gtbac_max, mod_biology::hsdoc_ba, mod_biology::hsdon, mod_biology::hsdop, mod_biology::hsfe, mod_biology::hsfe_ba, mod_biology::hsgrz, mod_biology::hsnh4, mod_biology::hsnh4_ba, mod_biology::hsnit, mod_biology::hsno3, mod_biology::hspo4, mod_biology::hspo4_ba, mod_biology::hssio, mod_biology::i_bac_ceff, mod_biology::ibacc, mod_biology::ibacf, mod_biology::ibacn, mod_biology::ibacp, mod_biology::icdmc, mod_biology::ichl, mod_biology::idacdc, mod_biology::idacos, mod_biology::idadet, mod_biology::idaphy, mod_biology::idbio, mod_biology::idbphy, mod_biology::idbtot, mod_biology::iddirr, mod_biology::idic_, mod_biology::idlatt, mod_biology::idomc, mod_biology::idomn, mod_biology::idomp, mod_biology::idsirr, mod_biology::idsphy, mod_biology::idspir, mod_biology::idstot, mod_biology::ifecc, mod_biology::ifecf, mod_biology::ifecn, mod_biology::ifecp, mod_biology::ifecs, mod_biology::ifeo_, mod_biology::iffc, mod_scalars::iic, mod_biology::ilab, mod_biology::imaxc2fealg, mod_biology::imaxc2nalg, mod_biology::imaxc2palg, mod_biology::imaxc2sialg, mod_biology::inh4_, mod_biology::inhib_fac, mod_biology::ino3_, mod_biology::iphyc, mod_biology::iphyf, mod_biology::iphyn, mod_biology::iphyp, mod_biology::iphys, mod_biology::ipigs, mod_biology::ipo4_, mod_biology::irct, mod_scalars::isalt, mod_biology::isfc, mod_biology::isio_, mod_scalars::itemp, mod_biology::larger, mod_biology::maxc2fealg, mod_biology::maxc2nalg, mod_biology::maxc2palg, mod_biology::maxc2sialg, mod_biology::minc2fealg, mod_biology::minc2nalg, mod_biology::minc2palg, mod_biology::minc2sialg, mod_biology::minrefuge, mod_biology::mxc2cl, mod_biology::mxc2cn, mod_biology::mxchlb, mod_biology::mxchlc, mod_biology::mxhpub, mod_biology::mxlpub, mod_biology::mxpaceff, mod_biology::mxppc, mod_biology::mxpsc, mod_biology::n2cbac, mod_biology::nbac, mod_param::nbt, mod_biology::ndbands, mod_param::ndbio3d, mod_param::ndbio4d, mod_scalars::ndia, mod_biology::nfec, mod_biology::nphy, mod_biology::npig, mod_scalars::nrrec, mod_scalars::ntsdia, mod_scalars::ntstart, mod_biology::p2cbac, mod_biology::phytbase, mod_biology::phytfac, mod_biology::qu_yld, mod_biology::r_exbac_c, mod_scalars::rad2deg, mod_biology::regcr, mod_biology::regen_flag, mod_biology::regfr, mod_biology::regnr, mod_biology::regpr, mod_biology::regsr, mod_biology::regtbase, mod_biology::regtfac, mod_biology::rtnit, mod_biology::rtuvr_dic, mod_biology::rtuvr_doc, mod_biology::rtuvr_flag, mod_biology::small, mod_biology::vsmall, mod_biology::wavedp, mod_biology::wf, and mod_biology::ws.

Referenced by biology().

Here is the caller graph for this function:

◆ fennel_tile()

subroutine biology_mod::fennel_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) ubk,
integer, intent(in) ubt,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) nstp,
integer, intent(in) nnew,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) rmask,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) rmask_wet,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) rmask_full,
real(r8), dimension(lbi:ubi,lbj:ubj,ubk), intent(in) hz,
real(r8), dimension(lbi:ubi,lbj:ubj,ubk), intent(in) z_r,
real(r8), dimension(lbi:ubi,lbj:ubj,0:ubk), intent(in) z_w,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) srflx,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) uwind,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) vwind,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) sustr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) svstr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(inout) ph,
real(r8), dimension(lbi:ubi,lbj:ubj,ndbio2d), intent(inout) diabio2d,
real(r8), dimension(lbi:ubi,lbj:ubj,ubk,ndbio3d), intent(inout) diabio3d,
real(r8), dimension(lbi:ubi,lbj:ubj,ubk,3,ubt), intent(inout) t )
private

Definition at line 214 of file fennel.h.

242!-----------------------------------------------------------------------
243!
244 USE mod_param
245 USE mod_biology
246 USE mod_ncparam
247 USE mod_scalars
248!
249 USE dateclock_mod, ONLY : caldate
250!
251! Imported variable declarations.
252!
253 integer, intent(in) :: ng, tile
254 integer, intent(in) :: LBi, UBi, LBj, UBj, UBk, UBt
255 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
256 integer, intent(in) :: nstp, nnew
257
258#ifdef ASSUMED_SHAPE
259# ifdef MASKING
260 real(r8), intent(in) :: rmask(LBi:,LBj:)
261# ifdef WET_DRY
262 real(r8), intent(in) :: rmask_wet(LBi:,LBj:)
263# ifdef DIAGNOSTICS_BIO
264 real(r8), intent(in) :: rmask_full(LBi:,LBj:)
265# endif
266# endif
267# endif
268 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
269 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
270 real(r8), intent(in) :: z_w(LBi:,LBj:,0:)
271 real(r8), intent(in) :: srflx(LBi:,LBj:)
272# if defined CARBON || defined OXYGEN
273# ifdef BULK_FLUXES
274 real(r8), intent(in) :: Uwind(LBi:,LBj:)
275 real(r8), intent(in) :: Vwind(LBi:,LBj:)
276# else
277 real(r8), intent(in) :: sustr(LBi:,LBj:)
278 real(r8), intent(in) :: svstr(LBi:,LBj:)
279# endif
280# endif
281# ifdef CARBON
282 real(r8), intent(inout) :: pH(LBi:,LBj:)
283# endif
284# ifdef DIAGNOSTICS_BIO
285 real(r8), intent(inout) :: DiaBio2d(LBi:,LBj:,:)
286 real(r8), intent(inout) :: DiaBio3d(LBi:,LBj:,:,:)
287# endif
288 real(r8), intent(inout) :: t(LBi:,LBj:,:,:,:)
289#else
290# ifdef MASKING
291 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
292# ifdef WET_DRY
293 real(r8), intent(in) :: rmask_wet(LBi:UBi,LBj:UBj)
294# ifdef DIAGNOSTICS_BIO
295 real(r8), intent(in) :: rmask_full(LBi:UBi,LBj:UBj)
296# endif
297# endif
298# endif
299 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,UBk)
300 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,UBk)
301 real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:UBk)
302 real(r8), intent(in) :: srflx(LBi:UBi,LBj:UBj)
303# if defined CARBON || defined OXYGEN
304# ifdef BULK_FLUXES
305 real(r8), intent(in) :: Uwind(LBi:UBi,LBj:UBj)
306 real(r8), intent(in) :: Vwind(LBi:UBi,LBj:UBj)
307# else
308 real(r8), intent(in) :: sustr(LBi:UBi,LBj:UBj)
309 real(r8), intent(in) :: svstr(LBi:UBi,LBj:UBj)
310# endif
311# endif
312# ifdef CARBON
313 real(r8), intent(inout) :: pH(LBi:UBi,LBj:UBj)
314# endif
315# ifdef DIAGNOSTICS_BIO
316 real(r8), intent(inout) :: DiaBio2d(LBi:UBi,LBj:UBj,NDbio2d)
317 real(r8), intent(inout) :: DiaBio3d(LBi:UBi,LBj:UBj,UBk,NDbio3d)
318# endif
319 real(r8), intent(inout) :: t(LBi:UBi,LBj:UBj,UBk,3,UBt)
320#endif
321!
322! Local variable declarations.
323!
324#ifdef CARBON
325 integer, parameter :: Nsink = 6
326#else
327 integer, parameter :: Nsink = 4
328#endif
329
330 integer :: Iter, i, ibio, isink, itrc, ivar, j, k, ks
331
332 integer, dimension(Nsink) :: idsink
333
334 real(r8), parameter :: eps = 1.0e-20_r8
335
336#if defined CARBON || defined OXYGEN
337 real(r8) :: u10squ
338#endif
339#ifdef OXYGEN
340# if defined OCMIP_OXYGEN_SC
341!
342! Alternative formulation for Schmidt number coefficients (Sc will be
343! slightly smaller up to about 35C) using the formulation proposed by
344! Keeling et al. (1998, Global Biogeochem. Cycles, 12, 141-163).
345!
346 real(r8), parameter :: A_O2 = 1638.0_r8
347 real(r8), parameter :: B_O2 = 81.83_r8
348 real(r8), parameter :: C_O2 = 1.483_r8
349 real(r8), parameter :: D_O2 = 0.008004_r8
350 real(r8), parameter :: E_O2 = 0.0_r8
351
352# elif defined RW14_OXYGEN_SC
353!
354! Alternative formulation for Schmidt number coefficients using the
355! formulation of Wanninkhof (2014, L and O Methods, 12,351-362).
356!
357 real(r8), parameter :: A_O2 = 1920.4_r8
358 real(r8), parameter :: B_O2 = 135.6_r8
359 real(r8), parameter :: C_O2 = 5.2122_r8
360 real(r8), parameter :: D_O2 = 0.10939_r8
361 real(r8), parameter :: E_O2 = 0.00093777_r8
362
363# else
364!
365! Schmidt number coefficients using the formulation of
366! Wanninkhof (1992).
367!
368 real(r8), parameter :: A_O2 = 1953.4_r8
369 real(r8), parameter :: B_O2 = 128.0_r8
370 real(r8), parameter :: C_O2 = 3.9918_r8
371 real(r8), parameter :: D_O2 = 0.050091_r8
372 real(r8), parameter :: E_O2 = 0.0_r8
373#endif
374 real(r8), parameter :: OA0 = 2.00907_r8 ! Oxygen
375 real(r8), parameter :: OA1 = 3.22014_r8 ! saturation
376 real(r8), parameter :: OA2 = 4.05010_r8 ! coefficients
377 real(r8), parameter :: OA3 = 4.94457_r8
378 real(r8), parameter :: OA4 =-0.256847_r8
379 real(r8), parameter :: OA5 = 3.88767_r8
380 real(r8), parameter :: OB0 =-0.00624523_r8
381 real(r8), parameter :: OB1 =-0.00737614_r8
382 real(r8), parameter :: OB2 =-0.0103410_r8
383 real(r8), parameter :: OB3 =-0.00817083_r8
384 real(r8), parameter :: OC0 =-0.000000488682_r8
385 real(r8), parameter :: rOxNO3= 8.625_r8 ! 138/16
386 real(r8), parameter :: rOxNH4= 6.625_r8 ! 106/16
387 real(r8) :: l2mol = 1000.0_r8/22.3916_r8 ! liter to mol
388#endif
389#ifdef CARBON
390 integer :: year
391 integer, parameter :: DoNewton = 0 ! pCO2 solver
392
393# if defined RW14_CO2_SC
394 real(r8), parameter :: A_CO2 = 2116.8_r8 ! Schmidt number
395 real(r8), parameter :: B_CO2 = 136.25_r8 ! transfer coeff
396 real(r8), parameter :: C_CO2 = 4.7353_r8 ! according to
397 real(r8), parameter :: D_CO2 = 0.092307_r8 ! Wanninkhof (2014)
398 real(r8), parameter :: E_CO2 = 0.0007555_r8
399# else
400 real(r8), parameter :: A_CO2 = 2073.1_r8 ! Schmidt
401 real(r8), parameter :: B_CO2 = 125.62_r8 ! number
402 real(r8), parameter :: C_CO2 = 3.6276_r8 ! transfer
403 real(r8), parameter :: D_CO2 = 0.043219_r8 ! coefficients
404 real(r8), parameter :: E_CO2 = 0.0_r8
405#endif
406
407 real(r8), parameter :: A1 = -60.2409_r8 ! surface
408 real(r8), parameter :: A2 = 93.4517_r8 ! CO2
409 real(r8), parameter :: A3 = 23.3585_r8 ! solubility
410 real(r8), parameter :: B1 = 0.023517_r8 ! coefficients
411 real(r8), parameter :: B2 = -0.023656_r8
412 real(r8), parameter :: B3 = 0.0047036_r8
413
414 real(r8) :: pmonth ! months since Jan 1951
415 real(r8) :: pCO2air_secular
416 real(dp) :: yday
417
418 real(r8), parameter :: pi2 = 6.2831853071796_r8
419
420 real(r8), parameter :: D0 = 282.6_r8 ! coefficients
421 real(r8), parameter :: D1 = 0.125_r8 ! to calculate
422 real(r8), parameter :: D2 =-7.18_r8 ! secular trend in
423 real(r8), parameter :: D3 = 0.86_r8 ! atmospheric pCO2
424 real(r8), parameter :: D4 =-0.99_r8
425 real(r8), parameter :: D5 = 0.28_r8
426 real(r8), parameter :: D6 =-0.80_r8
427 real(r8), parameter :: D7 = 0.06_r8
428#endif
429
430 real(r8) :: Att, AttFac, ExpAtt, Itop, PAR
431 real(r8) :: Epp, L_NH4, L_NO3, LTOT, Vp
432#ifdef PO4
433 real(r8), parameter :: MinVal = 1.0e-6_r8
434
435 real(r8) :: L_PO4, LMIN, mu, cff6
436#endif
437 real(r8) :: Chl2C, dtdays, t_PPmax, inhNH4
438
439 real(r8) :: cff, cff1, cff2, cff3, cff4, cff5
440#ifdef RIVER_DON
441 real(r8) :: cff7, cff8
442#endif
443 real(r8) :: fac1, fac2, fac3
444 real(r8) :: cffL, cffR, cu, dltL, dltR
445
446 real(r8) :: total_N
447
448#ifdef DIAGNOSTICS_BIO
449 real(r8) :: fiter
450#endif
451
452#ifdef OXYGEN
453 real(r8) :: SchmidtN_Ox, O2satu, O2_Flux
454 real(r8) :: TS, AA
455#endif
456
457#ifdef CARBON
458 real(r8) :: C_Flux_RemineL, C_Flux_RemineS, C_Flux_RemineR
459 real(r8) :: CO2_Flux, CO2_sol, SchmidtN, TempK
460#endif
461
462 real(r8) :: N_Flux_Assim
463 real(r8) :: N_Flux_CoagD, N_Flux_CoagP
464 real(r8) :: N_Flux_Egest
465 real(r8) :: N_Flux_NewProd, N_Flux_RegProd
466 real(r8) :: N_Flux_Nitrifi
467 real(r8) :: N_Flux_Pmortal, N_Flux_Zmortal
468 real(r8) :: N_Flux_RemineL, N_Flux_RemineS, N_Flux_RemineR
469 real(r8) :: N_Flux_Zexcret, N_Flux_Zmetabo
470
471 real(r8), dimension(Nsink) :: Wbio
472
473 integer, dimension(IminS:ImaxS,N(ng)) :: ksource
474
475 real(r8), dimension(IminS:ImaxS) :: PARsur
476#ifdef CARBON
477 real(r8), dimension(IminS:ImaxS) :: pCO2
478#endif
479
480 real(r8), dimension(IminS:ImaxS,N(ng),NT(ng)) :: Bio
481 real(r8), dimension(IminS:ImaxS,N(ng),NT(ng)) :: Bio_old
482
483 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: FC
484
485 real(r8), dimension(IminS:ImaxS,N(ng)) :: Hz_inv
486 real(r8), dimension(IminS:ImaxS,N(ng)) :: Hz_inv2
487 real(r8), dimension(IminS:ImaxS,N(ng)) :: Hz_inv3
488 real(r8), dimension(IminS:ImaxS,N(ng)) :: WL
489 real(r8), dimension(IminS:ImaxS,N(ng)) :: WR
490 real(r8), dimension(IminS:ImaxS,N(ng)) :: bL
491 real(r8), dimension(IminS:ImaxS,N(ng)) :: bR
492 real(r8), dimension(IminS:ImaxS,N(ng)) :: qc
493
494#include "set_bounds.h"
495#ifdef DIAGNOSTICS_BIO
496!
497!-----------------------------------------------------------------------
498! If appropriate, initialize time-averaged diagnostic arrays.
499!-----------------------------------------------------------------------
500!
501 IF (((iic(ng).gt.ntsdia(ng)).and. &
502 & (mod(iic(ng),ndia(ng)).eq.1)).or. &
503 & ((iic(ng).ge.ntsdia(ng)).and.(ndia(ng).eq.1)).or. &
504 & ((nrrec(ng).gt.0).and.(iic(ng).eq.ntstart(ng)))) THEN
505 DO ivar=1,ndbio2d
506 DO j=jstr,jend
507 DO i=istr,iend
508 diabio2d(i,j,ivar)=0.0_r8
509 END DO
510 END DO
511 END DO
512 DO ivar=1,ndbio3d
513 DO k=1,n(ng)
514 DO j=jstr,jend
515 DO i=istr,iend
516 diabio3d(i,j,k,ivar)=0.0_r8
517 END DO
518 END DO
519 END DO
520 END DO
521 END IF
522#endif
523!
524!-----------------------------------------------------------------------
525! Add biological Source/Sink terms.
526!-----------------------------------------------------------------------
527!
528! Avoid computing source/sink terms if no biological iterations.
529!
530 IF (bioiter(ng).le.0) RETURN
531!
532! Set time-stepping according to the number of iterations.
533!
534 dtdays=dt(ng)*sec2day/real(bioiter(ng),r8)
535#ifdef DIAGNOSTICS_BIO
536!
537! A factor to account for the number of iterations in accumulating
538! diagnostic rate variables.
539!
540 fiter=1.0_r8/real(bioiter(ng),r8)
541#endif
542!
543! Set vertical sinking indentification vector.
544!
545 idsink(1)=iphyt
546 idsink(2)=ichlo
547 idsink(3)=isden
548 idsink(4)=ilden
549#ifdef CARBON
550 idsink(5)=isdec
551 idsink(6)=ildec
552#endif
553!
554! Set vertical sinking velocity vector in the same order as the
555! identification vector, IDSINK.
556!
557 wbio(1)=wphy(ng) ! phytoplankton
558 wbio(2)=wphy(ng) ! chlorophyll
559 wbio(3)=wsdet(ng) ! small Nitrogen-detritus
560 wbio(4)=wldet(ng) ! large Nitrogen-detritus
561#ifdef CARBON
562 wbio(5)=wsdet(ng) ! small Carbon-detritus
563 wbio(6)=wldet(ng) ! large Carbon-detritus
564#endif
565!
566! Compute inverse thickness to avoid repeated divisions.
567!
568 j_loop : DO j=jstr,jend
569 DO k=1,n(ng)
570 DO i=istr,iend
571 hz_inv(i,k)=1.0_r8/hz(i,j,k)
572 END DO
573 END DO
574 DO k=1,n(ng)-1
575 DO i=istr,iend
576 hz_inv2(i,k)=1.0_r8/(hz(i,j,k)+hz(i,j,k+1))
577 END DO
578 END DO
579 DO k=2,n(ng)-1
580 DO i=istr,iend
581 hz_inv3(i,k)=1.0_r8/(hz(i,j,k-1)+hz(i,j,k)+hz(i,j,k+1))
582 END DO
583 END DO
584!
585! Extract biological variables from tracer arrays, place them into
586! scratch arrays, and restrict their values to be positive definite.
587! At input, all tracers (index nnew) from predictor step have
588! transport units (m Tunits) since we do not have yet the new
589! values for zeta and Hz. These are known after the 2D barotropic
590! time-stepping.
591!
592 DO itrc=1,nbt
593 ibio=idbio(itrc)
594 DO k=1,n(ng)
595 DO i=istr,iend
596 bio_old(i,k,ibio)=max(0.0_r8,t(i,j,k,nstp,ibio))
597 bio(i,k,ibio)=bio_old(i,k,ibio)
598 END DO
599 END DO
600 END DO
601#ifdef CARBON
602 DO k=1,n(ng)
603 DO i=istr,iend
604 bio_old(i,k,itic_)=min(bio_old(i,k,itic_),3000.0_r8)
605 bio_old(i,k,itic_)=max(bio_old(i,k,itic_),400.0_r8)
606 bio(i,k,itic_)=bio_old(i,k,itic_)
607 END DO
608 END DO
609#endif
610!
611! Extract potential temperature and salinity.
612!
613 DO k=1,n(ng)
614 DO i=istr,iend
615 bio(i,k,itemp)=min(t(i,j,k,nstp,itemp),35.0_r8)
616 bio(i,k,isalt)=max(t(i,j,k,nstp,isalt), 0.0_r8)
617 END DO
618 END DO
619!
620! Calculate surface Photosynthetically Available Radiation (PAR). The
621! net shortwave radiation is scaled back to Watts/m2 and multiplied by
622! the fraction that is photosynthetically available, PARfrac.
623!
624 DO i=istr,iend
625 parsur(i)=parfrac(ng)*srflx(i,j)*rho0*cp
626 END DO
627!
628!=======================================================================
629! Start internal iterations to achieve convergence of the nonlinear
630! backward-implicit solution.
631!=======================================================================
632!
633! During the iterative procedure a series of fractional time steps are
634! performed in a chained mode (splitting by different biological
635! conversion processes) in sequence of the main food chain. In all
636! stages the concentration of the component being consumed is treated
637! in fully implicit manner, so the algorithm guarantees non-negative
638! values, no matter how strong s the concentration of active consuming
639! component (Phytoplankton or Zooplankton). The overall algorithm,
640! as well as any stage of it, is formulated in conservative form
641! (except explicit sinking) in sense that the sum of concentration of
642! all components is conserved.
643!
644!
645! In the implicit algorithm, we have for example (N: nitrate,
646! P: phytoplankton),
647!
648! N(new) = N(old) - uptake * P(old) uptake = mu * N / (Kn + N)
649! {Michaelis-Menten}
650! below, we set
651! The N in the numerator of
652! cff = mu * P(old) / (Kn + N(old)) uptake is treated implicitly
653! as N(new)
654!
655! so the time-stepping of the equations becomes:
656!
657! N(new) = N(old) / (1 + cff) (1) when substracting a sink term,
658! consuming, divide by (1 + cff)
659! and
660!
661! P(new) = P(old) + cff * N(new) (2) when adding a source term,
662! growing, add (cff * source)
663!
664! Notice that if you substitute (1) in (2), you will get:
665!
666! P(new) = P(old) + cff * N(old) / (1 + cff) (3)
667!
668! If you add (1) and (3), you get
669!
670! N(new) + P(new) = N(old) + P(old)
671!
672! implying conservation regardless how "cff" is computed. Therefore,
673! this scheme is unconditionally stable regardless of the conversion
674! rate. It does not generate negative values since the constituent
675! to be consumed is always treated implicitly. It is also biased
676! toward damping oscillations.
677!
678! The iterative loop below is to iterate toward an universal Backward-
679! Euler treatment of all terms. So if there are oscillations in the
680! system, they are only physical oscillations. These iterations,
681! however, do not improve the accuaracy of the solution.
682!
683 iter_loop: DO iter=1,bioiter(ng)
684!
685!-----------------------------------------------------------------------
686! Light-limited computations.
687!-----------------------------------------------------------------------
688!
689! Compute attenuation coefficient based on the concentration of
690! chlorophyll-a within each grid box. Then, attenuate surface
691! photosynthetically available radiation (PARsur) down inot the
692! water column. Thus, PAR at certain depth depends on the whole
693! distribution of chlorophyll-a above.
694! To compute rate of maximum primary productivity (t_PPmax), one needs
695! PAR somewhat in the middle of the gridbox, so that attenuation "Att"
696! corresponds to half of the grid box height, while PAR is multiplied
697! by it twice: once to get it in the middle of grid-box and once the
698! compute on the lower grid-box interface.
699!
700 DO i=istr,iend
701 par=parsur(i)
702 attfac=0.0_r8
703 IF (parsur(i).gt.0.0_r8) THEN
704 DO k=n(ng),1,-1
705!
706! Compute average light attenuation for each grid cell. To include
707! other attenuation contributions like suspended sediment or CDOM
708! modify AttFac.
709!
710 att=(attsw(ng)+ &
711 & attchl(ng)*bio(i,k,ichlo)+ &
712 & attfac)* &
713 & (z_w(i,j,k)-z_w(i,j,k-1))
714 expatt=exp(-att)
715 itop=par
716 par=itop*(1.0_r8-expatt)/att ! average at cell center
717!
718! Compute Chlorophyll-a phytoplankton ratio, [mg Chla / (mg C)].
719!
720 cff=phycn(ng)*12.0_r8
721 chl2c=min(bio(i,k,ichlo)/(bio(i,k,iphyt)*cff+eps), &
722 & chl2c_m(ng))
723!
724! Temperature-limited and light-limited growth rate (Eppley, R.W.,
725! 1972, Fishery Bulletin, 70: 1063-1085; here 0.59=ln(2)*0.851).
726! Check value for Vp is 2.9124317 at 19.25 degC.
727!
728 vp=vp0(ng)*0.59_r8*(1.066_r8**bio(i,k,itemp))
729 fac1=par*phyis(ng)
730 epp=vp/sqrt(vp*vp+fac1*fac1)
731 t_ppmax=epp*fac1
732!
733! Nutrient-limitation terms (Parker 1993 Ecol Mod., 66, 113-120).
734!
735 cff1=bio(i,k,inh4_)*k_nh4(ng)
736 cff2=bio(i,k,ino3_)*k_no3(ng)
737 inhnh4=1.0_r8/(1.0_r8+cff1)
738 l_nh4=cff1/(1.0_r8+cff1)
739 l_no3=cff2*inhnh4/(1.0_r8+cff2)
740 ltot=l_no3+l_nh4
741#ifdef PO4
742 cff3=bio(i,k,ipo4_)*k_po4(ng)
743 l_po4=cff3/(1.0_r8+cff3)
744 lmin=min(ltot,l_po4)
745#endif
746!
747! Nitrate and ammonium uptake by Phytoplankton.
748!
749#ifdef PO4
750 mu=dtdays*t_ppmax*lmin
751 cff4=mu*bio(i,k,iphyt)*l_no3/ &
752 & max(minval,ltot)/max(minval,bio(i,k,ino3_))
753 cff5=mu*bio(i,k,iphyt)*l_nh4/ &
754 & max(minval,ltot)/max(minval,bio(i,k,inh4_))
755 cff6=r_p2n(ng)*mu*bio(i,k,iphyt)/ &
756 & max(minval,bio(i,k,ipo4_))
757#else
758 fac1=dtdays*t_ppmax
759 cff4=fac1*k_no3(ng)*inhnh4/(1.0_r8+cff2)*bio(i,k,iphyt)
760 cff5=fac1*k_nh4(ng)/(1.0_r8+cff1)*bio(i,k,iphyt)
761#endif
762 bio(i,k,ino3_)=bio(i,k,ino3_)/(1.0_r8+cff4)
763 bio(i,k,inh4_)=bio(i,k,inh4_)/(1.0_r8+cff5)
764#ifdef PO4
765 bio(i,k,ipo4_)=bio(i,k,ipo4_)/(1.0_r8+cff6)
766#endif
767 n_flux_newprod=bio(i,k,ino3_)*cff4
768 n_flux_regprod=bio(i,k,inh4_)*cff5
769 bio(i,k,iphyt)=bio(i,k,iphyt)+ &
770 & n_flux_newprod+n_flux_regprod
771!
772 bio(i,k,ichlo)=bio(i,k,ichlo)+ &
773#ifdef PO4
774 & (dtdays*t_ppmax*t_ppmax*lmin*lmin* &
775#else
776 & (dtdays*t_ppmax*t_ppmax*ltot*ltot* &
777#endif
778 & chl2c_m(ng)*bio(i,k,ichlo))/ &
779 & (phyis(ng)*max(chl2c,eps)*par+eps)
780#ifdef DIAGNOSTICS_BIO
781 diabio3d(i,j,k,ippro)=diabio3d(i,j,k,ippro)+ &
782# ifdef WET_DRY
783 & rmask_full(i,j)* &
784# endif
785 & (n_flux_newprod+n_flux_regprod)* &
786 & fiter
787 diabio3d(i,j,k,ino3u)=diabio3d(i,j,k,ino3u)+ &
788# ifdef WET_DRY
789 & rmask_full(i,j)* &
790# endif
791 & n_flux_newprod*fiter
792#endif
793#ifdef OXYGEN
794 bio(i,k,ioxyg)=bio(i,k,ioxyg)+ &
795 & n_flux_newprod*roxno3+ &
796 & n_flux_regprod*roxnh4
797#endif
798#ifdef CARBON
799!
800! Total inorganic carbon (CO2) uptake during phytoplankton growth.
801!
802 cff1=phycn(ng)*(n_flux_newprod+n_flux_regprod)
803 bio(i,k,itic_)=bio(i,k,itic_)-cff1
804# ifdef TALK_NONCONSERV
805!
806! Account for the uptake of NO3 on total alkalinity.
807!
808 bio(i,k,italk)=bio(i,k,italk)+n_flux_newprod- &
809 & n_flux_regprod
810# endif
811#endif
812!
813! The Nitrification of NH4 ==> NO3 is thought to occur only in dark and
814! only in aerobic water (see Olson, R. J., 1981, JMR: (39), 227-238.).
815!
816! NH4+ + 3/2 O2 ==> NO2- + H2O; via Nitrosomonas bacteria
817! NO2- + 1/2 O2 ==> NO3- ; via Nitrobacter bacteria
818!
819! Note that the entire process has a total loss of two moles of O2 per
820! mole of NH4. If we were to resolve NO2 profiles, this is where we
821! would change the code to split out the differential effects of the
822! two different bacteria types. If OXYGEN is defined, nitrification is
823! inhibited at low oxygen concentrations using a Michaelis-Menten term.
824!
825#ifdef OXYGEN
826 fac2=max(bio(i,k,ioxyg),0.0_r8) ! O2 max
827 fac3=max(fac2/(3.0_r8+fac2),0.0_r8) ! MM for O2 dependence
828 fac1=dtdays*nitrir(ng)*fac3
829#else
830 fac1=dtdays*nitrir(ng)
831#endif
832 cff1=(par-i_thnh4(ng))/ &
833 & (d_p5nh4(ng)+par-2.0_r8*i_thnh4(ng))
834 cff2=1.0_r8-max(0.0_r8,cff1)
835 cff3=fac1*cff2
836 bio(i,k,inh4_)=bio(i,k,inh4_)/(1.0_r8+cff3)
837 n_flux_nitrifi=bio(i,k,inh4_)*cff3
838 bio(i,k,ino3_)=bio(i,k,ino3_)+n_flux_nitrifi
839#ifdef DIAGNOSTICS_BIO
840 diabio3d(i,j,k,inifx)=diabio3d(i,j,k,inifx)+ &
841# ifdef WET_DRY
842 & rmask_full(i,j)* &
843# endif
844 & n_flux_nitrifi*fiter
845#endif
846#ifdef OXYGEN
847 bio(i,k,ioxyg)=bio(i,k,ioxyg)-2.0_r8*n_flux_nitrifi
848#endif
849#if defined CARBON && defined TALK_NONCONSERV
850 bio(i,k,italk)=bio(i,k,italk)-2.0_r8*n_flux_nitrifi
851#endif
852!
853! Light attenuation at the bottom of the grid cell. It is the starting
854! PAR value for the next (deeper) vertical grid cell.
855!
856 par=itop*expatt
857 END DO
858!
859! If PARsur=0, nitrification occurs at the maximum rate (NitriR).
860!
861 ELSE
862 cff3=dtdays*nitrir(ng)
863 DO k=n(ng),1,-1
864 bio(i,k,inh4_)=bio(i,k,inh4_)/(1.0_r8+cff3)
865 n_flux_nitrifi=bio(i,k,inh4_)*cff3
866 bio(i,k,ino3_)=bio(i,k,ino3_)+n_flux_nitrifi
867#ifdef DIAGNOSTICS_BIO
868 diabio3d(i,j,k,inifx)=diabio3d(i,j,k,inifx)+ &
869# ifdef WET_DRY
870 & rmask_full(i,j)* &
871# endif
872 & n_flux_nitrifi*fiter
873#endif
874#ifdef OXYGEN
875 bio(i,k,ioxyg)=bio(i,k,ioxyg)-2.0_r8*n_flux_nitrifi
876#endif
877#if defined CARBON && defined TALK_NONCONSERV
878 bio(i,k,italk)=bio(i,k,italk)-2.0_r8*n_flux_nitrifi
879#endif
880 END DO
881 END IF
882 END DO
883!
884!-----------------------------------------------------------------------
885! Phytoplankton grazing by zooplankton (rate: ZooGR), phytoplankton
886! assimilated to zooplankton (fraction: ZooAE_N) and egested to small
887! detritus, and phytoplankton mortality (rate: PhyMR) to small
888! detritus. [Landry 1993 L and O 38:468-472]
889!-----------------------------------------------------------------------
890!
891 fac1=dtdays*zoogr(ng)
892 cff2=dtdays*phymr(ng)
893 DO k=1,n(ng)
894 DO i=istr,iend
895!
896! Phytoplankton grazing by zooplankton.
897!
898 cff1=fac1*bio(i,k,izoop)*bio(i,k,iphyt)/ &
899 & (k_phy(ng)+bio(i,k,iphyt)*bio(i,k,iphyt))
900 cff3=1.0_r8/(1.0_r8+cff1)
901 bio(i,k,iphyt)=cff3*bio(i,k,iphyt)
902 bio(i,k,ichlo)=cff3*bio(i,k,ichlo)
903!
904! Phytoplankton assimilated to zooplankton and egested to small
905! detritus.
906!
907 n_flux_assim=cff1*bio(i,k,iphyt)*zooae_n(ng)
908 n_flux_egest=bio(i,k,iphyt)*cff1*(1.0_r8-zooae_n(ng))
909 bio(i,k,izoop)=bio(i,k,izoop)+ &
910 & n_flux_assim
911 bio(i,k,isden)=bio(i,k,isden)+ &
912 & n_flux_egest
913!
914! Phytoplankton mortality (limited by a phytoplankton minimum).
915!
916 n_flux_pmortal=cff2*max(bio(i,k,iphyt)-phymin(ng),0.0_r8)
917 bio(i,k,iphyt)=bio(i,k,iphyt)-n_flux_pmortal
918 bio(i,k,ichlo)=bio(i,k,ichlo)- &
919 & cff2*max(bio(i,k,ichlo)-chlmin(ng),0.0_r8)
920 bio(i,k,isden)=bio(i,k,isden)+ &
921 & n_flux_pmortal
922#ifdef CARBON
923 bio(i,k,isdec)=bio(i,k,isdec)+ &
924 & phycn(ng)*(n_flux_egest+n_flux_pmortal)+ &
925 & (phycn(ng)-zoocn(ng))*n_flux_assim
926#endif
927 END DO
928 END DO
929!
930!-----------------------------------------------------------------------
931! Zooplankton basal metabolism to NH4 (rate: ZooBM), zooplankton
932! mortality to small detritus (rate: ZooMR), zooplankton ingestion
933! related excretion (rate: ZooER).
934!-----------------------------------------------------------------------
935!
936 cff1=dtdays*zoobm(ng)
937 fac2=dtdays*zoomr(ng)
938 fac3=dtdays*zooer(ng)
939 DO k=1,n(ng)
940 DO i=istr,iend
941 fac1=fac3*bio(i,k,iphyt)*bio(i,k,iphyt)/ &
942 & (k_phy(ng)+bio(i,k,iphyt)*bio(i,k,iphyt))
943 cff2=fac2*bio(i,k,izoop)
944 cff3=fac1*zooae_n(ng)
945 bio(i,k,izoop)=bio(i,k,izoop)/ &
946 & (1.0_r8+cff2+cff3)
947!
948! Zooplankton mortality and excretion.
949!
950 n_flux_zmortal=cff2*bio(i,k,izoop)
951 n_flux_zexcret=cff3*bio(i,k,izoop)
952 bio(i,k,inh4_)=bio(i,k,inh4_)+n_flux_zexcret
953#ifdef PO4
954 bio(i,k,ipo4_)=bio(i,k,ipo4_)+r_p2n(ng)*n_flux_zexcret
955#endif
956 bio(i,k,isden)=bio(i,k,isden)+n_flux_zmortal
957!
958! Zooplankton basal metabolism (limited by a zooplankton minimum).
959!
960 n_flux_zmetabo=cff1*max(bio(i,k,izoop)-zoomin(ng),0.0_r8)
961 bio(i,k,izoop)=bio(i,k,izoop)-n_flux_zmetabo
962 bio(i,k,inh4_)=bio(i,k,inh4_)+n_flux_zmetabo
963#ifdef PO4
964 bio(i,k,ipo4_)=bio(i,k,ipo4_)+r_p2n(ng)*n_flux_zmetabo
965#endif
966#ifdef OXYGEN
967 bio(i,k,ioxyg)=bio(i,k,ioxyg)- &
968 & roxnh4*(n_flux_zmetabo+n_flux_zexcret)
969#endif
970#ifdef CARBON
971 bio(i,k,isdec)=bio(i,k,isdec)+ &
972 & zoocn(ng)*n_flux_zmortal
973 bio(i,k,itic_)=bio(i,k,itic_)+ &
974 & zoocn(ng)*(n_flux_zmetabo+n_flux_zexcret)
975#ifdef TALK_NONCONSERV
976 bio(i,k,italk)=bio(i,k,italk)+n_flux_zmetabo+ &
977 & n_flux_zexcret
978#endif
979#endif
980 END DO
981 END DO
982!
983!-----------------------------------------------------------------------
984! Coagulation of phytoplankton and small detritus to large detritus.
985!-----------------------------------------------------------------------
986!
987 fac1=dtdays*coagr(ng)
988 DO k=1,n(ng)
989 DO i=istr,iend
990 cff1=fac1*(bio(i,k,isden)+bio(i,k,iphyt))
991 cff2=1.0_r8/(1.0_r8+cff1)
992 bio(i,k,iphyt)=bio(i,k,iphyt)*cff2
993 bio(i,k,ichlo)=bio(i,k,ichlo)*cff2
994 bio(i,k,isden)=bio(i,k,isden)*cff2
995 n_flux_coagp=bio(i,k,iphyt)*cff1
996 n_flux_coagd=bio(i,k,isden)*cff1
997 bio(i,k,ilden)=bio(i,k,ilden)+ &
998 & n_flux_coagp+n_flux_coagd
999#ifdef CARBON
1000 bio(i,k,isdec)=bio(i,k,isdec)-phycn(ng)*n_flux_coagd
1001 bio(i,k,ildec)=bio(i,k,ildec)+ &
1002 & phycn(ng)*(n_flux_coagp+n_flux_coagd)
1003#endif
1004 END DO
1005 END DO
1006!
1007!-----------------------------------------------------------------------
1008! Detritus recycling to NH4, remineralization.
1009!-----------------------------------------------------------------------
1010!
1011#ifdef OXYGEN
1012 DO k=1,n(ng)
1013 DO i=istr,iend
1014 fac1=max(bio(i,k,ioxyg)-6.0_r8,0.0_r8) ! O2 off max
1015 fac2=max(fac1/(3.0_r8+fac1),0.0_r8) ! MM for O2 dependence
1016 cff1=dtdays*sderrn(ng)*fac2
1017 cff2=1.0_r8/(1.0_r8+cff1)
1018 cff3=dtdays*lderrn(ng)*fac2
1019 cff4=1.0_r8/(1.0_r8+cff3)
1020 bio(i,k,isden)=bio(i,k,isden)*cff2
1021 bio(i,k,ilden)=bio(i,k,ilden)*cff4
1022 n_flux_remines=bio(i,k,isden)*cff1
1023 n_flux_reminel=bio(i,k,ilden)*cff3
1024 bio(i,k,inh4_)=bio(i,k,inh4_)+ &
1025 & n_flux_remines+n_flux_reminel
1026# ifdef PO4
1027 bio(i,k,ipo4_)=bio(i,k,ipo4_)+r_p2n(ng) &
1028 & *(n_flux_remines+n_flux_reminel)
1029# endif
1030 bio(i,k,ioxyg)=bio(i,k,ioxyg)- &
1031 & (n_flux_remines+n_flux_reminel)*roxnh4
1032# if defined CARBON && defined TALK_NONCONSERV
1033 bio(i,k,italk)=bio(i,k,italk)+n_flux_remines+ &
1034 & n_flux_reminel
1035# endif
1036# ifdef RIVER_DON
1037 cff7=dtdays*rderrn(ng)*fac2
1038 cff8=1.0_r8/(1.0_r8+cff7)
1039 bio(i,k,irden)=bio(i,k,irden)*cff8
1040 n_flux_reminer=bio(i,k,irden)*cff7
1041 bio(i,k,inh4_)=bio(i,k,inh4_)+ &
1042 & n_flux_reminer
1043# ifdef PO4
1044 bio(i,k,ipo4_)=bio(i,k,ipo4_)+r_p2n(ng) &
1045 & *n_flux_reminer
1046# endif
1047 bio(i,k,ioxyg)=bio(i,k,ioxyg)-n_flux_reminer*roxnh4
1048# if defined CARBON && defined TALK_NONCONSERV
1049 bio(i,k,italk)=bio(i,k,italk)+n_flux_reminer
1050# endif
1051# endif
1052 END DO
1053 END DO
1054#else
1055 cff1=dtdays*sderrn(ng)
1056 cff2=1.0_r8/(1.0_r8+cff1)
1057 cff3=dtdays*lderrn(ng)
1058 cff4=1.0_r8/(1.0_r8+cff3)
1059# ifdef RIVER_DON
1060 cff7=dtdays*rderrn(ng)
1061 cff8=1.0_r8/(1.0_r8+cff7)
1062# endif
1063 DO k=1,n(ng)
1064 DO i=istr,iend
1065 bio(i,k,isden)=bio(i,k,isden)*cff2
1066 bio(i,k,ilden)=bio(i,k,ilden)*cff4
1067 n_flux_remines=bio(i,k,isden)*cff1
1068 n_flux_reminel=bio(i,k,ilden)*cff3
1069 bio(i,k,inh4_)=bio(i,k,inh4_)+ &
1070 & n_flux_remines+n_flux_reminel
1071# ifdef PO4
1072 bio(i,k,ipo4_)=bio(i,k,ipo4_)+r_p2n(ng) &
1073 & *(n_flux_remines+n_flux_reminel)
1074# endif
1075# if defined CARBON && defined TALK_NONCONSERV
1076 bio(i,k,italk)=bio(i,k,italk)+n_flux_remines+ &
1077 & n_flux_reminel
1078# endif
1079# ifdef RIVER_DON
1080 bio(i,k,irden)=bio(i,k,irden)*cff8
1081 n_flux_reminer=bio(i,k,irden)*cff7
1082 bio(i,k,inh4_)=bio(i,k,inh4_)+n_flux_reminer
1083# ifdef PO4
1084 bio(i,k,ipo4_)=bio(i,k,ipo4_)+r_p2n(ng) &
1085 & *n_flux_reminer
1086# endif
1087# if defined CARBON && defined TALK_NONCONSERV
1088 bio(i,k,italk)=bio(i,k,italk)+n_flux_reminer
1089# endif
1090# endif
1091 END DO
1092 END DO
1093#endif
1094#ifdef OXYGEN
1095!
1096!-----------------------------------------------------------------------
1097! Surface O2 gas exchange.
1098!-----------------------------------------------------------------------
1099!
1100! Compute surface O2 gas exchange.
1101!
1102 cff1=rho0*550.0_r8
1103# if defined RW14_OXYGEN_SC
1104 cff2=dtdays*0.251_r8*24.0_r8/100.0_r8
1105# else
1106 cff2=dtdays*0.31_r8*24.0_r8/100.0_r8
1107# endif
1108 k=n(ng)
1109 DO i=istr,iend
1110!
1111! Compute O2 transfer velocity : u10squared (u10 in m/s)
1112!
1113# ifdef BULK_FLUXES
1114 u10squ=uwind(i,j)*uwind(i,j)+vwind(i,j)*vwind(i,j)
1115# else
1116 u10squ=cff1*sqrt((0.5_r8*(sustr(i,j)+sustr(i+1,j)))**2+ &
1117 & (0.5_r8*(svstr(i,j)+svstr(i,j+1)))**2)
1118# endif
1119 schmidtn_ox=a_o2-bio(i,k,itemp)*(b_o2-bio(i,k,itemp)*(c_o2- &
1120 & bio(i,k,itemp)*(d_o2- &
1121 & bio(i,k,itemp)*e_o2)))
1122 cff3=cff2*u10squ*sqrt(660.0_r8/schmidtn_ox)
1123!
1124! Calculate O2 saturation concentration using Garcia and Gordon
1125! L and O (1992) formula, (EXP(AA) is in ml/l).
1126!
1127 ts=log((298.15_r8-bio(i,k,itemp))/ &
1128 & (273.15_r8+bio(i,k,itemp)))
1129 aa=oa0+ts*(oa1+ts*(oa2+ts*(oa3+ts*(oa4+ts*oa5))))+ &
1130 & bio(i,k,isalt)*(ob0+ts*(ob1+ts*(ob2+ts*ob3)))+ &
1131 & oc0*bio(i,k,isalt)*bio(i,k,isalt)
1132!
1133! Convert from ml/l to mmol/m3.
1134!
1135 o2satu=l2mol*exp(aa)
1136!
1137! Add in O2 gas exchange.
1138!
1139 o2_flux=cff3*(o2satu-bio(i,k,ioxyg))
1140 bio(i,k,ioxyg)=bio(i,k,ioxyg)+ &
1141 & o2_flux*hz_inv(i,k)
1142# ifdef DIAGNOSTICS_BIO
1143 diabio2d(i,j,io2fx)=diabio2d(i,j,io2fx)+ &
1144# ifdef WET_DRY
1145 & rmask_full(i,j)* &
1146# endif
1147 & o2_flux*fiter
1148# endif
1149
1150 END DO
1151#endif
1152
1153#ifdef CARBON
1154!
1155!-----------------------------------------------------------------------
1156! Allow different remineralization rates for detrital C and detrital N.
1157!-----------------------------------------------------------------------
1158!
1159 cff1=dtdays*sderrc(ng)
1160 cff2=1.0_r8/(1.0_r8+cff1)
1161 cff3=dtdays*lderrc(ng)
1162 cff4=1.0_r8/(1.0_r8+cff3)
1163# ifdef RIVER_DON
1164 cff7=dtdays*rderrc(ng)
1165 cff8=1.0_r8/(1.0_r8+cff7)
1166# endif
1167 DO k=1,n(ng)
1168 DO i=istr,iend
1169 bio(i,k,isdec)=bio(i,k,isdec)*cff2
1170 bio(i,k,ildec)=bio(i,k,ildec)*cff4
1171 c_flux_remines=bio(i,k,isdec)*cff1
1172 c_flux_reminel=bio(i,k,ildec)*cff3
1173 bio(i,k,itic_)=bio(i,k,itic_)+ &
1174 & c_flux_remines+c_flux_reminel
1175# ifdef RIVER_DON
1176 bio(i,k,irdec)=bio(i,k,irdec)*cff8
1177 c_flux_reminer=bio(i,k,irdec)*cff7
1178 bio(i,k,itic_)=bio(i,k,itic_)+c_flux_reminer
1179# endif
1180 END DO
1181 END DO
1182# ifndef TALK_NONCONSERV
1183!
1184! Alkalinity is treated as a diagnostic variable. TAlk = f(S[PSU])
1185! following Brewer et al. (1986).
1186!
1187 DO k=1,n(ng)
1188 DO i=istr,iend
1189 bio(i,k,italk)=587.05_r8+50.56_r8*bio(i,k,isalt)
1190 END DO
1191 END DO
1192# endif
1193!
1194!-----------------------------------------------------------------------
1195! Surface CO2 gas exchange.
1196!-----------------------------------------------------------------------
1197!
1198! Compute equilibrium partial pressure inorganic carbon (ppmv) at the
1199! surface.
1200!
1201 k=n(ng)
1202# ifdef pCO2_RZ
1203 CALL pco2_water_rz (istr, iend, lbi, ubi, lbj, ubj, &
1204 & imins, imaxs, j, donewton, &
1205# ifdef MASKING
1206 & rmask, &
1207# endif
1208 & bio(imins:,k,itemp), bio(imins:,k,isalt), &
1209 & bio(imins:,k,itic_), bio(imins:,k,italk), &
1210 & ph, pco2)
1211# else
1212 CALL pco2_water (istr, iend, lbi, ubi, lbj, ubj, &
1213 & imins, imaxs, j, donewton, &
1214# ifdef MASKING
1215 & rmask, &
1216# endif
1217 & bio(imins:,k,itemp), bio(imins:,k,isalt), &
1218 & bio(imins:,k,itic_), bio(imins:,k,italk), &
1219 & 0.0_r8, 0.0_r8, ph, pco2)
1220# endif
1221!
1222! Compute surface CO2 gas exchange.
1223!
1224 cff1=rho0*550.0_r8
1225# if defined RW14_CO2_SC
1226 cff2=dtdays*0.251_r8*24.0_r8/100.0_r8
1227# else
1228 cff2=dtdays*0.31_r8*24.0_r8/100.0_r8
1229# endif
1230 DO i=istr,iend
1231!
1232! Compute CO2 transfer velocity : u10squared (u10 in m/s)
1233!
1234# ifdef BULK_FLUXES
1235 u10squ=uwind(i,j)**2+vwind(i,j)**2
1236# else
1237 u10squ=cff1*sqrt((0.5_r8*(sustr(i,j)+sustr(i+1,j)))**2+ &
1238 & (0.5_r8*(svstr(i,j)+svstr(i,j+1)))**2)
1239# endif
1240 schmidtn=a_co2-bio(i,k,itemp)*(b_co2-bio(i,k,itemp)*(c_co2- &
1241 & bio(i,k,itemp)*(d_co2- &
1242 & bio(i,k,itemp)*e_co2)))
1243 cff3=cff2*u10squ*sqrt(660.0_r8/schmidtn)
1244!
1245! Calculate CO2 solubility [mol/(kg.atm)] using Weiss (1974) formula.
1246!
1247 tempk=0.01_r8*(bio(i,k,itemp)+273.15_r8)
1248 co2_sol=exp(a1+ &
1249 & a2/tempk+ &
1250 & a3*log(tempk)+ &
1251 & bio(i,k,isalt)*(b1+tempk*(b2+b3*tempk)))
1252!
1253! Add in CO2 gas exchange.
1254!
1255 CALL caldate (tdays(ng), yy_i=year, yd_dp=yday)
1256 pmonth=year-1951.0_r8+yday/365.0_r8
1257# if defined PCO2AIR_DATA
1258 pco2air_secular=380.464_r8+9.321_r8*sin(pi2*yday/365.25_r8+ &
1259 & 1.068_r8)
1260 co2_flux=cff3*co2_sol*(pco2air_secular-pco2(i))
1261# elif defined PCO2AIR_SECULAR
1262 pco2air_secular=d0+d1*pmonth*12.0_r8+ &
1263 & d2*sin(pi2*pmonth+d3)+ &
1264 & d4*sin(pi2*pmonth+d5)+ &
1265 & d6*sin(pi2*pmonth+d7)
1266 co2_flux=cff3*co2_sol*(pco2air_secular-pco2(i))
1267# else
1268 co2_flux=cff3*co2_sol*(pco2air(ng)-pco2(i))
1269# endif
1270 bio(i,k,itic_)=bio(i,k,itic_)+ &
1271 & co2_flux*hz_inv(i,k)
1272# ifdef DIAGNOSTICS_BIO
1273 diabio2d(i,j,icofx)=diabio2d(i,j,icofx)+ &
1274# ifdef WET_DRY
1275 & rmask_full(i,j)* &
1276# endif
1277 & co2_flux*fiter
1278 diabio2d(i,j,ipco2)=pco2(i)
1279# ifdef WET_DRY
1280 diabio2d(i,j,ipco2)=diabio2d(i,j,ipco2)*rmask_full(i,j)
1281# endif
1282# endif
1283 END DO
1284#endif
1285!
1286!-----------------------------------------------------------------------
1287! Vertical sinking terms.
1288!-----------------------------------------------------------------------
1289!
1290! Reconstruct vertical profile of selected biological constituents
1291! "Bio(:,:,isink)" in terms of a set of parabolic segments within each
1292! grid box. Then, compute semi-Lagrangian flux due to sinking.
1293!
1294 sink_loop: DO isink=1,nsink
1295 ibio=idsink(isink)
1296!
1297! Copy concentration of biological particulates into scratch array
1298! "qc" (q-central, restrict it to be positive) which is hereafter
1299! interpreted as a set of grid-box averaged values for biogeochemical
1300! constituent concentration.
1301!
1302 DO k=1,n(ng)
1303 DO i=istr,iend
1304 qc(i,k)=bio(i,k,ibio)
1305 END DO
1306 END DO
1307!
1308 DO k=n(ng)-1,1,-1
1309 DO i=istr,iend
1310 fc(i,k)=(qc(i,k+1)-qc(i,k))*hz_inv2(i,k)
1311 END DO
1312 END DO
1313 DO k=2,n(ng)-1
1314 DO i=istr,iend
1315 dltr=hz(i,j,k)*fc(i,k)
1316 dltl=hz(i,j,k)*fc(i,k-1)
1317 cff=hz(i,j,k-1)+2.0_r8*hz(i,j,k)+hz(i,j,k+1)
1318 cffr=cff*fc(i,k)
1319 cffl=cff*fc(i,k-1)
1320!
1321! Apply PPM monotonicity constraint to prevent oscillations within the
1322! grid box.
1323!
1324 IF ((dltr*dltl).le.0.0_r8) THEN
1325 dltr=0.0_r8
1326 dltl=0.0_r8
1327 ELSE IF (abs(dltr).gt.abs(cffl)) THEN
1328 dltr=cffl
1329 ELSE IF (abs(dltl).gt.abs(cffr)) THEN
1330 dltl=cffr
1331 END IF
1332!
1333! Compute right and left side values (bR,bL) of parabolic segments
1334! within grid box Hz(k); (WR,WL) are measures of quadratic variations.
1335!
1336! NOTE: Although each parabolic segment is monotonic within its grid
1337! box, monotonicity of the whole profile is not guaranteed,
1338! because bL(k+1)-bR(k) may still have different sign than
1339! qc(i,k+1)-qc(i,k). This possibility is excluded,
1340! after bL and bR are reconciled using WENO procedure.
1341!
1342 cff=(dltr-dltl)*hz_inv3(i,k)
1343 dltr=dltr-cff*hz(i,j,k+1)
1344 dltl=dltl+cff*hz(i,j,k-1)
1345 br(i,k)=qc(i,k)+dltr
1346 bl(i,k)=qc(i,k)-dltl
1347 wr(i,k)=(2.0_r8*dltr-dltl)**2
1348 wl(i,k)=(dltr-2.0_r8*dltl)**2
1349 END DO
1350 END DO
1351 cff=1.0e-14_r8
1352 DO k=2,n(ng)-2
1353 DO i=istr,iend
1354 dltl=max(cff,wl(i,k ))
1355 dltr=max(cff,wr(i,k+1))
1356 br(i,k)=(dltr*br(i,k)+dltl*bl(i,k+1))/(dltr+dltl)
1357 bl(i,k+1)=br(i,k)
1358 END DO
1359 END DO
1360 DO i=istr,iend
1361 fc(i,n(ng))=0.0_r8 ! NO-flux boundary condition
1362#if defined LINEAR_CONTINUATION
1363 bl(i,n(ng))=br(i,n(ng)-1)
1364 br(i,n(ng))=2.0_r8*qc(i,n(ng))-bl(i,n(ng))
1365#elif defined NEUMANN
1366 bl(i,n(ng))=br(i,n(ng)-1)
1367 br(i,n(ng))=1.5_r8*qc(i,n(ng))-0.5_r8*bl(i,n(ng))
1368#else
1369 br(i,n(ng))=qc(i,n(ng)) ! default strictly monotonic
1370 bl(i,n(ng))=qc(i,n(ng)) ! conditions
1371 br(i,n(ng)-1)=qc(i,n(ng))
1372#endif
1373#if defined LINEAR_CONTINUATION
1374 br(i,1)=bl(i,2)
1375 bl(i,1)=2.0_r8*qc(i,1)-br(i,1)
1376#elif defined NEUMANN
1377 br(i,1)=bl(i,2)
1378 bl(i,1)=1.5_r8*qc(i,1)-0.5_r8*br(i,1)
1379#else
1380 bl(i,2)=qc(i,1) ! bottom grid boxes are
1381 br(i,1)=qc(i,1) ! re-assumed to be
1382 bl(i,1)=qc(i,1) ! piecewise constant.
1383#endif
1384 END DO
1385!
1386! Apply monotonicity constraint again, since the reconciled interfacial
1387! values may cause a non-monotonic behavior of the parabolic segments
1388! inside the grid box.
1389!
1390 DO k=1,n(ng)
1391 DO i=istr,iend
1392 dltr=br(i,k)-qc(i,k)
1393 dltl=qc(i,k)-bl(i,k)
1394 cffr=2.0_r8*dltr
1395 cffl=2.0_r8*dltl
1396 IF ((dltr*dltl).lt.0.0_r8) THEN
1397 dltr=0.0_r8
1398 dltl=0.0_r8
1399 ELSE IF (abs(dltr).gt.abs(cffl)) THEN
1400 dltr=cffl
1401 ELSE IF (abs(dltl).gt.abs(cffr)) THEN
1402 dltl=cffr
1403 END IF
1404 br(i,k)=qc(i,k)+dltr
1405 bl(i,k)=qc(i,k)-dltl
1406 END DO
1407 END DO
1408!
1409! After this moment reconstruction is considered complete. The next
1410! stage is to compute vertical advective fluxes, FC. It is expected
1411! that sinking may occurs relatively fast, the algorithm is designed
1412! to be free of CFL criterion, which is achieved by allowing
1413! integration bounds for semi-Lagrangian advective flux to use as
1414! many grid boxes in upstream direction as necessary.
1415!
1416! In the two code segments below, WL is the z-coordinate of the
1417! departure point for grid box interface z_w with the same indices;
1418! FC is the finite volume flux; ksource(:,k) is index of vertical
1419! grid box which contains the departure point (restricted by N(ng)).
1420! During the search: also add in content of whole grid boxes
1421! participating in FC.
1422!
1423 cff=dtdays*abs(wbio(isink))
1424 DO k=1,n(ng)
1425 DO i=istr,iend
1426 fc(i,k-1)=0.0_r8
1427 wl(i,k)=z_w(i,j,k-1)+cff
1428 wr(i,k)=hz(i,j,k)*qc(i,k)
1429 ksource(i,k)=k
1430 END DO
1431 END DO
1432 DO k=1,n(ng)
1433 DO ks=k,n(ng)-1
1434 DO i=istr,iend
1435 IF (wl(i,k).gt.z_w(i,j,ks)) THEN
1436 ksource(i,k)=ks+1
1437 fc(i,k-1)=fc(i,k-1)+wr(i,ks)
1438 END IF
1439 END DO
1440 END DO
1441 END DO
1442!
1443! Finalize computation of flux: add fractional part.
1444!
1445 DO k=1,n(ng)
1446 DO i=istr,iend
1447 ks=ksource(i,k)
1448 cu=min(1.0_r8,(wl(i,k)-z_w(i,j,ks-1))*hz_inv(i,ks))
1449 fc(i,k-1)=fc(i,k-1)+ &
1450 & hz(i,j,ks)*cu* &
1451 & (bl(i,ks)+ &
1452 & cu*(0.5_r8*(br(i,ks)-bl(i,ks))- &
1453 & (1.5_r8-cu)* &
1454 & (br(i,ks)+bl(i,ks)- &
1455 & 2.0_r8*qc(i,ks))))
1456 END DO
1457 END DO
1458 DO k=1,n(ng)
1459 DO i=istr,iend
1460 bio(i,k,ibio)=qc(i,k)+(fc(i,k)-fc(i,k-1))*hz_inv(i,k)
1461 END DO
1462 END DO
1463
1464#ifdef BIO_SEDIMENT
1465!
1466! Particulate flux reaching the seafloor is remineralized and returned
1467! to the dissolved nitrate pool. Without this conversion, particulate
1468! material falls out of the system. This is a temporary fix to restore
1469! total nitrogen conservation. It will be replaced later by a
1470! parameterization that includes the time delay of remineralization
1471! and dissolved oxygen.
1472!
1473 cff2=4.0_r8/16.0_r8
1474# ifdef OXYGEN
1475 cff3=115.0_r8/16.0_r8
1476 cff4=106.0_r8/16.0_r8
1477# endif
1478 IF ((ibio.eq.iphyt).or. &
1479 & (ibio.eq.isden).or. &
1480 & (ibio.eq.ilden)) THEN
1481 DO i=istr,iend
1482 cff1=fc(i,0)*hz_inv(i,1)
1483# ifdef DENITRIFICATION
1484 bio(i,1,inh4_)=bio(i,1,inh4_)+cff1*cff2
1485# ifdef DIAGNOSTICS_BIO
1486 diabio2d(i,j,idnit)=diabio2d(i,j,idnit)+ &
1487# ifdef WET_DRY
1488 & rmask_full(i,j)* &
1489# endif
1490 & (1.0_r8-cff2)*cff1*hz(i,j,1)*fiter
1491# endif
1492# ifdef PO4
1493 bio(i,1,ipo4_)=bio(i,1,ipo4_)+cff1*r_p2n(ng)
1494# endif
1495# ifdef OXYGEN
1496 bio(i,1,ioxyg)=bio(i,1,ioxyg)-cff1*cff3
1497# endif
1498# else
1499 bio(i,1,inh4_)=bio(i,1,inh4_)+cff1
1500# ifdef PO4
1501 bio(i,1,ipo4_)=bio(i,1,ipo4_)+cff1*r_p2n(ng)
1502# endif
1503# ifdef OXYGEN
1504 bio(i,1,ioxyg)=bio(i,1,ioxyg)-cff1*cff4
1505# endif
1506# if defined CARBON && defined TALK_NONCONSERV
1507 bio(i,1,italk)=bio(i,1,italk)+cff1
1508# endif
1509# endif
1510 END DO
1511 END IF
1512# ifdef CARBON
1513# ifdef DENITRIFICATION
1514 cff3=12.0_r8
1515 cff4=0.74_r8
1516# endif
1517 IF ((ibio.eq.isdec).or. &
1518 & (ibio.eq.ildec))THEN
1519 DO i=istr,iend
1520 cff1=fc(i,0)*hz_inv(i,1)
1521 bio(i,1,itic_)=bio(i,1,itic_)+cff1
1522 END DO
1523 END IF
1524 IF (ibio.eq.iphyt)THEN
1525 DO i=istr,iend
1526 cff1=fc(i,0)*hz_inv(i,1)
1527 bio(i,1,itic_)=bio(i,1,itic_)+cff1*phycn(ng)
1528 END DO
1529 END IF
1530# endif
1531#endif
1532 END DO sink_loop
1533 END DO iter_loop
1534!
1535!-----------------------------------------------------------------------
1536! Update global tracer variables: Add increment due to BGC processes
1537! to tracer array in time index "nnew". Index "nnew" is solution after
1538! advection and mixing and has transport units (m Tunits) hence the
1539! increment is multiplied by Hz. Notice that we need to subtract
1540! original values "Bio_old" at the top of the routine to just account
1541! for the concentractions affected by BGC processes. This also takes
1542! into account any constraints (non-negative concentrations, carbon
1543! concentration range) specified before entering BGC kernel. If "Bio"
1544! were unchanged by BGC processes, the increment would be exactly
1545! zero. Notice that final tracer values, t(:,:,:,nnew,:) are not
1546! bounded >=0 so that we can preserve total inventory of N and
1547! C even when advection causes tracer concentration to go negative.
1548! (J. Wilkin and H. Arango, Apr 27, 2012)
1549!-----------------------------------------------------------------------
1550!
1551#ifdef CARBON
1552 DO k=1,n(ng)
1553 DO i=istr,iend
1554 bio(i,k,itic_)=min(bio(i,k,itic_),3000.0_r8)
1555 bio(i,k,itic_)=max(bio(i,k,itic_),400.0_r8)
1556 END DO
1557 END DO
1558#endif
1559 DO itrc=1,nbt
1560 ibio=idbio(itrc)
1561 DO k=1,n(ng)
1562 DO i=istr,iend
1563 cff=bio(i,k,ibio)-bio_old(i,k,ibio)
1564#ifdef MASKING
1565 cff=cff*rmask(i,j)
1566# ifdef WET_DRY
1567 cff=cff*rmask_wet(i,j)
1568# endif
1569#endif
1570 t(i,j,k,nnew,ibio)=t(i,j,k,nnew,ibio)+cff*hz(i,j,k)
1571 END DO
1572 END DO
1573 END DO
1574 END DO j_loop
1575!
1576 RETURN
dateclock_mod
Definition dateclock.F:2
dateclock_mod::caldate
subroutine, public caldate(currenttime, yy_i, yd_i, mm_i, dd_i, h_i, m_i, s_i, yd_dp, dd_dp, h_dp, m_dp, s_dp)
Definition dateclock.F:76
mod_biology::isden
integer isden
Definition fennel_mod.h:84
mod_biology::ipco2
integer ipco2
Definition fennel_mod.h:109
mod_biology::k_po4
real(r8), dimension(:), allocatable k_po4
Definition fennel_mod.h:134
mod_biology::idnit
integer idnit
Definition fennel_mod.h:108
mod_biology::sderrc
real(r8), dimension(:), allocatable sderrc
Definition fennel_mod.h:149
mod_biology::parfrac
real(r8), dimension(:), allocatable parfrac
Definition fennel_mod.h:139
mod_biology::zoomr
real(r8), dimension(:), allocatable zoomr
Definition fennel_mod.h:162
mod_biology::rderrc
real(r8), dimension(:), allocatable rderrc
Definition fennel_mod.h:151
mod_biology::wldet
real(r8), dimension(:), allocatable wldet
Definition fennel_mod.h:153
mod_biology::zoocn
real(r8), dimension(:), allocatable zoocn
Definition fennel_mod.h:158
mod_biology::vp0
real(r8), dimension(:), allocatable vp0
Definition fennel_mod.h:152
mod_biology::sderrn
real(r8), dimension(:), allocatable sderrn
Definition fennel_mod.h:148
mod_biology::k_phy
real(r8), dimension(:), allocatable k_phy
Definition fennel_mod.h:135
mod_biology::itic_
integer itic_
Definition fennel_mod.h:91
mod_biology::nitrir
real(r8), dimension(:), allocatable nitrir
Definition fennel_mod.h:138
mod_biology::r_p2n
real(r8), dimension(:), allocatable r_p2n
Definition fennel_mod.h:141
mod_biology::ilden
integer ilden
Definition fennel_mod.h:83
mod_biology::k_nh4
real(r8), dimension(:), allocatable k_nh4
Definition fennel_mod.h:132
mod_biology::phyis
real(r8), dimension(:), allocatable phyis
Definition fennel_mod.h:143
mod_biology::attsw
real(r8), dimension(:), allocatable attsw
Definition fennel_mod.h:125
mod_biology::chlmin
real(r8), dimension(:), allocatable chlmin
Definition fennel_mod.h:128
mod_biology::isdec
integer isdec
Definition fennel_mod.h:90
mod_biology::irden
integer irden
Definition fennel_mod.h:86
mod_biology::chl2c_m
real(r8), dimension(:), allocatable chl2c_m
Definition fennel_mod.h:127
mod_biology::zoogr
real(r8), dimension(:), allocatable zoogr
Definition fennel_mod.h:160
mod_biology::d_p5nh4
real(r8), dimension(:), allocatable d_p5nh4
Definition fennel_mod.h:130
mod_biology::rderrn
real(r8), dimension(:), allocatable rderrn
Definition fennel_mod.h:150
mod_biology::zoomin
real(r8), dimension(:), allocatable zoomin
Definition fennel_mod.h:161
mod_biology::italk
integer italk
Definition fennel_mod.h:92
mod_biology::k_no3
real(r8), dimension(:), allocatable k_no3
Definition fennel_mod.h:133
mod_biology::inifx
integer inifx
Definition fennel_mod.h:118
mod_biology::wsdet
real(r8), dimension(:), allocatable wsdet
Definition fennel_mod.h:155
mod_biology::phymr
real(r8), dimension(:), allocatable phymr
Definition fennel_mod.h:145
mod_biology::phymin
real(r8), dimension(:), allocatable phymin
Definition fennel_mod.h:144
mod_biology::iphyt
integer iphyt
Definition fennel_mod.h:81
mod_biology::i_thnh4
real(r8), dimension(:), allocatable i_thnh4
Definition fennel_mod.h:131
mod_biology::lderrn
real(r8), dimension(:), allocatable lderrn
Definition fennel_mod.h:136
mod_biology::phycn
real(r8), dimension(:), allocatable phycn
Definition fennel_mod.h:140
mod_biology::pco2air
real(r8), dimension(:), allocatable pco2air
Definition fennel_mod.h:163
mod_biology::coagr
real(r8), dimension(:), allocatable coagr
Definition fennel_mod.h:129
mod_biology::ioxyg
integer ioxyg
Definition fennel_mod.h:98
mod_biology::wphy
real(r8), dimension(:), allocatable wphy
Definition fennel_mod.h:154
mod_biology::zooer
real(r8), dimension(:), allocatable zooer
Definition fennel_mod.h:159
mod_biology::ino3u
integer ino3u
Definition fennel_mod.h:117
mod_biology::ippro
integer ippro
Definition fennel_mod.h:116
mod_biology::lderrc
real(r8), dimension(:), allocatable lderrc
Definition fennel_mod.h:137
mod_biology::attchl
real(r8), dimension(:), allocatable attchl
Definition fennel_mod.h:126
mod_biology::izoop
integer izoop
Definition fennel_mod.h:82
mod_biology::zoobm
real(r8), dimension(:), allocatable zoobm
Definition fennel_mod.h:157
mod_biology::zooae_n
real(r8), dimension(:), allocatable zooae_n
Definition fennel_mod.h:156
mod_biology::ildec
integer ildec
Definition fennel_mod.h:89
mod_biology::icofx
integer icofx
Definition fennel_mod.h:107
mod_biology::io2fx
integer io2fx
Definition fennel_mod.h:110
mod_biology::irdec
integer irdec
Definition fennel_mod.h:94
mod_biology::ichlo
integer ichlo
Definition fennel_mod.h:80
mod_param::ndbio2d
integer ndbio2d
Definition mod_param.F:584
mod_scalars::cp
real(dp) cp
Definition mod_scalars.F:456
mod_scalars::tdays
real(dp), dimension(:), allocatable tdays
Definition mod_scalars.F:261
mod_scalars::sec2day
real(dp), parameter sec2day
Definition mod_scalars.F:817
mod_scalars::rho0
real(dp) rho0
Definition mod_scalars.F:787

References mod_biology::attchl, mod_biology::attsw, mod_biology::bioiter, dateclock_mod::caldate(), mod_biology::chl2c_m, mod_biology::chlmin, mod_biology::coagr, mod_scalars::cp, mod_biology::d_p5nh4, mod_scalars::dt, mod_biology::i_thnh4, mod_biology::ichlo, mod_biology::icofx, mod_biology::idbio, mod_biology::idnit, mod_scalars::iic, mod_biology::ildec, mod_biology::ilden, mod_biology::inh4_, mod_biology::inifx, mod_biology::ino3_, mod_biology::ino3u, mod_biology::io2fx, mod_biology::ioxyg, mod_biology::ipco2, mod_biology::iphyt, mod_biology::ipo4_, mod_biology::ippro, mod_biology::irdec, mod_biology::irden, mod_scalars::isalt, mod_biology::isdec, mod_biology::isden, mod_biology::italk, mod_scalars::itemp, mod_biology::itic_, mod_biology::izoop, mod_biology::k_nh4, mod_biology::k_no3, mod_biology::k_phy, mod_biology::k_po4, mod_biology::lderrc, mod_biology::lderrn, mod_param::n, mod_param::nbt, mod_scalars::ndia, mod_biology::nitrir, mod_scalars::nrrec, mod_scalars::ntsdia, mod_scalars::ntstart, mod_biology::parfrac, pco2_water(), pco2_water_rz(), mod_biology::pco2air, mod_biology::phycn, mod_biology::phyis, mod_biology::phymin, mod_biology::phymr, mod_biology::r_p2n, mod_biology::rderrc, mod_biology::rderrn, mod_scalars::rho0, mod_biology::sderrc, mod_biology::sderrn, mod_scalars::sec2day, mod_scalars::tdays, mod_biology::vp0, mod_biology::wldet, mod_biology::wphy, mod_biology::wsdet, mod_biology::zooae_n, mod_biology::zoobm, mod_biology::zoocn, mod_biology::zooer, mod_biology::zoogr, mod_biology::zoomin, and mod_biology::zoomr.

Here is the call graph for this function:

◆ hypoxia_srm_tile()

subroutine biology_mod::hypoxia_srm_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) ubk,
integer, intent(in) ubt,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) nstp,
integer, intent(in) nnew,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) rmask,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) rmask_full,
real(r8), dimension(lbi:ubi,lbj:ubj,ubk), intent(in) hz,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) uwind,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) vwind,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) sustr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) svstr,
real(r8), dimension(lbi:,lbj:,:), intent(in) respiration,
real(r8), dimension(lbi:ubi,lbj:ubj,ndbio2d), intent(inout) diabio2d,
real(r8), dimension(lbi:ubi,lbj:ubj,ubk,3,ubt), intent(inout) t )
private

Definition at line 122 of file hypoxia_srm.h.

143!-----------------------------------------------------------------------
144!
145 USE mod_param
146 USE mod_biology
147 USE mod_ncparam
148 USE mod_scalars
149!
150! Imported variable declarations.
151!
152 integer, intent(in) :: ng, tile
153 integer, intent(in) :: LBi, UBi, LBj, UBj, UBk, UBt
154 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
155 integer, intent(in) :: nstp, nnew
156
157#ifdef ASSUMED_SHAPE
158# ifdef MASKING
159 real(r8), intent(in) :: rmask(LBi:,LBj:)
160# if defined WET_DRY && defined DIAGNOSTICS_BIO
161 real(r8), intent(in) :: rmask_full(LBi:,LBj:)
162# endif
163# endif
164 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
165# ifdef BULK_FLUXES
166 real(r8), intent(in) :: Uwind(LBi:,LBj:)
167 real(r8), intent(in) :: Vwind(LBi:,LBj:)
168# else
169 real(r8), intent(in) :: sustr(LBi:,LBj:)
170 real(r8), intent(in) :: svstr(LBi:,LBj:)
171# endif
172 real(r8), intent(in) :: respiration(LBi:,LBj:,:)
173# ifdef DIAGNOSTICS_BIO
174 real(r8), intent(inout) :: DiaBio2d(LBi:,LBj:,:)
175# endif
176 real(r8), intent(inout) :: t(LBi:,LBj:,:,:,:)
177#else
178# ifdef MASKING
179 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
180# if defined WET_DRY && defined DIAGNOSTICS_BIO
181 real(r8), intent(in) :: rmask_full(LBi:UBi,LBj:UBj)
182# endif
183# endif
184 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,UBk)
185# ifdef BULK_FLUXES
186 real(r8), intent(in) :: Uwind(LBi:UBi,LBj:UBj)
187 real(r8), intent(in) :: Vwind(LBi:UBi,LBj:UBj)
188# else
189 real(r8), intent(in) :: sustr(LBi:UBi,LBj:UBj)
190 real(r8), intent(in) :: svstr(LBi:UBi,LBj:UBj)
191# endif
192 real(r8), intent(inout) :: repiration(LBi:UBi,LBj:UBj,UBk)
193# ifdef DIAGNOSTICS_BIO
194 real(r8), intent(inout) :: DiaBio2d(LBi:UBi,LBj:UBj,NDbio2d)
195# endif
196 real(r8), intent(inout) :: t(LBi:UBi,LBj:UBj,UBk,3,UBt)
197#endif
198!
199! Local variable declarations.
200!
201 integer :: Iter, i, ibio, itrc, j, k
202
203 real(r8) :: u10squ
204
205 real(r8), parameter :: OA0 = 2.00907_r8 ! Oxygen
206 real(r8), parameter :: OA1 = 3.22014_r8 ! saturation
207 real(r8), parameter :: OA2 = 4.05010_r8 ! coefficients
208 real(r8), parameter :: OA3 = 4.94457_r8
209 real(r8), parameter :: OA4 =-0.256847_r8
210 real(r8), parameter :: OA5 = 3.88767_r8
211 real(r8), parameter :: OB0 =-0.00624523_r8
212 real(r8), parameter :: OB1 =-0.00737614_r8
213 real(r8), parameter :: OB2 =-0.0103410_r8
214 real(r8), parameter :: OB3 =-0.00817083_r8
215 real(r8), parameter :: OC0 =-0.000000488682_r8
216 real(r8), parameter :: rOxNO3= 8.625_r8 ! 138/16
217 real(r8), parameter :: rOxNH4= 6.625_r8 ! 106/16
218 real(r8) :: l2mol = 1000.0_r8/22.3916_r8 ! liter to mol
219
220 real(r8) :: TS, AA
221
222 real(r8) :: cff, cff1, cff2, cff3, cff4
223 real(r8) :: dtdays
224
225#ifdef DIAGNOSTICS_BIO
226 real(r8) :: fiter
227#endif
228
229 real(r8) :: SchmidtN_Ox, O2satu, O2_Flux
230
231 real(r8), dimension(IminS:ImaxS,N(ng),NT(ng)) :: Bio
232 real(r8), dimension(IminS:ImaxS,N(ng),NT(ng)) :: Bio_old
233
234 real(r8), dimension(IminS:ImaxS,N(ng)) :: Hz_inv
235
236#include "set_bounds.h"
237
238#ifdef DIAGNOSTICS_BIO
239!
240!-----------------------------------------------------------------------
241! If appropriate, initialize time-averaged diagnostic arrays.
242!-----------------------------------------------------------------------
243!
244 IF (((iic(ng).gt.ntsdia(ng)).and. &
245 & (mod(iic(ng),ndia(ng)).eq.1)).or. &
246 & ((iic(ng).ge.ntsdia(ng)).and.(ndia(ng).eq.1)).or. &
247 & ((nrrec(ng).gt.0).and.(iic(ng).eq.ntstart(ng)))) THEN
248 DO ivar=1,ndbio2d
249 DO j=jstr,jend
250 DO i=istr,iend
251 diabio2d(i,j,ivar)=0.0_r8
252 END DO
253 END DO
254 END DO
255 END IF
256#endif
257!
258!-----------------------------------------------------------------------
259! Add biological Source/Sink terms.
260!-----------------------------------------------------------------------
261!
262! Avoid computing source/sink terms if no biological iterations.
263!
264 IF (bioiter(ng).le.0) RETURN
265!
266! Set time-stepping according to the number of iterations.
267!
268 dtdays=dt(ng)*sec2day/real(bioiter(ng),r8)
269
270#ifdef DIAGNOSTICS_BIO
271!
272! A factor to account for the number of iterations in accumulating
273! diagnostic rate variables.
274!
275 fiter=1.0_r8/real(bioiter(ng),r8)
276#endif
277!
278! Compute inverse thickness to avoid repeated divisions.
279!
280 j_loop : DO j=jstr,jend
281 DO k=1,n(ng)
282 DO i=istr,iend
283 hz_inv(i,k)=1.0_r8/hz(i,j,k)
284 END DO
285 END DO
286!
287! Extract biological variables from tracer arrays, place them into
288! scratch arrays, and restrict their values to be positive definite.
289! At input, all tracers (index nnew) from predictor step have
290! transport units (m Tunits) since we do not have yet the new
291! values for zeta and Hz. These are known after the 2D barotropic
292! time-stepping.
293!
294 DO itrc=1,nbt
295 ibio=idbio(itrc)
296 DO k=1,n(ng)
297 DO i=istr,iend
298 bio_old(i,k,ibio)=max(0.0_r8,t(i,j,k,nstp,ibio))
299 bio(i,k,ibio)=bio_old(i,k,ibio)
300 END DO
301 END DO
302 END DO
303!
304! Extract potential temperature and salinity.
305!
306 DO k=1,n(ng)
307 DO i=istr,iend
308 bio(i,k,itemp)=min(t(i,j,k,nstp,itemp),35.0_r8)
309 bio(i,k,isalt)=max(t(i,j,k,nstp,isalt), 0.0_r8)
310 END DO
311 END DO
312!
313!=======================================================================
314! Start internal iterations to achieve convergence of the nonlinear
315! backward-implicit solution.
316!=======================================================================
317!
318! The iterative loop below is to iterate toward an universal Backward-
319! Euler treatment of all terms. So if there are oscillations in the
320! system, they are only physical oscillations. These iterations,
321! however, do not improve the accuaracy of the solution.
322!
323 iter_loop: DO iter=1,bioiter(ng)
324!
325!-----------------------------------------------------------------------
326! Total biological respiration.
327!-----------------------------------------------------------------------
328!
329! The 3D respiration rate (millimole/m3/day) is processed as an input
330! field elsewhere. It can be read from a forcing NetCDF file and
331! interpolate between time snapshots or set with analytical functions.
332! It is assumed that has zero values in places with no respiration.
333!
334 DO k=1,n(ng)
335 DO i=istr,iend
336 cff1=dtdays*respiration(i,j,k)
337 bio(i,k,ioxyg)=bio(i,k,ioxyg)-cff1
338 bio(i,k,ioxyg)=max(bio(i,k,ioxyg),0.0_r8)
339 END DO
340 END DO
341
342#ifdef SURFACE_DO_SATURATION
343!
344!-----------------------------------------------------------------------
345! Setting surface layer O2 to saturation.
346!-----------------------------------------------------------------------
347!
348! Calculate O2 saturation concentration using Garcia and Gordon
349! L and O (1992) formula, (EXP(AA) is in ml/l).
350!
351 k=n(ng)
352 DO i=istr,iend
353 ts=log((298.15_r8-bio(i,k,itemp))/ &
354 & (273.15_r8+bio(i,k,itemp)))
355 aa=oa0+ts*(oa1+ts*(oa2+ts*(oa3+ts*(oa4+ts*oa5))))+ &
356 & bio(i,k,isalt)*(ob0+ts*(ob1+ts*(ob2+ts*ob3)))+ &
357 & oc0*bio(i,k,isalt)*bio(i,k,isalt)
358 o2satu=l2mol*exp(aa) ! convert from ml/l to mmol/m3
359 bio(i,k,ioxyg)=o2satu
360 END DO
361#else
362!
363!-----------------------------------------------------------------------
364! Surface O2 gas exchange (same as Fennel model).
365!-----------------------------------------------------------------------
366!
367! Compute surface O2 gas exchange.
368!
369 cff2=rho0*550.0_r8
370 cff3=dtdays*0.31_r8*24.0_r8/100.0_r8
371 k=n(ng)
372 DO i=istr,iend
373!
374! Compute O2 transfer velocity : u10squared (u10 in m/s)
375!
376# ifdef BULK_FLUXES
377 u10squ=uwind(i,j)*uwind(i,j)+vwind(i,j)*vwind(i,j)
378# else
379 u10squ=cff2*sqrt((0.5_r8*(sustr(i,j)+sustr(i+1,j)))**2+ &
380 & (0.5_r8*(svstr(i,j)+svstr(i,j+1)))**2)
381# endif
382# ifdef OCMIP_OXYGEN_SC
383!
384! Alternative formulation for Schmidt number (Sc will be slightly
385! smaller up to about 35 C): Compute the Schmidt number of oxygen
386! in seawater using the formulation proposed by Keeling et al.
387! (1998, Global Biogeochem. Cycles, 12, 141-163). Input temperature
388! in Celsius.
389!
390 schmidtn_ox=1638.0_r8- &
391 & bio(i,k,itemp)*(81.83_r8- &
392 & bio(i,k,itemp)* &
393 & (1.483_r8- &
394 & bio(i,k,itemp)*0.008004_r8))
395# else
396!
397! Calculate the Schmidt number for O2 in sea water (Wanninkhof, 1992).
398!
399 schmidtn_ox=1953.4_r8- &
400 & bio(i,k,itemp)*(128.0_r8- &
401 & bio(i,k,itemp)* &
402 & (3.9918_r8- &
403 & bio(i,k,itemp)*0.050091_r8))
404# endif
405 cff4=cff3*u10squ*sqrt(660.0_r8/schmidtn_ox)
406!
407! Calculate O2 saturation concentration using Garcia and Gordon
408! L and O (1992) formula, (EXP(AA) is in ml/l).
409!
410 ts=log((298.15_r8-bio(i,k,itemp))/ &
411 & (273.15_r8+bio(i,k,itemp)))
412 aa=oa0+ts*(oa1+ts*(oa2+ts*(oa3+ts*(oa4+ts*oa5))))+ &
413 & bio(i,k,isalt)*(ob0+ts*(ob1+ts*(ob2+ts*ob3)))+ &
414 & oc0*bio(i,k,isalt)*bio(i,k,isalt)
415!
416! Convert from ml/l to mmol/m3.
417!
418 o2satu=l2mol*exp(aa)
419!
420! Add in O2 gas exchange.
421!
422 o2_flux=cff4*(o2satu-bio(i,k,ioxyg))
423 bio(i,k,ioxyg)=bio(i,k,ioxyg)+ &
424 & o2_flux*hz_inv(i,k)
425# ifdef DIAGNOSTICS_BIO
426 diabio2d(i,j,io2fx)=diabio2d(i,j,io2fx)+ &
427# ifdef WET_DRY
428 & rmask_full(i,j)* &
429# endif
430 & o2_flux*fiter
431# endif
432 END DO
433#endif
434 END DO iter_loop
435!
436!-----------------------------------------------------------------------
437! Update global tracer variables: Add increment due to BGC processes
438! to tracer array in time index "nnew". Index "nnew" is solution after
439! advection and mixing and has transport units (m Tunits) hence the
440! increment is multiplied by Hz. Notice that we need to subtract
441! original values "Bio_old" at the top of the routine to just account
442! for the concentractions affected by BGC processes. This also takes
443! into account any constraints (non-negative concentrations) specified
444! before entering BGC kernel. If "Bio" were unchanged by BGC processes,
445! the increment would be exactly zero. Notice that final tracer values,
446! t(:,:,:,nnew,:) are not bounded >=0 so that we can preserve total
447! inventory of nutrients even when advection causes tracer
448! concentration to go negative.
449!-----------------------------------------------------------------------
450!
451 DO itrc=1,nbt
452 ibio=idbio(itrc)
453 DO k=1,n(ng)
454 DO i=istr,iend
455 cff=bio(i,k,ibio)-bio_old(i,k,ibio)
456 t(i,j,k,nnew,ibio)=t(i,j,k,nnew,ibio)+cff*hz(i,j,k)
457 END DO
458 END DO
459 END DO
460 END DO j_loop
461!
462 RETURN

References mod_biology::bioiter, mod_scalars::dt, mod_biology::idbio, mod_scalars::iic, mod_biology::io2fx, mod_biology::ioxyg, mod_scalars::isalt, mod_scalars::itemp, mod_param::n, mod_param::nbt, mod_scalars::ndia, mod_scalars::nrrec, mod_scalars::ntsdia, mod_scalars::ntstart, mod_scalars::rho0, and mod_scalars::sec2day.

◆ nemuro_tile()

subroutine biology_mod::nemuro_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) ubk,
integer, intent(in) ubt,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) nstp,
integer, intent(in) nnew,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) rmask,
real(r8), dimension(lbi:ubi,lbj:ubj,ubk), intent(in) hz,
real(r8), dimension(lbi:ubi,lbj:ubj,ubk), intent(in) z_r,
real(r8), dimension(lbi:ubi,lbj:ubj,0:ubk), intent(in) z_w,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) srflx,
real(r8), dimension(lbi:ubi,lbj:ubj,ubk,3,ubt), intent(inout) t )
private

Definition at line 100 of file nemuro.h.

110!-----------------------------------------------------------------------
111!
112 USE mod_param
113 USE mod_biology
114 USE mod_ncparam
115 USE mod_scalars
116!
117! Imported variable declarations.
118!
119 integer, intent(in) :: ng, tile
120 integer, intent(in) :: LBi, UBi, LBj, UBj, UBk, UBt
121 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
122 integer, intent(in) :: nstp, nnew
123
124#ifdef ASSUMED_SHAPE
125# ifdef MASKING
126 real(r8), intent(in) :: rmask(LBi:,LBj:)
127# endif
128 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
129 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
130 real(r8), intent(in) :: z_w(LBi:,LBj:,0:)
131 real(r8), intent(in) :: srflx(LBi:,LBj:)
132 real(r8), intent(inout) :: t(LBi:,LBj:,:,:,:)
133#else
134# ifdef MASKING
135 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
136# endif
137 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,UBk)
138 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,UBk)
139 real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:UBk)
140 real(r8), intent(in) :: srflx(LBi:UBi,LBj:UBj)
141 real(r8), intent(inout) :: t(LBi:UBi,LBj:UBj,UBk,3,UBt)
142#endif
143!
144! Local variable declarations.
145!
146 integer, parameter :: Nsink = 2
147
148 integer :: Iter, ibio, indx, isink, itime, itrc, iTrcMax
149 integer :: i, j, k, ks
150
151 integer, dimension(Nsink) :: idsink
152
153 real(r8), parameter :: MinVal = 1.0e-6_r8
154
155 real(r8) :: AttL, AttS, IrrL, IrrS, KappaL, KappaS
156 real(r8) :: dtdays, dz
157 real(r8) :: GppAPS, GppAPL, GppNPS, GppNPL, GppPS, GppPL
158 real(r8) :: GraPL2ZL, GraPL2ZP, GraPS2ZL, GraPS2ZS
159 real(r8) :: GraZL2ZP, GraZS2ZL, GraZS2ZP
160 real(r8) :: EgeZL, EgeZP, EgeZS
161 real(r8) :: ExcPL, ExcPS, ExcZL, ExcZP, ExcZS
162 real(r8) :: MorPL, MorPS
163 real(r8) :: ResPL, ResPS
164 real(r8) :: RnewL, RnewS
165 real(r8) :: cff, cff1, cff2, cff3, cff4, cff5, cff6, cff7
166 real(r8) :: fac, fac1, fac2, fac3, fac4, fac5, fac6, fac7
167 real(r8) :: cffL, cffR, cu, dltL, dltR
168
169 real(r8), dimension(Nsink) :: Wbio
170
171 integer, dimension(IminS:ImaxS,N(ng)) :: ksource
172
173 real(r8), dimension(IminS:ImaxS) :: PARsur
174
175 real(r8), dimension(NT(ng),2) :: BioTrc
176
177 real(r8), dimension(IminS:ImaxS,N(ng),NT(ng)) :: Bio
178 real(r8), dimension(IminS:ImaxS,N(ng),NT(ng)) :: Bio_old
179
180 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: FC
181
182 real(r8), dimension(IminS:ImaxS,N(ng)) :: Hz_inv
183 real(r8), dimension(IminS:ImaxS,N(ng)) :: Hz_inv2
184 real(r8), dimension(IminS:ImaxS,N(ng)) :: Hz_inv3
185 real(r8), dimension(IminS:ImaxS,N(ng)) :: LightL
186 real(r8), dimension(IminS:ImaxS,N(ng)) :: LightS
187 real(r8), dimension(IminS:ImaxS,N(ng)) :: WL
188 real(r8), dimension(IminS:ImaxS,N(ng)) :: WR
189 real(r8), dimension(IminS:ImaxS,N(ng)) :: bL
190 real(r8), dimension(IminS:ImaxS,N(ng)) :: bR
191 real(r8), dimension(IminS:ImaxS,N(ng)) :: qc
192
193#include "set_bounds.h"
194!
195!-----------------------------------------------------------------------
196! Add biological Source/Sink terms.
197!-----------------------------------------------------------------------
198!
199! Avoid computing source/sink terms if no biological iterations.
200!
201 IF (bioiter(ng).le.0) RETURN
202!
203! Set time-stepping size (days) according to the number of iterations.
204!
205 dtdays=dt(ng)*sec2day/real(bioiter(ng),r8)
206!
207! Set vertical sinking indentification vector.
208!
209 idsink(1)=ipon_ ! particulate organic nitrogen
210 idsink(2)=iopal ! particulate organic silica
211!
212! Set vertical sinking velocity vector in the same order as the
213! identification vector, IDSINK.
214!
215 wbio(1)=setvpon(ng) ! particulate organic nitrogen
216 wbio(2)=setvopal(ng) ! particulate organic silica
217!
218! Compute inverse thickness to avoid repeated divisions.
219!
220 j_loop : DO j=jstr,jend
221 DO k=1,n(ng)
222 DO i=istr,iend
223 hz_inv(i,k)=1.0_r8/hz(i,j,k)
224 END DO
225 END DO
226 DO k=1,n(ng)-1
227 DO i=istr,iend
228 hz_inv2(i,k)=1.0_r8/(hz(i,j,k)+hz(i,j,k+1))
229 END DO
230 END DO
231 DO k=2,n(ng)-1
232 DO i=istr,iend
233 hz_inv3(i,k)=1.0_r8/(hz(i,j,k-1)+hz(i,j,k)+hz(i,j,k+1))
234 END DO
235 END DO
236!
237! Extract biological variables from tracer arrays, place them into
238! scratch arrays, and restrict their values to be positive definite.
239! At input, all tracers (index nnew) from predictor step have
240! transport units (m Tunits) since we do not have yet the new
241! values for zeta and Hz. These are known after the 2D barotropic
242! time-stepping.
243!
244 DO itrc=1,nbt
245 ibio=idbio(itrc)
246 DO k=1,n(ng)
247 DO i=istr,iend
248 bio_old(i,k,ibio)=max(0.0_r8,t(i,j,k,nstp,ibio))
249 bio(i,k,ibio)=bio_old(i,k,ibio)
250 END DO
251 END DO
252 END DO
253!
254! Extract potential temperature and salinity.
255!
256 DO k=1,n(ng)
257 DO i=istr,iend
258 bio(i,k,itemp)=t(i,j,k,nstp,itemp)
259 END DO
260 END DO
261!
262! Calculate surface Photosynthetically Available Radiation (PAR). The
263! net shortwave radiation is scaled back to Watts/m2 and multiplied by
264! the fraction that is photosynthetically available, PARfrac.
265!
266 DO i=istr,iend
267 parsur(i)=parfrac(ng)*srflx(i,j)*rho0*cp
268 END DO
269!
270!=======================================================================
271! Start internal iterations to achieve convergence of the nonlinear
272! backward-implicit solution.
273!=======================================================================
274!
275! During the iterative procedure a series of fractional time steps are
276! performed in a chained mode (splitting by different biological
277! conversion processes) in sequence of the main food chain. In all
278! stages the concentration of the component being consumed is treated
279! in a fully implicit manner, so the algorithm guarantees non-negative
280! values, no matter how strong the concentration of active consuming
281! component (Phytoplankton or Zooplankton). The overall algorithm,
282! as well as any stage of it, is formulated in conservative form
283! (except explicit sinking) in sense that the sum of concentration of
284! all components is conserved.
285!
286! In the implicit algorithm, we have for example (N: nutrient,
287! P: phytoplankton),
288!
289! N(new) = N(old) - uptake * P(old) uptake = mu * N / (Kn + N)
290! {Michaelis-Menten}
291! below, we set
292! The N in the numerator of
293! cff = mu * P(old) / (Kn + N(old)) uptake is treated implicitly
294! as N(new)
295!
296! so the time-stepping of the equations becomes:
297!
298! N(new) = N(old) / (1 + cff) (1) when substracting a sink term,
299! consuming, divide by (1 + cff)
300! and
301!
302! P(new) = P(old) + cff * N(new) (2) when adding a source term,
303! growing, add (cff * source)
304!
305! Notice that if you substitute (1) in (2), you will get:
306!
307! P(new) = P(old) + cff * N(old) / (1 + cff) (3)
308!
309! If you add (1) and (3), you get
310!
311! N(new) + P(new) = N(old) + P(old)
312!
313! implying conservation regardless how "cff" is computed. Therefore,
314! this scheme is unconditionally stable regardless of the conversion
315! rate. It does not generate negative values since the constituent
316! to be consumed is always treated implicitly. It is also biased
317! toward damping oscillations.
318!
319! The iterative loop below is to iterate toward an universal Backward-
320! Euler treatment of all terms. So if there are oscillations in the
321! system, they are only physical oscillations. These iterations,
322! however, do not improve the accuaracy of the solution.
323!
324 iter_loop: DO iter=1,bioiter(ng)
325!
326! Compute light attenuation as function of depth.
327!
328 cff1=1.0/vmaxs(ng)
329 cff2=1.0/vmaxl(ng)
330 DO i=istr,iend
331 atts=parsur(i)
332 attl=parsur(i)
333 IF (parsur(i).gt.0.0_r8) THEN ! day time
334 DO k=n(ng),1,-1
335!
336! Attenuate the light to the center of the grid cell using the
337! Platt et al. (1980) photoinhibition formulation. Here, AttSW is
338! the light attenuation due to seawater and AttPS and AttPL is the
339! attenuation due to Small and Large Phytoplankton (self-shading
340! coefficient).
341!
342 dz=0.5_r8*(z_w(i,j,k)-z_w(i,j,k-1))
343 kappas=attsw(ng)+ &
344 & attps(ng)*(bio(i,k,isphy)+bio(i,k,ilphy))
345 kappal=attsw(ng)+ &
346 & attpl(ng)*(bio(i,k,isphy)+bio(i,k,ilphy))
347 irrs=exp(-kappas*dz)
348 irrl=exp(-kappal*dz)
349 atts=atts*irrs
350 attl=attl*irrl
351 lights(i,k)=(1.0_r8-exp(-alphaps(ng)*atts*cff1))* &
352 & exp(-betaps(ng)*atts*cff1)
353 lightl(i,k)=(1.0_r8-exp(-alphapl(ng)*attl*cff2))* &
354 & exp(-betapl(ng)*attl*cff2)
355!
356! Attenuate the light to the bottom of the grid cell.
357!
358 atts=atts*irrs
359 attl=attl*irrl
360 END DO
361 ELSE ! night time
362 DO k=1,n(ng)
363 lights(i,k)=0.0_r8
364 lightl(i,k)=0.0_r8
365 END DO
366 END IF
367 END DO
368!
369!-----------------------------------------------------------------------
370! Phytoplankton primary productivity.
371!-----------------------------------------------------------------------
372!
373! Gross primary production of Small Phytoplankton consisting of
374! nutrient uptake (NO3 and NH4) terms, temperature-dependend term,
375! and light limitation term. The Michaelis-Menten curve is used to
376! describe the change in uptake rate as a function of nutrient
377! concentration.
378!
379 cff=dtdays*vmaxs(ng)
380 DO k=1,n(ng)
381 DO i=istr,iend
382!
383! Small Phytoplankton gross primary productivity, GppPS.
384!
385 cff1=cff*exp(kgpps(ng)*bio(i,k,itemp))*lights(i,k)* &
386 & bio(i,k,isphy)
387 cff2=cff1*exp(-pusais(ng)*bio(i,k,inh4_))/ &
388 & (kno3s(ng)+bio(i,k,ino3_))
389 cff3=cff1/(knh4s(ng)+bio(i,k,inh4_))
390 bio(i,k,ino3_)=bio(i,k,ino3_)/(1.0_r8+cff2)
391 bio(i,k,inh4_)=bio(i,k,inh4_)/(1.0_r8+cff3)
392 gppnps=bio(i,k,ino3_)*cff2
393 gppaps=bio(i,k,inh4_)*cff3
394 gppps=gppnps+gppaps
395 bio(i,k,isphy)=bio(i,k,isphy)+gppps
396!
397! Small Phytoplankton respiration rate, ResPS, assumed to be
398! proportional to biomass. Use ratio of NO3 uptake to total update
399! (NO3 + NH4) to compute respiration contributions.
400!
401 rnews=gppnps/max(minval,gppps)
402 cff4=dtdays*resps0(ng)*exp(kresps(ng)*bio(i,k,itemp))
403 bio(i,k,isphy)=bio(i,k,isphy)/(1.0_r8+cff4)
404 resps=bio(i,k,isphy)*cff4
405 bio(i,k,ino3_)=bio(i,k,ino3_)+resps*rnews
406 bio(i,k,inh4_)=bio(i,k,inh4_)+resps*(1.0_r8-rnews)
407!
408! Small Phytoplankton extracellular excrection rate, ExcPS, assumed to
409! be proportional to production.
410!
411 excps=gppps*gammas(ng)
412 bio(i,k,isphy)=bio(i,k,isphy)-excps
413 bio(i,k,idon_)=bio(i,k,idon_)+excps
414 END DO
415 END DO
416!
417! Gross primary production of Large Phytoplankton consisting of
418! nutrient uptake (NO3, NH4, Silicate) terms, temperature-dependend
419! term, and light limitation term. Notice that there is a silicate
420! limiting term (which complicates the implicit algorithm). Again,
421! the Michaelis-Menten curve is used to describe the change in
422! uptake rate as a function of nutrient concentration.
423!
424 cff=dtdays*vmaxl(ng)
425 fac1=1.0/rsin(ng)
426 fac2=dtdays*respl0(ng)
427 DO k=1,n(ng)
428 DO i=istr,iend
429!
430! Large Phytoplankton gross primary productivity, GppPL. Notice that
431! the primary productivity is limited by previous time-step silicate
432! concentration.
433!
434 cff1=cff*exp(kgppl(ng)*bio(i,k,itemp))*lightl(i,k)* &
435 & bio(i,k,ilphy)
436 cff2=exp(-pusail(ng)*bio(i,k,inh4_))/ &
437 & (kno3l(ng)+bio(i,k,ino3_))
438 cff3=1.0_r8/(knh4l(ng)+bio(i,k,inh4_))
439 cff4=cff2*bio(i,k,ino3_)
440 cff5=cff3*bio(i,k,inh4_)
441 cff6=bio(i,k,isioh)/(ksil(ng)+bio(i,k,isioh))
442 cff7=cff6/max(minval,cff4+cff5)
443 cff4=cff1*cff2*min(1.0_r8,cff7) ! Si limitation on N03
444 cff5=cff1*cff3*min(1.0_r8,cff7) ! Si limitation on NH4
445 bio(i,k,ino3_)=bio(i,k,ino3_)/(1.0_r8+cff4)
446 bio(i,k,inh4_)=bio(i,k,inh4_)/(1.0_r8+cff5)
447 gppnpl=bio(i,k,ino3_)*cff4
448 gppapl=bio(i,k,inh4_)*cff5
449 gpppl=gppnpl+gppapl
450 bio(i,k,ilphy)=bio(i,k,ilphy)+gpppl
451 bio(i,k,isioh)=bio(i,k,isioh)-gpppl*rsin(ng)
452!
453! Large Phytoplankton respiration rate, ResPL, assumed to be
454! proportional to biomass. Use ratio of NO3 uptake to total update
455! (NO3 + NH4) to compute respiration contributions. Use Si:N ratio to
456! compute SiOH4 contribution.
457!
458 rnewl=gppnpl/max(minval,gpppl)
459 cff7=fac2*exp(krespl(ng)*bio(i,k,itemp))
460 bio(i,k,ilphy)=bio(i,k,ilphy)/(1.0_r8+cff7)
461 respl=bio(i,k,ilphy)*cff7
462 bio(i,k,ino3_)=bio(i,k,ino3_)+respl*rnewl
463 bio(i,k,inh4_)=bio(i,k,inh4_)+respl*(1.0_r8-rnewl)
464 bio(i,k,isioh)=bio(i,k,isioh)+respl*rsin(ng)
465!
466! Large Phytoplankton extracellular excrection rate, ExcPL, assumed to
467! be proportional to production.
468!
469 excpl=gpppl*gammal(ng)
470 bio(i,k,ilphy)=bio(i,k,ilphy)-excpl
471 bio(i,k,idon_)=bio(i,k,idon_)+excpl
472 bio(i,k,isioh)=bio(i,k,isioh)+excpl*rsin(ng)
473 END DO
474 END DO
475!
476!-----------------------------------------------------------------------
477! Phytoplankton mortality to particulate organic nitrogen.
478!-----------------------------------------------------------------------
479!
480 fac1=dtdays*morps0(ng)
481 fac2=dtdays*morpl0(ng)
482 DO k=1,n(ng)
483 DO i=istr,iend
484 cff1=fac1*bio(i,k,isphy)*exp(kmorps(ng)*bio(i,k,itemp))
485 cff2=fac2*bio(i,k,ilphy)*exp(kmorpl(ng)*bio(i,k,itemp))
486 bio(i,k,isphy)=bio(i,k,isphy)/(1.0_r8+cff1)
487 bio(i,k,ilphy)=bio(i,k,ilphy)/(1.0_r8+cff2)
488 morps=bio(i,k,isphy)*cff1
489 morpl=bio(i,k,ilphy)*cff2
490 bio(i,k,ipon_)=bio(i,k,ipon_)+morps+morpl
491 bio(i,k,iopal)=bio(i,k,iopal)+morpl*rsin(ng)
492 END DO
493 END DO
494!
495!-----------------------------------------------------------------------
496! Zooplankton grazing, egestion and excretion.
497!-----------------------------------------------------------------------
498
499#if defined IVLEV_EXPLICIT
500!
501! The rate of grazing by the zooplankton is modeled using an Ivlev
502! equation with a feeding threshold using an explicit (non-conserving)
503! algorithm to the original formulation. Notice that term is forced to
504! be positive using a MAX function.
505!
506#elif defined HOLLING_GRAZING
507!
508! The rate of grazing by the zooplankton is modeled using a Holling-
509! type s-shaped curve. It is known to be numerically more stable and
510! allows an implicit discretization.
511!
512! P(new) = P(old) - dt*mu*[P(old)/(Kp + P(old)^2)]*P(new)*Z(old)
513!
514! The implicit grazing term is then:
515!
516! P(new) = P(old) / (1 + G)
517!
518! were the grazing rate, G, is:
519!
520! G = dt * mu * [P(old)/(Kp + P(old)^2)] * Z(old)
521!
522#else
523# define IVLEV_IMPLICIT
524!
525! The rate of grazing by the zooplankton is modeled using an Ivlev
526! equation with a feeding threshold. An implicit algorithm is
527! achieved by multiplying grazing term by a unity factor, alpha:
528!
529! alpha = 1 = P(new)/(P(old)+deltaP)
530!
531! where
532!
533! deltaP = P(new) - P(old) = - dt*mu*[1-EXP(lambda*P(old))]
534!
535! The factor alpha can be approximated using Taylor series to:
536!
537! alpha = [P(new) / P(old)] * [1 - deltaP/P(old)]
538!
539! The discretized grazing term is then:
540!
541! P(new) = P(old) - dt*mu*[1-EXP(lambda*P)] * alpha * Z(old)
542!
543! Which can be approximated with an implicit algorithm to:
544!
545! P(new) = P(old) / (1 + G)
546!
547! were the grazing rate, G, is:
548!
549! G = [1 + P(old)/(dt*mu*(1 - EXP(lambda*P(old))))] * Z(old)
550!
551#endif
552 fac1=dtdays*grmaxsps(ng)
553 fac2=dtdays*grmaxlps(ng)
554 fac3=dtdays*grmaxlpl(ng)
555 fac4=dtdays*grmaxlzs(ng)
556 fac5=dtdays*grmaxppl(ng)
557 fac6=dtdays*grmaxpzs(ng)
558 fac7=dtdays*grmaxpzl(ng)
559 DO k=1,n(ng)
560 DO i=istr,iend
561!
562! Temperature-dependent term (Q10).
563!
564 cff1=exp(kgras(ng)*bio(i,k,itemp))
565 cff2=exp(kgral(ng)*bio(i,k,itemp))
566 cff3=exp(kgrap(ng)*bio(i,k,itemp))
567!
568! Small Zooplankton grazing on Small Phytoplankton, GraPS2ZS.
569!
570#if defined IVLEV_EXPLICIT
571 cff4=1.0_r8-exp(lams(ng)*(ps2zsstar(ng)-bio(i,k,isphy)))
572 graps2zs=fac1*cff1*max(0.0_r8,cff4)*bio(i,k,iszoo)
573 bio(i,k,isphy)=bio(i,k,isphy)-graps2zs
574 bio(i,k,iszoo)=bio(i,k,iszoo)+graps2zs
575#else
576# ifdef HOLLING_GRAZING
577 cff4=1.0_r8/(kps2zs(ng)+bio(i,k,isphy)*bio(i,k,isphy))
578 cff=fac1*cff1*cff4*bio(i,k,iszoo)*bio(i,k,isphy)
579# elif defined IVLEV_IMPLICIT
580 cff4=1.0_r8-exp(lams(ng)*(ps2zsstar(ng)-bio(i,k,isphy)))
581 cff5=1.0_r8/(fac1*cff4)
582 cff=(1.0_r8+bio(i,k,isphy)*cff5)*cff1*bio(i,k,iszoo)
583# endif
584 bio(i,k,isphy)=bio(i,k,isphy)/(1.0_r8+cff)
585 graps2zs=cff*bio(i,k,isphy)
586 bio(i,k,iszoo)=bio(i,k,iszoo)+graps2zs
587#endif
588!
589! Large Zooplankton grazing on Small Phytoplankton, GraPS2ZL.
590!
591#if defined IVLEV_EXPLICIT
592 cff4=1.0_r8-exp(laml(ng)*(ps2zlstar(ng)-bio(i,k,isphy)))
593 graps2zl=fac2*cff2*max(0.0_r8,cff4)*bio(i,k,ilzoo)
594 bio(i,k,isphy)=bio(i,k,isphy)-graps2zl
595 bio(i,k,ilzoo)=bio(i,k,ilzoo)+graps2zl
596#else
597# ifdef HOLLING_GRAZING
598 cff4=1.0_r8/(kps2zl(ng)+bio(i,k,isphy)*bio(i,k,isphy))
599 cff=fac2*cff2*cff4*bio(i,k,ilzoo)*bio(i,k,isphy)
600# elif defined IVLEV_IMPLICIT
601 cff4=1.0_r8-exp(laml(ng)*(ps2zlstar(ng)-bio(i,k,isphy)))
602 cff5=1.0_r8/(fac2*cff4)
603 cff=(1.0_r8+bio(i,k,isphy)*cff5)*cff2*bio(i,k,ilzoo)
604# endif
605 bio(i,k,isphy)=bio(i,k,isphy)/(1.0_r8+cff)
606 graps2zl=cff*bio(i,k,isphy)
607 bio(i,k,ilzoo)=bio(i,k,ilzoo)+graps2zl
608#endif
609!
610! Large Zooplankton grazing on Large Phytoplankton, GraPL2ZL.
611!
612#if defined IVLEV_EXPLICIT
613 cff4=1.0_r8-exp(laml(ng)*(pl2zlstar(ng)-bio(i,k,ilphy)))
614 grapl2zl=fac3*cff2*max(0.0_r8,cff4)*bio(i,k,ilzoo)
615 bio(i,k,ilphy)=bio(i,k,ilphy)-grapl2zl
616 bio(i,k,ilzoo)=bio(i,k,ilzoo)+grapl2zl
617#else
618# ifdef HOLLING_GRAZING
619 cff4=1.0_r8/(kpl2zl(ng)+bio(i,k,ilphy)*bio(i,k,ilphy))
620 cff=fac3*cff2*cff4*bio(i,k,ilzoo)*bio(i,k,ilphy)
621# elif defined IVLEV_IMPLICIT
622 cff4=1.0_r8-exp(laml(ng)*(pl2zlstar(ng)-bio(i,k,ilphy)))
623 cff5=1.0_r8/(fac3*cff4)
624 cff=(1.0_r8+bio(i,k,ilphy)*cff5)*cff2*bio(i,k,ilzoo)
625# endif
626 bio(i,k,ilphy)=bio(i,k,ilphy)/(1.0_r8+cff)
627 grapl2zl=cff*bio(i,k,ilphy)
628 bio(i,k,ilzoo)=bio(i,k,ilzoo)+grapl2zl
629#endif
630!
631! Large Zooplankton grazing on Small Zooplankton, GraZS2ZL.
632!
633#if defined IVLEV_EXPLICIT
634 cff4=1.0_r8-exp(laml(ng)*(zs2zlstar(ng)-bio(i,k,iszoo)))
635 grazs2zl=fac4*cff2*max(0.0_r8,cff4)*bio(i,k,ilzoo)
636 bio(i,k,iszoo)=bio(i,k,iszoo)-grazs2zl
637 bio(i,k,ilzoo)=bio(i,k,ilzoo)+grazs2zl
638#else
639# ifdef HOLLING_GRAZING
640 cff4=1.0_r8/(kzs2zl(ng)+bio(i,k,iszoo)*bio(i,k,iszoo))
641 cff=fac4*cff2*cff4*bio(i,k,ilzoo)*bio(i,k,iszoo)
642# elif defined IVLEV_IMPLICIT
643 cff4=1.0_r8-exp(laml(ng)*(zs2zlstar(ng)-bio(i,k,iszoo)))
644 cff5=1.0_r8/(fac4*cff4)
645 cff=(1.0_r8+bio(i,k,isphy)*cff5)*cff2*bio(i,k,ilzoo)
646# endif
647 bio(i,k,iszoo)=bio(i,k,iszoo)/(1.0_r8+cff)
648 grazs2zl=cff*bio(i,k,iszoo)
649 bio(i,k,ilzoo)=bio(i,k,ilzoo)+grazs2zl
650#endif
651!
652! Predactor Zooplankton grazing on Large Phytoplankton, GraPL2ZP.
653!
654#if defined IVLEV_EXPLICIT
655 cff4=1.0_r8-exp(lamp(ng)*(pl2zpstar(ng)-bio(i,k,ilphy)))
656 cff5=exp(-pusaipl(ng)*(bio(i,k,ilzoo)+bio(i,k,iszoo)))
657 grapl2zp=fac5*cff3*cff5*max(0.0_r8,cff4)*bio(i,k,ipzoo)
658 bio(i,k,ilphy)=bio(i,k,ilphy)-grapl2zp
659 bio(i,k,ipzoo)=bio(i,k,ipzoo)+grapl2zp
660#else
661# ifdef HOLLING_GRAZING
662 cff4=1.0_r8/(kpl2zp(ng)+bio(i,k,ilphy)*bio(i,k,ilphy))
663 cff5=exp(-pusaipl(ng)*(bio(i,k,ilzoo)+bio(i,k,iszoo)))
664 cff=fac5*cff3*cff4*cff5*bio(i,k,ipzoo)*bio(i,k,ilphy)
665# elif defined IVLEV_IMPLICIT
666 cff4=1.0_r8-exp(lamp(ng)*(pl2zpstar(ng)-bio(i,k,ilphy)))
667 cff5=exp(-pusaipl(ng)*(bio(i,k,ilzoo)+bio(i,k,iszoo)))
668 cff6=1.0_r8/(fac5*cff4)
669 cff=(1.0_r8+bio(i,k,ilphy)*cff6)*cff3*cff5*bio(i,k,ipzoo)
670# endif
671 bio(i,k,ilphy)=bio(i,k,ilphy)/(1.0_r8+cff)
672 grapl2zp=cff*bio(i,k,ilphy)
673 bio(i,k,ipzoo)=bio(i,k,ipzoo)+grapl2zp
674#endif
675!
676! Predactory Zooplankton grazing on Small Zooplankton, GraZS2ZP.
677!
678#if defined IVLEV_EXPLICIT
679 cff4=1.0_r8-exp(lamp(ng)*(zs2zpstar(ng)-bio(i,k,iszoo)))
680 cff5=exp(-pusaizs(ng)*bio(i,k,ilzoo))
681 grazs2zp=fac6*cff3*cff5*max(0.0_r8,cff4)*bio(i,k,ipzoo)
682 bio(i,k,iszoo)=bio(i,k,iszoo)-grazs2zp
683 bio(i,k,ipzoo)=bio(i,k,ipzoo)+grazs2zp
684#else
685# ifdef HOLLING_GRAZING
686 cff4=1.0_r8/(kzs2zp(ng)+bio(i,k,iszoo)*bio(i,k,iszoo))
687 cff5=exp(-pusaizs(ng)*bio(i,k,ilzoo))
688 cff=fac6*cff3*cff4*cff5*bio(i,k,ipzoo)*bio(i,k,iszoo)
689# elif defined IVLEV_IMPLICIT
690 cff4=1.0_r8-exp(lamp(ng)*(zs2zpstar(ng)-bio(i,k,iszoo)))
691 cff5=exp(-pusaizs(ng)*bio(i,k,ilzoo))
692 cff6=1.0_r8/(fac6*cff4)
693 cff=(1.0_r8+bio(i,k,iszoo)*cff6)*cff3*cff5*bio(i,k,ipzoo)
694# endif
695 bio(i,k,iszoo)=bio(i,k,iszoo)/(1.0_r8+cff)
696 grazs2zp=cff*bio(i,k,iszoo)
697 bio(i,k,ipzoo)=bio(i,k,ipzoo)+grazs2zp
698#endif
699!
700! Predactory Zooplankton grazing on Large Zooplankton, GraZL2ZP.
701!
702#if defined IVLEV_EXPLICIT
703 cff4=1.0_r8-exp(lamp(ng)*(zl2zpstar(ng)-bio(i,k,ilzoo)))
704 grazl2zp=fac7*cff3*max(0.0_r8,cff4)*bio(i,k,ipzoo)
705 bio(i,k,ilzoo)=bio(i,k,ilzoo)-grazl2zp
706 bio(i,k,ipzoo)=bio(i,k,ipzoo)+grazl2zp
707#else
708# ifdef HOLLING_GRAZING
709 cff4=1.0_r8/(kzl2zp(ng)+bio(i,k,ilzoo)*bio(i,k,ilzoo))
710 cff=fac7*cff3*cff4*bio(i,k,ipzoo)*bio(i,k,ilzoo)
711# elif defined IVLEV_IMPLICIT
712 cff4=1.0_r8-exp(lamp(ng)*(zl2zpstar(ng)-bio(i,k,ilzoo)))
713 cff5=1.0_r8/(fac7*cff4)
714 cff=(1.0_r8+bio(i,k,ilzoo)*cff5)*cff3*bio(i,k,ipzoo)
715# endif
716 bio(i,k,ilzoo)=bio(i,k,ilzoo)/(1.0_r8+cff)
717 grazl2zp=cff*bio(i,k,ilzoo)
718 bio(i,k,ipzoo)=bio(i,k,ipzoo)+grazl2zp
719#endif
720!
721! Zooplankton egestion to Particulate Organic Nitrogen (PON) and
722! Particulate Organic Silica (opal).
723!
724 egezs=(1.0_r8-alphazs(ng))* &
725 & graps2zs
726 egezl=(1.0_r8-alphazl(ng))* &
727 & (graps2zl+grapl2zl+grazs2zl)
728 egezp=(1.0_r8-alphazp(ng))* &
729 & (grapl2zp+grazs2zp+grazl2zp)
730 bio(i,k,iszoo)=bio(i,k,iszoo)-egezs
731 bio(i,k,ilzoo)=bio(i,k,ilzoo)-egezl
732 bio(i,k,ipzoo)=bio(i,k,ipzoo)-egezp
733 bio(i,k,ipon_)=bio(i,k,ipon_)+egezs+egezl+egezp
734 bio(i,k,iopal)=bio(i,k,iopal)+(grapl2zl+grapl2zp)*rsin(ng)
735!
736! Zooplankton excretion to NH4.
737!
738 exczs=(alphazs(ng)-betazs(ng))* &
739 & graps2zs
740 exczl=(alphazl(ng)-betazl(ng))* &
741 & (graps2zl+grapl2zl+grazs2zl)
742 exczp=(alphazp(ng)-betazp(ng))* &
743 & (grapl2zp+grazs2zp+grazl2zp)
744 bio(i,k,iszoo)=bio(i,k,iszoo)-exczs
745 bio(i,k,ilzoo)=bio(i,k,ilzoo)-exczl
746 bio(i,k,ipzoo)=bio(i,k,ipzoo)-exczp
747 bio(i,k,inh4_)=bio(i,k,inh4_)+exczs+exczl+exczp
748 END DO
749 END DO
750!
751!-----------------------------------------------------------------------
752! Zooplankton motality to particulate organic nitrogen.
753!-----------------------------------------------------------------------
754!
755 fac1=dtdays*morzs0(ng)
756 fac2=dtdays*morzl0(ng)
757 fac3=dtdays*morzp0(ng)
758 DO k=1,n(ng)
759 DO i=istr,iend
760 cff1=fac1*bio(i,k,iszoo)*exp(kmorzs(ng)*bio(i,k,itemp))
761 cff2=fac2*bio(i,k,ilzoo)*exp(kmorzl(ng)*bio(i,k,itemp))
762 cff3=fac3*bio(i,k,ipzoo)*exp(kmorzp(ng)*bio(i,k,itemp))
763 bio(i,k,iszoo)=bio(i,k,iszoo)/(1.0_r8+cff1)
764 bio(i,k,ilzoo)=bio(i,k,ilzoo)/(1.0_r8+cff2)
765 bio(i,k,ipzoo)=bio(i,k,ipzoo)/(1.0_r8+cff3)
766 bio(i,k,ipon_)=bio(i,k,ipon_)+ &
767 & bio(i,k,iszoo)*cff1+ &
768 & bio(i,k,ilzoo)*cff2+ &
769 & bio(i,k,ipzoo)*cff3
770 END DO
771 END DO
772!
773!-----------------------------------------------------------------------
774! Nutrient decomposition.
775!-----------------------------------------------------------------------
776!
777 fac1=dtdays*nit0(ng)
778 fac2=dtdays*vp2n0(ng)
779 fac3=dtdays*vp2d0(ng)
780 fac4=dtdays*vd2n0(ng)
781 fac5=dtdays*vo2s0(ng)
782 DO k=1,n(ng)
783 DO i=istr,iend
784!
785! Nitrification: NH4 to NO3.
786!
787 cff1=fac1*exp(knit(ng)*bio(i,k,itemp))
788 bio(i,k,inh4_)=bio(i,k,inh4_)/(1.0_r8+cff1)
789 bio(i,k,ino3_)=bio(i,k,ino3_)+ &
790 & bio(i,k,inh4_)*cff1
791!
792! Decomposition: PON to NH4.
793!
794 cff2=fac2*exp(kp2n(ng)*bio(i,k,itemp))
795 bio(i,k,ipon_)=bio(i,k,ipon_)/(1.0_r8+cff2)
796 bio(i,k,inh4_)=bio(i,k,inh4_)+ &
797 & bio(i,k,ipon_)*cff2
798!
799! Decomposition: PON to DON.
800!
801 cff3=fac3*exp(kp2d(ng)*bio(i,k,itemp))
802 bio(i,k,ipon_)=bio(i,k,ipon_)/(1.0_r8+cff3)
803 bio(i,k,idon_)=bio(i,k,idon_)+ &
804 & bio(i,k,ipon_)*cff3
805!
806! Decomposition: DON to NH4.
807!
808 cff4=fac4*exp(kd2n(ng)*bio(i,k,itemp))
809 bio(i,k,idon_)=bio(i,k,idon_)/(1.0_r8+cff4)
810 bio(i,k,inh4_)=bio(i,k,inh4_)+ &
811 & bio(i,k,idon_)*cff4
812!
813! Decomposition: Opal to SiOH4.
814!
815 cff5=fac5*exp(ko2s(ng)*bio(i,k,itemp))
816 bio(i,k,iopal)=bio(i,k,iopal)/(1.0_r8+cff5)
817 bio(i,k,isioh)=bio(i,k,isioh)+ &
818 & bio(i,k,iopal)*cff5
819 END DO
820 END DO
821!
822!-----------------------------------------------------------------------
823! Vertical sinking terms: PON and Opal.
824!-----------------------------------------------------------------------
825!
826! Reconstruct vertical profile of selected biological constituents
827! "Bio(:,:,isink)" in terms of a set of parabolic segments within each
828! grid box. Then, compute semi-Lagrangian flux due to sinking.
829!
830 sink_loop: DO isink=1,nsink
831 ibio=idsink(isink)
832!
833! Copy concentration of biological particulates into scratch array
834! "qc" (q-central, restrict it to be positive) which is hereafter
835! interpreted as a set of grid-box averaged values for biogeochemical
836! constituent concentration.
837!
838 DO k=1,n(ng)
839 DO i=istr,iend
840 qc(i,k)=bio(i,k,ibio)
841 END DO
842 END DO
843!
844 DO k=n(ng)-1,1,-1
845 DO i=istr,iend
846 fc(i,k)=(qc(i,k+1)-qc(i,k))*hz_inv2(i,k)
847 END DO
848 END DO
849 DO k=2,n(ng)-1
850 DO i=istr,iend
851 dltr=hz(i,j,k)*fc(i,k)
852 dltl=hz(i,j,k)*fc(i,k-1)
853 cff=hz(i,j,k-1)+2.0_r8*hz(i,j,k)+hz(i,j,k+1)
854 cffr=cff*fc(i,k)
855 cffl=cff*fc(i,k-1)
856!
857! Apply PPM monotonicity constraint to prevent oscillations within the
858! grid box.
859!
860 IF ((dltr*dltl).le.0.0_r8) THEN
861 dltr=0.0_r8
862 dltl=0.0_r8
863 ELSE IF (abs(dltr).gt.abs(cffl)) THEN
864 dltr=cffl
865 ELSE IF (abs(dltl).gt.abs(cffr)) THEN
866 dltl=cffr
867 END IF
868!
869! Compute right and left side values (bR,bL) of parabolic segments
870! within grid box Hz(k); (WR,WL) are measures of quadratic variations.
871!
872! NOTE: Although each parabolic segment is monotonic within its grid
873! box, monotonicity of the whole profile is not guaranteed,
874! because bL(k+1)-bR(k) may still have different sign than
875! qc(i,k+1)-qc(i,k). This possibility is excluded,
876! after bL and bR are reconciled using WENO procedure.
877!
878 cff=(dltr-dltl)*hz_inv3(i,k)
879 dltr=dltr-cff*hz(i,j,k+1)
880 dltl=dltl+cff*hz(i,j,k-1)
881 br(i,k)=qc(i,k)+dltr
882 bl(i,k)=qc(i,k)-dltl
883 wr(i,k)=(2.0_r8*dltr-dltl)**2
884 wl(i,k)=(dltr-2.0_r8*dltl)**2
885 END DO
886 END DO
887 cff=1.0e-14_r8
888 DO k=2,n(ng)-2
889 DO i=istr,iend
890 dltl=max(cff,wl(i,k ))
891 dltr=max(cff,wr(i,k+1))
892 br(i,k)=(dltr*br(i,k)+dltl*bl(i,k+1))/(dltr+dltl)
893 bl(i,k+1)=br(i,k)
894 END DO
895 END DO
896 DO i=istr,iend
897 fc(i,n(ng))=0.0_r8 ! NO-flux boundary condition
898#if defined LINEAR_CONTINUATION
899 bl(i,n(ng))=br(i,n(ng)-1)
900 br(i,n(ng))=2.0_r8*qc(i,n(ng))-bl(i,n(ng))
901#elif defined NEUMANN
902 bl(i,n(ng))=br(i,n(ng)-1)
903 br(i,n(ng))=1.5_r8*qc(i,n(ng))-0.5_r8*bl(i,n(ng))
904#else
905 br(i,n(ng))=qc(i,n(ng)) ! default strictly monotonic
906 bl(i,n(ng))=qc(i,n(ng)) ! conditions
907 br(i,n(ng)-1)=qc(i,n(ng))
908#endif
909#if defined LINEAR_CONTINUATION
910 br(i,1)=bl(i,2)
911 bl(i,1)=2.0_r8*qc(i,1)-br(i,1)
912#elif defined NEUMANN
913 br(i,1)=bl(i,2)
914 bl(i,1)=1.5_r8*qc(i,1)-0.5_r8*br(i,1)
915#else
916 bl(i,2)=qc(i,1) ! bottom grid boxes are
917 br(i,1)=qc(i,1) ! re-assumed to be
918 bl(i,1)=qc(i,1) ! piecewise constant.
919#endif
920 END DO
921!
922! Apply monotonicity constraint again, since the reconciled interfacial
923! values may cause a non-monotonic behavior of the parabolic segments
924! inside the grid box.
925!
926 DO k=1,n(ng)
927 DO i=istr,iend
928 dltr=br(i,k)-qc(i,k)
929 dltl=qc(i,k)-bl(i,k)
930 cffr=2.0_r8*dltr
931 cffl=2.0_r8*dltl
932 IF ((dltr*dltl).lt.0.0_r8) THEN
933 dltr=0.0_r8
934 dltl=0.0_r8
935 ELSE IF (abs(dltr).gt.abs(cffl)) THEN
936 dltr=cffl
937 ELSE IF (abs(dltl).gt.abs(cffr)) THEN
938 dltl=cffr
939 END IF
940 br(i,k)=qc(i,k)+dltr
941 bl(i,k)=qc(i,k)-dltl
942 END DO
943 END DO
944!
945! After this moment reconstruction is considered complete. The next
946! stage is to compute vertical advective fluxes, FC. It is expected
947! that sinking may occurs relatively fast, the algorithm is designed
948! to be free of CFL criterion, which is achieved by allowing
949! integration bounds for semi-Lagrangian advective flux to use as
950! many grid boxes in upstream direction as necessary.
951!
952! In the two code segments below, WL is the z-coordinate of the
953! departure point for grid box interface z_w with the same indices;
954! FC is the finite volume flux; ksource(:,k) is index of vertical
955! grid box which contains the departure point (restricted by N(ng)).
956! During the search: also add in content of whole grid boxes
957! participating in FC.
958!
959 cff=dtdays*abs(wbio(isink))
960 DO k=1,n(ng)
961 DO i=istr,iend
962 fc(i,k-1)=0.0_r8
963 wl(i,k)=z_w(i,j,k-1)+cff
964 wr(i,k)=hz(i,j,k)*qc(i,k)
965 ksource(i,k)=k
966 END DO
967 END DO
968 DO k=1,n(ng)
969 DO ks=k,n(ng)-1
970 DO i=istr,iend
971 IF (wl(i,k).gt.z_w(i,j,ks)) THEN
972 ksource(i,k)=ks+1
973 fc(i,k-1)=fc(i,k-1)+wr(i,ks)
974 END IF
975 END DO
976 END DO
977 END DO
978!
979! Finalize computation of flux: add fractional part.
980!
981 DO k=1,n(ng)
982 DO i=istr,iend
983 ks=ksource(i,k)
984 cu=min(1.0_r8,(wl(i,k)-z_w(i,j,ks-1))*hz_inv(i,ks))
985 fc(i,k-1)=fc(i,k-1)+ &
986 & hz(i,j,ks)*cu* &
987 & (bl(i,ks)+ &
988 & cu*(0.5_r8*(br(i,ks)-bl(i,ks))- &
989 & (1.5_r8-cu)* &
990 & (br(i,ks)+bl(i,ks)- &
991 & 2.0_r8*qc(i,ks))))
992 END DO
993 END DO
994 DO k=1,n(ng)
995 DO i=istr,iend
996 bio(i,k,ibio)=qc(i,k)+(fc(i,k)-fc(i,k-1))*hz_inv(i,k)
997 END DO
998 END DO
999
1000#ifdef BIO_SEDIMENT
1001!
1002! Particulate fluxes reaching the seafloor are remineralized and returned
1003! to the dissolved nutrient pool. Without this conversion, particulate
1004! material falls out of the system. This is a temporary fix to restore
1005! total nutrient conservation. This may require a time delay
1006! remineralization in the future.
1007!
1008! HGA: The original Nemuro model has a restoring upwelling rate (UPW).
1009! The code below is an interpretation in terms of the semi-
1010! Lagrangian algorithm. What is the correct nutrient path from
1011! the benthos to the water column? NH4 to NO3?
1012!
1013 IF (ibio.eq.ipon_) THEN
1014 DO i=istr,iend
1015 cff1=fc(i,0)*hz_inv(i,1)
1016 bio(i,1,ino3_)=bio(i,1,ino3_)+cff1
1017 END DO
1018 ELSE IF (ibio.eq.iopal) THEN
1019 DO i=istr,iend
1020 cff1=fc(i,0)*hz_inv(i,1)
1021 bio(i,1,isioh)=bio(i,1,isioh)+cff1
1022 END DO
1023 END IF
1024#endif
1025
1026 END DO sink_loop
1027 END DO iter_loop
1028!
1029!-----------------------------------------------------------------------
1030! Update global tracer variables: Add increment due to BGC processes
1031! to tracer array in time index "nnew". Index "nnew" is solution after
1032! advection and mixing and has transport units (m Tunits) hence the
1033! increment is multiplied by Hz. Notice that we need to subtract
1034! original values "Bio_old" at the top of the routine to just account
1035! for the concentractions affected by BGC processes. This also takes
1036! into account any constraints (non-negative concentrations, carbon
1037! concentration range) specified before entering BGC kernel. If "Bio"
1038! were unchanged by BGC processes, the increment would be exactly
1039! zero. Notice that final tracer values, t(:,:,:,nnew,:) are not
1040! bounded >=0 so that we can preserve total inventory of nutrients
1041! when advection causes tracer concentration to go negative.
1042!-----------------------------------------------------------------------
1043!
1044 DO itrc=1,nbt
1045 ibio=idbio(itrc)
1046 DO k=1,n(ng)
1047 DO i=istr,iend
1048 cff=bio(i,k,ibio)-bio_old(i,k,ibio)
1049 t(i,j,k,nnew,ibio)=t(i,j,k,nnew,ibio)+cff*hz(i,j,k)
1050 END DO
1051 END DO
1052 END DO
1053
1054 END DO j_loop
1055!
1056 RETURN
mod_biology::pl2zlstar
real(r8), dimension(:), allocatable pl2zlstar
Definition nemuro_mod.h:259
mod_biology::isioh
integer isioh
Definition nemuro_mod.h:187
mod_biology::kps2zs
real(r8), dimension(:), allocatable kps2zs
Definition nemuro_mod.h:237
mod_biology::kmorzl
real(r8), dimension(:), allocatable kmorzl
Definition nemuro_mod.h:224
mod_biology::kpl2zl
real(r8), dimension(:), allocatable kpl2zl
Definition nemuro_mod.h:235
mod_biology::ipzoo
integer ipzoo
Definition nemuro_mod.h:182
mod_biology::ko2s
real(r8), dimension(:), allocatable ko2s
Definition nemuro_mod.h:232
mod_biology::pusaipl
real(r8), dimension(:), allocatable pusaipl
Definition nemuro_mod.h:256
mod_biology::knit
real(r8), dimension(:), allocatable knit
Definition nemuro_mod.h:229
mod_biology::pusais
real(r8), dimension(:), allocatable pusais
Definition nemuro_mod.h:257
mod_biology::kzs2zl
real(r8), dimension(:), allocatable kzs2zl
Definition nemuro_mod.h:243
mod_biology::vp2n0
real(r8), dimension(:), allocatable vp2n0
Definition nemuro_mod.h:273
mod_biology::ipon_
integer ipon_
Definition nemuro_mod.h:185
mod_biology::alphaps
real(r8), dimension(:), allocatable alphaps
Definition nemuro_mod.h:195
mod_biology::ilphy
integer ilphy
Definition nemuro_mod.h:178
mod_biology::vmaxs
real(r8), dimension(:), allocatable vmaxs
Definition nemuro_mod.h:270
mod_biology::vp2d0
real(r8), dimension(:), allocatable vp2d0
Definition nemuro_mod.h:272
mod_biology::ps2zsstar
real(r8), dimension(:), allocatable ps2zsstar
Definition nemuro_mod.h:262
mod_biology::zs2zpstar
real(r8), dimension(:), allocatable zs2zpstar
Definition nemuro_mod.h:276
mod_biology::knh4l
real(r8), dimension(:), allocatable knh4l
Definition nemuro_mod.h:227
mod_biology::kgpps
real(r8), dimension(:), allocatable kgpps
Definition nemuro_mod.h:218
mod_biology::grmaxppl
real(r8), dimension(:), allocatable grmaxppl
Definition nemuro_mod.h:212
mod_biology::iszoo
integer iszoo
Definition nemuro_mod.h:181
mod_biology::lams
real(r8), dimension(:), allocatable lams
Definition nemuro_mod.h:247
mod_biology::kzs2zp
real(r8), dimension(:), allocatable kzs2zp
Definition nemuro_mod.h:244
mod_biology::kps2zl
real(r8), dimension(:), allocatable kps2zl
Definition nemuro_mod.h:236
mod_biology::vd2n0
real(r8), dimension(:), allocatable vd2n0
Definition nemuro_mod.h:268
mod_biology::setvpon
real(r8), dimension(:), allocatable setvpon
Definition nemuro_mod.h:267
mod_biology::kmorzs
real(r8), dimension(:), allocatable kmorzs
Definition nemuro_mod.h:226
mod_biology::vmaxl
real(r8), dimension(:), allocatable vmaxl
Definition nemuro_mod.h:269
mod_biology::morpl0
real(r8), dimension(:), allocatable morpl0
Definition nemuro_mod.h:248
mod_biology::kmorps
real(r8), dimension(:), allocatable kmorps
Definition nemuro_mod.h:223
mod_biology::rsin
real(r8), dimension(:), allocatable rsin
Definition nemuro_mod.h:265
mod_biology::grmaxpzs
real(r8), dimension(:), allocatable grmaxpzs
Definition nemuro_mod.h:214
mod_biology::vo2s0
real(r8), dimension(:), allocatable vo2s0
Definition nemuro_mod.h:271
mod_biology::pusail
real(r8), dimension(:), allocatable pusail
Definition nemuro_mod.h:255
mod_biology::kgppl
real(r8), dimension(:), allocatable kgppl
Definition nemuro_mod.h:217
mod_biology::kresps
real(r8), dimension(:), allocatable kresps
Definition nemuro_mod.h:240
mod_biology::grmaxlzs
real(r8), dimension(:), allocatable grmaxlzs
Definition nemuro_mod.h:211
mod_biology::krespl
real(r8), dimension(:), allocatable krespl
Definition nemuro_mod.h:239
mod_biology::kgras
real(r8), dimension(:), allocatable kgras
Definition nemuro_mod.h:221
mod_biology::alphazl
real(r8), dimension(:), allocatable alphazl
Definition nemuro_mod.h:196
mod_biology::kgral
real(r8), dimension(:), allocatable kgral
Definition nemuro_mod.h:219
mod_biology::betapl
real(r8), dimension(:), allocatable betapl
Definition nemuro_mod.h:202
mod_biology::resps0
real(r8), dimension(:), allocatable resps0
Definition nemuro_mod.h:264
mod_biology::attpl
real(r8), dimension(:), allocatable attpl
Definition nemuro_mod.h:199
mod_biology::kp2n
real(r8), dimension(:), allocatable kp2n
Definition nemuro_mod.h:234
mod_biology::isphy
integer isphy
Definition nemuro_mod.h:179
mod_biology::attps
real(r8), dimension(:), allocatable attps
Definition nemuro_mod.h:200
mod_biology::morzl0
real(r8), dimension(:), allocatable morzl0
Definition nemuro_mod.h:250
mod_biology::betazp
real(r8), dimension(:), allocatable betazp
Definition nemuro_mod.h:206
mod_biology::morzs0
real(r8), dimension(:), allocatable morzs0
Definition nemuro_mod.h:252
mod_biology::gammal
real(r8), dimension(:), allocatable gammal
Definition nemuro_mod.h:207
mod_biology::lamp
real(r8), dimension(:), allocatable lamp
Definition nemuro_mod.h:246
mod_biology::atts
real(r8), dimension(:), allocatable atts
Definition red_tide_mod.h:62
mod_biology::alphapl
real(r8), dimension(:), allocatable alphapl
Definition nemuro_mod.h:194
mod_biology::kmorzp
real(r8), dimension(:), allocatable kmorzp
Definition nemuro_mod.h:225
mod_biology::kpl2zp
real(r8), dimension(:), allocatable kpl2zp
Definition nemuro_mod.h:238
mod_biology::ps2zlstar
real(r8), dimension(:), allocatable ps2zlstar
Definition nemuro_mod.h:261
mod_biology::grmaxlps
real(r8), dimension(:), allocatable grmaxlps
Definition nemuro_mod.h:210
mod_biology::kd2n
real(r8), dimension(:), allocatable kd2n
Definition nemuro_mod.h:216
mod_biology::zl2zpstar
real(r8), dimension(:), allocatable zl2zpstar
Definition nemuro_mod.h:274
mod_biology::nit0
real(r8), dimension(:), allocatable nit0
Definition nemuro_mod.h:253
mod_biology::kno3l
real(r8), dimension(:), allocatable kno3l
Definition nemuro_mod.h:230
mod_biology::alphazs
real(r8), dimension(:), allocatable alphazs
Definition nemuro_mod.h:198
mod_biology::kzl2zp
real(r8), dimension(:), allocatable kzl2zp
Definition nemuro_mod.h:242
mod_biology::betazl
real(r8), dimension(:), allocatable betazl
Definition nemuro_mod.h:205
mod_biology::gammas
real(r8), dimension(:), allocatable gammas
Definition nemuro_mod.h:208
mod_biology::setvopal
real(r8), dimension(:), allocatable setvopal
Definition nemuro_mod.h:266
mod_biology::grmaxlpl
real(r8), dimension(:), allocatable grmaxlpl
Definition nemuro_mod.h:209
mod_biology::respl0
real(r8), dimension(:), allocatable respl0
Definition nemuro_mod.h:263
mod_biology::kno3s
real(r8), dimension(:), allocatable kno3s
Definition nemuro_mod.h:231
mod_biology::morzp0
real(r8), dimension(:), allocatable morzp0
Definition nemuro_mod.h:251
mod_biology::kmorpl
real(r8), dimension(:), allocatable kmorpl
Definition nemuro_mod.h:222
mod_biology::pl2zpstar
real(r8), dimension(:), allocatable pl2zpstar
Definition nemuro_mod.h:260
mod_biology::pusaizs
real(r8), dimension(:), allocatable pusaizs
Definition nemuro_mod.h:258
mod_biology::iopal
integer iopal
Definition nemuro_mod.h:188
mod_biology::alphazp
real(r8), dimension(:), allocatable alphazp
Definition nemuro_mod.h:197
mod_biology::grmaxsps
real(r8), dimension(:), allocatable grmaxsps
Definition nemuro_mod.h:215
mod_biology::kgrap
real(r8), dimension(:), allocatable kgrap
Definition nemuro_mod.h:220
mod_biology::betazs
real(r8), dimension(:), allocatable betazs
Definition nemuro_mod.h:204
mod_biology::knh4s
real(r8), dimension(:), allocatable knh4s
Definition nemuro_mod.h:228
mod_biology::ksil
real(r8), dimension(:), allocatable ksil
Definition nemuro_mod.h:241
mod_biology::idon_
integer idon_
Definition nemuro_mod.h:186
mod_biology::grmaxpzl
real(r8), dimension(:), allocatable grmaxpzl
Definition nemuro_mod.h:213
mod_biology::laml
real(r8), dimension(:), allocatable laml
Definition nemuro_mod.h:245
mod_biology::morps0
real(r8), dimension(:), allocatable morps0
Definition nemuro_mod.h:249
mod_biology::kp2d
real(r8), dimension(:), allocatable kp2d
Definition nemuro_mod.h:233
mod_biology::betaps
real(r8), dimension(:), allocatable betaps
Definition nemuro_mod.h:203
mod_biology::zs2zlstar
real(r8), dimension(:), allocatable zs2zlstar
Definition nemuro_mod.h:275
mod_biology::ilzoo
integer ilzoo
Definition nemuro_mod.h:180

References mod_biology::alphapl, mod_biology::alphaps, mod_biology::alphazl, mod_biology::alphazp, mod_biology::alphazs, mod_biology::attpl, mod_biology::attps, mod_biology::attsw, mod_biology::betapl, mod_biology::betaps, mod_biology::betazl, mod_biology::betazp, mod_biology::betazs, mod_biology::bioiter, mod_scalars::cp, mod_scalars::dt, mod_biology::gammal, mod_biology::gammas, mod_biology::grmaxlpl, mod_biology::grmaxlps, mod_biology::grmaxlzs, mod_biology::grmaxppl, mod_biology::grmaxpzl, mod_biology::grmaxpzs, mod_biology::grmaxsps, mod_biology::idbio, mod_biology::idon_, mod_biology::ilphy, mod_biology::ilzoo, mod_biology::inh4_, mod_biology::ino3_, mod_biology::iopal, mod_biology::ipon_, mod_biology::ipzoo, mod_biology::isioh, mod_biology::isphy, mod_biology::iszoo, mod_scalars::itemp, mod_biology::kd2n, mod_biology::kgppl, mod_biology::kgpps, mod_biology::kgral, mod_biology::kgrap, mod_biology::kgras, mod_biology::kmorpl, mod_biology::kmorps, mod_biology::kmorzl, mod_biology::kmorzp, mod_biology::kmorzs, mod_biology::knh4l, mod_biology::knh4s, mod_biology::knit, mod_biology::kno3l, mod_biology::kno3s, mod_biology::ko2s, mod_biology::kp2d, mod_biology::kp2n, mod_biology::kpl2zl, mod_biology::kpl2zp, mod_biology::kps2zl, mod_biology::kps2zs, mod_biology::krespl, mod_biology::kresps, mod_biology::ksil, mod_biology::kzl2zp, mod_biology::kzs2zl, mod_biology::kzs2zp, mod_biology::laml, mod_biology::lamp, mod_biology::lams, mod_biology::morpl0, mod_biology::morps0, mod_biology::morzl0, mod_biology::morzp0, mod_biology::morzs0, mod_param::n, mod_param::nbt, mod_biology::nit0, mod_biology::parfrac, mod_biology::pl2zlstar, mod_biology::pl2zpstar, mod_biology::ps2zlstar, mod_biology::ps2zsstar, mod_biology::pusail, mod_biology::pusaipl, mod_biology::pusais, mod_biology::pusaizs, mod_biology::respl0, mod_biology::resps0, mod_scalars::rho0, mod_biology::rsin, mod_scalars::sec2day, mod_biology::setvopal, mod_biology::setvpon, mod_biology::vd2n0, mod_biology::vmaxl, mod_biology::vmaxs, mod_biology::vo2s0, mod_biology::vp2d0, mod_biology::vp2n0, mod_biology::zl2zpstar, mod_biology::zs2zlstar, and mod_biology::zs2zpstar.

◆ npzd_franks_tile()

subroutine biology_mod::npzd_franks_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) ubk,
integer, intent(in) ubt,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) nstp,
integer, intent(in) nnew,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) rmask,
real(r8), dimension(lbi:ubi,lbj:ubj,ubk), intent(in) hz,
real(r8), dimension(lbi:ubi,lbj:ubj,ubk), intent(in) z_r,
real(r8), dimension(lbi:ubi,lbj:ubj,0:ubk), intent(in) z_w,
real(r8), dimension(lbi:ubi,lbj:ubj,ubk,3,ubt), intent(inout) t )
private

Definition at line 87 of file npzd_Franks.h.

96!-----------------------------------------------------------------------
97!
98 USE mod_param
99 USE mod_biology
100 USE mod_ncparam
101 USE mod_scalars
102!
103! Imported variable declarations.
104!
105 integer, intent(in) :: ng, tile
106 integer, intent(in) :: LBi, UBi, LBj, UBj, UBk, UBt
107 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
108 integer, intent(in) :: nstp, nnew
109
110#ifdef ASSUMED_SHAPE
111# ifdef MASKING
112 real(r8), intent(in) :: rmask(LBi:,LBj:)
113# endif
114 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
115 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
116 real(r8), intent(in) :: z_w(LBi:,LBj:,0:)
117 real(r8), intent(inout) :: t(LBi:,LBj:,:,:,:)
118#else
119# ifdef MASKING
120 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
121# endif
122 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,UBk)
123 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,UBk)
124 real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:UBk)
125 real(r8), intent(inout) :: t(LBi:UBi,LBj:UBj,UBk,3,UBt)
126#endif
127!
128! Local variable declarations.
129!
130 integer, parameter :: Nsink = 1
131
132 integer :: Iter, i, ibio, isink, itrc, itrmx, j, k, ks
133
134 integer, dimension(Nsink) :: idsink
135
136 real(r8), parameter :: eps = 1.0e-16_r8
137
138 real(r8) :: cff, cff1, cff2, cff3, dtdays
139 real(r8) :: cffL, cffR, cu, dltL, dltR
140
141 real(r8), dimension(Nsink) :: Wbio
142
143 integer, dimension(IminS:ImaxS,N(ng)) :: ksource
144
145 real(r8), dimension(IminS:ImaxS,N(ng),NT(ng)) :: Bio
146
147 real(r8), dimension(IminS:ImaxS,N(ng),NT(ng)) :: Bio_old
148
149 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: FC
150
151 real(r8), dimension(IminS:ImaxS,N(ng)) :: Hz_inv
152 real(r8), dimension(IminS:ImaxS,N(ng)) :: Hz_inv2
153 real(r8), dimension(IminS:ImaxS,N(ng)) :: Hz_inv3
154 real(r8), dimension(IminS:ImaxS,N(ng)) :: WL
155 real(r8), dimension(IminS:ImaxS,N(ng)) :: WR
156 real(r8), dimension(IminS:ImaxS,N(ng)) :: bL
157 real(r8), dimension(IminS:ImaxS,N(ng)) :: bR
158 real(r8), dimension(IminS:ImaxS,N(ng)) :: qc
159
160#include "set_bounds.h"
161!
162!-----------------------------------------------------------------------
163! Add biological Source/Sink terms.
164!-----------------------------------------------------------------------
165!
166! Avoid computing source/sink terms if no biological iterations.
167!
168 IF (bioiter(ng).le.0) RETURN
169!
170! Set time-stepping according to the number of iterations.
171!
172 dtdays=dt(ng)*sec2day/real(bioiter(ng),r8)
173!
174! Set vertical sinking indentification vector.
175!
176 idsink(1)=isdet ! Small detritus
177!
178! Set vertical sinking velocity vector in the same order as the
179! identification vector, IDSINK.
180!
181 wbio(1)=wdet(ng) ! Small detritus
182!
183! Compute inverse thickness to avoid repeated divisions.
184!
185 j_loop : DO j=jstr,jend
186 DO k=1,n(ng)
187 DO i=istr,iend
188 hz_inv(i,k)=1.0_r8/hz(i,j,k)
189 END DO
190 END DO
191 DO k=1,n(ng)-1
192 DO i=istr,iend
193 hz_inv2(i,k)=1.0_r8/(hz(i,j,k)+hz(i,j,k+1))
194 END DO
195 END DO
196 DO k=2,n(ng)-1
197 DO i=istr,iend
198 hz_inv3(i,k)=1.0_r8/(hz(i,j,k-1)+hz(i,j,k)+hz(i,j,k+1))
199 END DO
200 END DO
201!
202! Extract biological variables from tracer arrays, place them into
203! scratch arrays, and restrict their values to be positive definite.
204! At input, all tracers (index nnew) from predictor step have
205! transport units (m Tunits) since we do not have yet the new
206! values for zeta and Hz. These are known after the 2D barotropic
207! time-stepping.
208!
209 DO itrc=1,nbt
210 ibio=idbio(itrc)
211 DO k=1,n(ng)
212 DO i=istr,iend
213 bio_old(i,k,ibio)=t(i,j,k,nstp,ibio)
214 END DO
215 END DO
216 END DO
217!
218! Determine Correction for negativity.
219!
220 DO k=1,n(ng)
221 DO i=istr,iend
222 cff1=max(0.0_r8,eps-bio_old(i,k,ino3_))+ &
223 & max(0.0_r8,eps-bio_old(i,k,iphyt))+ &
224 & max(0.0_r8,eps-bio_old(i,k,izoop))+ &
225 & max(0.0_r8,eps-bio_old(i,k,isdet))
226!
227! If correction needed, determine the largest pool to debit.
228!
229 IF (cff1.gt.0.0) THEN
230 itrmx=idbio(1)
231 cff=t(i,j,k,nstp,itrmx)
232 DO ibio=idbio(2),idbio(nbt)
233 IF (t(i,j,k,nstp,ibio).gt.cff) THEN
234 itrmx=ibio
235 cff=t(i,j,k,nstp,ibio)
236 END IF
237 END DO
238!
239! Update new values.
240!
241 DO itrc=1,nbt
242 ibio=idbio(itrc)
243 bio(i,k,ibio)=max(eps,bio_old(i,k,ibio))- &
244 & cff1*(sign(0.5_r8, &
245 & real(itrmx-ibio,r8)**2)+ &
246 & sign(0.5_r8, &
247 & -real(itrmx-ibio,r8)**2))
248 END DO
249 ELSE
250 DO itrc=1,nbt
251 ibio=idbio(itrc)
252 bio(i,k,ibio)=bio_old(i,k,ibio)
253 END DO
254 END IF
255 END DO
256 END DO
257!
258!=======================================================================
259! Start internal iterations to achieve convergence of the nonlinear
260! backward-implicit solution.
261!=======================================================================
262!
263! During the iterative procedure a series of fractional time steps are
264! performed in a chained mode (splitting by different biological
265! conversion processes) in sequence of the main food chain. In all
266! stages the concentration of the component being consumed is treated
267! in fully implicit manner, so the algorithm guarantees non-negative
268! values, no matter how strong s the concentration of active consuming
269! component (Phytoplankton or Zooplankton). The overall algorithm,
270! as well as any stage of it, is formulated in conservative form
271! (except explicit sinking) in sense that the sum of concentration of
272! all components is conserved.
273!
274! In the implicit algorithm, we have for example (N: nutrient,
275! P: phytoplankton),
276!
277! N(new) = N(old) - uptake * P(old) uptake = mu * N / (Kn + N)
278! {Michaelis-Menten}
279! below, we set
280! The N in the numerator of
281! cff = mu * P(old) / (Kn + N(old)) uptake is treated implicitly
282! as N(new)
283!
284! so the time-stepping of the equations becomes:
285!
286! N(new) = N(old) / (1 + cff) (1) when substracting a sink term,
287! consuming, divide by (1 + cff)
288! and
289!
290! P(new) = P(old) + cff * N(new) (2) when adding a source term,
291! growing, add (cff * source)
292!
293! Notice that if you substitute (1) in (2), you will get:
294!
295! P(new) = P(old) + cff * N(old) / (1 + cff) (3)
296!
297! If you add (1) and (3), you get
298!
299! N(new) + P(new) = N(old) + P(old)
300!
301! implying conservation regardless how "cff" is computed. Therefore,
302! this scheme is unconditionally stable regardless of the conversion
303! rate. It does not generate negative values since the constituent
304! to be consumed is always treated implicitly. It is also biased
305! toward damping oscillations.
306!
307! The iterative loop below is to iterate toward an universal Backward-
308! Euler treatment of all terms. So if there are oscillations in the
309! system, they are only physical oscillations. These iterations,
310! however, do not improve the accuaracy of the solution.
311!
312 iter_loop: DO iter=1,bioiter(ng)
313!
314! Nutrient uptake by phytoplankton.
315!
316 cff1=dtdays*vm_no3(ng)
317 DO k=1,n(ng)
318 DO i=istr,iend
319 cff=bio(i,k,iphyt)* &
320 & cff1*exp(k_ext(ng)*z_r(i,j,k))/ &
321 & (k_no3(ng)+bio(i,k,ino3_))
322 bio(i,k,ino3_)=bio(i,k,ino3_)/ &
323 & (1.0_r8+cff)
324 bio(i,k,iphyt)=bio(i,k,iphyt)+ &
325 & bio(i,k,ino3_)*cff
326 END DO
327 END DO
328!
329! Phytoplankton grazing by Zooplankton and mortality to Detritus
330! (rate: PhyMR).
331!
332 cff1=dtdays*zoogr(ng)
333 cff2=dtdays*phymr(ng)
334 cff3=k_phy(ng)*k_phy(ng)
335 DO k=1,n(ng)
336 DO i=istr,iend
337 cff=bio(i,k,izoop)*bio(i,k,iphyt)*cff1/ &
338 & (cff3+bio(i,k,iphyt)*bio(i,k,iphyt))
339 bio(i,k,iphyt)=bio(i,k,iphyt)/ &
340 & (1.0_r8+cff+cff2)
341 bio(i,k,izoop)=bio(i,k,izoop)+ &
342 & bio(i,k,iphyt)*cff*(1.0_r8-zooga(ng))
343 bio(i,k,isdet)=bio(i,k,isdet)+ &
344 & bio(i,k,iphyt)* &
345 & (cff2+cff*(zooga(ng)-zooec(ng)))
346 bio(i,k,ino3_)=bio(i,k,ino3_)+ &
347 & bio(i,k,iphyt)*cff*zooec(ng)
348 END DO
349 END DO
350!
351! Zooplankton excretion to nutrients and mortality to Detritus.
352!
353 cff1=1.0_r8/(1.0_r8+dtdays*(zoomr(ng)+zoomd(ng)))
354 cff2=dtdays*zoomr(ng)
355 cff3=dtdays*zoomd(ng)
356 DO k=1,n(ng)
357 DO i=istr,iend
358 bio(i,k,izoop)=bio(i,k,izoop)*cff1
359 bio(i,k,ino3_)=bio(i,k,ino3_)+ &
360 & bio(i,k,izoop)*cff2
361 bio(i,k,isdet)=bio(i,k,isdet)+ &
362 & bio(i,k,izoop)*cff3
363 END DO
364 END DO
365!
366! Detritus breakdown to nutrients.
367!
368 cff1=dtdays*detrr(ng)
369 cff2=1.0_r8/(1.0_r8+cff1)
370 DO k=1,n(ng)
371 DO i=istr,iend
372 bio(i,k,isdet)=bio(i,k,isdet)*cff2
373 bio(i,k,ino3_)=bio(i,k,ino3_)+ &
374 & bio(i,k,isdet)*cff1
375 END DO
376 END DO
377!
378!-----------------------------------------------------------------------
379! Vertical sinking terms.
380!-----------------------------------------------------------------------
381!
382! Reconstruct vertical profile of selected biological constituents
383! "Bio(:,:,isink)" in terms of a set of parabolic segments within each
384! grid box. Then, compute semi-Lagrangian flux due to sinking.
385!
386 sink_loop: DO isink=1,nsink
387 ibio=idsink(isink)
388!
389! Copy concentration of biological particulates into scratch array
390! "qc" (q-central, restrict it to be positive) which is hereafter
391! interpreted as a set of grid-box averaged values for biogeochemical
392! constituent concentration.
393!
394 DO k=1,n(ng)
395 DO i=istr,iend
396 qc(i,k)=bio(i,k,ibio)
397 END DO
398 END DO
399!
400 DO k=n(ng)-1,1,-1
401 DO i=istr,iend
402 fc(i,k)=(qc(i,k+1)-qc(i,k))*hz_inv2(i,k)
403 END DO
404 END DO
405 DO k=2,n(ng)-1
406 DO i=istr,iend
407 dltr=hz(i,j,k)*fc(i,k)
408 dltl=hz(i,j,k)*fc(i,k-1)
409 cff=hz(i,j,k-1)+2.0_r8*hz(i,j,k)+hz(i,j,k+1)
410 cffr=cff*fc(i,k)
411 cffl=cff*fc(i,k-1)
412!
413! Apply PPM monotonicity constraint to prevent oscillations within the
414! grid box.
415!
416 IF ((dltr*dltl).le.0.0_r8) THEN
417 dltr=0.0_r8
418 dltl=0.0_r8
419 ELSE IF (abs(dltr).gt.abs(cffl)) THEN
420 dltr=cffl
421 ELSE IF (abs(dltl).gt.abs(cffr)) THEN
422 dltl=cffr
423 END IF
424!
425! Compute right and left side values (bR,bL) of parabolic segments
426! within grid box Hz(k); (WR,WL) are measures of quadratic variations.
427!
428! NOTE: Although each parabolic segment is monotonic within its grid
429! box, monotonicity of the whole profile is not guaranteed,
430! because bL(k+1)-bR(k) may still have different sign than
431! qc(i,k+1)-qc(i,k). This possibility is excluded,
432! after bL and bR are reconciled using WENO procedure.
433!
434 cff=(dltr-dltl)*hz_inv3(i,k)
435 dltr=dltr-cff*hz(i,j,k+1)
436 dltl=dltl+cff*hz(i,j,k-1)
437 br(i,k)=qc(i,k)+dltr
438 bl(i,k)=qc(i,k)-dltl
439 wr(i,k)=(2.0_r8*dltr-dltl)**2
440 wl(i,k)=(dltr-2.0_r8*dltl)**2
441 END DO
442 END DO
443 cff=1.0e-14_r8
444 DO k=2,n(ng)-2
445 DO i=istr,iend
446 dltl=max(cff,wl(i,k ))
447 dltr=max(cff,wr(i,k+1))
448 br(i,k)=(dltr*br(i,k)+dltl*bl(i,k+1))/(dltr+dltl)
449 bl(i,k+1)=br(i,k)
450 END DO
451 END DO
452 DO i=istr,iend
453 fc(i,n(ng))=0.0_r8 ! NO-flux boundary condition
454#if defined LINEAR_CONTINUATION
455 bl(i,n(ng))=br(i,n(ng)-1)
456 br(i,n(ng))=2.0_r8*qc(i,n(ng))-bl(i,n(ng))
457#elif defined NEUMANN
458 bl(i,n(ng))=br(i,n(ng)-1)
459 br(i,n(ng))=1.5_r8*qc(i,n(ng))-0.5_r8*bl(i,n(ng))
460#else
461 br(i,n(ng))=qc(i,n(ng)) ! default strictly monotonic
462 bl(i,n(ng))=qc(i,n(ng)) ! conditions
463 br(i,n(ng)-1)=qc(i,n(ng))
464#endif
465#if defined LINEAR_CONTINUATION
466 br(i,1)=bl(i,2)
467 bl(i,1)=2.0_r8*qc(i,1)-br(i,1)
468#elif defined NEUMANN
469 br(i,1)=bl(i,2)
470 bl(i,1)=1.5_r8*qc(i,1)-0.5_r8*br(i,1)
471#else
472 bl(i,2)=qc(i,1) ! bottom grid boxes are
473 br(i,1)=qc(i,1) ! re-assumed to be
474 bl(i,1)=qc(i,1) ! piecewise constant.
475#endif
476 END DO
477!
478! Apply monotonicity constraint again, since the reconciled interfacial
479! values may cause a non-monotonic behavior of the parabolic segments
480! inside the grid box.
481!
482 DO k=1,n(ng)
483 DO i=istr,iend
484 dltr=br(i,k)-qc(i,k)
485 dltl=qc(i,k)-bl(i,k)
486 cffr=2.0_r8*dltr
487 cffl=2.0_r8*dltl
488 IF ((dltr*dltl).lt.0.0_r8) THEN
489 dltr=0.0_r8
490 dltl=0.0_r8
491 ELSE IF (abs(dltr).gt.abs(cffl)) THEN
492 dltr=cffl
493 ELSE IF (abs(dltl).gt.abs(cffr)) THEN
494 dltl=cffr
495 END IF
496 br(i,k)=qc(i,k)+dltr
497 bl(i,k)=qc(i,k)-dltl
498 END DO
499 END DO
500!
501! After this moment reconstruction is considered complete. The next
502! stage is to compute vertical advective fluxes, FC. It is expected
503! that sinking may occurs relatively fast, the algorithm is designed
504! to be free of CFL criterion, which is achieved by allowing
505! integration bounds for semi-Lagrangian advective flux to use as
506! many grid boxes in upstream direction as necessary.
507!
508! In the two code segments below, WL is the z-coordinate of the
509! departure point for grid box interface z_w with the same indices;
510! FC is the finite volume flux; ksource(:,k) is index of vertical
511! grid box which contains the departure point (restricted by N(ng)).
512! During the search: also add in content of whole grid boxes
513! participating in FC.
514!
515 cff=dtdays*abs(wbio(isink))
516 DO k=1,n(ng)
517 DO i=istr,iend
518 fc(i,k-1)=0.0_r8
519 wl(i,k)=z_w(i,j,k-1)+cff
520 wr(i,k)=hz(i,j,k)*qc(i,k)
521 ksource(i,k)=k
522 END DO
523 END DO
524 DO k=1,n(ng)
525 DO ks=k,n(ng)-1
526 DO i=istr,iend
527 IF (wl(i,k).gt.z_w(i,j,ks)) THEN
528 ksource(i,k)=ks+1
529 fc(i,k-1)=fc(i,k-1)+wr(i,ks)
530 END IF
531 END DO
532 END DO
533 END DO
534!
535! Finalize computation of flux: add fractional part.
536!
537 DO k=1,n(ng)
538 DO i=istr,iend
539 ks=ksource(i,k)
540 cu=min(1.0_r8,(wl(i,k)-z_w(i,j,ks-1))*hz_inv(i,ks))
541 fc(i,k-1)=fc(i,k-1)+ &
542 & hz(i,j,ks)*cu* &
543 & (bl(i,ks)+ &
544 & cu*(0.5_r8*(br(i,ks)-bl(i,ks))- &
545 & (1.5_r8-cu)* &
546 & (br(i,ks)+bl(i,ks)- &
547 & 2.0_r8*qc(i,ks))))
548 END DO
549 END DO
550 DO k=1,n(ng)
551 DO i=istr,iend
552 bio(i,k,ibio)=qc(i,k)+(fc(i,k)-fc(i,k-1))*hz_inv(i,k)
553 END DO
554 END DO
555
556 END DO sink_loop
557 END DO iter_loop
558!
559!-----------------------------------------------------------------------
560! Update global tracer variables: Add increment due to BGC processes
561! to tracer array in time index "nnew". Index "nnew" is solution after
562! advection and mixing and has transport units (m Tunits) hence the
563! increment is multiplied by Hz. Notice that we need to subtract
564! original values "Bio_old" at the top of the routine to just account
565! for the concentractions affected by BGC processes. This also takes
566! into account any constraints (non-negative concentrations, carbon
567! concentration range) specified before entering BGC kernel. If "Bio"
568! were unchanged by BGC processes, the increment would be exactly
569! zero. Notice that final tracer values, t(:,:,:,nnew,:) are not
570! bounded >=0 so that we can preserve total inventory of nutrients
571! when advection causes tracer concentration to go negative.
572!-----------------------------------------------------------------------
573!
574 DO itrc=1,nbt
575 ibio=idbio(itrc)
576 DO k=1,n(ng)
577 DO i=istr,iend
578 cff=bio(i,k,ibio)-bio_old(i,k,ibio)
579 t(i,j,k,nnew,ibio)=t(i,j,k,nnew,ibio)+cff*hz(i,j,k)
580 END DO
581 END DO
582 END DO
583
584 END DO j_loop
585!
586 RETURN
mod_biology::zooga
real(r8), dimension(:), allocatable zooga
Definition npzd_Franks_mod.h:67
mod_biology::detrr
real(r8), dimension(:), allocatable detrr
Definition npzd_Franks_mod.h:51
mod_biology::wdet
real(r8), dimension(:), allocatable wdet
Definition npzd_Franks_mod.h:57
mod_biology::isdet
integer isdet
Definition npzd_Franks_mod.h:42
mod_biology::zoomd
real(r8), dimension(:), allocatable zoomd
Definition npzd_Franks_mod.h:66
mod_biology::zooec
real(r8), dimension(:), allocatable zooec
Definition npzd_Franks_mod.h:68
mod_biology::vm_no3
real(r8), dimension(:), allocatable vm_no3
Definition npzd_Franks_mod.h:56
mod_biology::k_ext
real(r8), dimension(:), allocatable k_ext
Definition npzd_Franks_mod.h:52

References mod_biology::bioiter, mod_biology::detrr, mod_scalars::dt, mod_biology::idbio, mod_biology::ino3_, mod_biology::iphyt, mod_biology::isdet, mod_biology::izoop, mod_biology::k_ext, mod_biology::k_no3, mod_biology::k_phy, mod_param::n, mod_param::nbt, mod_biology::phymr, mod_scalars::sec2day, mod_biology::vm_no3, mod_biology::wdet, mod_biology::zooec, mod_biology::zooga, mod_biology::zoogr, mod_biology::zoomd, and mod_biology::zoomr.

◆ npzd_iron_tile()

subroutine biology_mod::npzd_iron_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) ubk,
integer, intent(in) ubt,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) nstp,
integer, intent(in) nnew,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) rmask,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) h,
real(r8), dimension(lbi:ubi,lbj:ubj,ubk), intent(in) hz,
real(r8), dimension(lbi:ubi,lbj:ubj,ubk), intent(in) z_r,
real(r8), dimension(lbi:ubi,lbj:ubj,0:ubk), intent(in) z_w,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) srflx,
real(r8), dimension(lbi:ubi,lbj:ubj,ubk,3,ubt), intent(inout) t )
private

Definition at line 92 of file npzd_iron.h.

105!-----------------------------------------------------------------------
106!
107 USE mod_param
108 USE mod_biology
109 USE mod_ncparam
110 USE mod_scalars
111!
112! Imported variable declarations.
113!
114 integer, intent(in) :: ng, tile
115 integer, intent(in) :: LBi, UBi, LBj, UBj, UBk, UBt
116 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
117 integer, intent(in) :: nstp, nnew
118
119#ifdef ASSUMED_SHAPE
120# ifdef MASKING
121 real(r8), intent(in) :: rmask(LBi:,LBj:)
122# endif
123# ifdef IRON_LIMIT
124 real(r8), intent(in) :: h(LBi:,LBj:)
125# endif
126 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
127 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
128 real(r8), intent(in) :: z_w(LBi:,LBj:,0:)
129 real(r8), intent(in) :: srflx(LBi:,LBj:)
130 real(r8), intent(inout) :: t(LBi:,LBj:,:,:,:)
131#else
132# ifdef MASKING
133 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
134# endif
135# ifdef IRON_LIMIT
136 real(r8), intent(in) :: h(LBi:UBi,LBj:UBj)
137# endif
138 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,UBk)
139 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,UBk)
140 real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:UBk)
141 real(r8), intent(in) :: srflx(LBi:UBi,LBj:UBj)
142 real(r8), intent(inout) :: t(LBi:UBi,LBj:UBj,UBk,3,UBt)
143#endif
144!
145! Local variable declarations.
146!
147 integer, parameter :: Nsink = 2
148
149 integer :: Iter, i, ibio, isink, itime, itrc, iTrcMax, j, k, ks
150
151 integer, dimension(Nsink) :: idsink
152
153 real(r8), parameter :: MinVal = 1.0e-6_r8
154
155 real(r8) :: Att, ExpAtt, Itop, PAR
156 real(r8) :: cff, cff1, cff2, cff3, cff4, cff5, cff6, dtdays
157 real(r8) :: cffL, cffR, cu, dltL, dltR
158 real(r8) :: fac
159#ifdef IRON_LIMIT
160 real(r8) :: Nlimit, FNlim
161 real(r8) :: FNratio, FCratio, FCratioE, Flimit
162 real(r8) :: FeC2FeN, FeN2FeC
163 real(r8) :: cffFe
164# ifdef IRON_RELAX
165 real(r8) :: FeNudgCoef
166# endif
167#endif
168 real(r8), dimension(Nsink) :: Wbio
169
170 integer, dimension(IminS:ImaxS,N(ng)) :: ksource
171
172 real(r8), dimension(IminS:ImaxS) :: PARsur
173
174 real(r8), dimension(NT(ng),2) :: BioTrc
175
176 real(r8), dimension(IminS:ImaxS,N(ng),NT(ng)) :: Bio
177 real(r8), dimension(IminS:ImaxS,N(ng),NT(ng)) :: Bio_old
178
179 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: FC
180
181 real(r8), dimension(IminS:ImaxS,N(ng)) :: Hz_inv
182 real(r8), dimension(IminS:ImaxS,N(ng)) :: Hz_inv2
183 real(r8), dimension(IminS:ImaxS,N(ng)) :: Hz_inv3
184 real(r8), dimension(IminS:ImaxS,N(ng)) :: Light
185 real(r8), dimension(IminS:ImaxS,N(ng)) :: WL
186 real(r8), dimension(IminS:ImaxS,N(ng)) :: WR
187 real(r8), dimension(IminS:ImaxS,N(ng)) :: bL
188 real(r8), dimension(IminS:ImaxS,N(ng)) :: bR
189 real(r8), dimension(IminS:ImaxS,N(ng)) :: qc
190
191#include "set_bounds.h"
192!
193!-----------------------------------------------------------------------
194! Add biological Source/Sink terms.
195!-----------------------------------------------------------------------
196!
197! Avoid computing source/sink terms if no biological iterations.
198!
199 IF (bioiter(ng).le.0) RETURN
200!
201! Set time-stepping size (days) according to the number of iterations.
202!
203 dtdays=dt(ng)*sec2day/real(bioiter(ng),r8)
204
205#if defined IRON_LIMIT && defined IRON_RELAX
206!
207! Set nudging coefficient for dissolved iron over the shelf.
208!
209 fenudgcoef=dt(ng)/(fenudgtime(ng)*86400.0_r8)
210#endif
211#ifdef IRON_LIMIT
212!
213! Set Fe:N and Fe:C conversion ratio and its inverse.
214!
215 fen2fec=(16.0_r8/106.0_r8)*1.0e3_r8
216 fec2fen=(106.0_r8/16.0_r8)*1.0e-3_r8
217#endif
218!
219! Set vertical sinking indentification vector.
220!
221 idsink(1)=iphyt ! Phytoplankton
222 idsink(2)=isdet ! Small detritus
223!
224! Set vertical sinking velocity vector in the same order as the
225! identification vector, IDSINK.
226!
227 wbio(1)=wphy(ng) ! Phytoplankton
228 wbio(2)=wdet(ng) ! Small detritus
229!
230! Compute inverse thickness to avoid repeated divisions.
231!
232 j_loop : DO j=jstr,jend
233 DO k=1,n(ng)
234 DO i=istr,iend
235 hz_inv(i,k)=1.0_r8/hz(i,j,k)
236 END DO
237 END DO
238 DO k=1,n(ng)-1
239 DO i=istr,iend
240 hz_inv2(i,k)=1.0_r8/(hz(i,j,k)+hz(i,j,k+1))
241 END DO
242 END DO
243 DO k=2,n(ng)-1
244 DO i=istr,iend
245 hz_inv3(i,k)=1.0_r8/(hz(i,j,k-1)+hz(i,j,k)+hz(i,j,k+1))
246 END DO
247 END DO
248!
249! Restrict biological tracer to be positive definite. If a negative
250! concentration is detected, nitrogen is drawn from the most abundant
251! pool to supplement the negative pools to a lower limit of MinVal
252! which is set to 1E-6 above.
253!
254 DO k=1,n(ng)
255 DO i=istr,iend
256!
257! At input, all tracers (index nnew) from predictor step have
258! transport units (m Tunits) since we do not have yet the new
259! values for zeta and Hz. These are known after the 2D barotropic
260! time-stepping.
261!
262 DO itrc=1,nbt
263 ibio=idbio(itrc)
264 biotrc(ibio,nstp)=t(i,j,k,nstp,ibio)
265 biotrc(ibio,nnew)=t(i,j,k,nnew,ibio)*hz_inv(i,k)
266 END DO
267!
268! Impose positive definite concentrations.
269!
270 cff2=0.0_r8
271 DO itime=1,2
272 cff1=0.0_r8
273 itrcmax=idbio(1)
274#ifdef IRON_LIMIT
275 DO itrc=1,nbt-2
276#else
277 DO itrc=1,nbt
278#endif
279 ibio=idbio(itrc)
280 cff1=cff1+max(0.0_r8,minval-biotrc(ibio,itime))
281 IF (biotrc(ibio,itime).gt.biotrc(itrcmax,itime)) THEN
282 itrcmax=ibio
283 END IF
284 biotrc(ibio,itime)=max(minval,biotrc(ibio,itime))
285 END DO
286 IF (biotrc(itrcmax,itime).gt.cff1) THEN
287 biotrc(itrcmax,itime)=biotrc(itrcmax,itime)-cff1
288 END IF
289#ifdef IRON_LIMIT
290 DO itrc=nbt-1,nbt
291 ibio=idbio(itrc)
292 biotrc(ibio,itime)=max(minval,biotrc(ibio,itime))
293 END DO
294#endif
295 END DO
296!
297! Load biological tracers into local arrays.
298!
299 DO itrc=1,nbt
300 ibio=idbio(itrc)
301 bio_old(i,k,ibio)=biotrc(ibio,nstp)
302 bio(i,k,ibio)=biotrc(ibio,nstp)
303 END DO
304
305#if defined IRON_LIMIT && defined IRON_RELAX
306!
307! Relax dissolved iron at coast (h <= FeHim) to a constant value
308! (FeMax) over a time scale (FeNudgTime; days) to simulate sources
309! at the shelf.
310!
311 IF (h(i,j).le.fehmin(ng)) THEN
312 bio(i,k,ifdis)=bio(i,k,ifdis)+ &
313 & fenudgcoef*(femax(ng)-bio(i,k,ifdis))
314 END IF
315#endif
316 END DO
317 END DO
318!
319! Calculate surface Photosynthetically Available Radiation (PAR). The
320! net shortwave radiation is scaled back to Watts/m2 and multiplied by
321! the fraction that is photosynthetically available, PARfrac.
322!
323 DO i=istr,iend
324#ifdef CONST_PAR
325!
326! Specify constant surface irradiance a la Powell and Spitz.
327!
328 parsur(i)=158.075_r8
329#else
330 parsur(i)=parfrac(ng)*srflx(i,j)*rho0*cp
331#endif
332 END DO
333!
334!=======================================================================
335! Start internal iterations to achieve convergence of the nonlinear
336! backward-implicit solution.
337!=======================================================================
338!
339! During the iterative procedure a series of fractional time steps are
340! performed in a chained mode (splitting by different biological
341! conversion processes) in sequence of the main food chain. In all
342! stages the concentration of the component being consumed is treated
343! in a fully implicit manner, so the algorithm guarantees non-negative
344! values, no matter how strong the concentration of active consuming
345! component (Phytoplankton or Zooplankton). The overall algorithm,
346! as well as any stage of it, is formulated in conservative form
347! (except explicit sinking) in sense that the sum of concentration of
348! all components is conserved.
349!
350! In the implicit algorithm, we have for example (N: nutrient,
351! P: phytoplankton),
352!
353! N(new) = N(old) - uptake * P(old) uptake = mu * N / (Kn + N)
354! {Michaelis-Menten}
355! below, we set
356! The N in the numerator of
357! cff = mu * P(old) / (Kn + N(old)) uptake is treated implicitly
358! as N(new)
359!
360! so the time-stepping of the equations becomes:
361!
362! N(new) = N(old) / (1 + cff) (1) when substracting a sink term,
363! consuming, divide by (1 + cff)
364! and
365!
366! P(new) = P(old) + cff * N(new) (2) when adding a source term,
367! growing, add (cff * source)
368!
369! Notice that if you substitute (1) in (2), you will get:
370!
371! P(new) = P(old) + cff * N(old) / (1 + cff) (3)
372!
373! If you add (1) and (3), you get
374!
375! N(new) + P(new) = N(old) + P(old)
376!
377! implying conservation regardless how "cff" is computed. Therefore,
378! this scheme is unconditionally stable regardless of the conversion
379! rate. It does not generate negative values since the constituent
380! to be consumed is always treated implicitly. It is also biased
381! toward damping oscillations.
382!
383! The iterative loop below is to iterate toward an universal Backward-
384! Euler treatment of all terms. So if there are oscillations in the
385! system, they are only physical oscillations. These iterations,
386! however, do not improve the accuaracy of the solution.
387!
388 iter_loop: DO iter=1,bioiter(ng)
389!
390! Compute light attenuation as function of depth.
391!
392 DO i=istr,iend
393 par=parsur(i)
394 IF (parsur(i).gt.0.0_r8) THEN ! day time
395 DO k=n(ng),1,-1
396!
397! Compute average light attenuation for each grid cell. Here, AttSW is
398! the light attenuation due to seawater and AttPhy is the attenuation
399! due to phytoplankton (self-shading coefficient).
400!
401 att=(attsw(ng)+attphy(ng)*bio(i,k,iphyt))* &
402 & (z_w(i,j,k)-z_w(i,j,k-1))
403 expatt=exp(-att)
404 itop=par
405 par=itop*(1.0_r8-expatt)/att ! average at cell center
406 light(i,k)=par
407!
408! Light attenuation at the bottom of the grid cell. It is the starting
409! PAR value for the next (deeper) vertical grid cell.
410!
411 par=itop*expatt
412 END DO
413 ELSE ! night time
414 DO k=1,n(ng)
415 light(i,k)=0.0_r8
416 END DO
417 END IF
418 END DO
419!
420! Phytoplankton photosynthetic growth and nitrate uptake (Vm_NO3 rate).
421! The Michaelis-Menten curve is used to describe the change in uptake
422! rate as a function of nitrate concentration. Here, PhyIS is the
423! initial slope of the P-I curve and K_NO3 is the half saturation of
424! phytoplankton nitrate uptake.
425#ifdef IRON_LIMIT
426!
427! Growth reduction factors due to iron limitation:
428!
429! FNratio current Fe:N ratio [umol-Fe/mmol-N]
430! FCratio current Fe:C ratio [umol-Fe/mol-C]
431! (umol-Fe/mmol-N)*(16 M-N/106 M-C)*(1E3 mmol-C/mol-C)
432! FCratioE empirical Fe:C ratio
433! Flimit Phytoplankton growth reduction factor due to Fe
434! limitation based on Fe:C ratio
435!
436#endif
437!
438 cff1=dtdays*vm_no3(ng)*phyis(ng)
439 cff2=vm_no3(ng)*vm_no3(ng)
440 cff3=phyis(ng)*phyis(ng)
441 DO k=1,n(ng)
442 DO i=istr,iend
443#ifdef IRON_LIMIT
444!
445! Calculate growth reduction factor due to iron limitation.
446!
447 fnratio=bio(i,k,ifphy)/max(minval,bio(i,k,iphyt))
448 fcratio=fnratio*fen2fec
449 fcratioe=b_fe(ng)*bio(i,k,ifdis)**a_fe(ng)
450 flimit=fcratio*fcratio/ &
451 & (fcratio*fcratio+k_fec(ng)*k_fec(ng))
452!
453 nlimit=1.0_r8/(k_no3(ng)+bio(i,k,ino3_))
454 fnlim=min(1.0_r8,flimit/(bio(i,k,ino3_)*nlimit))
455#endif
456 cff4=1.0_r8/sqrt(cff2+cff3*light(i,k)*light(i,k))
457 cff=bio(i,k,iphyt)* &
458#ifdef IRON_LIMIT
459 & cff1*cff4*light(i,k)*fnlim*nlimit
460#else
461 & cff1*cff4*light(i,k)/ &
462 & (k_no3(ng)+bio(i,k,ino3_))
463#endif
464 bio(i,k,ino3_)=bio(i,k,ino3_)/(1.0_r8+cff)
465 bio(i,k,iphyt)=bio(i,k,iphyt)+ &
466 & bio(i,k,ino3_)*cff
467
468#ifdef IRON_LIMIT
469!
470! Iron uptake proportional to growth.
471!
472 fac=cff*bio(i,k,ino3_)*fnratio/max(minval,bio(i,k,ifdis))
473 bio(i,k,ifdis)=bio(i,k,ifdis)/(1.0_r8+fac)
474 bio(i,k,ifphy)=bio(i,k,ifphy)+ &
475 & bio(i,k,ifdis)*fac
476!
477! Iron uptake to reach appropriate Fe:C ratio.
478!
479 cff5=dtdays*(fcratioe-fcratio)/t_fe(ng)
480 cff6=bio(i,k,iphyt)*cff5*fec2fen
481 IF (cff6.ge.0.0_r8) THEN
482 cff=cff6/max(minval,bio(i,k,ifdis))
483 bio(i,k,ifdis)=bio(i,k,ifdis)/(1.0_r8+cff)
484 bio(i,k,ifphy)=bio(i,k,ifphy)+ &
485 & bio(i,k,ifdis)*cff
486 ELSE
487 cff=-cff6/max(minval,bio(i,k,ifphy))
488 bio(i,k,ifphy)=bio(i,k,ifphy)/(1.0_r8+cff)
489 bio(i,k,ifdis)=bio(i,k,ifdis)+ &
490 & bio(i,k,ifphy)*cff
491 END IF
492#endif
493 END DO
494 END DO
495!
496! Grazing on phytoplankton by zooplankton (ZooGR rate) using the Ivlev
497! formulation (Ivlev, 1955) and lost of phytoplankton to the nitrate
498! pool as function of "sloppy feeding" and metabolic processes
499! (ZooEEN and ZooEED fractions).
500#ifdef IRON_LIMIT
501! The lost of phytoplankton to the dissolve iron pool is scale by the
502! remineralization rate (FeRR).
503#endif
504!
505 cff1=dtdays*zoogr(ng)
506 cff2=1.0_r8-zooeen(ng)-zooeed(ng)
507 DO k=1,n(ng)
508 DO i=istr,iend
509 cff=bio(i,k,izoop)* &
510 & cff1*(1.0_r8-exp(-ivlev(ng)*bio(i,k,iphyt)))/ &
511 & bio(i,k,iphyt)
512 bio(i,k,iphyt)=bio(i,k,iphyt)/(1.0_r8+cff)
513 bio(i,k,izoop)=bio(i,k,izoop)+ &
514 & bio(i,k,iphyt)*cff2*cff
515 bio(i,k,ino3_)=bio(i,k,ino3_)+ &
516 & bio(i,k,iphyt)*zooeen(ng)*cff
517 bio(i,k,isdet)=bio(i,k,isdet)+ &
518 & bio(i,k,iphyt)*zooeed(ng)*cff
519#ifdef IRON_LIMIT
520 bio(i,k,ifphy)=bio(i,k,ifphy)/(1.0_r8+cff)
521 bio(i,k,ifdis)=bio(i,k,ifdis)+ &
522 & bio(i,k,ifphy)*cff*ferr(ng)
523#endif
524 END DO
525 END DO
526!
527! Phytoplankton mortality to nutrients (PhyMRNro rate), detritus
528! (PhyMRD rate), and if applicable dissolved iron (FeRR rate).
529!
530 cff3=dtdays*phymrd(ng)
531 cff2=dtdays*phymrn(ng)
532 cff1=1.0_r8/(1.0_r8+cff2+cff3)
533 DO k=1,n(ng)
534 DO i=istr,iend
535 bio(i,k,iphyt)=bio(i,k,iphyt)*cff1
536 bio(i,k,ino3_)=bio(i,k,ino3_)+ &
537 & bio(i,k,iphyt)*cff2
538 bio(i,k,isdet)=bio(i,k,isdet)+ &
539 & bio(i,k,iphyt)*cff3
540#ifdef IRON_LIMIT
541 bio(i,k,ifphy)=bio(i,k,ifphy)*cff1
542 bio(i,k,ifdis)=bio(i,k,ifdis)+ &
543 & bio(i,k,ifphy)*(cff2+cff3)*ferr(ng)
544#endif
545 END DO
546 END DO
547!
548! Zooplankton mortality to nutrients (ZooMRN rate) and Detritus
549! (ZooMRD rate).
550!
551 cff3=dtdays*zoomrd(ng)
552 cff2=dtdays*zoomrn(ng)
553 cff1=1.0_r8/(1.0_r8+cff2+cff3)
554 DO k=1,n(ng)
555 DO i=istr,iend
556 bio(i,k,izoop)=bio(i,k,izoop)*cff1
557 bio(i,k,ino3_)=bio(i,k,ino3_)+ &
558 & bio(i,k,izoop)*cff2
559 bio(i,k,isdet)=bio(i,k,isdet)+ &
560 & bio(i,k,izoop)*cff3
561 END DO
562 END DO
563!
564! Detritus breakdown to nutrients: remineralization (DetRR rate).
565!
566 cff2=dtdays*detrr(ng)
567 cff1=1.0_r8/(1.0_r8+cff2)
568 DO k=1,n(ng)
569 DO i=istr,iend
570 bio(i,k,isdet)=bio(i,k,isdet)*cff1
571 bio(i,k,ino3_)=bio(i,k,ino3_)+ &
572 & bio(i,k,isdet)*cff2
573 END DO
574 END DO
575!
576!-----------------------------------------------------------------------
577! Vertical sinking terms: Phytoplankton and Detritus
578!-----------------------------------------------------------------------
579!
580! Reconstruct vertical profile of selected biological constituents
581! "Bio(:,:,isink)" in terms of a set of parabolic segments within each
582! grid box. Then, compute semi-Lagrangian flux due to sinking.
583!
584 sink_loop: DO isink=1,nsink
585 ibio=idsink(isink)
586!
587! Copy concentration of biological particulates into scratch array
588! "qc" (q-central, restrict it to be positive) which is hereafter
589! interpreted as a set of grid-box averaged values for biogeochemical
590! constituent concentration.
591!
592 DO k=1,n(ng)
593 DO i=istr,iend
594 qc(i,k)=bio(i,k,ibio)
595 END DO
596 END DO
597!
598 DO k=n(ng)-1,1,-1
599 DO i=istr,iend
600 fc(i,k)=(qc(i,k+1)-qc(i,k))*hz_inv2(i,k)
601 END DO
602 END DO
603 DO k=2,n(ng)-1
604 DO i=istr,iend
605 dltr=hz(i,j,k)*fc(i,k)
606 dltl=hz(i,j,k)*fc(i,k-1)
607 cff=hz(i,j,k-1)+2.0_r8*hz(i,j,k)+hz(i,j,k+1)
608 cffr=cff*fc(i,k)
609 cffl=cff*fc(i,k-1)
610!
611! Apply PPM monotonicity constraint to prevent oscillations within the
612! grid box.
613!
614 IF ((dltr*dltl).le.0.0_r8) THEN
615 dltr=0.0_r8
616 dltl=0.0_r8
617 ELSE IF (abs(dltr).gt.abs(cffl)) THEN
618 dltr=cffl
619 ELSE IF (abs(dltl).gt.abs(cffr)) THEN
620 dltl=cffr
621 END IF
622!
623! Compute right and left side values (bR,bL) of parabolic segments
624! within grid box Hz(k); (WR,WL) are measures of quadratic variations.
625!
626! NOTE: Although each parabolic segment is monotonic within its grid
627! box, monotonicity of the whole profile is not guaranteed,
628! because bL(k+1)-bR(k) may still have different sign than
629! qc(i,k+1)-qc(i,k). This possibility is excluded,
630! after bL and bR are reconciled using WENO procedure.
631!
632 cff=(dltr-dltl)*hz_inv3(i,k)
633 dltr=dltr-cff*hz(i,j,k+1)
634 dltl=dltl+cff*hz(i,j,k-1)
635 br(i,k)=qc(i,k)+dltr
636 bl(i,k)=qc(i,k)-dltl
637 wr(i,k)=(2.0_r8*dltr-dltl)**2
638 wl(i,k)=(dltr-2.0_r8*dltl)**2
639 END DO
640 END DO
641 cff=1.0e-14_r8
642 DO k=2,n(ng)-2
643 DO i=istr,iend
644 dltl=max(cff,wl(i,k ))
645 dltr=max(cff,wr(i,k+1))
646 br(i,k)=(dltr*br(i,k)+dltl*bl(i,k+1))/(dltr+dltl)
647 bl(i,k+1)=br(i,k)
648 END DO
649 END DO
650 DO i=istr,iend
651 fc(i,n(ng))=0.0_r8 ! NO-flux boundary condition
652#if defined LINEAR_CONTINUATION
653 bl(i,n(ng))=br(i,n(ng)-1)
654 br(i,n(ng))=2.0_r8*qc(i,n(ng))-bl(i,n(ng))
655#elif defined NEUMANN
656 bl(i,n(ng))=br(i,n(ng)-1)
657 br(i,n(ng))=1.5_r8*qc(i,n(ng))-0.5_r8*bl(i,n(ng))
658#else
659 br(i,n(ng))=qc(i,n(ng)) ! default strictly monotonic
660 bl(i,n(ng))=qc(i,n(ng)) ! conditions
661 br(i,n(ng)-1)=qc(i,n(ng))
662#endif
663#if defined LINEAR_CONTINUATION
664 br(i,1)=bl(i,2)
665 bl(i,1)=2.0_r8*qc(i,1)-br(i,1)
666#elif defined NEUMANN
667 br(i,1)=bl(i,2)
668 bl(i,1)=1.5_r8*qc(i,1)-0.5_r8*br(i,1)
669#else
670 bl(i,2)=qc(i,1) ! bottom grid boxes are
671 br(i,1)=qc(i,1) ! re-assumed to be
672 bl(i,1)=qc(i,1) ! piecewise constant.
673#endif
674 END DO
675!
676! Apply monotonicity constraint again, since the reconciled interfacial
677! values may cause a non-monotonic behavior of the parabolic segments
678! inside the grid box.
679!
680 DO k=1,n(ng)
681 DO i=istr,iend
682 dltr=br(i,k)-qc(i,k)
683 dltl=qc(i,k)-bl(i,k)
684 cffr=2.0_r8*dltr
685 cffl=2.0_r8*dltl
686 IF ((dltr*dltl).lt.0.0_r8) THEN
687 dltr=0.0_r8
688 dltl=0.0_r8
689 ELSE IF (abs(dltr).gt.abs(cffl)) THEN
690 dltr=cffl
691 ELSE IF (abs(dltl).gt.abs(cffr)) THEN
692 dltl=cffr
693 END IF
694 br(i,k)=qc(i,k)+dltr
695 bl(i,k)=qc(i,k)-dltl
696 END DO
697 END DO
698!
699! After this moment reconstruction is considered complete. The next
700! stage is to compute vertical advective fluxes, FC. It is expected
701! that sinking may occurs relatively fast, the algorithm is designed
702! to be free of CFL criterion, which is achieved by allowing
703! integration bounds for semi-Lagrangian advective flux to use as
704! many grid boxes in upstream direction as necessary.
705!
706! In the two code segments below, WL is the z-coordinate of the
707! departure point for grid box interface z_w with the same indices;
708! FC is the finite volume flux; ksource(:,k) is index of vertical
709! grid box which contains the departure point (restricted by N(ng)).
710! During the search: also add in content of whole grid boxes
711! participating in FC.
712!
713 cff=dtdays*abs(wbio(isink))
714 DO k=1,n(ng)
715 DO i=istr,iend
716 fc(i,k-1)=0.0_r8
717 wl(i,k)=z_w(i,j,k-1)+cff
718 wr(i,k)=hz(i,j,k)*qc(i,k)
719 ksource(i,k)=k
720 END DO
721 END DO
722 DO k=1,n(ng)
723 DO ks=k,n(ng)-1
724 DO i=istr,iend
725 IF (wl(i,k).gt.z_w(i,j,ks)) THEN
726 ksource(i,k)=ks+1
727 fc(i,k-1)=fc(i,k-1)+wr(i,ks)
728 END IF
729 END DO
730 END DO
731 END DO
732!
733! Finalize computation of flux: add fractional part.
734!
735 DO k=1,n(ng)
736 DO i=istr,iend
737 ks=ksource(i,k)
738 cu=min(1.0_r8,(wl(i,k)-z_w(i,j,ks-1))*hz_inv(i,ks))
739 fc(i,k-1)=fc(i,k-1)+ &
740 & hz(i,j,ks)*cu* &
741 & (bl(i,ks)+ &
742 & cu*(0.5_r8*(br(i,ks)-bl(i,ks))- &
743 & (1.5_r8-cu)* &
744 & (br(i,ks)+bl(i,ks)- &
745 & 2.0_r8*qc(i,ks))))
746 END DO
747 END DO
748 DO k=1,n(ng)
749 DO i=istr,iend
750 bio(i,k,ibio)=qc(i,k)+(fc(i,k)-fc(i,k-1))*hz_inv(i,k)
751 END DO
752 END DO
753
754 END DO sink_loop
755 END DO iter_loop
756!
757!-----------------------------------------------------------------------
758! Update global tracer variables: Add increment due to BGC processes
759! to tracer array in time index "nnew". Index "nnew" is solution after
760! advection and mixing and has transport units (m Tunits) hence the
761! increment is multiplied by Hz. Notice that we need to subtract
762! original values "Bio_old" at the top of the routine to just account
763! for the concentractions affected by BGC processes. This also takes
764! into account any constraints (non-negative concentrations, carbon
765! concentration range) specified before entering BGC kernel. If "Bio"
766! were unchanged by BGC processes, the increment would be exactly
767! zero. Notice that final tracer values, t(:,:,:,nnew,:) are not
768! bounded >=0 so that we can preserve total inventory of nutrients
769! when advection causes tracer concentration to go negative.
770!-----------------------------------------------------------------------
771!
772 DO itrc=1,nbt
773 ibio=idbio(itrc)
774 DO k=1,n(ng)
775 DO i=istr,iend
776 cff=bio(i,k,ibio)-bio_old(i,k,ibio)
777 t(i,j,k,nnew,ibio)=t(i,j,k,nnew,ibio)+cff*hz(i,j,k)
778 END DO
779 END DO
780 END DO
781
782 END DO j_loop
783!
784 RETURN
mod_biology::phymrd
real(r8), dimension(:), allocatable phymrd
Definition npzd_iron_mod.h:102
mod_biology::zooeed
real(r8), dimension(:), allocatable zooeed
Definition npzd_iron_mod.h:119
mod_biology::ifphy
integer ifphy
Definition npzd_iron_mod.h:68
mod_biology::ferr
real(r8), dimension(:), allocatable ferr
Definition npzd_iron_mod.h:86
mod_biology::a_fe
real(r8), dimension(:), allocatable a_fe
Definition npzd_iron_mod.h:84
mod_biology::ifdis
integer ifdis
Definition npzd_iron_mod.h:69
mod_biology::fenudgtime
real(r8), dimension(:), allocatable fenudgtime
Definition npzd_iron_mod.h:90
mod_biology::ivlev
real(r8), dimension(:), allocatable ivlev
Definition npzd_iron_mod.h:81
mod_biology::attphy
real(r8), dimension(:), allocatable attphy
Definition npzd_iron_mod.h:77
mod_biology::b_fe
real(r8), dimension(:), allocatable b_fe
Definition npzd_iron_mod.h:85
mod_biology::fehmin
real(r8), dimension(:), allocatable fehmin
Definition npzd_iron_mod.h:88
mod_biology::k_fec
real(r8), dimension(:), allocatable k_fec
Definition npzd_iron_mod.h:92
mod_biology::t_fe
real(r8), dimension(:), allocatable t_fe
Definition npzd_iron_mod.h:93
mod_biology::zoomrn
real(r8), dimension(:), allocatable zoomrn
Definition npzd_iron_mod.h:123
mod_biology::femax
real(r8), dimension(:), allocatable femax
Definition npzd_iron_mod.h:89
mod_biology::phymrn
real(r8), dimension(:), allocatable phymrn
Definition npzd_iron_mod.h:103
mod_biology::zoomrd
real(r8), dimension(:), allocatable zoomrd
Definition npzd_iron_mod.h:122
mod_biology::zooeen
real(r8), dimension(:), allocatable zooeen
Definition npzd_iron_mod.h:120

References mod_biology::a_fe, mod_biology::attphy, mod_biology::attsw, mod_biology::b_fe, mod_biology::bioiter, mod_scalars::cp, mod_biology::detrr, mod_scalars::dt, mod_biology::fehmin, mod_biology::femax, mod_biology::fenudgtime, mod_biology::ferr, mod_biology::idbio, mod_biology::ifdis, mod_biology::ifphy, mod_biology::ino3_, mod_biology::iphyt, mod_biology::isdet, mod_biology::ivlev, mod_biology::izoop, mod_biology::k_fec, mod_biology::k_no3, mod_param::n, mod_param::nbt, mod_biology::parfrac, mod_biology::phyis, mod_biology::phymrd, mod_biology::phymrn, mod_scalars::rho0, mod_scalars::sec2day, mod_biology::t_fe, mod_biology::vm_no3, mod_biology::wdet, mod_biology::wphy, mod_biology::zooeed, mod_biology::zooeen, mod_biology::zoogr, mod_biology::zoomrd, and mod_biology::zoomrn.

◆ npzd_powell_tile()

subroutine biology_mod::npzd_powell_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) ubk,
integer, intent(in) ubt,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) nstp,
integer, intent(in) nnew,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) rmask,
real(r8), dimension(lbi:ubi,lbj:ubj,ubk), intent(in) hz,
real(r8), dimension(lbi:ubi,lbj:ubj,ubk), intent(in) z_r,
real(r8), dimension(lbi:ubi,lbj:ubj,0:ubk), intent(in) z_w,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) srflx,
real(r8), dimension(lbi:ubi,lbj:ubj,ubk,3,ubt), intent(inout) t )
private

Definition at line 91 of file npzd_Powell.h.

101!-----------------------------------------------------------------------
102!
103 USE mod_param
104 USE mod_biology
105 USE mod_ncparam
106 USE mod_scalars
107!
108! Imported variable declarations.
109!
110 integer, intent(in) :: ng, tile
111 integer, intent(in) :: LBi, UBi, LBj, UBj, UBk, UBt
112 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
113 integer, intent(in) :: nstp, nnew
114
115#ifdef ASSUMED_SHAPE
116# ifdef MASKING
117 real(r8), intent(in) :: rmask(LBi:,LBj:)
118# endif
119 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
120 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
121 real(r8), intent(in) :: z_w(LBi:,LBj:,0:)
122 real(r8), intent(in) :: srflx(LBi:,LBj:)
123 real(r8), intent(inout) :: t(LBi:,LBj:,:,:,:)
124#else
125# ifdef MASKING
126 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
127# endif
128 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,UBk)
129 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,UBk)
130 real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:UBk)
131 real(r8), intent(in) :: srflx(LBi:UBi,LBj:UBj)
132 real(r8), intent(inout) :: t(LBi:UBi,LBj:UBj,UBk,3,UBt)
133#endif
134!
135! Local variable declarations.
136!
137 integer, parameter :: Nsink = 2
138
139 integer :: Iter, i, ibio, isink, itime, itrc, iTrcMax, j, k, ks
140
141 integer, dimension(Nsink) :: idsink
142
143 real(r8), parameter :: MinVal = 1.0e-6_r8
144
145 real(r8) :: Att, ExpAtt, Itop, PAR
146 real(r8) :: cff, cff1, cff2, cff3, cff4, dtdays
147 real(r8) :: cffL, cffR, cu, dltL, dltR
148
149 real(r8), dimension(Nsink) :: Wbio
150
151 integer, dimension(IminS:ImaxS,N(ng)) :: ksource
152
153 real(r8), dimension(IminS:ImaxS) :: PARsur
154
155 real(r8), dimension(NT(ng),2) :: BioTrc
156
157 real(r8), dimension(IminS:ImaxS,N(ng),NT(ng)) :: Bio
158 real(r8), dimension(IminS:ImaxS,N(ng),NT(ng)) :: Bio_old
159
160 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: FC
161
162 real(r8), dimension(IminS:ImaxS,N(ng)) :: Hz_inv
163 real(r8), dimension(IminS:ImaxS,N(ng)) :: Hz_inv2
164 real(r8), dimension(IminS:ImaxS,N(ng)) :: Hz_inv3
165 real(r8), dimension(IminS:ImaxS,N(ng)) :: Light
166 real(r8), dimension(IminS:ImaxS,N(ng)) :: WL
167 real(r8), dimension(IminS:ImaxS,N(ng)) :: WR
168 real(r8), dimension(IminS:ImaxS,N(ng)) :: bL
169 real(r8), dimension(IminS:ImaxS,N(ng)) :: bR
170 real(r8), dimension(IminS:ImaxS,N(ng)) :: qc
171
172#include "set_bounds.h"
173!
174!-----------------------------------------------------------------------
175! Add biological Source/Sink terms.
176!-----------------------------------------------------------------------
177!
178! Avoid computing source/sink terms if no biological iterations.
179!
180 IF (bioiter(ng).le.0) RETURN
181!
182! Set time-stepping size (days) according to the number of iterations.
183!
184 dtdays=dt(ng)*sec2day/real(bioiter(ng),r8)
185!
186! Set vertical sinking indentification vector.
187!
188 idsink(1)=iphyt ! Phytoplankton
189 idsink(2)=isdet ! Small detritus
190!
191! Set vertical sinking velocity vector in the same order as the
192! identification vector, IDSINK.
193!
194 wbio(1)=wphy(ng) ! Phytoplankton
195 wbio(2)=wdet(ng) ! Small detritus
196!
197! Compute inverse thickness to avoid repeated divisions.
198!
199 j_loop : DO j=jstr,jend
200 DO k=1,n(ng)
201 DO i=istr,iend
202 hz_inv(i,k)=1.0_r8/hz(i,j,k)
203 END DO
204 END DO
205 DO k=1,n(ng)-1
206 DO i=istr,iend
207 hz_inv2(i,k)=1.0_r8/(hz(i,j,k)+hz(i,j,k+1))
208 END DO
209 END DO
210 DO k=2,n(ng)-1
211 DO i=istr,iend
212 hz_inv3(i,k)=1.0_r8/(hz(i,j,k-1)+hz(i,j,k)+hz(i,j,k+1))
213 END DO
214 END DO
215!
216! Restrict biological tracer to be positive definite. If a negative
217! concentration is detected, nitrogen is drawn from the most abundant
218! pool to supplement the negative pools to a lower limit of MinVal
219! which is set to 1E-6 above.
220!
221 DO k=1,n(ng)
222 DO i=istr,iend
223!
224! At input, all tracers (index nnew) from predictor step have
225! transport units (m Tunits) since we do not have yet the new
226! values for zeta and Hz. These are known after the 2D barotropic
227! time-stepping.
228!
229 DO itrc=1,nbt
230 ibio=idbio(itrc)
231 biotrc(ibio,nstp)=t(i,j,k,nstp,ibio)
232 biotrc(ibio,nnew)=t(i,j,k,nnew,ibio)*hz_inv(i,k)
233 END DO
234!
235! Impose positive definite concentrations.
236!
237 cff2=0.0_r8
238 DO itime=1,2
239 cff1=0.0_r8
240 itrcmax=idbio(1)
241 DO itrc=1,nbt
242 ibio=idbio(itrc)
243 cff1=cff1+max(0.0_r8,minval-biotrc(ibio,itime))
244 IF (biotrc(ibio,itime).gt.biotrc(itrcmax,itime)) THEN
245 itrcmax=ibio
246 END IF
247 biotrc(ibio,itime)=max(minval,biotrc(ibio,itime))
248 END DO
249 IF (biotrc(itrcmax,itime).gt.cff1) THEN
250 biotrc(itrcmax,itime)=biotrc(itrcmax,itime)-cff1
251 END IF
252 END DO
253!
254! Load biological tracers into local arrays.
255!
256 DO itrc=1,nbt
257 ibio=idbio(itrc)
258 bio_old(i,k,ibio)=biotrc(ibio,nstp)
259 bio(i,k,ibio)=biotrc(ibio,nstp)
260 END DO
261 END DO
262 END DO
263!
264! Calculate surface Photosynthetically Available Radiation (PAR). The
265! net shortwave radiation is scaled back to Watts/m2 and multiplied by
266! the fraction that is photosynthetically available, PARfrac.
267!
268 DO i=istr,iend
269#ifdef CONST_PAR
270!
271! Specify constant surface irradiance a la Powell and Spitz.
272!
273 parsur(i)=158.075_r8
274#else
275 parsur(i)=parfrac(ng)*srflx(i,j)*rho0*cp
276#endif
277 END DO
278!
279!=======================================================================
280! Start internal iterations to achieve convergence of the nonlinear
281! backward-implicit solution.
282!=======================================================================
283!
284! During the iterative procedure a series of fractional time steps are
285! performed in a chained mode (splitting by different biological
286! conversion processes) in sequence of the main food chain. In all
287! stages the concentration of the component being consumed is treated
288! in a fully implicit manner, so the algorithm guarantees non-negative
289! values, no matter how strong the concentration of active consuming
290! component (Phytoplankton or Zooplankton). The overall algorithm,
291! as well as any stage of it, is formulated in conservative form
292! (except explicit sinking) in sense that the sum of concentration of
293! all components is conserved.
294!
295! In the implicit algorithm, we have for example (N: nutrient,
296! P: phytoplankton),
297!
298! N(new) = N(old) - uptake * P(old) uptake = mu * N / (Kn + N)
299! {Michaelis-Menten}
300! below, we set
301! The N in the numerator of
302! cff = mu * P(old) / (Kn + N(old)) uptake is treated implicitly
303! as N(new)
304!
305! so the time-stepping of the equations becomes:
306!
307! N(new) = N(old) / (1 + cff) (1) when substracting a sink term,
308! consuming, divide by (1 + cff)
309! and
310!
311! P(new) = P(old) + cff * N(new) (2) when adding a source term,
312! growing, add (cff * source)
313!
314! Notice that if you substitute (1) in (2), you will get:
315!
316! P(new) = P(old) + cff * N(old) / (1 + cff) (3)
317!
318! If you add (1) and (3), you get
319!
320! N(new) + P(new) = N(old) + P(old)
321!
322! implying conservation regardless how "cff" is computed. Therefore,
323! this scheme is unconditionally stable regardless of the conversion
324! rate. It does not generate negative values since the constituent
325! to be consumed is always treated implicitly. It is also biased
326! toward damping oscillations.
327!
328! The iterative loop below is to iterate toward an universal Backward-
329! Euler treatment of all terms. So if there are oscillations in the
330! system, they are only physical oscillations. These iterations,
331! however, do not improve the accuaracy of the solution.
332!
333 iter_loop: DO iter=1,bioiter(ng)
334!
335! Compute light attenuation as function of depth.
336!
337 DO i=istr,iend
338 par=parsur(i)
339 IF (parsur(i).gt.0.0_r8) THEN ! day time
340 DO k=n(ng),1,-1
341!
342! Compute average light attenuation for each grid cell. Here, AttSW is
343! the light attenuation due to seawater and AttPhy is the attenuation
344! due to phytoplankton (self-shading coefficient).
345!
346 att=(attsw(ng)+attphy(ng)*bio(i,k,iphyt))* &
347 & (z_w(i,j,k)-z_w(i,j,k-1))
348 expatt=exp(-att)
349 itop=par
350 par=itop*(1.0_r8-expatt)/att ! average at cell center
351 light(i,k)=par
352!
353! Light attenuation at the bottom of the grid cell. It is the starting
354! PAR value for the next (deeper) vertical grid cell.
355!
356 par=itop*expatt
357 END DO
358 ELSE ! night time
359 DO k=1,n(ng)
360 light(i,k)=0.0_r8
361 END DO
362 END IF
363 END DO
364!
365! Phytoplankton photosynthetic growth and nitrate uptake (Vm_NO3 rate).
366! The Michaelis-Menten curve is used to describe the change in uptake
367! rate as a function of nitrate concentration. Here, PhyIS is the
368! initial slope of the P-I curve and K_NO3 is the half saturation of
369! phytoplankton nitrate uptake.
370!
371 cff1=dtdays*vm_no3(ng)*phyis(ng)
372 cff2=vm_no3(ng)*vm_no3(ng)
373 cff3=phyis(ng)*phyis(ng)
374 DO k=1,n(ng)
375 DO i=istr,iend
376 cff4=1.0_r8/sqrt(cff2+cff3*light(i,k)*light(i,k))
377 cff=bio(i,k,iphyt)* &
378 & cff1*cff4*light(i,k)/ &
379 & (k_no3(ng)+bio(i,k,ino3_))
380 bio(i,k,ino3_)=bio(i,k,ino3_)/(1.0_r8+cff)
381 bio(i,k,iphyt)=bio(i,k,iphyt)+ &
382 & bio(i,k,ino3_)*cff
383 END DO
384 END DO
385!
386! Grazing on phytoplankton by zooplankton (ZooGR rate) using the Ivlev
387! formulation (Ivlev, 1955) and lost of phytoplankton to the nitrate
388! pool as function of "sloppy feeding" and metabolic processes
389! (ZooEEN and ZooEED fractions).
390!
391 cff1=dtdays*zoogr(ng)
392 cff2=1.0_r8-zooeen(ng)-zooeed(ng)
393 DO k=1,n(ng)
394 DO i=istr,iend
395 cff=bio(i,k,izoop)* &
396 & cff1*(1.0_r8-exp(-ivlev(ng)*bio(i,k,iphyt)))/ &
397 & bio(i,k,iphyt)
398 bio(i,k,iphyt)=bio(i,k,iphyt)/(1.0_r8+cff)
399 bio(i,k,izoop)=bio(i,k,izoop)+ &
400 & bio(i,k,iphyt)*cff2*cff
401 bio(i,k,ino3_)=bio(i,k,ino3_)+ &
402 & bio(i,k,iphyt)*zooeen(ng)*cff
403 bio(i,k,isdet)=bio(i,k,isdet)+ &
404 & bio(i,k,iphyt)*zooeed(ng)*cff
405 END DO
406 END DO
407!
408! Phytoplankton mortality to nutrients (PhyMRN rate) and detritus
409! (PhyMRD rate).
410!
411 cff3=dtdays*phymrd(ng)
412 cff2=dtdays*phymrn(ng)
413 cff1=1.0_r8/(1.0_r8+cff2+cff3)
414 DO k=1,n(ng)
415 DO i=istr,iend
416 bio(i,k,iphyt)=bio(i,k,iphyt)*cff1
417 bio(i,k,ino3_)=bio(i,k,ino3_)+ &
418 & bio(i,k,iphyt)*cff2
419 bio(i,k,isdet)=bio(i,k,isdet)+ &
420 & bio(i,k,iphyt)*cff3
421 END DO
422 END DO
423!
424! Zooplankton mortality to nutrients (ZooMRN rate) and Detritus
425! (ZooMRD rate).
426!
427 cff3=dtdays*zoomrd(ng)
428 cff2=dtdays*zoomrn(ng)
429 cff1=1.0_r8/(1.0_r8+cff2+cff3)
430 DO k=1,n(ng)
431 DO i=istr,iend
432 bio(i,k,izoop)=bio(i,k,izoop)*cff1
433 bio(i,k,ino3_)=bio(i,k,ino3_)+ &
434 & bio(i,k,izoop)*cff2
435 bio(i,k,isdet)=bio(i,k,isdet)+ &
436 & bio(i,k,izoop)*cff3
437 END DO
438 END DO
439!
440! Detritus breakdown to nutrients: remineralization (DetRR rate).
441!
442 cff2=dtdays*detrr(ng)
443 cff1=1.0_r8/(1.0_r8+cff2)
444 DO k=1,n(ng)
445 DO i=istr,iend
446 bio(i,k,isdet)=bio(i,k,isdet)*cff1
447 bio(i,k,ino3_)=bio(i,k,ino3_)+ &
448 & bio(i,k,isdet)*cff2
449 END DO
450 END DO
451!
452!-----------------------------------------------------------------------
453! Vertical sinking terms: Phytoplankton and Detritus
454!-----------------------------------------------------------------------
455!
456! Reconstruct vertical profile of selected biological constituents
457! "Bio(:,:,isink)" in terms of a set of parabolic segments within each
458! grid box. Then, compute semi-Lagrangian flux due to sinking.
459!
460 sink_loop: DO isink=1,nsink
461 ibio=idsink(isink)
462!
463! Copy concentration of biological particulates into scratch array
464! "qc" (q-central, restrict it to be positive) which is hereafter
465! interpreted as a set of grid-box averaged values for biogeochemical
466! constituent concentration.
467!
468 DO k=1,n(ng)
469 DO i=istr,iend
470 qc(i,k)=bio(i,k,ibio)
471 END DO
472 END DO
473!
474 DO k=n(ng)-1,1,-1
475 DO i=istr,iend
476 fc(i,k)=(qc(i,k+1)-qc(i,k))*hz_inv2(i,k)
477 END DO
478 END DO
479 DO k=2,n(ng)-1
480 DO i=istr,iend
481 dltr=hz(i,j,k)*fc(i,k)
482 dltl=hz(i,j,k)*fc(i,k-1)
483 cff=hz(i,j,k-1)+2.0_r8*hz(i,j,k)+hz(i,j,k+1)
484 cffr=cff*fc(i,k)
485 cffl=cff*fc(i,k-1)
486!
487! Apply PPM monotonicity constraint to prevent oscillations within the
488! grid box.
489!
490 IF ((dltr*dltl).le.0.0_r8) THEN
491 dltr=0.0_r8
492 dltl=0.0_r8
493 ELSE IF (abs(dltr).gt.abs(cffl)) THEN
494 dltr=cffl
495 ELSE IF (abs(dltl).gt.abs(cffr)) THEN
496 dltl=cffr
497 END IF
498!
499! Compute right and left side values (bR,bL) of parabolic segments
500! within grid box Hz(k); (WR,WL) are measures of quadratic variations.
501!
502! NOTE: Although each parabolic segment is monotonic within its grid
503! box, monotonicity of the whole profile is not guaranteed,
504! because bL(k+1)-bR(k) may still have different sign than
505! qc(i,k+1)-qc(i,k). This possibility is excluded,
506! after bL and bR are reconciled using WENO procedure.
507!
508 cff=(dltr-dltl)*hz_inv3(i,k)
509 dltr=dltr-cff*hz(i,j,k+1)
510 dltl=dltl+cff*hz(i,j,k-1)
511 br(i,k)=qc(i,k)+dltr
512 bl(i,k)=qc(i,k)-dltl
513 wr(i,k)=(2.0_r8*dltr-dltl)**2
514 wl(i,k)=(dltr-2.0_r8*dltl)**2
515 END DO
516 END DO
517 cff=1.0e-14_r8
518 DO k=2,n(ng)-2
519 DO i=istr,iend
520 dltl=max(cff,wl(i,k ))
521 dltr=max(cff,wr(i,k+1))
522 br(i,k)=(dltr*br(i,k)+dltl*bl(i,k+1))/(dltr+dltl)
523 bl(i,k+1)=br(i,k)
524 END DO
525 END DO
526 DO i=istr,iend
527 fc(i,n(ng))=0.0_r8 ! NO-flux boundary condition
528#if defined LINEAR_CONTINUATION
529 bl(i,n(ng))=br(i,n(ng)-1)
530 br(i,n(ng))=2.0_r8*qc(i,n(ng))-bl(i,n(ng))
531#elif defined NEUMANN
532 bl(i,n(ng))=br(i,n(ng)-1)
533 br(i,n(ng))=1.5_r8*qc(i,n(ng))-0.5_r8*bl(i,n(ng))
534#else
535 br(i,n(ng))=qc(i,n(ng)) ! default strictly monotonic
536 bl(i,n(ng))=qc(i,n(ng)) ! conditions
537 br(i,n(ng)-1)=qc(i,n(ng))
538#endif
539#if defined LINEAR_CONTINUATION
540 br(i,1)=bl(i,2)
541 bl(i,1)=2.0_r8*qc(i,1)-br(i,1)
542#elif defined NEUMANN
543 br(i,1)=bl(i,2)
544 bl(i,1)=1.5_r8*qc(i,1)-0.5_r8*br(i,1)
545#else
546 bl(i,2)=qc(i,1) ! bottom grid boxes are
547 br(i,1)=qc(i,1) ! re-assumed to be
548 bl(i,1)=qc(i,1) ! piecewise constant.
549#endif
550 END DO
551!
552! Apply monotonicity constraint again, since the reconciled interfacial
553! values may cause a non-monotonic behavior of the parabolic segments
554! inside the grid box.
555!
556 DO k=1,n(ng)
557 DO i=istr,iend
558 dltr=br(i,k)-qc(i,k)
559 dltl=qc(i,k)-bl(i,k)
560 cffr=2.0_r8*dltr
561 cffl=2.0_r8*dltl
562 IF ((dltr*dltl).lt.0.0_r8) THEN
563 dltr=0.0_r8
564 dltl=0.0_r8
565 ELSE IF (abs(dltr).gt.abs(cffl)) THEN
566 dltr=cffl
567 ELSE IF (abs(dltl).gt.abs(cffr)) THEN
568 dltl=cffr
569 END IF
570 br(i,k)=qc(i,k)+dltr
571 bl(i,k)=qc(i,k)-dltl
572 END DO
573 END DO
574!
575! After this moment reconstruction is considered complete. The next
576! stage is to compute vertical advective fluxes, FC. It is expected
577! that sinking may occurs relatively fast, the algorithm is designed
578! to be free of CFL criterion, which is achieved by allowing
579! integration bounds for semi-Lagrangian advective flux to use as
580! many grid boxes in upstream direction as necessary.
581!
582! In the two code segments below, WL is the z-coordinate of the
583! departure point for grid box interface z_w with the same indices;
584! FC is the finite volume flux; ksource(:,k) is index of vertical
585! grid box which contains the departure point (restricted by N(ng)).
586! During the search: also add in content of whole grid boxes
587! participating in FC.
588!
589 cff=dtdays*abs(wbio(isink))
590 DO k=1,n(ng)
591 DO i=istr,iend
592 fc(i,k-1)=0.0_r8
593 wl(i,k)=z_w(i,j,k-1)+cff
594 wr(i,k)=hz(i,j,k)*qc(i,k)
595 ksource(i,k)=k
596 END DO
597 END DO
598 DO k=1,n(ng)
599 DO ks=k,n(ng)-1
600 DO i=istr,iend
601 IF (wl(i,k).gt.z_w(i,j,ks)) THEN
602 ksource(i,k)=ks+1
603 fc(i,k-1)=fc(i,k-1)+wr(i,ks)
604 END IF
605 END DO
606 END DO
607 END DO
608!
609! Finalize computation of flux: add fractional part.
610!
611 DO k=1,n(ng)
612 DO i=istr,iend
613 ks=ksource(i,k)
614 cu=min(1.0_r8,(wl(i,k)-z_w(i,j,ks-1))*hz_inv(i,ks))
615 fc(i,k-1)=fc(i,k-1)+ &
616 & hz(i,j,ks)*cu* &
617 & (bl(i,ks)+ &
618 & cu*(0.5_r8*(br(i,ks)-bl(i,ks))- &
619 & (1.5_r8-cu)* &
620 & (br(i,ks)+bl(i,ks)- &
621 & 2.0_r8*qc(i,ks))))
622 END DO
623 END DO
624 DO k=1,n(ng)
625 DO i=istr,iend
626 bio(i,k,ibio)=qc(i,k)+(fc(i,k)-fc(i,k-1))*hz_inv(i,k)
627 END DO
628 END DO
629
630 END DO sink_loop
631 END DO iter_loop
632!
633!-----------------------------------------------------------------------
634! Update global tracer variables: Add increment due to BGC processes
635! to tracer array in time index "nnew". Index "nnew" is solution after
636! advection and mixing and has transport units (m Tunits) hence the
637! increment is multiplied by Hz. Notice that we need to subtract
638! original values "Bio_old" at the top of the routine to just account
639! for the concentractions affected by BGC processes. This also takes
640! into account any constraints (non-negative concentrations, carbon
641! concentration range) specified before entering BGC kernel. If "Bio"
642! were unchanged by BGC processes, the increment would be exactly
643! zero. Notice that final tracer values, t(:,:,:,nnew,:) are not
644! bounded >=0 so that we can preserve total inventory of nutrients
645! when advection causes tracer concentration to go negative.
646!-----------------------------------------------------------------------
647!
648 DO itrc=1,nbt
649 ibio=idbio(itrc)
650 DO k=1,n(ng)
651 DO i=istr,iend
652 cff=bio(i,k,ibio)-bio_old(i,k,ibio)
653 t(i,j,k,nnew,ibio)=t(i,j,k,nnew,ibio)+cff*hz(i,j,k)
654 END DO
655 END DO
656 END DO
657
658 END DO j_loop
659!
660 RETURN

References mod_biology::attphy, mod_biology::attsw, mod_biology::bioiter, mod_scalars::cp, mod_biology::detrr, mod_scalars::dt, mod_biology::idbio, mod_biology::ino3_, mod_biology::iphyt, mod_biology::isdet, mod_biology::ivlev, mod_biology::izoop, mod_biology::k_no3, mod_param::n, mod_param::nbt, mod_biology::parfrac, mod_biology::phyis, mod_biology::phymrd, mod_biology::phymrn, mod_scalars::rho0, mod_scalars::sec2day, mod_biology::vm_no3, mod_biology::wdet, mod_biology::wphy, mod_biology::zooeed, mod_biology::zooeen, mod_biology::zoogr, mod_biology::zoomrd, and mod_biology::zoomrn.

◆ pco2_water()

subroutine biology_mod::pco2_water ( integer, intent(in) istr,
integer, intent(in) iend,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) j,
integer, intent(in) donewton,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) rmask,
real(r8), dimension(imins:imaxs), intent(in) t,
real(r8), dimension(imins:imaxs), intent(in) s,
real(r8), dimension(imins:imaxs), intent(in) tic,
real(r8), dimension(imins:imaxs), intent(in) talk,
real(r8), intent(in) po4b,
real(r8), intent(in) sio3,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(inout) ph,
real(r8), dimension(imins:imaxs), intent(out) pco2 )
private

Definition at line 1913 of file fennel.h.

1920!
1921!***********************************************************************
1922! !
1923! This routine computes equilibrium partial pressure of CO2 (pCO2) !
1924! in the surface seawater. !
1925! !
1926! On Input: !
1927! !
1928! Istr Starting tile index in the I-direction. !
1929! Iend Ending tile index in the I-direction. !
1930! LBi I-dimension lower bound. !
1931! UBi I-dimension upper bound. !
1932! LBj J-dimension lower bound. !
1933! UBj J-dimension upper bound. !
1934! IminS I-dimension lower bound for private arrays. !
1935! ImaxS I-dimension upper bound for private arrays. !
1936! j j-pipelined index. !
1937! DoNewton Iteration solver: !
1938! [0] Bracket and bisection. !
1939! [1] Newton-Raphson method. !
1940! rmask Land/Sea masking. !
1941! T Surface temperature (Celsius). !
1942! S Surface salinity (PSS). !
1943! TIC Total inorganic carbon (millimol/m3). !
1944! TAlk Total alkalinity (milli-equivalents/m3). !
1945! PO4b Inorganic phosphate (millimol/m3). !
1946! SiO3 Inorganic silicate (millimol/m3). !
1947! pH Best pH guess. !
1948! !
1949! On Output: !
1950! !
1951! pCO2 partial pressure of CO2 (ppmv). !
1952! !
1953! Check Value: (T=24, S=36.6, TIC=2040, TAlk=2390, PO4b=0, !
1954! SiO3=0, pH=8) !
1955! !
1956! pcO2=0.35074945E+03 ppmv (DoNewton=0) !
1957! pCO2=0.35073560E+03 ppmv (DoNewton=1) !
1958! !
1959! This subroutine was adapted by Mick Follows (Oct 1999) from OCMIP2 !
1960! code CO2CALC. Modified for ROMS by Hernan Arango (Nov 2003). !
1961! !
1962!***********************************************************************
1963!
1964 USE mod_kinds
1965!
1966 implicit none
1967!
1968! Imported variable declarations.
1969!
1970 integer, intent(in) :: LBi, UBi, LBj, UBj, IminS, ImaxS
1971 integer, intent(in) :: Istr, Iend, j, DoNewton
1972!
1973# ifdef ASSUMED_SHAPE
1974# ifdef MASKING
1975 real(r8), intent(in) :: rmask(LBi:,LBj:)
1976# endif
1977 real(r8), intent(in) :: T(IminS:)
1978 real(r8), intent(in) :: S(IminS:)
1979 real(r8), intent(in) :: TIC(IminS:)
1980 real(r8), intent(in) :: TAlk(IminS:)
1981 real(r8), intent(inout) :: pH(LBi:,LBj:)
1982# else
1983# ifdef MASKING
1984 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
1985# endif
1986 real(r8), intent(in) :: T(IminS:ImaxS)
1987 real(r8), intent(in) :: S(IminS:ImaxS)
1988 real(r8), intent(in) :: TIC(IminS:ImaxS)
1989 real(r8), intent(in) :: TAlk(IminS:ImaxS)
1990 real(r8), intent(inout) :: pH(LBi:UBi,LBj:UBj)
1991# endif
1992 real(r8), intent(in) :: PO4b
1993 real(r8), intent(in) :: SiO3
1994
1995 real(r8), intent(out) :: pCO2(IminS:ImaxS)
1996!
1997! Local variable declarations.
1998!
1999 integer, parameter :: InewtonMax = 10
2000 integer, parameter :: IbrackMax = 30
2001
2002 integer :: Hstep, Ibrack, Inewton, i
2003
2004 real(r8) :: Tk, centiTk, invTk, logTk
2005 real(r8) :: SO4, scl, sqrtS, sqrtSO4
2006 real(r8) :: alk, dic, phos, sili
2007 real(r8) :: borate, sulfate, fluoride
2008 real(r8) :: ff, K1, K2, K1p, K2p, K3p, Kb, Kf, Ks, Ksi, Kw
2009 real(r8) :: K12, K12p, K123p, invKb, invKs, invKsi
2010 real(r8) :: A, A2, B, B2, C, dA, dB
2011 real(r8) :: df, fn, fni(3), ftest
2012 real(r8) :: deltaX, invX, invX2, X, X2, X3
2013 real(r8) :: pH_guess, pH_hi, pH_lo
2014 real(r8) :: X_guess, X_hi, X_lo, X_mid
2015 real(r8) :: CO2star, Htotal, Htotal2
2016!
2017!=======================================================================
2018! Determine coefficients for surface carbon chemisty. If land/sea
2019! masking, compute only on water points.
2020!=======================================================================
2021!
2022 i_loop: DO i=istr,iend
2023# ifdef MASKING
2024 IF (rmask(i,j).gt.0.0_r8) THEN
2025# endif
2026 tk=t(i)+273.15_r8
2027 centitk=0.01_r8*tk
2028 invtk=1.0_r8/tk
2029 logtk=log(tk)
2030 sqrts=sqrt(s(i))
2031 so4=19.924_r8*s(i)/(1000.0_r8-1.005_r8*s(i))
2032 sqrtso4=sqrt(so4)
2033 scl=s(i)/1.80655_r8
2034
2035 alk=talk(i)*0.000001_r8
2036 dic=tic(i)*0.000001_r8
2037 phos=po4b*0.000001_r8
2038 sili=sio3*0.000001_r8
2039!
2040!-----------------------------------------------------------------------
2041! Correction term for non-ideality, ff=k0*(1-pH2O). Equation 13 with
2042! table 6 values from Weiss and Price (1980, Mar. Chem., 8, 347-359).
2043!-----------------------------------------------------------------------
2044!
2045 ff=exp(-162.8301_r8+ &
2046 & 218.2968_r8/centitk+ &
2047 & log(centitk)*90.9241_r8- &
2048 & centitk*centitk*1.47696_r8+ &
2049 & s(i)*(0.025695_r8- &
2050 & centitk*(0.025225_r8- &
2051 & centitk*0.0049867_r8)))
2052!
2053!-----------------------------------------------------------------------
2054! Compute first (K1) and second (K2) dissociation constant of carboinic
2055! acid:
2056!
2057! K1 = [H][HCO3]/[H2CO3]
2058! K2 = [H][CO3]/[HCO3]
2059!
2060! From Millero (1995; page 664) using Mehrbach et al. (1973) data on
2061! seawater scale.
2062!-----------------------------------------------------------------------
2063!
2064 k1=10.0_r8**(62.008_r8- &
2065 & invtk*3670.7_r8- &
2066 & logtk*9.7944_r8+ &
2067 & s(i)*(0.0118_r8- &
2068 & s(i)*0.000116_r8))
2069 k2=10.0_r8**(-4.777_r8- &
2070 & invtk*1394.7_r8+ &
2071 & s(i)*(0.0184_r8- &
2072 & s(i)*0.000118_r8))
2073!
2074!-----------------------------------------------------------------------
2075! Compute dissociation constant of boric acid, Kb=[H][BO2]/[HBO2].
2076! From Millero (1995; page 669) using data from Dickson (1990).
2077!-----------------------------------------------------------------------
2078!
2079 kb=exp(-invtk*(8966.90_r8+ &
2080 & sqrts*(2890.53_r8+ &
2081 & sqrts*(77.942_r8- &
2082 & sqrts*(1.728_r8- &
2083 & sqrts*0.0996_r8))))- &
2084 & logtk*(24.4344_r8+ &
2085 & sqrts*(25.085_r8+ &
2086 & sqrts*0.2474_r8))+ &
2087 & tk*(sqrts*0.053105_r8)+ &
2088 & 148.0248_r8+ &
2089 & sqrts*(137.1942_r8+ &
2090 & sqrts*1.62142_r8))
2091!
2092!-----------------------------------------------------------------------
2093! Compute first (K1p), second (K2p), and third (K3p) dissociation
2094! constant of phosphoric acid:
2095!
2096! K1p = [H][H2PO4]/[H3PO4]
2097! K2p = [H][HPO4]/[H2PO4]
2098! K3p = [H][PO4]/[HPO4]
2099!
2100! From DOE (1994) equations 7.2.20, 7.2.23, and 7.2.26, respectively.
2101! With footnote using data from Millero (1974).
2102!-----------------------------------------------------------------------
2103!
2104 k1p=exp(115.525_r8- &
2105 & invtk*4576.752_r8- &
2106 & logtk*18.453_r8+ &
2107 & sqrts*(0.69171_r8-invtk*106.736_r8)- &
2108 & s(i)*(0.01844_r8+invtk*0.65643_r8))
2109 k2p=exp(172.0883_r8- &
2110 & invtk*8814.715_r8- &
2111 & logtk*27.927_r8+ &
2112 & sqrts*(1.3566_r8-invtk*160.340_r8)- &
2113 & s(i)*(0.05778_r8-invtk*0.37335_r8))
2114 k3p=exp(-18.141_r8- &
2115 & invtk*3070.75_r8+ &
2116 & sqrts*(2.81197_r8+invtk*17.27039_r8)- &
2117 & s(i)*(0.09984_r8+invtk*44.99486_r8))
2118!
2119!-----------------------------------------------------------------------
2120! Compute dissociation constant of silica, Ksi=[H][SiO(OH)3]/[Si(OH)4].
2121! From Millero (1995; page 671) using data from Yao and Millero (1995).
2122!-----------------------------------------------------------------------
2123!
2124 ksi=exp(117.385_r8- &
2125 & invtk*8904.2_r8- &
2126 & logtk*19.334_r8+ &
2127 & sqrtso4*(3.5913_r8-invtk*458.79_r8)- &
2128 & so4*(1.5998_r8-invtk*188.74_r8- &
2129 & so4*(0.07871_r8-invtk*12.1652_r8))+ &
2130 & log(1.0_r8-0.001005_r8*s(i)))
2131!
2132!-----------------------------------------------------------------------
2133! Compute ion product of whater, Kw = [H][OH].
2134! From Millero (1995; page 670) using composite data.
2135!-----------------------------------------------------------------------
2136!
2137 kw=exp(148.9652_r8- &
2138 & invtk*13847.26_r8- &
2139 & logtk*23.6521_r8- &
2140 & sqrts*(5.977_r8- &
2141 & invtk*118.67_r8- &
2142 & logtk*1.0495_r8)- &
2143 & s(i)*0.01615_r8)
2144!
2145!------------------------------------------------------------------------
2146! Compute salinity constant of hydrogen sulfate, Ks = [H][SO4]/[HSO4].
2147! From Dickson (1990, J. chem. Thermodynamics 22, 113)
2148!------------------------------------------------------------------------
2149!
2150 ks=exp(141.328_r8- &
2151 & invtk*4276.1_r8- &
2152 & logtk*23.093_r8+ &
2153 & sqrtso4*(324.57_r8-invtk*13856.0_r8-logtk*47.986_r8- &
2154 & so4*invtk*2698.0_r8)- &
2155 & so4*(771.54_r8-invtk*35474.0_r8-logtk*114.723_r8- &
2156 & so4*invtk*1776.0_r8)+ &
2157 & log(1.0_r8-0.001005_r8*s(i)))
2158!
2159!-----------------------------------------------------------------------
2160! Compute stability constant of hydrogen fluorid, Kf = [H][F]/[HF].
2161! From Dickson and Riley (1979) -- change pH scale to total.
2162!-----------------------------------------------------------------------
2163!
2164 kf=exp(-12.641_r8+ &
2165 & invtk*1590.2_r8+ &
2166 & sqrtso4*1.525_r8+ &
2167 & log(1.0_r8-0.001005_r8*s(i))+ &
2168 & log(1.0_r8+0.1400_r8*scl/(96.062_r8*ks)))
2169!
2170!-----------------------------------------------------------------------
2171! Calculate concentrations for borate (Uppstrom, 1974), sulfate (Morris
2172! and Riley, 1966), and fluoride (Riley, 1965).
2173!-----------------------------------------------------------------------
2174!
2175 borate=0.000232_r8*scl/10.811_r8
2176 sulfate=0.14_r8*scl/96.062_r8
2177 fluoride=0.000067_r8*scl/18.9984_r8
2178!
2179!=======================================================================
2180! Iteratively solver for computing hydrogen ions [H+] using either:
2181!
2182! (1) Newton-Raphson method with fixed number of iterations,
2183! use previous [H+] as first guess, or
2184! (2) bracket and bisection
2185!=======================================================================
2186!
2187! Set first guess and brackets for [H+] solvers.
2188!
2189 ph_guess=ph(i,j) ! Newton-Raphson
2190 ph_hi=10.0_r8 ! high bracket/bisection
2191 ph_lo=5.0_r8 ! low bracket/bisection
2192!
2193! Convert to [H+].
2194!
2195 x_guess=10.0_r8**(-ph_guess)
2196 x_lo=10.0_r8**(-ph_hi)
2197 x_hi=10.0_r8**(-ph_lo)
2198 x_mid=0.5_r8*(x_lo+x_hi)
2199!
2200!-----------------------------------------------------------------------
2201! Newton-Raphson method.
2202!-----------------------------------------------------------------------
2203!
2204 IF (donewton.eq.1) THEN
2205 x=x_guess
2206 k12=k1*k2
2207 k12p=k1p*k2p
2208 k123p=k12p*k3p
2209 invkb=1.0_r8/kb
2210 invks=1.0_r8/ks
2211 invksi=1.0_r8/ksi
2212!
2213 DO inewton=1,inewtonmax
2214!
2215! Set some common combinations of parameters used in the iterative [H+]
2216! solver.
2217!
2218 x2=x*x
2219 x3=x2*x
2220 invx=1.0_r8/x
2221 invx2=1.0_r8/x2
2222
2223 a=x*(k12p+x*(k1p+x))
2224 b=x*(k1+x)+k12
2225 c=1.0_r8/(1.0_r8+sulfate*invks)
2226
2227 a2=a*a
2228 b2=b*b
2229 da=x*(2.0_r8*k1p+3.0_r8*x)+k12p
2230 db=2.0_r8*x+k1
2231!
2232! Evaluate f([H+]):
2233!
2234! fn=HCO3+CO3+borate+OH+HPO4+2*PO4+H3PO4+silicate+Hfree+HSO4+HF-TALK
2235!
2236 fn=dic*k1*(x+2.0_r8*k2)/b+ &
2237 & borate/(1.0_r8+x*invkb)+ &
2238 & kw*invx+ &
2239 & phos*(k12p*x+2.0_r8*k123p-x3)/a+ &
2240 & sili/(1.0_r8+x*invksi)- &
2241 & x*c- &
2242 & sulfate/(1.0_r8+ks*invx*c)- &
2243 & fluoride/(1.0_r8+kf*invx)- &
2244 & alk
2245!
2246! Evaluate derivative, f(prime)([H+]):
2247!
2248! df= d(fn)/d(X)
2249!
2250 df=dic*k1*(b-db*(x+2.0_r8*k2))/b2- &
2251 & borate/(invkb*(1.0+x*invkb)**2)- &
2252 & kw*invx2+ &
2253 & phos*(a*(k12p-3.0_r8*x2)-da*(k12p*x+2.0_r8*k123p-x3))/a2-&
2254 & sili/(invksi*(1.0_r8+x*invksi)**2)+ &
2255 & c+ &
2256 & sulfate*ks*c*invx2/((1.0_r8+ks*invx*c)**2)+ &
2257 & fluoride*kf*invx2/((1.0_r8+kf*invx)**2)
2258!
2259! Evaluate increment in [H+].
2260!
2261 deltax=-fn/df
2262!
2263! Update estimate of [H+].
2264!
2265 x=x+deltax
2266 END DO
2267!
2268!-----------------------------------------------------------------------
2269! Bracket and bisection method.
2270!-----------------------------------------------------------------------
2271!
2272 ELSE
2273!
2274! If first step, use Bracket and Bisection method with fixed, large
2275! number of iterations
2276!
2277 k12=k1*k2
2278 k12p=k1p*k2p
2279 k123p=k12p*k3p
2280 invkb=1.0_r8/kb
2281 invks=1.0_r8/ks
2282 invksi=1.0_r8/ksi
2283!
2284 brack_it: DO ibrack=1,ibrackmax
2285 DO hstep=1,3
2286 IF (hstep.eq.1) x=x_hi
2287 IF (hstep.eq.2) x=x_lo
2288 IF (hstep.eq.3) x=x_mid
2289!
2290! Set some common combinations of parameters used in the iterative [H+]
2291! solver.
2292!
2293 x2=x*x
2294 x3=x2*x
2295 invx=1.0_r8/x
2296
2297 a=x*(k12p+x*(k1p+x))+k123p
2298 b=x*(k1+x)+k12
2299 c=1.0_r8/(1.0_r8+sulfate*invks)
2300
2301 a2=a*a
2302 b2=b*b
2303 da=x*(k1p*2.0_r8+3.0_r8*x2)+k12p
2304 db=2.0_r8*x+k1
2305!
2306! Evaluate f([H+]) for bracketing and mid-value cases.
2307!
2308 fni(hstep)=dic*(k1*x+2.0_r8*k12)/b+ &
2309 & borate/(1.0_r8+x*invkb)+ &
2310 & kw*invx+ &
2311 & phos*(k12p*x+2.0_r8*k123p-x3)/a+ &
2312 & sili/(1.0_r8+x*invksi)- &
2313 & x*c- &
2314 & sulfate/(1.0_r8+ks*invx*c)- &
2315 & fluoride/(1.0_r8+kf*invx)- &
2316 & alk
2317 END DO
2318!
2319! Now, bracket solution within two of three.
2320!
2321 IF (fni(3).eq.0.0_r8) THEN
2322 EXIT brack_it
2323 ELSE
2324 ftest=fni(1)/fni(3)
2325 IF (ftest.gt.0.0) THEN
2326 x_hi=x_mid
2327 ELSE
2328 x_lo=x_mid
2329 END IF
2330 x_mid=0.5_r8*(x_lo+x_hi)
2331 END IF
2332 END DO brack_it
2333!
2334! Last iteration gives value.
2335!
2336 x=x_mid
2337 END IF
2338!
2339!-----------------------------------------------------------------------
2340! Determine pCO2.
2341!-----------------------------------------------------------------------
2342!
2343! Total Hydrogen ion concentration, Htotal = [H+].
2344!
2345 htotal=x
2346 htotal2=htotal*htotal
2347!
2348! Calculate [CO2*] (mole/m3) as defined in DOE Methods Handbook 1994
2349! Version 2, ORNL/CDIAC-74, Dickson and Goyet, Eds. (Chapter 2,
2350! page 10, Eq A.49).
2351!
2352 co2star=dic*htotal2/(htotal2+k1*htotal+k1*k2)
2353!
2354! Save pH is used again outside this routine.
2355!
2356 ph(i,j)=-log10(htotal)
2357!
2358! Add two output arguments for storing pCO2surf.
2359!
2360 pco2(i)=co2star*1000000.0_r8/ff
2361
2362# ifdef MASKING
2363 ELSE
2364 ph(i,j)=0.0_r8
2365 pco2(i)=0.0_r8
2366 END IF
2367# endif
2368
2369 END DO i_loop
2370!
2371 RETURN
mod_kinds
Definition mod_kinds.F:2

Referenced by fennel_tile().

Here is the caller graph for this function:

◆ pco2_water_rz()

subroutine biology_mod::pco2_water_rz ( integer, intent(in) istr,
integer, intent(in) iend,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) j,
integer, intent(in) donewton,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) rmask,
real(r8), dimension(imins:imaxs), intent(in) t,
real(r8), dimension(imins:imaxs), intent(in) s,
real(r8), dimension(imins:imaxs), intent(in) tic,
real(r8), dimension(imins:imaxs), intent(in) talk,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(inout) ph,
real(r8), dimension(imins:imaxs), intent(out) pco2 )
private

Definition at line 1581 of file fennel.h.

1588!
1589!***********************************************************************
1590! !
1591! This routine computes equilibrium partial pressure of CO2 (pCO2) !
1592! in the surface seawater. !
1593! !
1594! On Input: !
1595! !
1596! Istr Starting tile index in the I-direction. !
1597! Iend Ending tile index in the I-direction. !
1598! LBi I-dimension lower bound. !
1599! UBi I-dimension upper bound. !
1600! LBj J-dimension lower bound. !
1601! UBj J-dimension upper bound. !
1602! IminS I-dimension lower bound for private arrays. !
1603! ImaxS I-dimension upper bound for private arrays. !
1604! j j-pipelined index. !
1605! DoNewton Iteration solver: !
1606! [0] Bracket and bisection. !
1607! [1] Newton-Raphson method. !
1608! rmask Land/Sea masking. !
1609! T Surface temperature (Celsius). !
1610! S Surface salinity (PSS). !
1611! TIC Total inorganic carbon (millimol/m3). !
1612! TAlk Total alkalinity (milli-equivalents/m3). !
1613! pH Best pH guess. !
1614! !
1615! On Output: !
1616! !
1617! pCO2 partial pressure of CO2 (ppmv). !
1618! !
1619! Check Value: (T=24, S=36.6, TIC=2040, TAlk=2390, PO4b=0, !
1620! SiO3=0, pH=8) !
1621! !
1622! pcO2= ppmv (DoNewton=0) !
1623! pCO2= ppmv (DoNewton=1) !
1624! !
1625! This subroutine was adapted by Katja Fennel (Nov 2005) from !
1626! Zeebe and Wolf-Gladrow (2001). !
1627! !
1628! Reference: !
1629! !
1630! Zeebe, R.E. and D. Wolf-Gladrow, 2005: CO2 in Seawater: !
1631! Equilibrium, kinetics, isotopes, Elsevier Oceanographic !
1632! Series, 65, pp 346. !
1633! !
1634!***********************************************************************
1635!
1636 USE mod_kinds
1637!
1638 implicit none
1639!
1640! Imported variable declarations.
1641!
1642 integer, intent(in) :: LBi, UBi, LBj, UBj, IminS, ImaxS
1643 integer, intent(in) :: Istr, Iend, j, DoNewton
1644!
1645# ifdef ASSUMED_SHAPE
1646# ifdef MASKING
1647 real(r8), intent(in) :: rmask(LBi:,LBj:)
1648# endif
1649 real(r8), intent(in) :: T(IminS:)
1650 real(r8), intent(in) :: S(IminS:)
1651 real(r8), intent(in) :: TIC(IminS:)
1652 real(r8), intent(in) :: TAlk(IminS:)
1653 real(r8), intent(inout) :: pH(LBi:,LBj:)
1654# else
1655# ifdef MASKING
1656 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
1657# endif
1658 real(r8), intent(in) :: T(IminS:ImaxS)
1659 real(r8), intent(in) :: S(IminS:ImaxS)
1660 real(r8), intent(in) :: TIC(IminS:ImaxS)
1661 real(r8), intent(in) :: TAlk(IminS:ImaxS)
1662 real(r8), intent(inout) :: pH(LBi:UBi,LBj:UBj)
1663# endif
1664
1665 real(r8), intent(out) :: pCO2(IminS:ImaxS)
1666!
1667! Local variable declarations.
1668!
1669 integer, parameter :: InewtonMax = 10
1670 integer, parameter :: IbrackMax = 30
1671
1672 integer :: Hstep, Ibrack, Inewton, i
1673
1674 real(r8) :: Tk, centiTk, invTk, logTk
1675 real(r8) :: scl, sqrtS
1676 real(r8) :: borate, alk, dic
1677 real(r8) :: ff, K1, K2, K12, Kb, Kw
1678 real(r8) :: p5, p4, p3, p2, p1, p0
1679 real(r8) :: df, fn, fni(3), ftest
1680 real(r8) :: deltaX, invX, invX2, X, X2, X3
1681 real(r8) :: pH_guess, pH_hi, pH_lo
1682 real(r8) :: X_guess, X_hi, X_lo, X_mid
1683 real(r8) :: CO2star, Htotal, Htotal2
1684!
1685!=======================================================================
1686! Determine coefficients for surface carbon chemisty. If land/sea
1687! masking, compute only on water points.
1688!=======================================================================
1689!
1690 i_loop: DO i=istr,iend
1691# ifdef MASKING
1692 IF (rmask(i,j).gt.0.0_r8) THEN
1693# endif
1694 tk=t(i)+273.15_r8
1695 centitk=0.01_r8*tk
1696 invtk=1.0_r8/tk
1697 logtk=log(tk)
1698 sqrts=sqrt(s(i))
1699 scl=s(i)/1.80655_r8
1700
1701 alk= talk(i)*0.000001_r8
1702 dic = tic(i)*0.000001_r8
1703!
1704!-----------------------------------------------------------------------
1705! Correction term for non-ideality, ff=k0*(1-pH2O). Equation 13 with
1706! table 6 values from Weiss and Price (1980, Mar. Chem., 8, 347-359).
1707!-----------------------------------------------------------------------
1708!
1709 ff=exp(-162.8301_r8+ &
1710 & 218.2968_r8/centitk+ &
1711 & log(centitk)*90.9241_r8- &
1712 & centitk*centitk*1.47696_r8+ &
1713 & s(i)*(0.025695_r8- &
1714 & centitk*(0.025225_r8- &
1715 & centitk*0.0049867_r8)))
1716!
1717!-----------------------------------------------------------------------
1718! Compute first (K1) and second (K2) dissociation constant of carboinic
1719! acid:
1720!
1721! K1 = [H][HCO3]/[H2CO3]
1722! K2 = [H][CO3]/[HCO3]
1723!
1724! From Millero (1995; page 664) using Mehrbach et al. (1973) data on
1725! seawater scale.
1726!-----------------------------------------------------------------------
1727!
1728 k1=10.0_r8**(62.008_r8- &
1729 & invtk*3670.7_r8- &
1730 & logtk*9.7944_r8+ &
1731 & s(i)*(0.0118_r8- &
1732 & s(i)*0.000116_r8))
1733 k2=10.0_r8**(-4.777_r8- &
1734 & invtk*1394.7_r8+ &
1735 & s(i)*(0.0184_r8- &
1736 & s(i)*0.000118_r8))
1737!
1738!-----------------------------------------------------------------------
1739! Compute dissociation constant of boric acid, Kb=[H][BO2]/[HBO2].
1740! From Millero (1995; page 669) using data from Dickson (1990).
1741!-----------------------------------------------------------------------
1742!
1743 kb=exp(-invtk*(8966.90_r8+ &
1744 & sqrts*(2890.53_r8+ &
1745 & sqrts*(77.942_r8- &
1746 & sqrts*(1.728_r8- &
1747 & sqrts*0.0996_r8))))- &
1748 & logtk*(24.4344_r8+ &
1749 & sqrts*(25.085_r8+ &
1750 & sqrts*0.2474_r8))+ &
1751 & tk*(sqrts*0.053105_r8)+ &
1752 & 148.0248_r8+ &
1753 & sqrts*(137.1942_r8+ &
1754 & sqrts*1.62142_r8))
1755!
1756!-----------------------------------------------------------------------
1757! Compute ion product of whater, Kw = [H][OH].
1758! From Millero (1995; page 670) using composite data.
1759!-----------------------------------------------------------------------
1760!
1761 kw=exp(148.9652_r8- &
1762 & invtk*13847.26_r8- &
1763 & logtk*23.6521_r8- &
1764 & sqrts*(5.977_r8- &
1765 & invtk*118.67_r8- &
1766 & logtk*1.0495_r8)- &
1767 & s(i)*0.01615_r8)
1768!
1769!-----------------------------------------------------------------------
1770! Calculate concentrations for borate (Uppstrom, 1974).
1771!-----------------------------------------------------------------------
1772!
1773 borate=0.000232_r8*scl/10.811_r8
1774!
1775!=======================================================================
1776! Iteratively solver for computing hydrogen ions [H+] using either:
1777!
1778! (1) Newton-Raphson method with fixed number of iterations,
1779! use previous [H+] as first guess, or
1780! (2) bracket and bisection
1781!=======================================================================
1782!
1783! Solve for h in fifth-order polynomial. First calculate
1784! polynomial coefficients.
1785!
1786 k12 = k1*k2
1787
1788 p5 = -1.0_r8;
1789 p4 = -alk-kb-k1;
1790 p3 = dic*k1-alk*(kb+k1)+kb*borate+kw-kb*k1-k12
1791 p2 = dic*(kb*k1+2*k12)-alk*(kb*k1+k12)+kb*borate*k1 &
1792 & +(kw*kb+kw*k1-kb*k12)
1793 p1 = 2.0_r8*dic*kb*k12-alk*kb*k12+kb*borate*k12 &
1794 & +kw*kb*k1+kw*k12
1795 p0 = kw*kb*k12;
1796!
1797! Set first guess and brackets for [H+] solvers.
1798!
1799 ph_guess=ph(i,j) ! Newton-Raphson
1800 ph_hi=10.0_r8 ! high bracket/bisection
1801 ph_lo=5.0_r8 ! low bracket/bisection
1802!
1803! Convert to [H+].
1804!
1805 x_guess=10.0_r8**(-ph_guess)
1806 x_lo=10.0_r8**(-ph_hi)
1807 x_hi=10.0_r8**(-ph_lo)
1808 x_mid=0.5_r8*(x_lo+x_hi)
1809!
1810!-----------------------------------------------------------------------
1811! Newton-Raphson method.
1812!-----------------------------------------------------------------------
1813!
1814 IF (donewton.eq.1) THEN
1815 x=x_guess
1816!
1817 DO inewton=1,inewtonmax
1818!
1819! Evaluate f([H+]) = p5*x^5+...+p1*x+p0
1820!
1821 fn=((((p5*x+p4)*x+p3)*x+p2)*x+p1)*x+p0
1822!
1823! Evaluate derivative, df([H+])/dx:
1824!
1825! df= d(fn)/d(X)
1826!
1827 df=(((5*p5*x+4*p4)*x+3*p3)*x+2*p2)*x+p1
1828!
1829! Evaluate increment in [H+].
1830!
1831 deltax=-fn/df
1832!
1833! Update estimate of [H+].
1834!
1835 x=x+deltax
1836 END DO
1837!
1838!-----------------------------------------------------------------------
1839! Bracket and bisection method.
1840!-----------------------------------------------------------------------
1841!
1842 ELSE
1843!
1844! If first step, use Bracket and Bisection method with fixed, large
1845! number of iterations
1846!
1847 brack_it: DO ibrack=1,ibrackmax
1848 DO hstep=1,3
1849 IF (hstep.eq.1) x=x_hi
1850 IF (hstep.eq.2) x=x_lo
1851 IF (hstep.eq.3) x=x_mid
1852!
1853! Evaluate f([H+]) for bracketing and mid-value cases.
1854!
1855 fni(hstep)=((((p5*x+p4)*x+p3)*x+p2)*x+p1)*x+p0
1856 END DO
1857!
1858! Now, bracket solution within two of three.
1859!
1860 IF (fni(3).eq.0) THEN
1861 EXIT brack_it
1862 ELSE
1863 ftest=fni(1)/fni(3)
1864 IF (ftest.gt.0) THEN
1865 x_hi=x_mid
1866 ELSE
1867 x_lo=x_mid
1868 END IF
1869 x_mid=0.5_r8*(x_lo+x_hi)
1870 END IF
1871 END DO brack_it
1872!
1873! Last iteration gives value.
1874!
1875 x=x_mid
1876 END IF
1877!
1878!-----------------------------------------------------------------------
1879! Determine pCO2.
1880!-----------------------------------------------------------------------
1881!
1882! Total Hydrogen ion concentration, Htotal = [H+].
1883!
1884 htotal=x
1885 htotal2=htotal*htotal
1886!
1887! Calculate [CO2*] (mole/m3) as defined in DOE Methods Handbook 1994
1888! Version 2, ORNL/CDIAC-74, Dickson and Goyet, Eds. (Chapter 2,
1889! page 10, Eq A.49).
1890!
1891 co2star=dic*htotal2/(htotal2+k1*htotal+k1*k2)
1892!
1893! Save pH is used again outside this routine.
1894!
1895 ph(i,j)=-log10(htotal)
1896!
1897! Add two output arguments for storing pCO2surf.
1898!
1899 pco2(i)=co2star*1000000.0_r8/ff
1900
1901# ifdef MASKING
1902 ELSE
1903 ph(i,j)=0.0_r8
1904 pco2(i)=0.0_r8
1905 END IF
1906# endif
1907
1908 END DO i_loop
1909!
1910 RETURN

Referenced by fennel_tile().

Here is the caller graph for this function:

◆ red_tide_tile()

subroutine biology_mod::red_tide_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) ubk,
integer, intent(in) ubt,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) nstp,
integer, intent(in) nnew,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) rmask,
real(r8), dimension(lbi:ubi,lbj:ubj,ubk), intent(in) hz,
real(r8), dimension(lbi:ubi,lbj:ubj,ubk), intent(in) z_r,
real(r8), dimension(lbi:ubi,lbj:ubj,0:ubk), intent(in) z_w,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) srflx_avg,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) srflx,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) cystini,
real(r8), dimension(lbi:,lbj:,:), intent(in) din_obs,
real(r8), dimension(lbi:ubi,lbj:ubj,ubk,3,ubt), intent(inout) t )
private

Definition at line 102 of file red_tide.h.

115!-----------------------------------------------------------------------
116!
117 USE mod_param
118 USE mod_biology
119 USE mod_ncparam
120 USE mod_scalars
121!
122 USE dateclock_mod, ONLY : caldate
123!
124! Imported variable declarations.
125!
126 integer, intent(in) :: ng, tile
127 integer, intent(in) :: LBi, UBi, LBj, UBj, UBk, UBt
128 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
129 integer, intent(in) :: nstp, nnew
130
131#ifdef ASSUMED_SHAPE
132# ifdef MASKING
133 real(r8), intent(in) :: rmask(LBi:,LBj:)
134# endif
135 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
136 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
137 real(r8), intent(in) :: z_w(LBi:,LBj:,0:)
138 real(r8), intent(in) :: CystIni(LBi:,LBj:)
139 real(r8), intent(in) :: DIN_obs(LBi:,LBj:,:)
140# ifdef DAILY_SHORTWAVE
141 real(r8), intent(in) :: srflx_avg(LBi:,LBj:)
142# endif
143 real(r8), intent(in) :: srflx(LBi:,LBj:)
144 real(r8), intent(inout) :: t(LBi:,LBj:,:,:,:)
145#else
146# ifdef MASKING
147 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
148# endif
149 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,UBk)
150 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,UBk)
151 real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:UBk)
152 real(r8), intent(in) :: CystIni(LBi:UBi,LBj:UBj)
153# ifdef DAILY_SHORTWAVE
154 real(r8), intent(in) :: srflx_avg(LBi:UBi,LBj:UBj)
155# endif
156 real(r8), intent(in) :: srflx(LBi:UBi,LBj:UBj)
157 real(r8), intent(in) :: DIN_ob(LBi:UBi,LBj:UBj,UBk)
158 real(r8), intent(inout) :: t(LBi:UBi,LBj:UBj,UBk,3,UBt)
159#endif
160!
161! Local variable declarations.
162!
163 integer, parameter :: Nswim = 1
164
165 integer, parameter :: NsedLayers = 10
166
167 integer :: Iter, i, ibio, iswim, itrc, j, k, ks, ksed
168
169 integer, dimension(Nswim) :: idswim
170
171 real(r8) :: Cell_Flux, C_depth, DIN, E_flux, EndoScale
172 real(r8) :: Rad, RadScale
173 real(r8) :: GermD, GermL, G_DIN, G_light, G_rate, M_rate
174 real(r8) :: G_fac, S_fac, T_fac
175 real(r8) :: dtdays, oNsedLayers, salt, temp, wmig
176 real(dp) :: yday
177
178 real(r8) :: alpha, cff, cffL, cffR, deltaL, deltaR, dz, wdt
179
180 real(r8), parameter :: eps = 1.0e-8_r8
181
182 real(r8), dimension(Nswim) :: Wbio
183
184 integer, dimension(IminS:ImaxS,N(ng)) :: ksource
185
186 real(r8), dimension(IminS:ImaxS) :: Germ
187
188 real(r8), dimension(IminS:ImaxS,N(ng),NT(ng)) :: Bio
189 real(r8), dimension(IminS:ImaxS,N(ng),NT(ng)) :: Bio_old
190
191 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: FC
192 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: aL
193 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: aR
194 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: dL
195 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: dR
196 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: r
197
198 real(r8), dimension(IminS:ImaxS,N(ng)) :: Hz_inv
199 real(r8), dimension(IminS:ImaxS,N(ng)) :: Light
200!
201! Temperature dependent grow factor polynomial coefficients.
202!
203!! real(r8), parameter :: TC0 = 0.382_r8 ! Stock el al, 2005
204!! real(r8), parameter :: TC1 =-0.0867_r8 ! Eq. 5a
205!! real(r8), parameter :: TC2 = 0.0160_r8
206!! real(r8), parameter :: TC3 =-0.000513_r8
207!!
208 real(r8), parameter :: TC0 = 0.379_r8 ! Revised
209 real(r8), parameter :: TC1 =-0.0961_r8 ! Stock 8/15/2006
210 real(r8), parameter :: TC2 = 0.0169_r8
211 real(r8), parameter :: TC3 =-0.000536_r8
212!
213! Salinity dependent grow factor polynomial coefficients.
214!
215!! real(r8), parameter :: SC0 =-0.872_r8 ! Stock el al, 2005
216!! real(r8), parameter :: SC1 = 0.220_r8 ! Eq. 6
217!! real(r8), parameter :: SC2 =-0.00808_r8
218!! real(r8), parameter :: SC3 = 0.0000882_r8
219!!
220 real(r8), parameter :: SC0 =-0.693_r8 ! Revised
221 real(r8), parameter :: SC1 = 0.186_r8 ! Stock 8/15/2006
222 real(r8), parameter :: SC2 =-0.00622_r8
223 real(r8), parameter :: SC3 = 0.0000557_r8
224
225#include "set_bounds.h"
226!
227!-----------------------------------------------------------------------
228! Add biological Source/Sink terms.
229!-----------------------------------------------------------------------
230!
231! Avoid computing source/sink terms if no biological iterations.
232!
233 IF (bioiter(ng).le.0) RETURN
234!
235! Set time-stepping size (days) according to the number of iterations.
236!
237 dtdays=dt(ng)*sec2day/real(bioiter(ng),r8)
238!
239! Set shortwave radiation scale. In ROMS all the fluxes are kinematic.
240!
241 radscale=rho0*cp ! Celsius m/s to Watts/m2
242!
243! Set critical depth (m; negative) used in the growth function.
244!
245 c_depth=(log(g_r(ng)/(g_eff(ng)*srad_cdepth(ng))))/attw(ng)
246!
247! Set vertical swimming identification vector.
248!
249 idswim(1)=idino ! Dinoflagellate
250!
251! Set vertical swimming velocity vector in the same order as the
252! identification vector, IDSWIM.
253!
254 wbio(1)=wdino(ng) ! Dinoflagellate
255!
256! Set scale for germination term.
257!
258 onsedlayers=1.0_r8/real(nsedlayers,r8)
259!
260! Compute inverse thickness to avoid repeated divisions.
261!
262 j_loop : DO j=jstr,jend
263 DO k=1,n(ng)
264 DO i=istr,iend
265 hz_inv(i,k)=1.0_r8/hz(i,j,k)
266 END DO
267 END DO
268!
269! Extract biological variables from tracer arrays, place them into
270! scratch arrays, and restrict their values to be positive definite.
271! At input, all tracers (index nnew) from predictor step have
272! transport units (m Tunits) since we do not have yet the new
273! values for zeta and Hz. These are known after the 2D barotropic
274! time-stepping.
275!
276 DO itrc=1,nbt
277 ibio=idbio(itrc)
278 DO k=1,n(ng)
279 DO i=istr,iend
280 bio_old(i,k,ibio)=max(0.0_r8,t(i,j,k,nstp,ibio))
281 bio(i,k,ibio)=bio_old(i,k,ibio)
282 END DO
283 END DO
284 END DO
285!
286! Extract potential temperature and salinity.
287!
288 DO k=1,n(ng)
289 DO i=istr,iend
290 bio(i,k,itemp)=min(t(i,j,k,nstp,itemp),36.0_r8)
291 bio(i,k,isalt)=max(0.0_r8,t(i,j,k,nstp,isalt))
292 END DO
293 END DO
294!
295! Calculate endogenous clock scale used in the cysts germination
296! term. The cysts germination rates are regulated by an endogenous
297! circannual clock.
298!
299 CALL caldate (tdays(ng), yd_dp=yday)
300!
301 IF (yday.lt.month_midday(1)) THEN
302 cff=(365.0_r8-month_midday(12)+yday)/ &
303 & (365.0_r8-month_midday(12)+month_midday(1))
304 endoscale=gpn(12)+cff*(gpn(1)-gpn(12))
305 ELSE IF (yday.ge.month_midday(12)) THEN
306 cff=(yday-month_midday(12))/ &
307 (365.0_r8-month_midday(12)+month_midday(1))
308 endoscale=gpn(12)+cff*(gpn(1)-gpn(12))
309 ELSE
310 DO i=1,11
311 IF ((yday.ge.month_midday(i)).and. &
312 & (yday.lt.month_midday(i+1))) THEN
313 cff=(yday-month_midday(i))/ &
314 & (month_midday(i+1)-month_midday(i))
315 endoscale=gpn(i)+cff*(gpn(i+1)-gpn(i))
316 END IF
317 END DO
318 END IF
319!
320!=======================================================================
321! Start internal iterations to achieve convergence of the nonlinear
322! backward-implicit solution.
323!=======================================================================
324!
325! The iterative loop below is to iterate toward an universal Backward-
326! Euler treatment of all terms. So if there are oscillations in the
327! system, they are only physical oscillations. These iterations,
328! however, do not improve the accuaracy of the solution.
329!
330 iter_loop: DO iter=1,bioiter(ng)
331!
332!-----------------------------------------------------------------------
333! Add Cyst germination flux at the bottom layer
334!-----------------------------------------------------------------------
335!
336! Calculate Cyst germination rate at the top of the sediment layer
337! as a function of bottom water temperature and non-spectral
338! irradiance.
339!
340 DO i=istr,iend
341!
342! Calculate "light" and "dark" cyst germination rates as a function
343! of bottom temperature.
344!
345 temp=bio(i,1,itemp) ! bottom, k=1
346 germl=(1.50_r8+ &
347 & (8.72_r8-1.50_r8)*0.5_r8* &
348 & (tanh(0.790_r8*temp-6.27_r8)+1.0_r8))*onsedlayers
349 germd=(1.04_r8+ &
350 & (4.26_r8-1.04_r8)*0.5_r8* &
351 & (tanh(0.394_r8*temp-3.33_r8)+1.0_r8))*onsedlayers
352!
353! Compute non-spectral irradiance flux at each sediment layer. Then,
354! compute cyst germination rate according to the light regime.
355!
356 germ(i)=0.0_r8 ! initialize
357 DO ksed=1,nsedlayers
358# ifdef DAILY_SHORTWAVE
359 e_flux=radscale*srflx_avg(i,j)* &
360 & exp( attw(ng)*z_w(i,j,0)- &
361 & atts(ng)*dg(ng)*(real(ksed,r8)-0.5) )
362# else
363 e_flux=radscale*srflx(i,j)* &
364 & exp( attw(ng)*z_w(i,j,0)- &
365 & atts(ng)*dg(ng)*(real(ksed,r8)-0.5) )
366# endif
367 IF (e_flux.gt.e_light(ng)) THEN
368 germ(i)=germ(i)+germl
369 ELSE IF (e_flux.lt.e_dark(ng)) THEN
370 germ(i)=germ(i)+germd
371 ELSE
372 germ(i)=germ(i)+ &
373 & (germd+ &
374 & (germl-germd)* &
375 & ((e_flux-e_dark(ng))/ &
376 & (e_light(ng)-e_dark(ng))))
377 END IF
378 END DO
379!
380! Multiply by endogenous clock factor. The cyst germination are
381! regulated by an endogenous circannual clock. The 100 factor here
382! is because "Dg" is meters and we need centimeters.
383!
384 germ(i)=germ(i)*dg(ng)*100.0_r8*endoscale
385!
386! Convert percentage cysts/day into decimal fraction of cysts.
387!
388 germ(i)=germ(i)*0.01_r8
389!
390! Calculate the flux of cells away from the bottom. It is referenced
391! to the initial number of cysts to be consistent with laboratory
392! experiments.
393!
394 cell_flux=cystini(i,j)* &
395 & germ(i)*hz_inv(i,1) ! cells/m3
396!
397! Add cell flux at the bottom layer (k=1).
398!
399 bio(i,1,idino)=bio(i,1,idino)+cell_flux*dtdays
400 END DO
401!
402!-----------------------------------------------------------------------
403! Compute growth term.
404!-----------------------------------------------------------------------
405!
406! The growth is dependent on temperature, salinity, non-spectral
407! irradiance (light), and nutrient (Dissolved Inorganic Nutrient, DIN).
408!
409 DO k=1,n(ng)
410 DO i=istr,iend
411 temp=bio(i,k,itemp)
412 salt=bio(i,k,isalt)
413!
414! Compute Alexandrium fundyense temperature dependent growth factor
415! using a cubic polynomial fitted to available data.
416!
417 IF (temp.ge.tmin_growth(ng)) THEN
418 t_fac=tc0+temp*(tc1+temp*(tc2+temp*tc3))
419 ELSE ! linear extrapolation
420!! T_fac=TC0+temp*(TC1+temp*(TC22+temp*TC3))- &
421!! & 0.0343_r8*(5.0_r8-temp) ! Stock el al, 2005
422!! ! Eq. 5b
423 t_fac=0.254_r8-0.0327_r8*(5.0_r8-temp) ! Stock 8/15/2006
424 END IF
425!
426! Compute Alexandrium fundyense salinity dependent growth factor
427! using a cubic polynomial to fit to available data.
428!
429 s_fac=sc0+salt*(sc1+salt*(sc2+salt*sc3))
430!
431! Compute temperature and salinity growth factor.
432!
433 g_fac=t_fac*s_fac
434!
435! Compute light dependency factor (Platt and Jassby, 1976).
436!
437# ifdef DAILY_SHORTWAVE
438 rad=srflx_avg(i,j)*radscale*exp(attw(ng)*z_r(i,j,k))
439# else
440 rad=srflx(i,j)*radscale*exp(attw(ng)*z_r(i,j,k))
441# endif
442 IF (z_r(i,j,k).gt.c_depth) THEN
443 cff=gmax(ng)*g_fac+g_r(ng)
444 g_light=max(0.0_r8,cff*tanh(g_eff(ng)*rad/cff)-g_r(ng))
445 ELSE
446 g_light=0.0_r8
447 END IF
448!
449! Compute dissolved inorganic nutrient (DIN) dependency.
450! [JWilkin: This ELSE block below appears redundant because if
451! z_r(i,j,k).le.C_depth then G_light=0.0_r8 (see above) and
452! therefore G_rate will be set to zero (see below) regardless of
453! the calculated value of G_DIN].
454!
455 IF (z_r(i,j,k).gt.c_depth) THEN
456 din=din_obs(i,j,k)
457 ELSE
458 din=din_cdepth(ng)
459 END IF
460!
461! The nutrient dependence is modeled by the Monod formulation with
462! half-saturation Kn.
463!
464 g_din=gmax(ng)*g_fac*din/(max(kn(ng),0.0_r8)+din)
465!
466! Compute growth term (implicit). The growth rate is either limited
467! by the nutrient or light. The rate is capped to be positive.
468!
469 g_rate=max(min(g_light,g_din),0.0_r8)
470 bio(i,k,idino)=bio(i,k,idino)/(1.0_r8-g_rate*dtdays)
471 END DO
472 END DO
473!
474!-----------------------------------------------------------------------
475! Compute mortality term.
476!-----------------------------------------------------------------------
477!
478! The mortality is modeled as function dependent on temperature
479! (implicit). Use a Q10 mortality rate equation.
480!
481 DO k=1,n(ng)
482 DO i=istr,iend
483 temp=bio(i,k,itemp)
484 m_rate=mor_a(ng)* &
485 & mor_q10(ng)**((temp-mor_t0(ng))*0.1_r8)+ &
486 & mor_b(ng)
487 bio(i,k,idino)=bio(i,k,idino)/(1.0_r8+m_rate*dtdays)
488 END DO
489 END DO
490!
491!-----------------------------------------------------------------------
492! Vertical sinking/ascending term: dinoflagellate swimming
493!-----------------------------------------------------------------------
494!
495! Reconstruct vertical profile of selected biological constituents
496! "Bio(:,:,iswim)" in terms of a set of parabolic segments within each
497! grid box. Then, compute semi-Lagrangian flux due to vertical motion.
498! Many thanks to Sasha Shchepetkin for the updated algorithm.
499!
500 swim_loop: DO iswim=1,nswim
501 ibio=idswim(iswim)
502 DO k=n(ng)-1,1,-1
503 DO i=istr,iend
504 fc(i,k)=(bio(i,k+1,ibio)-bio(i,k,ibio))/ &
505 & (hz(i,j,k+1)+hz(i,j,k))
506 END DO
507 END DO
508!
509 DO k=2,n(ng)-1
510 DO i=istr,iend
511 deltar=hz(i,j,k)*fc(i,k )
512 deltal=hz(i,j,k)*fc(i,k-1)
513 IF (deltar*deltal.lt.0.0_r8) THEN
514 deltar=0.0_r8
515 deltal=0.0_r8
516 END IF
517 cff=hz(i,j,k-1)+2.0_r8*hz(i,j,k)+hz(i,j,k+1)
518 cffr=cff*fc(i,k )
519 cffl=cff*fc(i,k-1)
520 IF (abs(deltar).gt.abs(cffl)) deltar=cffl
521 IF (abs(deltal).gt.abs(cffr)) deltal=cffr
522 cff=(deltar-deltal)/(hz(i,j,k-1)+hz(i,j,k)+hz(i,j,k+1))
523 deltar=deltar-cff*hz(i,j,k+1)
524 deltal=deltal+cff*hz(i,j,k-1)
525!
526 ar(i,k)=bio(i,k,ibio)+deltar
527 al(i,k)=bio(i,k,ibio)-deltal
528!
529 dr(i,k)=(2.0_r8*deltar-deltal)**2
530 dl(i,k)=(2.0_r8*deltal-deltar)**2
531 END DO
532 END DO
533
534#ifdef LIMIT_INTERIOR
535!
536! Apply boundary conditions for strictly monotonic option. The only way
537! to avoid extrapolation toward the boundary is to assume that field is
538! simply constant within topmost and bottommost grid boxes.
539!
540
541 DO i=istr,iend
542 ar(i,n(ng))=bio(i,n(ng),ibio)
543 al(i,n(ng))=bio(i,n(ng),ibio)
544 dr(i,n(ng))=0.0_r8
545 dl(i,n(ng))=0.0_r8
546!
547 ar(i,1)=bio(i,1,ibio)
548 al(i,1)=bio(i,1,ibio)
549 dr(i,1)=0.0_r8
550 dl(i,1)=0.0_r8
551 END DO
552#else
553!
554! Apply Neumann or linear continuation boundary conditions. Notice that
555! for Neumann conditions, the extrapolate values aR(i,N(ng)) and aL(i,0)
556! exceed corresponding box values.
557!
558 DO i=istr,iend
559 al(i,n(ng))=ar(i,n(ng)-1)
560# ifdef NEUMANN
561 ar(i,n(ng))=1.5_r8*bio(i,n(ng),ibio)-0.5_r8*al(i,n(ng))
562# else
563 ar(i,n(ng))=2.0_r8*bio(i,n(ng),ibio)-al(i,n(ng))
564# endif
565 dr(i,n(ng))=(2.0_r8*ar(i,n(ng))+al(i,n(ng))- &
566 & 3.0_r8*bio(i,n(ng),ibio))**2
567 dl(i,n(ng))=(3.0_r8*bio(i,n(ng),ibio)- &
568 & 2.0_r8*al(i,n(ng))-ar(i,n(ng)))**2
569!
570 ar(i,1)=al(i,2)
571# ifdef NEUMANN
572 al(i,1)=1.5_r8*bio(i,1,ibio)-0.5_r8*ar(i,1)
573# else
574 al(i,1)=2.0_r8*bio(i,1,ibio)-ar(i,1)
575# endif
576 dr(i,1)=(2.0_r8*ar(i,1)+al(i,1)- &
577 & 3.0_r8*bio(i,1,ibio))**2
578 dl(i,1)=(3.0_r8*bio(i,1,ibio)- &
579 & 2.0_r8*al(i,1)-ar(i,1))**2
580 END DO
581#endif
582!
583! Reconcile interfacial values aR and aL using Weighted Essentially
584! Non-Oscillatory (WENO) procedure.
585!
586 DO k=1,n(ng)-1
587 DO i=istr,iend
588 deltal=max(dl(i,k ),eps)
589 deltar=max(dr(i,k+1),eps)
590 r(i,k)=(deltar*ar(i,k)+deltal*al(i,k+1))/ &
591 & (deltar+deltal)
592 END DO
593 END DO
594 DO i=istr,iend
595#ifdef NEUMANN
596 r(i,n(ng))=1.5_r8*bio(i,n(ng),ibio)-0.5_r8*r(i,n(ng)-1)
597 r(i,0 )=1.5_r8*bio(i,1 ,ibio)-0.5_r8*r(i,1 )
598#else
599 r(i,n(ng))=2.0_r8*bio(i,n(ng),ibio)-r(i,n(ng)-1)
600 r(i,0 )=2.0_r8*bio(i,1 ,ibio)-r(i,1 )
601#endif
602 END DO
603!
604! Remapping step: This operation consists essentially of three stages:
605!---------------- (1) within each grid box compute averaged slope
606! (stored as dR) and curvature (stored as dL); then (2) compute
607! interfacial fluxes FC; and (3) apply these fluxes to complete
608! remapping step.
609!
610 DO k=1,n(ng)
611 DO i=istr,iend
612#ifdef LIMIT_INTERIOR
613 deltar=r(i,k)-bio(i,k,ibio) ! Constrain parabolic
614 deltal=bio(i,k,ibio)-r(i,k-1) ! segment monotonicity
615 cffr=2.0_r8*deltar ! like in PPM
616 cffl=2.0_r8*deltal
617 IF (deltar*deltal.lt.0.0_r8) THEN
618 deltar=0.0_r8
619 deltal=0.0_r8
620 ELSE IF (abs(deltar).gt.abs(cffl)) THEN
621 deltar=cffl
622 ELSE IF (abs(deltal).gt.abs(cffr)) THEN
623 deltal=cffr
624 END IF
625 ar(i,k)=bio(i,k,ibio)+deltar
626 al(i,k)=bio(i,k,ibio)-deltal
627#else
628 ar(i,k)=r(i,k )
629 al(i,k)=r(i,k-1)
630#endif
631 dl(i,k)=0.5_r8*(ar(i,k)-al(i,k))
632 dr(i,k)=0.5_r8*(ar(i,k)+al(i,k))-bio(i,k,ibio)
633 END DO
634 END DO
635!
636! Compute interfacial fluxes. The convention is that Wbio is positive
637! for upward motion (swimming, floating) and negative for downward motion
638! (sinking).
639!
640 wdt=-wbio(iswim)*dtdays
641 DO k=1,n(ng)-1
642 DO i=istr,iend
643 IF (wdt.gt.0.0_r8) THEN ! downward vertical
644 alpha=hz(i,j,k+1) ! motion (sinking)
645 cff =al(i,k+1)
646 cffl=dl(i,k+1)
647 cffr=dr(i,k+1)
648 dz=wdt
649 ELSE ! upward vertical
650 alpha=-hz(i,j,k) ! motion (swimming,
651 cff =ar(i,k) ! migration)
652 cffl=-dl(i,k)
653 cffr=dr(i,k)
654 dz=wdt
655!! IF (ABS(z_w(i,j,k)).lt.21.0_r8) THEN
656!! dz=wdt*(1.0_r8-TANH((21.0_r8+z_w(i,j,k))*0.1_r8))
657!! ELSE
658!! dz=wdt
659!! END IF
660 END IF
661 alpha=dz/alpha ! Courant number
662 fc(i,k)=dz*(cff+alpha*(cffl-cffr*(3.0_r8-2.0_r8*alpha)))
663 END DO
664 END DO
665 DO i=istr,iend
666 fc(i,0 )=0.0_r8
667 fc(i,n(ng))=0.0_r8
668 END DO
669!
670! Add semi-Lagrangian vertical flux.
671!
672 DO k=1,n(ng)
673 DO i=istr,iend
674 cff=(fc(i,k)-fc(i,k-1))*hz_inv(i,k)
675 bio(i,k,ibio)=bio(i,k,ibio)+cff
676 END DO
677 END DO
678
679 END DO swim_loop
680 END DO iter_loop
681!
682!-----------------------------------------------------------------------
683! Update global tracer variables: Add increment due to BGC processes
684! to tracer array in time index "nnew". Index "nnew" is solution after
685! advection and mixing and has transport units (m Tunits) hence the
686! increment is multiplied by Hz. Notice that we need to subtract
687! original values "Bio_old" at the top of the routine to just account
688! for the concentrations affected by BGC processes. This also takes
689! into account any constraints (non-negative concentrations, carbon
690! concentration range) specified before entering BGC kernel. If "Bio"
691! were unchanged by BGC processes, the increment would be exactly
692! zero. Notice that final tracer values, t(:,:,:,nnew,:) are not
693! bounded >=0 so that we can preserve total inventory of nutrients
694! when advection causes tracer concentration to go negative.
695!-----------------------------------------------------------------------
696!
697 DO itrc=1,nbt
698 ibio=idbio(itrc)
699 DO k=1,n(ng)
700 DO i=istr,iend
701 cff=bio(i,k,ibio)-bio_old(i,k,ibio)
702 t(i,j,k,nnew,ibio)=t(i,j,k,nnew,ibio)+cff*hz(i,j,k)
703 END DO
704 END DO
705 END DO
706
707 END DO j_loop
708!
709 RETURN
mod_biology::mor_t0
real(r8), dimension(:), allocatable mor_t0
Definition red_tide_mod.h:75
mod_biology::month_midday
real(dp), dimension(12) month_midday
Definition red_tide_mod.h:82
mod_biology::e_dark
real(r8), dimension(:), allocatable e_dark
Definition red_tide_mod.h:66
mod_biology::srad_cdepth
real(r8), dimension(:), allocatable srad_cdepth
Definition red_tide_mod.h:77
mod_biology::din_cdepth
real(r8), dimension(:), allocatable din_cdepth
Definition red_tide_mod.h:64
mod_biology::wdino
real(r8), dimension(:), allocatable wdino
Definition red_tide_mod.h:78
mod_biology::mor_q10
real(r8), dimension(:), allocatable mor_q10
Definition red_tide_mod.h:74
mod_biology::dg
real(r8), dimension(:), allocatable dg
Definition red_tide_mod.h:65
mod_biology::g_eff
real(r8), dimension(:), allocatable g_eff
Definition red_tide_mod.h:69
mod_biology::mor_b
real(r8), dimension(:), allocatable mor_b
Definition red_tide_mod.h:73
mod_biology::e_light
real(r8), dimension(:), allocatable e_light
Definition red_tide_mod.h:67
mod_biology::mor_a
real(r8), dimension(:), allocatable mor_a
Definition red_tide_mod.h:72
mod_biology::idino
integer idino
Definition red_tide_mod.h:55
mod_biology::attw
real(r8), dimension(:), allocatable attw
Definition red_tide_mod.h:63
mod_biology::g_r
real(r8), dimension(:), allocatable g_r
Definition red_tide_mod.h:70
mod_biology::kn
real(r8), dimension(:), allocatable kn
Definition red_tide_mod.h:71
mod_biology::tmin_growth
real(r8), dimension(:), allocatable tmin_growth
Definition red_tide_mod.h:76
mod_biology::gpn
real(r8), dimension(12) gpn
Definition red_tide_mod.h:96
mod_biology::gmax
real(r8), dimension(:), allocatable gmax
Definition red_tide_mod.h:68
mod_ncparam::idswim
integer idswim
Definition mod_ncparam.F:186

References mod_biology::atts, mod_biology::attw, mod_biology::bioiter, dateclock_mod::caldate(), mod_scalars::cp, mod_biology::dg, mod_biology::din_cdepth, mod_scalars::dt, mod_biology::e_dark, mod_biology::e_light, mod_biology::g_eff, mod_biology::g_r, mod_biology::gmax, mod_biology::gpn, mod_biology::idbio, mod_biology::idino, mod_scalars::isalt, mod_scalars::itemp, mod_biology::kn, mod_biology::month_midday, mod_biology::mor_a, mod_biology::mor_b, mod_biology::mor_q10, mod_biology::mor_t0, mod_param::n, mod_param::nbt, mod_scalars::rho0, mod_scalars::sec2day, mod_biology::srad_cdepth, mod_scalars::tdays, mod_biology::tmin_growth, and mod_biology::wdino.

Here is the call graph for this function: