56 integer,
intent(in) :: ng, tile
60 character (len=*),
parameter :: MyFile = &
68 IF (lbiofile(
inlm))
THEN
70 IF (lbiofile(
inlm).and.(tile.eq.0))
THEN
72 lbiofile(
inlm)=.false.
80 & lbi, ubi, lbj, ubj,
n(ng),
nt(ng), &
81 & imins, imaxs, jmins, jmaxs, &
101 & LBi, UBi, LBj, UBj, UBk, UBt, &
102 & IminS, ImaxS, JminS, JmaxS, &
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
126 real(r8),
intent(in) :: rmask(LBi:,LBj:)
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:,:,:,:)
135 real(r8),
intent(in) :: rmask(LBi:UBi,LBj:UBj)
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)
146 integer,
parameter :: Nsink = 2
148 integer :: Iter, ibio, indx, isink, itime, itrc, iTrcMax
149 integer :: i, j, k, ks
151 integer,
dimension(Nsink) :: idsink
153 real(r8),
parameter :: MinVal = 1.0e-6_r8
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
169 real(r8),
dimension(Nsink) :: Wbio
171 integer,
dimension(IminS:ImaxS,N(ng)) :: ksource
173 real(r8),
dimension(IminS:ImaxS) :: PARsur
175 real(r8),
dimension(NT(ng),2) :: BioTrc
177 real(r8),
dimension(IminS:ImaxS,N(ng),NT(ng)) :: Bio
178 real(r8),
dimension(IminS:ImaxS,N(ng),NT(ng)) :: Bio_old
180 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: FC
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
193#include "set_bounds.h"
220 j_loop :
DO j=jstr,jend
223 hz_inv(i,k)=1.0_r8/hz(i,j,k)
228 hz_inv2(i,k)=1.0_r8/(hz(i,j,k)+hz(i,j,k+1))
233 hz_inv3(i,k)=1.0_r8/(hz(i,j,k-1)+hz(i,j,k)+hz(i,j,k+1))
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)
324 iter_loop:
DO iter=1,
bioiter(ng)
333 IF (parsur(i).gt.0.0_r8)
THEN
342 dz=0.5_r8*(z_w(i,j,k)-z_w(i,j,k-1))
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)
385 cff1=cff*exp(
kgpps(ng)*bio(i,k,
itemp))*lights(i,k)* &
392 gppnps=bio(i,k,
ino3_)*cff2
393 gppaps=bio(i,k,
inh4_)*cff3
401 rnews=gppnps/max(minval,gppps)
404 resps=bio(i,k,
isphy)*cff4
406 bio(i,k,
inh4_)=bio(i,k,
inh4_)+resps*(1.0_r8-rnews)
434 cff1=cff*exp(
kgppl(ng)*bio(i,k,
itemp))*lightl(i,k)* &
439 cff4=cff2*bio(i,k,
ino3_)
440 cff5=cff3*bio(i,k,
inh4_)
442 cff7=cff6/max(minval,cff4+cff5)
443 cff4=cff1*cff2*min(1.0_r8,cff7)
444 cff5=cff1*cff3*min(1.0_r8,cff7)
447 gppnpl=bio(i,k,
ino3_)*cff4
448 gppapl=bio(i,k,
inh4_)*cff5
458 rnewl=gppnpl/max(minval,gpppl)
461 respl=bio(i,k,
ilphy)*cff7
463 bio(i,k,
inh4_)=bio(i,k,
inh4_)+respl*(1.0_r8-rnewl)
488 morps=bio(i,k,
isphy)*cff1
489 morpl=bio(i,k,
ilphy)*cff2
499#if defined IVLEV_EXPLICIT
506#elif defined HOLLING_GRAZING
523# define IVLEV_IMPLICIT
570#if defined IVLEV_EXPLICIT
572 graps2zs=fac1*cff1*max(0.0_r8,cff4)*bio(i,k,
iszoo)
576# ifdef HOLLING_GRAZING
578 cff=fac1*cff1*cff4*bio(i,k,
iszoo)*bio(i,k,
isphy)
579# elif defined IVLEV_IMPLICIT
581 cff5=1.0_r8/(fac1*cff4)
582 cff=(1.0_r8+bio(i,k,
isphy)*cff5)*cff1*bio(i,k,
iszoo)
585 graps2zs=cff*bio(i,k,
isphy)
591#if defined IVLEV_EXPLICIT
593 graps2zl=fac2*cff2*max(0.0_r8,cff4)*bio(i,k,
ilzoo)
597# ifdef HOLLING_GRAZING
599 cff=fac2*cff2*cff4*bio(i,k,
ilzoo)*bio(i,k,
isphy)
600# elif defined IVLEV_IMPLICIT
602 cff5=1.0_r8/(fac2*cff4)
603 cff=(1.0_r8+bio(i,k,
isphy)*cff5)*cff2*bio(i,k,
ilzoo)
606 graps2zl=cff*bio(i,k,
isphy)
612#if defined IVLEV_EXPLICIT
614 grapl2zl=fac3*cff2*max(0.0_r8,cff4)*bio(i,k,
ilzoo)
618# ifdef HOLLING_GRAZING
620 cff=fac3*cff2*cff4*bio(i,k,
ilzoo)*bio(i,k,
ilphy)
621# elif defined IVLEV_IMPLICIT
623 cff5=1.0_r8/(fac3*cff4)
624 cff=(1.0_r8+bio(i,k,
ilphy)*cff5)*cff2*bio(i,k,
ilzoo)
627 grapl2zl=cff*bio(i,k,
ilphy)
633#if defined IVLEV_EXPLICIT
635 grazs2zl=fac4*cff2*max(0.0_r8,cff4)*bio(i,k,
ilzoo)
639# ifdef HOLLING_GRAZING
641 cff=fac4*cff2*cff4*bio(i,k,
ilzoo)*bio(i,k,
iszoo)
642# elif defined IVLEV_IMPLICIT
644 cff5=1.0_r8/(fac4*cff4)
645 cff=(1.0_r8+bio(i,k,
isphy)*cff5)*cff2*bio(i,k,
ilzoo)
648 grazs2zl=cff*bio(i,k,
iszoo)
654#if defined IVLEV_EXPLICIT
657 grapl2zp=fac5*cff3*cff5*max(0.0_r8,cff4)*bio(i,k,
ipzoo)
661# ifdef HOLLING_GRAZING
664 cff=fac5*cff3*cff4*cff5*bio(i,k,
ipzoo)*bio(i,k,
ilphy)
665# elif defined IVLEV_IMPLICIT
668 cff6=1.0_r8/(fac5*cff4)
669 cff=(1.0_r8+bio(i,k,
ilphy)*cff6)*cff3*cff5*bio(i,k,
ipzoo)
672 grapl2zp=cff*bio(i,k,
ilphy)
678#if defined IVLEV_EXPLICIT
681 grazs2zp=fac6*cff3*cff5*max(0.0_r8,cff4)*bio(i,k,
ipzoo)
685# ifdef HOLLING_GRAZING
688 cff=fac6*cff3*cff4*cff5*bio(i,k,
ipzoo)*bio(i,k,
iszoo)
689# elif defined IVLEV_IMPLICIT
692 cff6=1.0_r8/(fac6*cff4)
693 cff=(1.0_r8+bio(i,k,
iszoo)*cff6)*cff3*cff5*bio(i,k,
ipzoo)
696 grazs2zp=cff*bio(i,k,
iszoo)
702#if defined IVLEV_EXPLICIT
704 grazl2zp=fac7*cff3*max(0.0_r8,cff4)*bio(i,k,
ipzoo)
708# ifdef HOLLING_GRAZING
710 cff=fac7*cff3*cff4*bio(i,k,
ipzoo)*bio(i,k,
ilzoo)
711# elif defined IVLEV_IMPLICIT
713 cff5=1.0_r8/(fac7*cff4)
714 cff=(1.0_r8+bio(i,k,
ilzoo)*cff5)*cff3*bio(i,k,
ipzoo)
717 grazl2zp=cff*bio(i,k,
ilzoo)
727 & (graps2zl+grapl2zl+grazs2zl)
729 & (grapl2zp+grazs2zp+grazl2zp)
733 bio(i,k,
ipon_)=bio(i,k,
ipon_)+egezs+egezl+egezp
741 & (graps2zl+grapl2zl+grazs2zl)
743 & (grapl2zp+grazs2zp+grazl2zp)
747 bio(i,k,
inh4_)=bio(i,k,
inh4_)+exczs+exczl+exczp
767 & bio(i,k,
iszoo)*cff1+ &
768 & bio(i,k,
ilzoo)*cff2+ &
769 & bio(i,k,
ipzoo)*cff3
778 fac2=dtdays*
vp2n0(ng)
779 fac3=dtdays*
vp2d0(ng)
780 fac4=dtdays*
vd2n0(ng)
781 fac5=dtdays*
vo2s0(ng)
790 & bio(i,k,
inh4_)*cff1
797 & bio(i,k,
ipon_)*cff2
804 & bio(i,k,
ipon_)*cff3
811 & bio(i,k,
idon_)*cff4
818 & bio(i,k,
iopal)*cff5
830 sink_loop:
DO isink=1,nsink
840 qc(i,k)=bio(i,k,ibio)
846 fc(i,k)=(qc(i,k+1)-qc(i,k))*hz_inv2(i,k)
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)
860 IF ((dltr*dltl).le.0.0_r8)
THEN
863 ELSE IF (abs(dltr).gt.abs(cffl))
THEN
865 ELSE IF (abs(dltl).gt.abs(cffr))
THEN
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)
883 wr(i,k)=(2.0_r8*dltr-dltl)**2
884 wl(i,k)=(dltr-2.0_r8*dltl)**2
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)
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))
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))
905 br(i,
n(ng))=qc(i,
n(ng))
906 bl(i,
n(ng))=qc(i,
n(ng))
907 br(i,
n(ng)-1)=qc(i,
n(ng))
909#if defined LINEAR_CONTINUATION
911 bl(i,1)=2.0_r8*qc(i,1)-br(i,1)
914 bl(i,1)=1.5_r8*qc(i,1)-0.5_r8*br(i,1)
932 IF ((dltr*dltl).lt.0.0_r8)
THEN
935 ELSE IF (abs(dltr).gt.abs(cffl))
THEN
937 ELSE IF (abs(dltl).gt.abs(cffr))
THEN
959 cff=dtdays*abs(wbio(isink))
963 wl(i,k)=z_w(i,j,k-1)+cff
964 wr(i,k)=hz(i,j,k)*qc(i,k)
971 IF (wl(i,k).gt.z_w(i,j,ks))
THEN
973 fc(i,k-1)=fc(i,k-1)+wr(i,ks)
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)+ &
988 & cu*(0.5_r8*(br(i,ks)-bl(i,ks))- &
990 & (br(i,ks)+bl(i,ks)- &
996 bio(i,k,ibio)=qc(i,k)+(fc(i,k)-fc(i,k-1))*hz_inv(i,k)
1013 IF (ibio.eq.
ipon_)
THEN
1015 cff1=fc(i,0)*hz_inv(i,1)
1018 ELSE IF (ibio.eq.
iopal)
THEN
1020 cff1=fc(i,0)*hz_inv(i,1)
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)
subroutine, public biology(ng, tile)
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)
real(r8), dimension(:), allocatable pl2zlstar
real(r8), dimension(:), allocatable kps2zs
real(r8), dimension(:), allocatable parfrac
real(r8), dimension(:), allocatable kmorzl
real(r8), dimension(:), allocatable kpl2zl
real(r8), dimension(:), allocatable ko2s
real(r8), dimension(:), allocatable pusaipl
real(r8), dimension(:), allocatable knit
real(r8), dimension(:), allocatable pusais
real(r8), dimension(:), allocatable kzs2zl
real(r8), dimension(:), allocatable vp2n0
real(r8), dimension(:), allocatable alphaps
real(r8), dimension(:), allocatable vmaxs
real(r8), dimension(:), allocatable vp2d0
real(r8), dimension(:), allocatable ps2zsstar
integer, dimension(:), allocatable bioiter
real(r8), dimension(:), allocatable zs2zpstar
real(r8), dimension(:), allocatable attsw
real(r8), dimension(:), allocatable knh4l
real(r8), dimension(:), allocatable kgpps
real(r8), dimension(:), allocatable grmaxppl
real(r8), dimension(:), allocatable lams
real(r8), dimension(:), allocatable kzs2zp
real(r8), dimension(:), allocatable kps2zl
real(r8), dimension(:), allocatable vd2n0
real(r8), dimension(:), allocatable setvpon
real(r8), dimension(:), allocatable kmorzs
real(r8), dimension(:), allocatable vmaxl
real(r8), dimension(:), allocatable morpl0
real(r8), dimension(:), allocatable kmorps
real(r8), dimension(:), allocatable rsin
real(r8), dimension(:), allocatable grmaxpzs
real(r8), dimension(:), allocatable vo2s0
real(r8), dimension(:), allocatable pusail
real(r8), dimension(:), allocatable kgppl
real(r8), dimension(:), allocatable kresps
real(r8), dimension(:), allocatable grmaxlzs
real(r8), dimension(:), allocatable krespl
real(r8), dimension(:), allocatable kgras
real(r8), dimension(:), allocatable alphazl
real(r8), dimension(:), allocatable kgral
real(r8), dimension(:), allocatable betapl
real(r8), dimension(:), allocatable resps0
real(r8), dimension(:), allocatable attpl
real(r8), dimension(:), allocatable kp2n
real(r8), dimension(:), allocatable attps
real(r8), dimension(:), allocatable morzl0
real(r8), dimension(:), allocatable betazp
real(r8), dimension(:), allocatable morzs0
real(r8), dimension(:), allocatable gammal
real(r8), dimension(:), allocatable lamp
integer, dimension(:), allocatable idbio
real(r8), dimension(:), allocatable alphapl
real(r8), dimension(:), allocatable kmorzp
real(r8), dimension(:), allocatable kpl2zp
real(r8), dimension(:), allocatable ps2zlstar
real(r8), dimension(:), allocatable grmaxlps
real(r8), dimension(:), allocatable kd2n
real(r8), dimension(:), allocatable zl2zpstar
real(r8), dimension(:), allocatable nit0
real(r8), dimension(:), allocatable kno3l
real(r8), dimension(:), allocatable alphazs
real(r8), dimension(:), allocatable kzl2zp
real(r8), dimension(:), allocatable betazl
real(r8), dimension(:), allocatable gammas
real(r8), dimension(:), allocatable setvopal
real(r8), dimension(:), allocatable grmaxlpl
real(r8), dimension(:), allocatable respl0
real(r8), dimension(:), allocatable kno3s
real(r8), dimension(:), allocatable morzp0
real(r8), dimension(:), allocatable kmorpl
real(r8), dimension(:), allocatable pl2zpstar
real(r8), dimension(:), allocatable pusaizs
real(r8), dimension(:), allocatable alphazp
real(r8), dimension(:), allocatable grmaxsps
real(r8), dimension(:), allocatable kgrap
real(r8), dimension(:), allocatable betazs
real(r8), dimension(:), allocatable knh4s
real(r8), dimension(:), allocatable ksil
real(r8), dimension(:), allocatable grmaxpzl
real(r8), dimension(:), allocatable laml
real(r8), dimension(:), allocatable morps0
real(r8), dimension(:), allocatable kp2d
real(r8), dimension(:), allocatable betaps
real(r8), dimension(:), allocatable zs2zlstar
type(t_forces), dimension(:), allocatable forces
type(t_grid), dimension(:), allocatable grid
type(t_ocean), dimension(:), allocatable ocean
integer, dimension(:), allocatable n
integer, dimension(:), allocatable nt
real(dp), dimension(:), allocatable dt
real(dp), parameter sec2day
integer, dimension(:), allocatable nnew
integer, dimension(:), allocatable nstp
recursive subroutine wclock_off(ng, model, region, line, routine)
recursive subroutine wclock_on(ng, model, region, line, routine)