Changeset 339 for trunk/NEMO/TOP_SRC/SMS/p4zprod.F
- Timestamp:
- 2005-11-14T13:30:28+01:00 (18 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/TOP_SRC/SMS/p4zprod.F (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/TOP_SRC/SMS/p4zprod.F
r274 r339 1 CCC$Header$2 CCC TOP 1.0 , LOCEAN-IPSL (2005)3 C This software is governed by CeCILL licence see modipsl/doc/NEMO_CeCILL.txt4 C ---------------------------------------------------------------------------5 1 CDIR$ LIST 6 2 SUBROUTINE p4zprod … … 42 38 USE sms 43 39 IMPLICIT NONE 40 #include "domzgr_substitute.h90" 44 41 CDIR$ LIST 45 42 CC---------------------------------------------------------------------- … … 48 45 INTEGER ji, jj, jk 49 46 REAL silfac,pislopen(jpi,jpj,jpk),pislope2n(jpi,jpj,jpk) 50 REAL zmixnano ,zmixdiat,zfact47 REAL zmixnano(jpi,jpj),zmixdiat(jpi,jpj),zfact 51 48 REAL prdiachl,prbiochl,silim,ztn,zadap,zadap2 52 49 REAL ysopt(jpi,jpj,jpk),pislopead(jpi,jpj,jpk) 53 50 REAL prdia(jpi,jpj,jpk),prbio(jpi,jpj,jpk) 54 51 REAL etot2(jpi,jpj,jpk),pislopead2(jpi,jpj,jpk) 55 REAL silfac2,siborn,zprod 56 C 52 REAL xlim,silfac2,siborn,zprod,zprod2 53 REAL zmxltst,zmxlday 54 C 57 55 C Computation of the optimal production 58 56 C ------------------------------------- … … 69 67 call p4zday 70 68 71 DO jk = 1,jkopt72 DO 73 DO 69 DO jk = 1,jpkm1 70 DO jj = 1,jpj 71 DO ji = 1,jpi 74 72 C 75 73 C Computation of the P-I slope for nanos and diatoms … … 77 75 C 78 76 ztn=max(0.,tn(ji,jj,jk)-15.) 79 zadap= 2.+3.*ztn/(2.+ztn)80 zadap2= 2.77 zadap=1.+2.*ztn/(2.+ztn) 78 zadap2=1. 81 79 82 80 zfact=exp(-0.21*emoy(ji,jj,jk)) … … 97 95 END DO 98 96 99 DO jk = 1,j kopt97 DO jk = 1,jpkm1 100 98 DO jj = 1,jpj 101 99 DO ji = 1,jpi … … 113 111 END DO 114 112 115 DO jk = 1,j kopt113 DO jk = 1,jpkm1 116 114 DO jj = 1,jpj 117 115 DO ji = 1,jpi … … 124 122 c (silpot2) 125 123 C 126 silim=min((1.-exp(-etot(ji,jj,jk)*pislope2n(ji,jj,jk))), 127 & trn(ji,jj,jk,jpfer)/(conc3+trn(ji,jj,jk,jpfer)), 128 & trn(ji,jj,jk,jpno3)/(conc1+trn(ji,jj,jk,jpno3)), 129 & trn(ji,jj,jk,jppo4)/(conc1+trn(ji,jj,jk,jppo4))) 124 C 125 xlim=xdiatno3(ji,jj,jk)+xdiatnh4(ji,jj,jk) 126 C 127 silim=min(prdia(ji,jj,jk)/(rtrn+prmax(ji,jj,jk)), 128 & trn(ji,jj,jk,jpfer)/(concdfe(ji,jj,jk)+trn(ji,jj,jk,jpfer)), 129 & trn(ji,jj,jk,jppo4)/(concdnh4+trn(ji,jj,jk,jppo4)), 130 & xlim) 130 131 silfac=5.4*exp(-4.23*silim)+1.13 131 132 siborn=max(0.,(trn(ji,jj,jk,jpsil)-15.E-6)) 132 silfac2=1.+ 2.*siborn/(siborn+xksi2)133 silfac=min( 6.53,silfac*silfac2)133 silfac2=1.+3.*siborn/(siborn+xksi2) 134 silfac=min(7.6,silfac*silfac2) 134 135 C 135 136 ysopt(ji,jj,jk)=grosip*trn(ji,jj,jk,jpsil)/(trn(ji,jj,jk,jpsil) 136 $ +xksi1)*silfac*(1.-0.6*cmask(ji,jj,1)) 137 C 138 END DO 139 END DO 140 END DO 141 142 DO jk = 1,jkopt 143 DO jj = 1,jpj 144 DO ji = 1,jpi 145 IF (tmask(ji,jj,jk).NE.0) THEN 146 C 137 $ +xksi1)*silfac 138 C 139 END DO 140 END DO 141 END DO 142 C 143 C Computation of the limitation term due to 144 C A mixed layer deeper than the euphotic depth 145 C -------------------------------------------- 146 C 147 DO jj=1,jpj 148 DO ji=1,jpi 149 zmxltst=max(0.,hmld(ji,jj)-zmeu(ji,jj)) 150 zmxlday=zmxltst**2/rjjss 151 zmixnano(ji,jj)=1.-zmxlday/(12.+zmxlday) 152 zmixdiat(ji,jj)=1.-zmxlday/(36.+zmxlday) 153 END DO 154 END DO 155 156 DO jk = 1,jpkm1 157 DO jj = 1,jpj 158 DO ji = 1,jpi 159 if (fsdepw(ji,jj,jk+1).le.hmld(ji,jj)) then 160 C 147 161 C Mixed-layer effect on production 148 162 C -------------------------------- 149 C 150 zmixnano=max(0.2,(1.-0.8*(hmld(ji,jj)/zmeu(ji,jj)-1.))) 151 zmixdiat=max(0.5,(1.-0.5*(hmld(ji,jj)/zmeu(ji,jj)-1.))) 152 prbio(ji,jj,jk)=prbio(ji,jj,jk)*min(1.,zmixnano) 153 prdia(ji,jj,jk)=prdia(ji,jj,jk)*min(1.,zmixdiat) 154 C 155 ENDIF 156 END DO 157 END DO 158 END DO 159 160 DO jk = 1,jkopt 163 C 164 prbio(ji,jj,jk)=prbio(ji,jj,jk)*zmixnano(ji,jj) 165 prdia(ji,jj,jk)=prdia(ji,jj,jk)*zmixdiat(ji,jj) 166 endif 167 END DO 168 END DO 169 END DO 170 C 171 DO jk = 1,jpkm1 161 172 DO jj = 1,jpj 162 173 DO ji = 1,jpi … … 172 183 END DO 173 184 174 DO jk = 1,j kopt185 DO jk = 1,jpkm1 175 186 DO jj = 1,jpj 176 187 DO ji = 1,jpi … … 192 203 & *xlimphy(ji,jj,jk) 193 204 194 prorca5(ji,jj,jk) = (15.E-6)**2*zprod/0.033 205 zprod2=rjjss*prorca(ji,jj,jk)*prbiochl*trn(ji,jj,jk,jpphy) 206 & *max(0.1,xlimphy(ji,jj,jk)) 207 208 prorca5(ji,jj,jk) = (fecnm)**2*zprod/chlcnm 195 209 & /(pislopead(ji,jj,jk)*etot2(ji,jj,jk)*trn(ji,jj,jk,jpnfe) 196 210 & +rtrn) 197 211 198 prorca6(ji,jj,jk) = 0.033*144.*zprod/(pislopead(ji,jj,jk)212 prorca6(ji,jj,jk) = chlcnm*144.*zprod2/(pislopead(ji,jj,jk) 199 213 & *etot2(ji,jj,jk)*max(trn(ji,jj,jk,jpnch),1.E-10)+rtrn) 200 214 … … 203 217 END DO 204 218 205 DO jk = 1,j kopt219 DO jk = 1,jpkm1 206 220 DO jj = 1,jpj 207 221 DO ji = 1,jpi … … 221 235 prorca3(ji,jj,jk) = prorca2(ji,jj,jk)*ysopt(ji,jj,jk) 222 236 C 223 zprod=rjjss*prorca2(ji,jj,jk)*prdiachl*xlimdia(ji,jj,jk) 237 zprod=rjjss*prorca2(ji,jj,jk)*prdiachl*trn(ji,jj,jk,jpdia) 238 & *max(0.1,xlimdia(ji,jj,jk)) 239 240 zprod2=rjjss*prorca2(ji,jj,jk)*prdiachl*xlimdia2(ji,jj,jk) 224 241 & *trn(ji,jj,jk,jpdia) 225 C 226 prorca4(ji,jj,jk) = (20.E-6)**2*zprod/0.05 242 243 C 244 prorca4(ji,jj,jk) = (fecdm)**2*zprod2/chlcdm 227 245 & /(pislopead2(ji,jj,jk)*etot2(ji,jj,jk)*trn(ji,jj,jk,jpdfe) 228 246 & +rtrn) 229 247 C 230 prorca7(ji,jj,jk) = 0.05*144.*zprod/(pislopead2(ji,jj,jk)248 prorca7(ji,jj,jk) = chlcdm*144.*zprod/(pislopead2(ji,jj,jk) 231 249 & *etot2(ji,jj,jk)*max(trn(ji,jj,jk,jpdch),1.E-10)+rtrn) 232 250 C … … 238 256 RETURN 239 257 END 258
Note: See TracChangeset
for help on using the changeset viewer.
