92 & LBi, UBi, LBj, UBj, UBk, UBt, &
93 & IminS, ImaxS, JminS, JmaxS, &
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
117 real(r8),
intent(in) :: rmask(LBi:,LBj:)
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:,:,:,:)
126 real(r8),
intent(in) :: rmask(LBi:UBi,LBj:UBj)
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)
137 integer,
parameter :: Nsink = 2
139 integer :: Iter, i, ibio, isink, itime, itrc, iTrcMax, j, k, ks
141 integer,
dimension(Nsink) :: idsink
143 real(r8),
parameter :: MinVal = 1.0e-6_r8
145 real(r8) :: Att, ExpAtt, Itop, PAR
146 real(r8) :: cff, cff1, cff2, cff3, cff4, dtdays
147 real(r8) :: cffL, cffR, cu, dltL, dltR
149 real(r8),
dimension(Nsink) :: Wbio
151 integer,
dimension(IminS:ImaxS,N(ng)) :: ksource
153 real(r8),
dimension(IminS:ImaxS) :: PARsur
155 real(r8),
dimension(NT(ng),2) :: BioTrc
157 real(r8),
dimension(IminS:ImaxS,N(ng),NT(ng)) :: Bio
158 real(r8),
dimension(IminS:ImaxS,N(ng),NT(ng)) :: Bio_old
160 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: FC
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
172#include "set_bounds.h"
199 j_loop :
DO j=jstr,jend
202 hz_inv(i,k)=1.0_r8/hz(i,j,k)
207 hz_inv2(i,k)=1.0_r8/(hz(i,j,k)+hz(i,j,k+1))
212 hz_inv3(i,k)=1.0_r8/(hz(i,j,k-1)+hz(i,j,k)+hz(i,j,k+1))
231 biotrc(ibio,nstp)=t(i,j,k,nstp,ibio)
232 biotrc(ibio,nnew)=t(i,j,k,nnew,ibio)*hz_inv(i,k)
243 cff1=cff1+max(0.0_r8,minval-biotrc(ibio,itime))
244 IF (biotrc(ibio,itime).gt.biotrc(itrcmax,itime))
THEN
247 biotrc(ibio,itime)=max(minval,biotrc(ibio,itime))
249 IF (biotrc(itrcmax,itime).gt.cff1)
THEN
250 biotrc(itrcmax,itime)=biotrc(itrcmax,itime)-cff1
258 bio_old(i,k,ibio)=biotrc(ibio,nstp)
259 bio(i,k,ibio)=biotrc(ibio,nstp)
333 iter_loop:
DO iter=1,
bioiter(ng)
339 IF (parsur(i).gt.0.0_r8)
THEN
347 & (z_w(i,j,k)-z_w(i,j,k-1))
350 par=itop*(1.0_r8-expatt)/att
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)/ &
391 cff1=dtdays*
zoogr(ng)
395 cff=bio(i,k,
izoop)* &
396 & cff1*(1.0_r8-exp(-
ivlev(ng)*bio(i,k,
iphyt)))/ &
400 & bio(i,k,
iphyt)*cff2*cff
413 cff1=1.0_r8/(1.0_r8+cff2+cff3)
418 & bio(i,k,
iphyt)*cff2
420 & bio(i,k,
iphyt)*cff3
429 cff1=1.0_r8/(1.0_r8+cff2+cff3)
434 & bio(i,k,
izoop)*cff2
436 & bio(i,k,
izoop)*cff3
442 cff2=dtdays*
detrr(ng)
443 cff1=1.0_r8/(1.0_r8+cff2)
448 & bio(i,k,
isdet)*cff2
460 sink_loop:
DO isink=1,nsink
470 qc(i,k)=bio(i,k,ibio)
476 fc(i,k)=(qc(i,k+1)-qc(i,k))*hz_inv2(i,k)
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)
490 IF ((dltr*dltl).le.0.0_r8)
THEN
493 ELSE IF (abs(dltr).gt.abs(cffl))
THEN
495 ELSE IF (abs(dltl).gt.abs(cffr))
THEN
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)
513 wr(i,k)=(2.0_r8*dltr-dltl)**2
514 wl(i,k)=(dltr-2.0_r8*dltl)**2
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)
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))
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))
535 br(i,
n(ng))=qc(i,
n(ng))
536 bl(i,
n(ng))=qc(i,
n(ng))
537 br(i,
n(ng)-1)=qc(i,
n(ng))
539#if defined LINEAR_CONTINUATION
541 bl(i,1)=2.0_r8*qc(i,1)-br(i,1)
544 bl(i,1)=1.5_r8*qc(i,1)-0.5_r8*br(i,1)
562 IF ((dltr*dltl).lt.0.0_r8)
THEN
565 ELSE IF (abs(dltr).gt.abs(cffl))
THEN
567 ELSE IF (abs(dltl).gt.abs(cffr))
THEN
589 cff=dtdays*abs(wbio(isink))
593 wl(i,k)=z_w(i,j,k-1)+cff
594 wr(i,k)=hz(i,j,k)*qc(i,k)
601 IF (wl(i,k).gt.z_w(i,j,ks))
THEN
603 fc(i,k-1)=fc(i,k-1)+wr(i,ks)
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)+ &
618 & cu*(0.5_r8*(br(i,ks)-bl(i,ks))- &
620 & (br(i,ks)+bl(i,ks)- &
626 bio(i,k,ibio)=qc(i,k)+(fc(i,k)-fc(i,k-1))*hz_inv(i,k)
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)