Changeset 339
- Timestamp:
- 2005-11-14T13:30:28+01:00 (18 years ago)
- Location:
- trunk/NEMO/TOP_SRC/SMS
- Files:
-
- 20 edited
-
p4zbio.F (modified) (27 diffs)
-
p4zche.F (modified) (10 diffs)
-
p4zdiat.F (modified) (5 diffs)
-
p4zflx.F (modified) (9 diffs)
-
p4zint.F (modified) (4 diffs)
-
p4zlys.F (modified) (7 diffs)
-
p4zmeso.F (modified) (7 diffs)
-
p4zmicro.F (modified) (6 diffs)
-
p4znano.F (modified) (5 diffs)
-
p4zopt.F (modified) (8 diffs)
-
p4zprg.F (modified) (6 diffs)
-
p4zprod.F (modified) (13 diffs)
-
p4zrem.F (modified) (16 diffs)
-
p4zsed.F (modified) (10 diffs)
-
p4zsink.F (modified) (8 diffs)
-
p4zsink2.F (modified) (4 diffs)
-
trcbio.F (modified) (4 diffs)
-
trcexp.F (modified) (9 diffs)
-
trcopt.F (modified) (3 diffs)
-
trcsed.F (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/TOP_SRC/SMS/p4zbio.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 SUBROUTINE p4zbio 6 2 CDIR$ LIST … … 32 28 USE trp_trc 33 29 USE sms 34 USE lib_mpp35 USE lbclnk36 30 IMPLICIT NONE 31 #include "domzgr_substitute.h90" 37 32 CDIR$ LIST 38 33 CC----------------------------------------------------------------- … … 40 35 CC ================== 41 36 C 42 INTEGER ji, jj, jk 43 44 REAL xcond,zdenom,zdenom1(jpi,jpj,jpk),zdenom2(jpi,jpj,jpk) 45 REAL zneg, prodca 46 C 47 REAL irondep(jpi,jpj,jpk),sidep(jpi,jpj,jpk),prodt 48 INTEGER jn 49 C 50 CC---------------------------------------------------------------------- 51 CC statement functions 52 CC =================== 53 CDIR$ NOLIST 54 #include "domzgr_substitute.h90" 55 CDIR$ LIST 56 C 57 C SET HALF PRECISION CONSTANTS 58 C----------------------------- 59 C 60 C Initialisation of variables used to compute deposition 61 C ------------------------------------------------------ 62 C 63 irondep = 0. 64 sidep = 0. 65 C 66 C 67 C Iron and Si deposition at the surface 68 C ------------------------------------- 69 C 70 do jj=1,jpj 71 do ji=1,jpi 72 irondep(ji,jj,1)=(0.01*dust(ji,jj)/(55.85*rmoss) 73 & +3E-10/raass)*rfact2/fse3t(ji,jj,1) 74 sidep(ji,jj,1)=8.8*0.075*dust(ji,jj)*rfact2/ 75 & (fse3t(ji,jj,1)*28.01*rmoss) 76 end do 77 end do 37 INTEGER ji, jj, jk, jn 38 39 REAL zdenom,zdenom1(jpi,jpj,jpk),zdenom2(jpi,jpj,jpk) 40 REAL prodca,ztemp 41 C 42 REAL prodt 43 REAL zfracal(jpi,jpj,jpk) 78 44 C 79 45 C ASSIGN THE SHEAR RATE THAT IS USED FOR AGGREGATION … … 82 48 zdiss=0.01 83 49 C 84 50 DO jk=1,jpkm1 85 51 DO jj=1,jpj 86 52 DO ji=1,jpi … … 88 54 END DO 89 55 END DO 90 56 END DO 91 57 C 92 58 C Compute de different ratios for scavenging of iron … … 104 70 END DO 105 71 END DO 106 72 C 73 C Compute the fraction of nanophytoplankton that is made 74 C of calcifiers 75 C ------------------------------------------------------ 76 C 77 DO jk=1,jpkm1 78 DO jj=1,jpj 79 DO ji=1,jpi 80 ztemp=max(0.,tn(ji,jj,jk)) 81 zfracal(ji,jj,jk)=caco3r*xlimphy(ji,jj,jk)*max(0.0001 82 & ,ztemp/(2.+ztemp))*max(1.,trn(ji,jj,jk,jpphy)*1E6/2.) 83 zfracal(ji,jj,jk)=min(0.8,zfracal(ji,jj,jk)) 84 zfracal(ji,jj,jk)=max(0.01,zfracal(ji,jj,jk)) 85 END DO 86 END DO 87 END DO 107 88 108 89 C … … 111 92 C 112 93 CALL p4zopt 113 114 94 C 95 C Call routine to compute the co-limitations by the various 96 C nutrients 97 C --------------------------------------------------------- 98 C 99 CALL p4zlim 115 100 C 116 101 C Call production routine to compute phytoplankton growth rate … … 119 104 C ------------------------------------------------------------ 120 105 C 121 122 106 CALL p4zprod 123 124 125 107 C 126 108 C Call phytoplankton mortality routines. Mortality losses for … … 129 111 C 130 112 CALL p4znano 131 132 113 CALL p4zdiat 133 134 114 C 135 115 C Call zooplankton sources/sinks routines. … … 138 118 C 139 119 CALL p4zmicro 140 141 120 CALL p4zmeso 142 143 121 C 144 122 C Call subroutine for computation of the vertical flux 145 123 C of particulate organic matter 146 124 C ---------------------------------------------------- 125 C 147 126 CALL p4zsink 148 149 127 C 150 128 C Call subroutine for computation of remineralization … … 152 130 C ---------------------------------------------------- 153 131 CALL p4zrem 154 155 C156 C Vertical loop to pre-compute concentration changes of the rapid157 C varying tracers for preventing them to fall below 0158 C ---------------------------------------------------------------159 C160 DO jk = 1,jpkm1161 DO jj = 1,jpj162 DO ji = 1,jpi163 C164 C Evolution of PO4165 C ----------------166 C167 zneg = trn(ji,jj,jk,jppo4)168 & -prorca(ji,jj,jk)-prorca2(ji,jj,jk)+denitr(ji,jj,jk)169 & +grarem(ji,jj,jk)*sigma1+grarem2(ji,jj,jk)*sigma2170 & +olimi(ji,jj,jk)+po4dep(ji,jj,jk)*rfact2171 C172 C Nullity test for PO4173 C --------------------174 C175 xcond=(0.5+sign(0.5,zneg))176 prorca(ji,jj,jk)=prorca(ji,jj,jk)*xcond177 prorca2(ji,jj,jk)=prorca2(ji,jj,jk)*xcond178 proreg(ji,jj,jk)=proreg(ji,jj,jk)*xcond179 proreg2(ji,jj,jk)=proreg2(ji,jj,jk)*xcond180 pronew(ji,jj,jk)=pronew(ji,jj,jk)*xcond181 pronew2(ji,jj,jk)=pronew2(ji,jj,jk)*xcond182 C183 C Evolution of NO3184 C ----------------185 C186 zneg = trn(ji,jj,jk,jpno3)187 & -pronew(ji,jj,jk)-pronew2(ji,jj,jk)188 & +po4dep(ji,jj,jk)*rfact2+onitr(ji,jj,jk)189 & -denitr(ji,jj,jk)*rdenit+nitdep(ji,jj,jk)*rfact2190 C191 C Nullity test for NO3192 C --------------------193 C194 xcond=(0.5+sign(0.5,zneg))195 prorca(ji,jj,jk)=prorca(ji,jj,jk)*xcond196 prorca2(ji,jj,jk)=prorca2(ji,jj,jk)*xcond197 proreg(ji,jj,jk)=proreg(ji,jj,jk)*xcond198 proreg2(ji,jj,jk)=proreg2(ji,jj,jk)*xcond199 pronew(ji,jj,jk)=pronew(ji,jj,jk)*xcond200 pronew2(ji,jj,jk)=pronew2(ji,jj,jk)*xcond201 denitr(ji,jj,jk)=denitr(ji,jj,jk)*xcond202 C203 C Evolution of NH4204 C ----------------205 C206 zneg = trn(ji,jj,jk,jpnh4)207 & -proreg(ji,jj,jk)-proreg2(ji,jj,jk)-onitr(ji,jj,jk)208 & +grarem(ji,jj,jk)*sigma1+grarem2(ji,jj,jk)*sigma2209 & +olimi(ji,jj,jk)+denitr(ji,jj,jk)210 C211 C Nullity test for NH4212 C --------------------213 C214 xcond=(0.5+sign(0.5,zneg))215 prorca(ji,jj,jk)=prorca(ji,jj,jk)*xcond216 prorca2(ji,jj,jk)=prorca2(ji,jj,jk)*xcond217 proreg(ji,jj,jk)=proreg(ji,jj,jk)*xcond218 proreg2(ji,jj,jk)=proreg2(ji,jj,jk)*xcond219 pronew(ji,jj,jk)=pronew(ji,jj,jk)*xcond220 pronew2(ji,jj,jk)=pronew2(ji,jj,jk)*xcond221 onitr(ji,jj,jk)=onitr(ji,jj,jk)*xcond222 C223 C Evolution of IRON224 C -----------------225 C226 zneg = trn(ji,jj,jk,jpfer)227 & +(excret-1.)*prorca5(ji,jj,jk)-xaggdfe(ji,jj,jk)228 & +(excret2-1.)*prorca4(ji,jj,jk)-xbactfer(ji,jj,jk)229 & +grafer(ji,jj,jk)+grafer2(ji,jj,jk)230 & +ofer(ji,jj,jk)-xscave(ji,jj,jk)+irondep(ji,jj,jk)231 & +(ironsed(ji,jj,jk)+po4dep(ji,jj,jk)*9.E-5)*rfact2232 C233 C Nullity test for iron234 C ---------------------235 C236 xcond=(0.5+sign(0.5,zneg))237 prorca4(ji,jj,jk)=prorca4(ji,jj,jk)*xcond238 prorca5(ji,jj,jk)=prorca5(ji,jj,jk)*xcond239 C240 C Evolution of O2241 C ---------------242 C243 xcond=(0.5+sign(0.5,(trn(ji,jj,jk,jpoxy)-oxymin)))244 zneg = trn(ji,jj,jk,jpoxy)245 & +o2ut*(proreg(ji,jj,jk)+proreg2(ji,jj,jk))246 & +(o2ut+o2nit)*(pronew(ji,jj,jk)+pronew2(ji,jj,jk))247 & -o2ut*olimi(ji,jj,jk)-o2ut*xcond*(grarem(ji,jj,jk)248 & *sigma1+grarem2(ji,jj,jk)*sigma2)-o2nit*onitr(ji,jj,jk)249 C250 C Nullity test for oxygen251 C -----------------------252 C253 xcond=(0.5+sign(0.5,zneg))254 olimi(ji,jj,jk)=olimi(ji,jj,jk)*xcond255 onitr(ji,jj,jk)=onitr(ji,jj,jk)*xcond256 C257 END DO258 END DO259 END DO260 261 DO jk = 1,jpkm1262 DO jj = 1,jpj263 DO ji = 1,jpi264 C265 C Evolution of nanophytoplankton266 C ------------------------------267 C268 zneg = trn(ji,jj,jk,jpphy)269 & +prorca(ji,jj,jk)*(1.-excret)-tortp(ji,jj,jk)270 & -grazp(ji,jj,jk)-grazn(ji,jj,jk)-respp(ji,jj,jk)271 C272 C Nullity test for Phyto273 C ----------------------274 C275 xcond=(0.5+sign(0.5,zneg))276 tortp(ji,jj,jk)=tortp(ji,jj,jk)*xcond277 grazp(ji,jj,jk)=grazp(ji,jj,jk)*xcond278 grazn(ji,jj,jk)=grazn(ji,jj,jk)*xcond279 respp(ji,jj,jk)=respp(ji,jj,jk)*xcond280 C281 C Evolution of nanophytoplankton chlorophyll282 C ------------------------------283 C284 zneg = trn(ji,jj,jk,jpnch)285 & +prorca6(ji,jj,jk)*(1.-excret)-tortnch(ji,jj,jk)286 & -grazpch(ji,jj,jk)-graznch(ji,jj,jk)287 & -respnch(ji,jj,jk)288 C289 C Nullity test for Phyto290 C ----------------------291 C292 xcond=(0.5+sign(0.5,zneg))293 tortnch(ji,jj,jk)=tortnch(ji,jj,jk)*xcond294 graznch(ji,jj,jk)=graznch(ji,jj,jk)*xcond295 grazpch(ji,jj,jk)=grazpch(ji,jj,jk)*xcond296 respnch(ji,jj,jk)=respnch(ji,jj,jk)*xcond297 C298 C Evolution of biogenic Iron in Nanophytoplankton299 C -----------------------------------------------300 C301 zneg = trn(ji,jj,jk,jpnfe)302 & +prorca5(ji,jj,jk)*(1.-excret)-tortnf(ji,jj,jk)303 & -respnf(ji,jj,jk)-grazpf(ji,jj,jk)-graznf(ji,jj,jk)304 C305 C Nullity test for Biogenic Iron in Nanophytoplankton306 C ---------------------------------------------------307 C308 xcond=(0.5+sign(0.5,zneg))309 tortnf(ji,jj,jk)=tortnf(ji,jj,jk)*xcond310 respnf(ji,jj,jk)=respnf(ji,jj,jk)*xcond311 grazpf(ji,jj,jk)=grazpf(ji,jj,jk)*xcond312 graznf(ji,jj,jk)=graznf(ji,jj,jk)*xcond313 C314 C Evolution of Diatoms315 C ------------------316 C317 zneg = trn(ji,jj,jk,jpdia)318 & +prorca2(ji,jj,jk)*(1.-excret2)-tortp2(ji,jj,jk)319 & -respp2(ji,jj,jk)-grazd(ji,jj,jk)-grazsd(ji,jj,jk)320 C321 C Nullity test for diatoms322 C ----------------------323 C324 xcond=(0.5+sign(0.5,zneg))325 tortp2(ji,jj,jk)=tortp2(ji,jj,jk)*xcond326 respp2(ji,jj,jk)=respp2(ji,jj,jk)*xcond327 grazd(ji,jj,jk)=grazd(ji,jj,jk)*xcond328 grazsd(ji,jj,jk)=grazsd(ji,jj,jk)*xcond329 C330 C Evolution of Diatoms Chlorophyll331 C ------------------332 C333 zneg = trn(ji,jj,jk,jpdch)334 & +prorca7(ji,jj,jk)*(1.-excret2)-tortdch(ji,jj,jk)335 & -respdch(ji,jj,jk)-grazdch(ji,jj,jk)-grazsch(ji,jj,jk)336 C337 C Nullity test for diatoms338 C ----------------------339 C340 xcond=(0.5+sign(0.5,zneg))341 tortdch(ji,jj,jk)=tortdch(ji,jj,jk)*xcond342 respdch(ji,jj,jk)=respdch(ji,jj,jk)*xcond343 grazdch(ji,jj,jk)=grazdch(ji,jj,jk)*xcond344 grazsch(ji,jj,jk)=grazsch(ji,jj,jk)*xcond345 C346 C Evolution of biogenic Iron in diatoms347 C -------------------------------------348 C349 zneg = trn(ji,jj,jk,jpdfe)350 & +prorca4(ji,jj,jk)*(1.-excret2)-grazsf(ji,jj,jk)351 & -tortdf(ji,jj,jk)-respdf(ji,jj,jk)-grazf(ji,jj,jk)352 C353 C Nullity test for Biogenic Iron in diatoms354 C -----------------------------------------355 C356 xcond=(0.5+sign(0.5,zneg))357 tortdf(ji,jj,jk)=tortdf(ji,jj,jk)*xcond358 respdf(ji,jj,jk)=respdf(ji,jj,jk)*xcond359 grazf(ji,jj,jk)=grazf(ji,jj,jk)*xcond360 grazsf(ji,jj,jk)=grazsf(ji,jj,jk)*xcond361 C362 C Evolution of biogenic Silica in diatoms363 C ---------------------------------------364 C365 zneg = trn(ji,jj,jk,jpbsi)366 & +prorca3(ji,jj,jk)*(1.-excret2)-tortds(ji,jj,jk)367 & -respds(ji,jj,jk)-grazs(ji,jj,jk)-grazss(ji,jj,jk)368 C369 C Nullity test for Biogenic Silica in Diatoms370 C -------------------------------------------371 C372 xcond=(0.5+sign(0.5,zneg))373 tortds(ji,jj,jk)=tortds(ji,jj,jk)*xcond374 respds(ji,jj,jk)=respds(ji,jj,jk)*xcond375 grazs(ji,jj,jk)=grazs(ji,jj,jk)*xcond376 grazss(ji,jj,jk)=grazss(ji,jj,jk)*xcond377 END DO378 END DO379 END DO380 381 DO jk = 1,jpkm1382 DO jj = 1,jpj383 DO ji = 1,jpi384 C385 C Evolution of Zooplankton386 C ------------------------387 C388 zneg = trn(ji,jj,jk,jpzoo)+epsher*389 & (grazp(ji,jj,jk)+grazm(ji,jj,jk)+grazsd(ji,jj,jk))390 & -grazz(ji,jj,jk)-tortz(ji,jj,jk)-respz(ji,jj,jk)391 C392 C Nullity test for Zooplankton393 C ----------------------------394 C395 xcond=(0.5+sign(0.5,zneg))396 tortz(ji,jj,jk)=tortz(ji,jj,jk)*xcond397 respz(ji,jj,jk)=respz(ji,jj,jk)*xcond398 grazz(ji,jj,jk)=grazz(ji,jj,jk)*xcond399 C400 C Evolution of Mesozooplankton401 C ------------------------402 C403 zneg = trn(ji,jj,jk,jpmes)404 & +epsher2*(grazd(ji,jj,jk)+grazn(ji,jj,jk)+grazz(ji,jj,jk)405 & +grazpoc(ji,jj,jk)+grazffe(ji,jj,jk))-tortz2(ji,jj,jk)406 & -respz2(ji,jj,jk)407 C408 C Nullity test for Zooplankton409 C ----------------------------410 C411 xcond=(0.5+sign(0.5,zneg))412 tortz2(ji,jj,jk)=tortz2(ji,jj,jk)*xcond413 respz2(ji,jj,jk)=respz2(ji,jj,jk)*xcond414 END DO415 END DO416 END DO417 418 DO jk = 1,jpkm1419 DO jj = 1,jpj420 DO ji = 1,jpi421 C422 C Evolution of detritus423 C ---------------------424 C425 zneg = trn(ji,jj,jk,jppoc)426 & -grazpoc(ji,jj,jk)+grapoc(ji,jj,jk)-grazm(ji,jj,jk)427 & +respz(ji,jj,jk)-xagg(ji,jj,jk)+xaggdoc(ji,jj,jk)428 & +respp(ji,jj,jk)+tortp2(ji,jj,jk)+orem2(ji,jj,jk)429 & +tortz(ji,jj,jk)+tortp(ji,jj,jk)-orem(ji,jj,jk)430 & +(sinking(ji,jj,jk)-sinking(ji,jj,jk+1))431 & /fse3t(ji,jj,jk)432 C433 C Nullity test for POC434 C --------------------435 C436 xcond=(0.5+sign(0.5,zneg))437 grazm(ji,jj,jk)=grazm(ji,jj,jk)*xcond438 sinking(ji,jj,jk+1)=sinking(ji,jj,jk+1)*xcond439 orem(ji,jj,jk)=orem(ji,jj,jk)*xcond440 xagg(ji,jj,jk)=xagg(ji,jj,jk)*xcond441 grazpoc(ji,jj,jk)=grazpoc(ji,jj,jk)*xcond442 C443 C Evolution of detritus444 C ---------------------445 C446 zneg = trn(ji,jj,jk,jpgoc)447 & +grapoc2(ji,jj,jk)+respp2(ji,jj,jk)+xagg(ji,jj,jk)448 & +tortz2(ji,jj,jk)+respz2(ji,jj,jk)-orem2(ji,jj,jk)449 & +xaggdoc2(ji,jj,jk)-grazffe(ji,jj,jk)450 & +(sinking2(ji,jj,jk)-sinking2(ji,jj,jk+1))451 & /fse3t(ji,jj,jk)452 C453 C Nullity test on goc212454 C ----------------------455 C456 xcond=(0.5+sign(0.5,zneg))457 sinking2(ji,jj,jk+1)=sinking2(ji,jj,jk+1)*xcond458 orem2(ji,jj,jk)=orem2(ji,jj,jk)*xcond459 C460 C Evolution of small biogenic Iron461 C --------------------------462 C463 zdenom=1./(trn(ji,jj,jk,jppoc)+trn(ji,jj,jk,jpgoc)+rtrn)464 C465 zneg = trn(ji,jj,jk,jpsfe)466 & +unass*(grazpf(ji,jj,jk)+grazsf(ji,jj,jk))467 & -grazpof(ji,jj,jk)-(1.-unass)*grazmf(ji,jj,jk)468 & +tortdf(ji,jj,jk)+respnf(ji,jj,jk)+tortnf(ji,jj,jk)469 & +ferat3*(tortz(ji,jj,jk)+respz(ji,jj,jk))-ofer(ji,jj,jk)470 & +ofer2(ji,jj,jk)-xaggfe(ji,jj,jk)471 & +xscave(ji,jj,jk)*zdenom1(ji,jj,jk)472 & +(sinkfer(ji,jj,jk)-sinkfer(ji,jj,jk+1))473 & /fse3t(ji,jj,jk)474 C475 C Nullity test for biogenic iron476 C --------------------477 C478 xcond=(0.5+sign(0.5,zneg))479 sinkfer(ji,jj,jk+1)=sinkfer(ji,jj,jk+1)*xcond480 ofer(ji,jj,jk)=ofer(ji,jj,jk)*xcond481 xaggfe(ji,jj,jk)=xaggfe(ji,jj,jk)*xcond482 grazmf(ji,jj,jk)=grazmf(ji,jj,jk)*xcond483 C484 C Evolution of big biogenic Iron485 C --------------------------486 C487 zneg = trn(ji,jj,jk,jpbfe)488 & +unass2*(graznf(ji,jj,jk)+grazf(ji,jj,jk)+grazfff(ji,jj,jk)489 & +grazpof(ji,jj,jk)+ferat3*grazz(ji,jj,jk))+ferat3*490 & (tortz2(ji,jj,jk)+respz2(ji,jj,jk))-ofer2(ji,jj,jk)491 & +respdf(ji,jj,jk)+xaggfe(ji,jj,jk)+xbactfer(ji,jj,jk)492 & -grazfff(ji,jj,jk)+xscave(ji,jj,jk)*zdenom2(ji,jj,jk)493 & +(sinkfer2(ji,jj,jk)-sinkfer2(ji,jj,jk+1))494 & /fse3t(ji,jj,jk)495 C496 C Nullity test for biogenic iron497 C --------------------498 C499 xcond=(0.5+sign(0.5,zneg))500 sinkfer2(ji,jj,jk+1)=sinkfer2(ji,jj,jk+1)*xcond501 ofer2(ji,jj,jk)=ofer2(ji,jj,jk)*xcond502 grazfff(ji,jj,jk)=grazfff(ji,jj,jk)*xcond503 C504 C Evolution of sinking biogenic silica505 C --------------------------506 C507 zneg = trn(ji,jj,jk,jpdsi)508 & +tortds(ji,jj,jk)+grazss(ji,jj,jk)509 & +respds(ji,jj,jk)+grazs(ji,jj,jk)-osil(ji,jj,jk)510 & +(sinksil(ji,jj,jk)-sinksil(ji,jj,jk+1))511 & /fse3t(ji,jj,jk)512 C513 C Nullity test for Biogenic Silica514 C --------------------------------515 C516 xcond=(0.5+sign(0.5,zneg))517 sinksil(ji,jj,jk+1)=sinksil(ji,jj,jk+1)*xcond518 osil(ji,jj,jk)=osil(ji,jj,jk)*xcond519 C520 END DO521 END DO522 END DO523 C524 C Recompute the SMS related to zooplankton grazing525 C ------------------------------------------------526 C527 DO jk = 1,jpkm1528 DO jj = 1,jpj529 DO ji = 1,jpi530 grarem(ji,jj,jk)=(grazp(ji,jj,jk)+grazm(ji,jj,jk)531 & +grazsd(ji,jj,jk))*(1.-epsher-unass)532 533 grafer(ji,jj,jk)=(grazpf(ji,jj,jk)+grazsf(ji,jj,jk)534 & +grazmf(ji,jj,jk))*(1.-epsher-unass)535 & +(grazm(ji,jj,jk)*max((trn(ji,jj,jk,jpsfe)/536 & (trn(ji,jj,jk,jppoc)+rtrn)-ferat3),0.)537 & +grazp(ji,jj,jk)*max((trn(ji,jj,jk,jpnfe)/538 & (trn(ji,jj,jk,jpphy)+rtrn)-ferat3),0.)539 & +grazsd(ji,jj,jk)*max((trn(ji,jj,jk,jpdfe)/540 & (trn(ji,jj,jk,jpdia)+rtrn)-ferat3),0.))*epsher541 542 grarem2(ji,jj,jk)=(grazd(ji,jj,jk)+grazz(ji,jj,jk)543 & +grazn(ji,jj,jk)+grazpoc(ji,jj,jk)+grazffe(ji,jj,jk))544 & *(1.-epsher2-unass2)545 546 grafer2(ji,jj,jk)=(grazf(ji,jj,jk)+graznf(ji,jj,jk)547 & +grazz(ji,jj,jk)*ferat3+grazpof(ji,jj,jk)548 & +grazfff(ji,jj,jk))*(1.-epsher2-unass2)549 & +epsher2*(grazd(ji,jj,jk)*max(550 & (trn(ji,jj,jk,jpdfe)/(trn(ji,jj,jk,jpdia)+rtrn)551 & -ferat3),0.)+grazn(ji,jj,jk)*max(552 & (trn(ji,jj,jk,jpnfe)/(trn(ji,jj,jk,jpphy)+rtrn)553 & -ferat3),0.)+grazpoc(ji,jj,jk)*max(554 & (trn(ji,jj,jk,jpsfe)/(trn(ji,jj,jk,jppoc)+rtrn)555 & -ferat3),0.)+grazffe(ji,jj,jk)*max(556 & (trn(ji,jj,jk,jpbfe)/(trn(ji,jj,jk,jpgoc)+rtrn)557 & -ferat3),0.))558 559 grapoc2(ji,jj,jk)=(grazd(ji,jj,jk)+grazz(ji,jj,jk)560 & +grazn(ji,jj,jk)+grazpoc(ji,jj,jk)+grazffe(ji,jj,jk))*unass2561 562 grapoc(ji,jj,jk)=(grazp(ji,jj,jk)+grazm(ji,jj,jk)563 & +grazsd(ji,jj,jk))*unass564 END DO565 END DO566 END DO567 132 C 568 133 C Determination of tracers concentration as a function of … … 580 145 & -prorca(ji,jj,jk)-prorca2(ji,jj,jk) 581 146 & +olimi(ji,jj,jk)+grarem(ji,jj,jk)*sigma1+denitr(ji,jj,jk) 582 & +grarem2(ji,jj,jk)*sigma2 +po4dep(ji,jj,jk)*rfact2147 & +grarem2(ji,jj,jk)*sigma2 583 148 C 584 149 C Evolution of NO3 and NH4 … … 587 152 trn(ji,jj,jk,jpno3) = trn(ji,jj,jk,jpno3) 588 153 & -pronew(ji,jj,jk)-pronew2(ji,jj,jk)+onitr(ji,jj,jk) 589 & -denitr(ji,jj,jk)*rdenit+po4dep(ji,jj,jk)*rfact2 590 & +nitdep(ji,jj,jk)*rfact2 154 & -denitr(ji,jj,jk)*rdenit 591 155 592 156 trn(ji,jj,jk,jpnh4) = trn(ji,jj,jk,jpnh4) … … 675 239 C 676 240 trn(ji,jj,jk,jppoc) = trn(ji,jj,jk,jppoc) 677 & -grazpoc(ji,jj,jk)+grapoc(ji,jj,jk)+tortp2(ji,jj,jk) 678 & -grazm(ji,jj,jk)+respp(ji,jj,jk)+tortz(ji,jj,jk) 679 & +tortp(ji,jj,jk)+respz(ji,jj,jk)-orem(ji,jj,jk) 680 & +orem2(ji,jj,jk)-xagg(ji,jj,jk)+xaggdoc(ji,jj,jk) 681 & +(sinking(ji,jj,jk)-sinking(ji,jj,jk+1)) 682 & /fse3t(ji,jj,jk) 241 & -grazpoc(ji,jj,jk)+grapoc(ji,jj,jk)-grazm(ji,jj,jk) 242 & +respz(ji,jj,jk)-xagg(ji,jj,jk)+xaggdoc(ji,jj,jk) 243 & +(1.-0.5*zfracal(ji,jj,jk))*(tortp(ji,jj,jk) 244 & +respp(ji,jj,jk))+0.5*tortp2(ji,jj,jk) 245 & +orem2(ji,jj,jk)+tortz(ji,jj,jk)-orem(ji,jj,jk) 683 246 C 684 247 C Evolution of rapid Detritus … … 686 249 C 687 250 trn(ji,jj,jk,jpgoc) = trn(ji,jj,jk,jpgoc) 688 & 689 & 690 & -grazffe(ji,jj,jk)+xaggdoc2(ji,jj,jk)691 & +(sinking2(ji,jj,jk)-sinking2(ji,jj,jk+1))692 & /fse3t(ji,jj,jk) 251 & +grapoc2(ji,jj,jk)+respp2(ji,jj,jk)+xagg(ji,jj,jk) 252 & +tortz2(ji,jj,jk)+respz2(ji,jj,jk)-orem2(ji,jj,jk) 253 & +0.5*zfracal(ji,jj,jk)*(respp(ji,jj,jk)+tortp(ji,jj,jk)) 254 & +0.5*tortp2(ji,jj,jk)+xaggdoc2(ji,jj,jk)-grazffe(ji,jj,jk) 255 C 693 256 END DO 694 257 END DO … … 702 265 C --------------- 703 266 C 704 xcond=(0.5+sign(0.5,(trn(ji,jj,jk,jpoxy)-oxymin)))705 267 trn(ji,jj,jk,jpoxy) = trn(ji,jj,jk,jpoxy) 706 268 & +o2ut*(proreg(ji,jj,jk)+proreg2(ji,jj,jk)-olimi(ji,jj,jk) 707 & - xcond*(grarem(ji,jj,jk)*sigma1+grarem2(ji,jj,jk)*sigma2))269 & -grarem(ji,jj,jk)*sigma1-grarem2(ji,jj,jk)*sigma2) 708 270 & +(o2ut+o2nit)*( pronew(ji,jj,jk)+pronew2(ji,jj,jk)) 709 271 & -o2nit*onitr(ji,jj,jk) … … 712 274 END DO 713 275 END DO 276 714 277 715 278 DO jk = 1,jpkm1 … … 724 287 & +(excret2-1.)*prorca4(ji,jj,jk)-xbactfer(ji,jj,jk) 725 288 & +grafer(ji,jj,jk)+grafer2(ji,jj,jk) 726 & +ofer(ji,jj,jk)-xscave(ji,jj,jk) +irondep(ji,jj,jk)727 & +(ironsed(ji,jj,jk)+po4dep(ji,jj,jk)*9E-5)*rfact2 289 & +ofer(ji,jj,jk)-xscave(ji,jj,jk) 290 C 728 291 END DO 729 292 END DO … … 736 299 C Evolution of small biogenic Iron 737 300 C -------------------------- 738 C739 zdenom=1./(trn(ji,jj,jk,jppoc)+trn(ji,jj,jk,jpgoc)+rtrn)740 301 C 741 302 trn(ji,jj,jk,jpsfe) = trn(ji,jj,jk,jpsfe) 742 303 & +unass*(grazpf(ji,jj,jk)+grazsf(ji,jj,jk)) 743 304 & -grazpof(ji,jj,jk)-(1.-unass)*grazmf(ji,jj,jk) 744 & +tortdf(ji,jj,jk)+respnf(ji,jj,jk)+tortnf(ji,jj,jk) 745 & +ferat3*(tortz(ji,jj,jk)+respz(ji,jj,jk))-ofer(ji,jj,jk) 305 & +(1.-0.5*zfracal(ji,jj,jk))*(tortnf(ji,jj,jk) 306 & +respnf(ji,jj,jk))+0.5*tortdf(ji,jj,jk)+ferat3* 307 & (tortz(ji,jj,jk)+respz(ji,jj,jk))-ofer(ji,jj,jk) 746 308 & +ofer2(ji,jj,jk)-xaggfe(ji,jj,jk) 747 309 & +xscave(ji,jj,jk)*zdenom1(ji,jj,jk) 748 & +(sinkfer(ji,jj,jk)-sinkfer(ji,jj,jk+1))749 & /fse3t(ji,jj,jk)750 310 C 751 311 C Evolution of big biogenic Iron … … 754 314 trn(ji,jj,jk,jpbfe) = trn(ji,jj,jk,jpbfe) 755 315 & +unass2*(graznf(ji,jj,jk)+grazf(ji,jj,jk)+grazfff(ji,jj,jk) 756 & +grazpof(ji,jj,jk)+ grazz(ji,jj,jk)*ferat3)+ferat3*316 & +grazpof(ji,jj,jk)+ferat3*grazz(ji,jj,jk))+ferat3* 757 317 & (tortz2(ji,jj,jk)+respz2(ji,jj,jk))-ofer2(ji,jj,jk) 758 & + respdf(ji,jj,jk)+xaggfe(ji,jj,jk)+xbactfer(ji,jj,jk)759 & -grazfff(ji,jj,jk)+xscave(ji,jj,jk)*zdenom2(ji,jj,jk)760 & + (sinkfer2(ji,jj,jk)-sinkfer2(ji,jj,jk+1))761 & /fse3t(ji,jj,jk)318 & +0.5*zfracal(ji,jj,jk)*(respnf(ji,jj,jk)+tortnf(ji,jj,jk)) 319 & +0.5*tortdf(ji,jj,jk)+respdf(ji,jj,jk)+xaggfe(ji,jj,jk) 320 & +xbactfer(ji,jj,jk)-grazfff(ji,jj,jk)+xscave(ji,jj,jk) 321 & *zdenom2(ji,jj,jk) 762 322 END DO 763 323 END DO … … 775 335 & -tortds(ji,jj,jk)-respds(ji,jj,jk)-grazs(ji,jj,jk) 776 336 C 777 silpro(ji,jj,jk)=778 & tortds(ji,jj,jk)+respds(ji,jj,jk)+grazs(ji,jj,jk)779 & +grazss(ji,jj,jk)780 C781 337 END DO 782 338 END DO … … 793 349 & +tortds(ji,jj,jk)+respds(ji,jj,jk)+grazs(ji,jj,jk) 794 350 & -osil(ji,jj,jk)+grazss(ji,jj,jk) 795 & +(sinksil(ji,jj,jk)-sinksil(ji,jj,jk+1))796 & /fse3t(ji,jj,jk)797 351 C 798 352 END DO … … 823 377 trn(ji,jj,jk,jpsil) = trn(ji,jj,jk,jpsil) 824 378 & -(1.-excret2)*prorca3(ji,jj,jk)+osil(ji,jj,jk) 825 & +sidep(ji,jj,jk)+cotdep(ji,jj,jk)*rfact2/6.826 379 C 827 380 END DO … … 842 395 prodca = pronew(ji,jj,jk)+pronew2(ji,jj,jk) 843 396 & -onitr(ji,jj,jk)+rdenit*denitr(ji,jj,jk) 844 & -po4dep(ji,jj,jk)*rfact2-nitdep(ji,jj,jk)*rfact2845 397 C 846 398 C potential production of calcite and biogenic silicate 847 399 C ------------------------------------------------------ 848 400 C 849 prcaca(ji,jj,jk)=caco3r*(0.5*(unass*grazp(ji,jj,jk)+ 401 prcaca(ji,jj,jk)= 402 & zfracal(ji,jj,jk)*(0.5*(unass*grazp(ji,jj,jk)+ 850 403 & unass2*grazn(ji,jj,jk))+tortp(ji,jj,jk)+respp(ji,jj,jk)) 851 & *xlimphy(ji,jj,jk)*xlimphy(ji,jj,jk)852 404 C 853 405 C Consumption of Total (12C)O2 … … 855 407 C 856 408 trn(ji,jj,jk,jpdic) = trn(ji,jj,jk,jpdic) 857 & -prodt-prcaca(ji,jj,jk) +po4dep(ji,jj,jk)*rfact2*2.633409 & -prodt-prcaca(ji,jj,jk) 858 410 C 859 411 C Consumption of alkalinity due to ca++ uptake and increase … … 864 416 trn(ji,jj,jk,jptal) = trn(ji,jj,jk,jptal) 865 417 & +rno3*prodca-2.*prcaca(ji,jj,jk) 866 & +cotdep(ji,jj,jk)*rfact2867 418 END DO 868 419 END DO … … 877 428 C 878 429 trn(ji,jj,jk,jpcal) = trn(ji,jj,jk,jpcal) 879 & +prcaca(ji,jj,jk)+(sinkcal(ji,jj,jk)- 880 & sinkcal(ji,jj,jk+1))/fse3t(ji,jj,jk) 430 & +prcaca(ji,jj,jk) 881 431 END DO 882 432 END DO 883 433 ENDDO 884 434 C 885 DO jn=1 , jptra 886 CALL lbc_lnk(trn(:,:,:,jn), 'T', 1. ) 887 END DO 888 889 # if defined key_trc_diaadd 890 DO jj=1,jpj 891 DO ji=1,jpi 892 trc2d(ji,jj,12) = irondep(ji,jj,1)*1e3*rfact2r 893 & *fse3t(ji,jj,1) 894 END DO 895 END DO 896 # endif 435 C 436 C Loop to test if tracers concentrations fall below 0. 437 C ---------------------------------------------------- 438 C 439 C 440 znegtr(:,:,:) = 1. 441 C 442 DO jn = 1,jptra 443 DO jk = 1,jpk 444 DO jj = 1,jpj 445 DO ji = 1,jpi 446 if (trn(ji,jj,jk,jn).lt.0.) then 447 znegtr(ji,jj,jk)=0. 448 endif 449 END DO 450 END DO 451 END DO 452 END DO 453 C 454 DO jn = 1,jptra 455 trn(:,:,:,jn) = trb(:,:,:,jn)+ 456 & znegtr(:,:,:)*(trn(:,:,:,jn)-trb(:,:,:,jn)) 457 END DO 897 458 C 898 459 # if defined key_trc_dia3d 899 460 trc3d(:,:,:,4)=etot(:,:,:) 900 trc3d(:,:,:,5)=prorca(:,:,:)* 1e3*rfact2r901 trc3d(:,:,:,6)=prorca2(:,:,:)* 1e3*rfact2r902 trc3d(:,:,:,7)=pronew(:,:,:)* 1e3*rfact2r903 trc3d(:,:,:,8)=pronew2(:,:,:)* 1e3*rfact2r904 trc3d(:,:,:,9)=prorca3(:,:,:)* 1e3*rfact2r905 trc3d(:,:,:,10)=prorca4(:,:,:)* 1e3*rfact2r906 trc3d(:,:,:,11)=prorca5(:,:,:)* 1e3*rfact2r461 trc3d(:,:,:,5)=prorca(:,:,:)*znegtr(:,:,:)*1e3*rfact2r 462 trc3d(:,:,:,6)=prorca2(:,:,:)*znegtr(:,:,:)*1e3*rfact2r 463 trc3d(:,:,:,7)=pronew(:,:,:)*znegtr(:,:,:)*1e3*rfact2r 464 trc3d(:,:,:,8)=pronew2(:,:,:)*znegtr(:,:,:)*1e3*rfact2r 465 trc3d(:,:,:,9)=prorca3(:,:,:)*znegtr(:,:,:)*1e3*rfact2r 466 trc3d(:,:,:,10)=prorca4(:,:,:)*znegtr(:,:,:)*1e3*rfact2r 467 trc3d(:,:,:,11)=prorca5(:,:,:)*znegtr(:,:,:)*1e3*rfact2r 907 468 # endif 908 469 C 909 470 #endif 910 C 911 471 C 912 472 RETURN 913 473 END -
trunk/NEMO/TOP_SRC/SMS/p4zche.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 p4zche … … 29 25 CC parameters and commons 30 26 CC ====================== 31 CDIR$ NOLIST27 CDIR$ nolist 32 28 USE oce_trc 33 29 USE trp_trc 34 30 USE sms 35 31 IMPLICIT NONE 32 #include "domzgr_substitute.h90" 36 33 CDIR$ list 37 34 CC---------------------------------------------------------------------- … … 40 37 C 41 38 INTEGER ji, jj, jk 42 REAL tkel, sal, rrr, qtt 43 REAL pres, tc, cl, cpexp 44 REAL akb, temzer, cek0, oxy 45 REAL zsqrt, ztr, zlogt 46 REAL zqtt, qtt2, sal15 47 REAL ckb, ck1, ck2, ckw, ak1, ak2, aksp0 48 CC---------------------------------------------------------------------- 49 CC statement functions 50 CC =================== 51 CDIR$ NOLIST 52 #include "domzgr_substitute.h90" 53 CDIR$ LIST 39 REAL tkel, sal, qtt, zbuf1, zbuf2 40 REAL pres, tc, cl, cpexp, cek0, oxy, cpexp2 41 REAL zsqrt, ztr, zlogt, cek1 42 REAL zqtt, qtt2, sal15, zis, zis2 43 REAL ckb, ck1, ck2, ckw, ak1, ak2, akb, aksp0, akw 54 44 C 55 45 C* 1. CHEMICAL CONSTANTS - SURFACE LAYER 56 46 C --------------------------------------- 57 temzer = 273.1658 C59 C vertical slab60 C =============61 47 C 62 48 DO jj = 1,jpj … … 66 52 C ------------------------------ 67 53 C 68 tkel = tn(ji,jj,1)+ temzer54 tkel = tn(ji,jj,1)+273.16 69 55 qtt = tkel*0.01 70 56 qtt2=qtt*qtt … … 72 58 zqtt=log(qtt) 73 59 C 74 C* 1.2 LN(K0) OF SOLUBILITY OF CO2 (EQ. 12, WEISS, 1974) 60 C* 1.2 LN(K0) OF SOLUBILITY OF CO2 (EQ. 12, WEISS, 1980) 61 C AND FOR THE ATMOSPHERE FOR NON IDEAL GAS 75 62 C ------------------------------------------------------- 76 63 C 77 64 cek0 = c00+c01/qtt+c02*zqtt+sal*(c03+c04*qtt+c05*qtt2) 65 cek1 = ca0+ca1/qtt+ca2*zqtt+ca3*qtt2+sal*(ca4 66 & +ca5*qtt+ca6*qtt2) 78 67 C 79 68 C* 1.3 LN(K0) OF SOLUBILITY OF O2 and N2 (EQ. 4, WEISS, 1970) … … 82 71 oxy = ox0+ox1/qtt+ox2*zqtt+sal*(ox3+ox4*qtt+ox5*qtt2) 83 72 C 84 C* 1.4 SET CHEMICAL CHEMICAL CONSTANTS 85 C -------------------------------------- 86 C 87 chemc(ji,jj,1) = exp(cek0)*1.E-6 88 C 89 C* 1.5 O2 SOLUBILITY IN SEAWATER (WEISS, 1970, CF. EQ. 4) 90 C --------------------------------------------------------- 91 C 92 chemc(ji,jj,3) = exp(oxy)*oxyco 73 C* 1.4 SET SOLUBILITIES OF O2 AND CO2 74 C ----------------------------------- 75 C 76 chemc(ji,jj,1) = exp(cek0)*1.E-6*rhop(ji,jj,1)/1000. 77 chemc(ji,jj,2) = exp(oxy)*oxyco 78 chemc(ji,jj,3) = exp(cek1)*1.E-6*rhop(ji,jj,1)/1000. 93 79 C 94 80 ENDDO … … 99 85 C 100 86 DO jk = 1,jpk 101 C 102 C* 2.1 APPROX. SEAWATER PRESSURE AT U-POINT DEPTH (BAR) 103 C ------------------------------------------------------ 104 C 105 DO jj=1,jpj 87 DO jj = 1,jpj 106 88 DO ji = 1,jpi 107 89 C 108 C* 2. 2 SET [H+] (FIRST GUESS)109 C ----------------- -----------90 C* 2.1 SET PRESSION 91 C ----------------- 110 92 C 111 93 pres = 1.025e-1*fsdept(ji,jj,jk) 112 hi(ji,jj,jk) = 1.E-7 113 C 114 C* 2.3 SET ABSOLUTE TEMPERATURE 94 C 95 C* 2.2 SET ABSOLUTE TEMPERATURE 115 96 C ------------------------------ 116 97 C 117 tkel = tn(ji,jj,jk)+ temzer98 tkel = tn(ji,jj,jk)+273.16 118 99 qtt = tkel*0.01 119 100 sal = sn(ji,jj,jk) + (1.-tmask(ji,jj,jk))*35. … … 122 103 zlogt = log(tkel) 123 104 ztr = 1./tkel 124 C 125 C* 2.4 CHLORINITY (WOOSTER ET AL., 1969) 105 zis = 19.924*sal/(1000.-1.005*sal) 106 zis2 = zis*zis 107 tc = tn(ji,jj,jk) + (1.-tmask(ji,jj,jk))*20. 108 C 109 C* 2.3 CHLORINITY (WOOSTER ET AL., 1969) 126 110 C --------------------------------------- 127 111 C 128 112 cl = sal*salchl 129 113 C 130 C* 2. 5 LN(K0) OF SOLUBILITY OF CO2 (EQ. 12, WEISS, 1974)114 C* 2.4 DISSOCIATION CONSTANT FOR CARBONATE AND BORATE 131 115 C ------------------------------------------------------- 132 116 C 133 cek0 = c00+c01/qtt+c02*log(qtt)+134 & sal*(c03+c04*qtt+c05*qtt*qtt)135 C136 C COEFFICIENT OCMIP137 C ------------------138 C139 117 ckb = (cb0+cb1*zsqrt+cb2*sal+cb3*sal15+cb4*sal*sal)*ztr 140 $ +(cb5+cb6*zsqrt+cb7*sal)+ 141 $ (cb8+cb9*zsqrt+cb10*sal)*zlogt+cb11*zsqrt*tkel 142 ck1 = c10*ztr+c11+c12*zlogt+(c13*ztr+c14)*zsqrt+ 143 $ c15*sal+c16*sal15+log(1.+c17*sal) 144 ck2 = c20*ztr+c21+c22*zlogt+(c23*ztr+c24)*zsqrt+c25*sal 145 $ +c26*sal15+log(1.+c27*sal) 146 C 147 C* 2.6 PKW (H2O) (DICKSON AND RILEY, 1979) 118 & +(cb5+cb6*zsqrt+cb7*sal)+ 119 & (cb8+cb9*zsqrt+cb10*sal)*zlogt+cb11*zsqrt*tkel 120 ck1 = c10*ztr+c11+c12*zlogt+c13*sal+c14*sal**2 121 ck2 = c20*ztr+c21+c22*sal+c23*sal**2 122 C 123 C* 2.5 PKW (H2O) (DICKSON AND RILEY, 1979) 148 124 C ----------------------------------------- 149 125 C 150 126 ckw = cw0*ztr+cw1+cw2*zlogt+(cw3*ztr+cw4+cw5*zlogt)* 151 $zsqrt+cw6*sal152 C 153 C* 2. 7K1, K2 OF CARBONIC ACID, KB OF BORIC ACID, KW (H2O) (LIT.?)127 & zsqrt+cw6*sal 128 C 129 C* 2.6 K1, K2 OF CARBONIC ACID, KB OF BORIC ACID, KW (H2O) (LIT.?) 154 130 C ----------------------------------------------------------------- 155 131 C 156 ak1 = exp(ck1)157 ak2 = exp(ck2)132 ak1 = 10**(ck1) 133 ak2 = 10**(ck2) 158 134 akb = exp(ckb) 159 akw 3(ji,jj,jk)= exp(ckw)160 C 161 C*2. 8APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE IN SEAWATER135 akw = exp(ckw) 136 C 137 C*2.7 APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE IN SEAWATER 162 138 C (S=27-43, T=2-25 DEG C) AT pres =0 (ATMOSPH. PRESSURE) 163 139 C (INGLE, 1800, EQ. 6) 164 140 C ------------------------------------------------------------- 165 141 C 166 aksp0 = 1.E-7*(akcc1+akcc2*sal**(1./3.)+akcc3*log (sal)142 aksp0 = 1.E-7*(akcc1+akcc2*sal**(1./3.)+akcc3*log10(sal) 167 143 & +akcc4*tkel*tkel) 168 144 C 169 C* 2. 9FORMULA FOR CPEXP AFTER EDMOND AND GIESKES (1970)145 C* 2.8 FORMULA FOR CPEXP AFTER EDMOND AND GIESKES (1970) 170 146 C (REFERENCE TO CULBERSON AND PYTKOQICZ (1968) AS MADE 171 147 C IN BROECKER ET AL. (1982) IS INCORRECT; HERE RGAS IS … … 181 157 C 182 158 cpexp = pres /(rgas*tkel) 183 C 184 C* 2.10 KB OF BORIC ACID, K1,K2 OF CARBONIC ACID PRESSURE 159 cpexp2 = pres * pres/(rgas*tkel) 160 C 161 C* 2.9 KB OF BORIC ACID, K1,K2 OF CARBONIC ACID PRESSURE 185 162 C CORRECTION AFTER CULBERSON AND PYTKOWICZ (1968) 186 163 C (CF. BROECKER ET AL., 1982) 187 164 C -------------------------------------------------------- 188 165 C 189 tc = tn(ji,jj,jk) + (1.-tmask(ji,jj,jk))*20. 190 akb3(ji,jj,jk) = akb*exp(cpexp*(devkb-devkbt*tc)) 191 ak13(ji,jj,jk) = ak1*exp(cpexp*(devk1-devk1t*tc)) 192 ak23(ji,jj,jk) = ak2*exp(cpexp*(devk2-devk2t*tc)) 193 C 194 C 2.11 APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE (OR ARAGONITE) 166 zbuf1 = -(devk1(3)+devk2(3)*tc+devk3(3)*tc*tc) 167 zbuf2 = 0.5*(devk4(3)+devk5(3)*tc) 168 akb3(ji,jj,jk) = akb*exp(zbuf1*cpexp+zbuf2*cpexp2) 169 170 zbuf1 = -(devk1(1)+devk2(1)*tc+devk3(1)*tc*tc) 171 zbuf2 = 0.5*(devk4(1)+devk5(1)*tc) 172 ak13(ji,jj,jk) = ak1*exp(zbuf1*cpexp+zbuf2*cpexp2) 173 174 zbuf1 = -(devk1(2)+devk2(2)*tc+devk3(2)*tc*tc) 175 zbuf2 = 0.5*(devk4(2)+devk5(2)*tc) 176 ak23(ji,jj,jk) = ak2*exp(zbuf1*cpexp+zbuf2*cpexp2) 177 178 zbuf1 = -(devk1(4)+devk2(4)*tc+devk3(4)*tc*tc) 179 zbuf2 = 0.5*(devk4(4)+devk5(4)*tc) 180 akw3(ji,jj,jk) = akw*exp(zbuf1*cpexp+zbuf2*cpexp2) 181 C 182 C 2.10 APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE (OR ARAGONITE) 195 183 C AS FUNCTION OF PRESSURE FOLLWING EDMOND AND GIESKES (1970) 196 184 C (P. 1285) AND BERNER (1976) … … 199 187 aksp(ji,jj,jk) = aksp0*exp(cpexp*(devks-devkst*tc)) 200 188 C 201 C* 2.12 DENSITY OF SEAWATER AND TOTAL BORATE CONCENTR. [MOLES/L] 202 C --------------------------------------------------------------- 203 C 204 rrr = rhop(ji,jj,jk)/1000. 205 borat(ji,jj,jk) = bor1*rrr*cl*bor2 206 C 207 C 2.13 Iron and SIO3 saturation concentration from ... 189 C* 2.11 TOTAL BORATE CONCENTR. [MOLES/L] 190 C -------------------------------------- 191 C 192 borat(ji,jj,jk) = bor1*cl*bor2 193 C 194 C 2.12 Iron and SIO3 saturation concentration from ... 208 195 C ---------------------------------------------------- 209 196 C 210 197 sio3eq(ji,jj,jk)=exp(log(10.)*(6.44-968./tkel))*1E-6 211 fekeq(ji,jj,jk)=10**(1 6.27-1565.7/(273.15+tn(ji,jj,jk)))198 fekeq(ji,jj,jk)=10**(17.27-1565.7/(273.15+tc)) 212 199 C 213 200 ENDDO 214 201 ENDDO 215 202 END DO 216 C 203 C 217 204 #endif 218 205 C -
trunk/NEMO/TOP_SRC/SMS/p4zdiat.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 p4zdiat … … 46 42 CC ================== 47 43 INTEGER ji, jj, jk 48 REAL compadi 49 REAL wchl2n(jpi,jpj,jpk) 50 51 44 REAL zfact,zstep,compadi 45 C 46 C Time step duration for biology 47 C ------------------------------ 48 C 49 zstep=rfact2/rjjss 50 C 52 51 C Aggregation term for diatoms is increased in case of nutrient 53 52 C stress as observed in reality. The stressed cells become more … … 58 57 DO jj = 1,jpj 59 58 DO ji = 1,jpi 60 wchl2n(ji,jj,jk)=wchl+0.02*(1.-min(trn(ji,jj,jk,jppo4)/conc1,61 & trn(ji,jj,jk,jpfer)/conc3,trn(ji,jj,jk,jpsil)62 & /(xksi(ji,jj)+rtrn),trn(ji,jj,jk,jpno3)/conc1,1.))63 END DO64 END DO65 END DO66 67 DO jk = 1,jpkm168 DO jj = 1,jpj69 DO ji = 1,jpi70 59 C 71 60 compadi = max((trn(ji,jj,jk,jpdia)-1E-8),0.) 61 zfact=1./(trn(ji,jj,jk,jpdia)+rtrn) 72 62 C 73 63 C Aggregation term for diatoms is increased in case of nutrient … … 76 66 C ------------------------------------------------------------ 77 67 C 78 respp2(ji,jj,jk) = rfact2*1E6/rjjss*wchl2n(ji,jj,jk) 79 & *zdiss(ji,jj,jk)*compadi*trn(ji,jj,jk,jpdia)*tmask(ji,jj,jk) 68 respp2(ji,jj,jk) = 1E6*zstep 69 & *(wchl+wchld*(1.-xlimdia(ji,jj,jk))) 70 & *zdiss(ji,jj,jk)*compadi*trn(ji,jj,jk,jpdia) 80 71 # if defined key_off_degrad 81 72 & *facvol(ji,jj,jk) 82 73 # endif 83 74 84 75 respds(ji,jj,jk) = respp2(ji,jj,jk) 85 & *trn(ji,jj,jk,jpbsi) /(trn(ji,jj,jk,jpdia)+rtrn)76 & *trn(ji,jj,jk,jpbsi)*zfact 86 77 87 78 respdf(ji,jj,jk) = respp2(ji,jj,jk) 88 & *trn(ji,jj,jk,jpdfe) /(trn(ji,jj,jk,jpdia)+rtrn)89 79 & *trn(ji,jj,jk,jpdfe)*zfact 80 90 81 respdch(ji,jj,jk)=respp2(ji,jj,jk) 91 & *trn(ji,jj,jk,jpdch) /(trn(ji,jj,jk,jpdia)+rtrn)82 & *trn(ji,jj,jk,jpdch)*zfact 92 83 C 93 84 C Phytoplankton mortality. 94 85 C ------------------------ 95 86 C 96 tortp2(ji,jj,jk) = mprat2* rfact2/rjjss*trn(ji,jj,jk,jpdia)97 & /(xkmort+trn(ji,jj,jk,jpdia))*compadi *tmask(ji,jj,jk)87 tortp2(ji,jj,jk) = mprat2*zstep*trn(ji,jj,jk,jpdia) 88 & /(xkmort+trn(ji,jj,jk,jpdia))*compadi 98 89 # if defined key_off_degrad 99 90 & *facvol(ji,jj,jk) … … 101 92 102 93 tortds(ji,jj,jk) = tortp2(ji,jj,jk) 103 & *trn(ji,jj,jk,jpbsi) /(trn(ji,jj,jk,jpdia)+rtrn)94 & *trn(ji,jj,jk,jpbsi)*zfact 104 95 105 96 tortdf(ji,jj,jk)=tortp2(ji,jj,jk) 106 & *trn(ji,jj,jk,jpdfe) /(trn(ji,jj,jk,jpdia)+rtrn)97 & *trn(ji,jj,jk,jpdfe)*zfact 107 98 108 99 tortdch(ji,jj,jk)=tortp2(ji,jj,jk) 109 & *trn(ji,jj,jk,jpdch) /(trn(ji,jj,jk,jpdia)+rtrn)100 & *trn(ji,jj,jk,jpdch)*zfact 110 101 C 111 102 END DO -
trunk/NEMO/TOP_SRC/SMS/p4zflx.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 p4zflx … … 34 30 USE sms 35 31 IMPLICIT NONE 32 #include "domzgr_substitute.h90" 36 33 CDIR$ LIST 37 34 CC---------------------------------------------------------------------- … … 39 36 CC ================== 40 37 C 41 INTEGER ji, jj, krorr 42 REAL zexp1, zexp2 43 REAL a1, a2, a3, b2, b3, ttc, ws, alpco2 44 REAL fld, flu, oxy16, flu16 45 REAL zph,ah2,zbot,zdic,zalk,schmitt, zrhocd 46 REAL zwind(jpi,jpj) 47 48 CC 49 CC---------------------------------------------------------------------- 50 CC statement functions 51 CC =================== 52 CDIR$ NOLIST 53 #include "domzgr_substitute.h90" 54 CDIR$ LIST 38 INTEGER nspyr, ji, jj, krorr 39 REAL zpdtan 40 REAL kgco2(jpi,jpj),kgo2(jpi,jpj) 41 REAL ttc, ws 42 REAL fld, flu, oxy16, flu16, zfact 43 REAL zph,ah2,zbot,zdic,zalk,schmitto2, zalka 44 REAL schmittco2 55 45 C 56 46 C … … 59 49 c ----------------------------------------------------- 60 50 C 61 62 zexp1 = -2./3. 63 zexp2 = -1./2. 64 a1 = 0.17 65 a2 = 2.85 66 a3 = 5.90 67 b2 = 9.65 68 b3 = 49.3 69 70 zrhocd = 1.3*1.3e-3 71 DO jj = 1, jpj 72 DO ji = 1 , jpi 73 IF (igaswind .EQ. 0 ) then 74 zwind(ji,jj) = sqrt(taux(ji,jj)**2+tauy(ji,jj)**2) 75 $ /zrhocd 76 ELSE 77 zwind(ji,jj) = vatm(ji,jj) 78 ENDIF 79 END DO 80 END DO 51 zpdtan = raass / rdt 52 nspyr = nint(zpdtan) 81 53 C 82 54 C* 1.1 SURFACE CHEMISTRY (PCO2 AND [H+] IN … … 93 65 C -------------------------------------------- 94 66 C 95 zbot = borat(ji,jj,1) 96 zdic = trn(ji,jj,1,jpdic) 97 zph = max(hi(ji,jj,1),1.E-10) 67 zbot = borat(ji,jj,1) 68 zfact = rhop(ji,jj,1)/1000.+rtrn 69 zdic = trn(ji,jj,1,jpdic)/zfact 70 zph = max(hi(ji,jj,1),1.E-10)/zfact 71 zalka = trn(ji,jj,1,jptal)/zfact 98 72 C 99 73 C* 1.3 CALCULATE [ALK]([CO3--], [HCO3-]) 100 74 C ------------------------------------ 101 75 C 102 zalk=trn(ji,jj,1,jptal)-103 & 76 zalk=zalka- 77 & (akw3(ji,jj,1)/zph-zph+zbot/(1.+zph/akb3(ji,jj,1))) 104 78 C 105 79 C* 1.4 CALCULATE [H+] AND [H2CO3] 106 80 C ----------------------------------------- 107 81 C 108 109 & 110 111 h2co3(ji,jj) = (2*zdic-zalk)/(2.+ak13(ji,jj,1)/ah2)112 hi(ji,jj,1) = ah282 ah2=sqrt((zdic-zalk)**2+4*(zalk*ak23(ji,jj,1) 83 & /ak13(ji,jj,1))*(2*zdic-zalk)) 84 ah2=0.5*ak13(ji,jj,1)/zalk*((zdic-zalk)+ah2) 85 h2co3(ji,jj) = (2*zdic-zalk)/(2.+ak13(ji,jj,1)/ah2)*zfact 86 hi(ji,jj,1) = ah2*zfact 113 87 END DO 114 88 END DO … … 124 98 DO jj = 1,jpj 125 99 DO ji = 1,jpi 126 127 ws = zwind(ji,jj) 100 C 128 101 ttc = min(35.,tn(ji,jj,1)) 129 schmitt= 2073.1-125.62*ttc+3.6276*ttc**2-0.043126*ttc**3 102 schmittco2=2073.1-125.62*ttc+3.6276*ttc**2 103 & -0.043126*ttc**3 104 ws=vatm(ji,jj) 130 105 C 131 106 C 2.2 COMPUTE GAS EXCHANGE FOR CO2 132 107 C -------------------------------- 133 108 C 134 kg wanin(ji,jj) = (0.3*ws*ws + 2.5*(0.5246+ttc*(0.016256+135 & ttc*0.00049946)))*sqrt(660./schmitt)109 kgco2(ji,jj) = (0.3*ws*ws + 2.5*(0.5246+ttc*(0.016256+ 110 & ttc*0.00049946)))*sqrt(660./schmittco2) 136 111 C 137 C 2.3 CONVERT TO M/S138 C ------------------ 112 C 2.3 CONVERT TO m/s, and apply sea-ice cover 113 C ----------------------------------------------------- 139 114 C 140 kgwanin(ji,jj) = kgwanin(ji,jj)/100./3600. 115 kgco2(ji,jj) = kgco2(ji,jj)/(100.*3600.) 116 & *(1-freeze(ji,jj))*tmask(ji,jj,1) 141 117 C 142 C 2.4 convert to mol/m2/s/uatm, alpco2(chemc(ji,jj,1)) is in143 C mol/L/uatm and apply ice cover144 C -----------------------------------------------------------145 C146 kgwanin(ji,jj) = kgwanin(ji,jj)*chemc(ji,jj,1)*1.e3*147 & (1-freeze(ji,jj))148 118 END DO 149 119 END DO 150 120 C 151 C 2.5 COMPUTE GAS EXCHANGE COEFFICIENT FO O2 FROM LISS AND152 C MERLIVATEQUATIONS153 C ----------------------------------------------- ----------121 C 2.5 COMPUTE GAS EXCHANGE COEFFICIENT FO O2 FROM 122 C Waninkhof EQUATIONS 123 C ----------------------------------------------- 154 124 C 155 125 DO jj = 1,jpj 156 126 DO ji = 1,jpi 157 127 C 158 ws = zwind(ji,jj) 128 ws = vatm(ji,jj) 129 schmitto2 = 1953.4-128.0*ttc+3.9918*ttc**2 130 & -0.050091*ttc**3 159 131 160 ttc = min(35.,tn(ji,jj,1)) 161 schmitt = 1953.4-128.0*ttc+3.9918*ttc**2 162 & -0.050091*ttc**3 132 kgo2(ji,jj) = (0.3*ws*ws + 2.5*(0.5246+ttc*(0.016256+ 133 & ttc*0.00049946)))*sqrt(660./schmitto2) 163 134 C 164 IF (ws.LE.3.6) THEN 165 fugaci(ji,jj) = (a1*ws)*(schmitt/660.)**zexp1 166 ENDIF 167 IF ((ws.GT.3.6).AND.(ws.LE.13.)) THEN 168 fugaci(ji,jj) = (a2*ws-b2)*(schmitt/660.)**zexp2 169 ENDIF 170 IF (ws.GT.13.) THEN 171 fugaci(ji,jj) = (a3*ws-b3)*(schmitt/660.)**zexp2 172 ENDIF 173 C 174 C CONVERT TO CM AND APPLY SEA ICE COVER 135 C CONVERT TO m/s AND APPLY SEA ICE COVER 175 136 C ------------------------------------- 176 137 C 177 fugaci(ji,jj) = fugaci(ji,jj)/100./3600.*178 $ 138 kgo2(ji,jj) = kgo2(ji,jj)/(100.*3600.) 139 $ *(1-freeze(ji,jj))*tmask(ji,jj,1) 179 140 C 180 # if defined key_off_degrad181 fugaci(ji,jj) = exp(-rfact*fugaci(ji,jj)182 $ *facvol(ji,jj,1)/fse3t(ji,jj,1))183 # else184 fugaci(ji,jj) = exp(-rfact*fugaci(ji,jj)185 $ /fse3t(ji,jj,1))186 # endif187 188 141 ENDDO 189 142 ENDDO 190 143 C 191 192 144 DO jj = 1,jpj 193 145 DO ji = 1,jpi … … 196 148 C ------------------------------------ 197 149 C 198 alpco2 = chemc(ji,jj,1) 199 fld = atcco2*tmask(ji,jj,1)*kgwanin(ji,jj) 200 flu = h2co3(ji,jj)/alpco2 201 & *tmask(ji,jj,1)*kgwanin(ji,jj) 202 203 tra(ji,jj,1,jpdic)= tra(ji,jj,1,jpdic)+(fld-flu) 204 & /1000./fse3t(ji,jj,1) 150 fld = atcco2*tmask(ji,jj,1)*chemc(ji,jj,3)*kgco2(ji,jj) 151 flu = h2co3(ji,jj)*tmask(ji,jj,1)*kgco2(ji,jj) 152 tra(ji,jj,1,jpdic)= tra(ji,jj,1,jpdic)+(fld-flu) 153 & /fse3t(ji,jj,1) 205 154 C 206 155 C Compute O2 flux … … 208 157 C 209 158 oxy16 = trn(ji,jj,1,jpoxy) 210 flu16 = (-fugaci(ji,jj)+1)*fse3t(ji,jj,1) 211 & *(atcox*chemc(ji,jj,3)-oxy16)* 212 & tmask(ji,jj,1)/rfact 159 flu16 = (atcox*chemc(ji,jj,2)-oxy16)*kgo2(ji,jj) 213 160 tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy)+flu16 214 & /fse3t(ji,jj,1) 215 161 & /fse3t(ji,jj,1) 216 162 C 217 163 C Save diagnostics … … 219 165 C 220 166 # if defined key_trc_diaadd 221 trc2d(ji,jj,1) = (fld-flu) 167 trc2d(ji,jj,1) = (fld-flu)*1000. 222 168 trc2d(ji,jj,2) = flu16*1000. 223 trc2d(ji,jj,3) = kg wanin(ji,jj)224 trc2d(ji,jj,4) = (fld-flu)/(kgwanin(ji,jj)+1.E-15)169 trc2d(ji,jj,3) = kgco2(ji,jj) 170 trc2d(ji,jj,4) = atcco2-h2co3(ji,jj)/(chemc(ji,jj,1)+rtrn) 225 171 # endif 226 172 C -
trunk/NEMO/TOP_SRC/SMS/p4zint.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 p4zint(kt) … … 47 43 INTEGER nspyr,nvit1t,nvit2t 48 44 REAL zpdtan, zman, zpdtmo, zdemi 49 REAL zt 45 REAL zt, zdum 50 46 C 51 47 C … … 82 78 83 79 Tgfunc(:,:,:) = exp(0.063913*tn(:,:,:)) 80 Tgfunc2(:,:,:) = exp(0.07608*tn(:,:,:)) 84 81 C 85 82 C Computation of the silicon dependant half saturation … … 87 84 C --------------------------------------------------- 88 85 C 89 doji=1,jpi90 dojj=1,jpj91 xksimax(ji,jj)=92 & max(xksimax(ji,jj),(1.+7.*trn(ji,jj,1,jpsil)**293 & /(xksi2*xksi2+trn(ji,jj,1,jpsil)**2))*1E-6)94 end do95 end do86 DO ji=1,jpi 87 DO jj=1,jpj 88 zdum=trn(ji,jj,1,jpsil)**2 89 xksimax(ji,jj) = max(xksimax(ji,jj),(1.+7.*zdum 90 & /(xksi2*xksi2*25.+zdum))*1E-6) 91 END DO 92 END DO 96 93 C 97 if (mod(kt,nspyr).eq.0) then94 IF (nday_year.EQ.365) THEN 98 95 xksi=xksimax 99 96 xksimax=0. 100 endif97 ENDIF 101 98 C 102 99 #endif -
trunk/NEMO/TOP_SRC/SMS/p4zlys.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 p4zlys … … 43 39 INTEGER ji, jj, jk, jn 44 40 REAL zbot, zalk, zdic, zph, remco3, ah2 45 REAL delco3, excess, dispot 41 REAL delco3, excess, dispot, zfact, zalka 46 42 C 47 43 C … … 54 50 C ------------------------------------------- 55 51 C 56 57 58 52 DO jk = 1,jpkm1 53 DO jj=1,jpj 54 DO ji = 1, jpi 59 55 C 60 56 C* 1.3 SET DUMMY VARIABLE FOR TOTAL BORATE 61 57 C ----------------------------------------- 62 58 C 63 zbot = borat(ji,jj,jk) 59 zbot = borat(ji,jj,jk) 60 zfact=rhop(ji,jj,jk)/1000.+rtrn 64 61 C 65 62 C* 1.4 SET DUMMY VARIABLE FOR [H+] 66 63 C --------------------------------- 67 64 C 68 zph = hi(ji,jj,jk)*tmask(ji,jj,jk)69 & 65 zph = hi(ji,jj,jk)*tmask(ji,jj,jk)/zfact 66 & +(1.-tmask(ji,jj,jk))*1.e-9 70 67 C 71 68 C* 1.5 SET DUMMY VARIABLE FOR [SUM(CO2)]GIVEN 72 69 C ------------------------------------------- 73 70 C 74 zdic = trn(ji,jj,jk,jpdic) 71 zdic=trn(ji,jj,jk,jpdic)/zfact 72 zalka=trn(ji,jj,jk,jptal)/zfact 75 73 C 76 74 C* 1.6 CALCULATE [ALK]([CO3--], [HCO3-]) 77 75 C ------------------------------------ 78 76 C 79 zalk=trn(ji,jj,jk,jptal)- 80 & (akw3(ji,jj,jk)/zph-zph 81 & +zbot/(1.+zph/akb3(ji,jj,jk))) 77 zalk=zalka-(akw3(ji,jj,jk)/zph-zph 78 & +zbot/(1.+zph/akb3(ji,jj,jk))) 82 79 C 83 80 C* 2.10 CALCULATE [H+] and [CO3--] 84 81 C ----------------------------------------- 85 82 C 86 87 & 88 & 83 ah2=sqrt((zdic-zalk)*(zdic-zalk)+ 84 & 4.*(zalk*ak23(ji,jj,jk)/ak13(ji,jj,jk)) 85 & *(2*zdic-zalk)) 89 86 C 90 ah2=0.5*ak13(ji,jj,jk)/zalk*((zdic-zalk)+ah2) 91 co3(ji,jj,jk) = zalk/(2.+ah2/ak23(ji,jj,jk)) 87 ah2=0.5*ak13(ji,jj,jk)/zalk*((zdic-zalk)+ah2) 88 co3(ji,jj,jk) = zalk/(2.+ah2/ak23(ji,jj,jk))*zfact 89 90 hi(ji,jj,jk) = ah2*zfact 92 91 C 93 hi(ji,jj,jk) = ah2 92 ENDDO 93 ENDDO 94 END DO 94 95 C 95 ENDDO96 ENDDO97 END DO98 96 END DO 99 97 C … … 116 114 C ------------------------------------------ 117 115 C 118 excess = max(0., delco3)116 excess = max(0.,-delco3) 119 117 C 120 118 C* 2.3 AMOUNT CACO3 (12C) THAT RE-ENTERS SOLUTION … … 123 121 C -------------------------------------------------------------- 124 122 C 125 dispot = trn(ji,jj,jk,jpcal)* min(1.,126 & (1.-delco3/(dispo0+abs(delco3))))123 dispot = trn(ji,jj,jk,jpcal)* 124 & excess/(dispo0+excess) 127 125 # if defined key_off_degrad 128 & 126 & *facvol(ji,jj,jk) 129 127 # endif 130 128 C … … 135 133 remco3=dispot/rmoss 136 134 co3(ji,jj,jk) = co3(ji,jj,jk)+ 137 & 135 & remco3*rfact 138 136 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal)+ 139 & 137 & 2.*remco3 140 138 tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal)- 141 & 139 & remco3 142 140 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic)+ 143 & 141 & remco3 144 142 C 145 143 ENDDO … … 148 146 149 147 # if defined key_trc_dia3d 150 trc3d(:,:,:,1) = hi(:,:,:)148 trc3d(:,:,:,1) = rhop(:,:,:) 151 149 trc3d(:,:,:,2) = co3(:,:,:) 152 150 trc3d(:,:,:,3) = aksp(:,:,:)/calcon -
trunk/NEMO/TOP_SRC/SMS/p4zmeso.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 p4zmeso … … 51 47 INTEGER ji, jj, jk 52 48 REAL compadi,compaph,compapoc,compaz 53 REAL compam,zdenom,graze2 49 REAL zfact,zstep,compam,zdenom,graze2 50 C 51 C 52 C 53 C Time step duration for biology 54 C ------------------------------ 55 C 56 zstep=rfact2/rjjss 54 57 C 55 58 DO jk = 1,jpkm1 … … 58 61 C 59 62 compam=max((trn(ji,jj,jk,jpmes)-1.E-9),0.) 63 zfact=zstep*tgfunc(ji,jj,jk)*compam 64 # if defined key_off_degrad 65 & *facvol(ji,jj,jk) 66 # endif 60 67 C 61 68 C Respiration rates of both zooplankton 62 69 C ------------------------------------- 63 70 C 64 respz2(ji,jj,jk) = resrat2*rfact2/rjjss 71 respz2(ji,jj,jk) = resrat2*zfact 72 & *(1.+3.*nitrfac(ji,jj,jk)) 65 73 & *trn(ji,jj,jk,jpmes)/(xkmort+trn(ji,jj,jk,jpmes)) 66 & *compam*tmask(ji,jj,jk)67 # if defined key_off_degrad68 & *facvol(ji,jj,jk)69 # endif70 74 C 71 75 C Zooplankton mortality. A square function has been selected with … … 74 78 C --------------------------------------------------------------- 75 79 C 76 tortz2(ji,jj,jk) = mzrat2*1E6*rfact2/rjjss*tgfunc(ji,jj,jk) 77 & *trn(ji,jj,jk,jpmes)*compam*tmask(ji,jj,jk) 78 # if defined key_off_degrad 79 & *facvol(ji,jj,jk) 80 # endif 80 tortz2(ji,jj,jk) = mzrat2*1E6*zfact*trn(ji,jj,jk,jpmes) 81 81 C 82 82 END DO … … 89 89 C 90 90 compadi = max((trn(ji,jj,jk,jpdia)-1E-8),0.) 91 compaz = max((trn(ji,jj,jk,jpzoo)-1.E- 9),0.)92 compaph = max((trn(ji,jj,jk,jpphy)- 1E-8),0.)93 compapoc=max((trn(ji,jj,jk,jppoc)-1E- 9),0.)91 compaz = max((trn(ji,jj,jk,jpzoo)-1.E-8),0.) 92 compaph = max((trn(ji,jj,jk,jpphy)-2E-7),0.) 93 compapoc=max((trn(ji,jj,jk,jppoc)-1E-8),0.) 94 94 C 95 95 C Microzooplankton grazing 96 96 C ------------------------ 97 97 C 98 graze2 = grazrat2/rjjss*rfact2*tmask(ji,jj,jk)99 & *Tgfunc(ji,jj,jk)100 # if defined key_off_degrad101 & *facvol(ji,jj,jk)102 # endif103 104 98 zdenom=1./(xkgraz2+xprefc*trn(ji,jj,jk,jpdia) 105 99 & +xprefz*trn(ji,jj,jk,jpzoo) … … 107 101 & +xprefpoc*trn(ji,jj,jk,jppoc)) 108 102 109 graz d(ji,jj,jk) = graze2*xprefc*compadi*zdenom103 graze2 = grazrat2*zstep*Tgfunc2(ji,jj,jk)*zdenom 110 104 & *trn(ji,jj,jk,jpmes) 105 # if defined key_off_degrad 106 & *facvol(ji,jj,jk) 107 # endif 111 108 112 grazz(ji,jj,jk) = graze2*xprefz*compaz*zdenom 113 & *trn(ji,jj,jk,jpmes) 114 115 grazn(ji,jj,jk) = graze2*xprefp*compaph*zdenom 116 & *trn(ji,jj,jk,jpmes) 117 118 grazpoc(ji,jj,jk) = graze2*xprefpoc*compapoc*zdenom 119 & *trn(ji,jj,jk,jpmes) 109 grazd(ji,jj,jk) = graze2*xprefc*compadi 110 grazz(ji,jj,jk) = graze2*xprefz*compaz 111 grazn(ji,jj,jk) = graze2*xprefp*compaph 112 grazpoc(ji,jj,jk) = graze2*xprefpoc*compapoc 120 113 121 114 graznf(ji,jj,jk) = grazn(ji,jj,jk) … … 148 141 C ---------------------------------- 149 142 C 150 grazffe(ji,jj,jk) = 1.3E-2/5.6E-7*rfact2/rjjss151 & * wsbio4(ji,jj,jk)*trn(ji,jj,jk,jpgoc)*trn(ji,jj,jk,jpmes)143 grazffe(ji,jj,jk) = 5E3*zstep*wsbio4(ji,jj,jk) 144 & *tgfunc2(ji,jj,jk)*trn(ji,jj,jk,jpgoc)*trn(ji,jj,jk,jpmes) 152 145 # if defined key_off_degrad 153 146 & *facvol(ji,jj,jk) -
trunk/NEMO/TOP_SRC/SMS/p4zmicro.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 p4zmicro … … 47 43 INTEGER ji, jj, jk 48 44 REAL compadi,compadi2,compaz,compaph,compapoc 49 REAL graze,zdenom 50 REAL zinano,zidiat,zipoc 51 45 REAL graze,zdenom,zdenom2 46 REAL zfact,zstep,zinano,zidiat,zipoc 47 C 48 C Time step duration for biology 49 C ------------------------------ 50 C 51 zstep=rfact2/rjjss 52 52 C 53 53 … … 57 57 C 58 58 compaz = max((trn(ji,jj,jk,jpzoo)-1.E-9),0.) 59 zfact=zstep*tgfunc(ji,jj,jk)*compaz 60 # if defined key_off_degrad 61 & *facvol(ji,jj,jk) 62 # endif 59 63 C 60 64 C Respiration rates of both zooplankton 61 65 C ------------------------------------- 62 66 C 63 respz(ji,jj,jk) = resrat*rfact2/rjjss 67 respz(ji,jj,jk) = resrat*zfact 68 & *(1.+3.*nitrfac(ji,jj,jk)) 64 69 & *trn(ji,jj,jk,jpzoo)/(xkmort+trn(ji,jj,jk,jpzoo)) 65 & *compaz*tmask(ji,jj,jk)66 # if defined key_off_degrad67 & *facvol(ji,jj,jk)68 # endif69 70 C 70 71 C Zooplankton mortality. A square function has been selected with … … 73 74 C --------------------------------------------------------------- 74 75 C 75 tortz(ji,jj,jk) = mzrat*rfact2*1E6/rjjss*tgfunc(ji,jj,jk) 76 & *compaz*trn(ji,jj,jk,jpzoo)*tmask(ji,jj,jk) 77 # if defined key_off_degrad 78 & *facvol(ji,jj,jk) 79 # endif 76 tortz(ji,jj,jk) = mzrat*1E6*zfact*trn(ji,jj,jk,jpzoo) 77 C 80 78 END DO 81 79 END DO … … 87 85 C 88 86 compadi = max((trn(ji,jj,jk,jpdia)-1E-8),0.) 89 compadi2=min(compadi, 2.E-6)90 compaph = max((trn(ji,jj,jk,jpphy)- 1E-8),0.)91 compapoc=max((trn(ji,jj,jk,jppoc)-1E- 9),0.)87 compadi2=min(compadi,5.E-7) 88 compaph = max((trn(ji,jj,jk,jpphy)-2E-7),0.) 89 compapoc=max((trn(ji,jj,jk,jppoc)-1E-8),0.) 92 90 C 93 91 C Microzooplankton grazing 94 92 C ------------------------ 95 93 C 96 graze = grazrat*rfact2/rjjss*tmask(ji,jj,jk) 97 & *tgfunc(ji,jj,jk) 94 zdenom2 = 1./(zprefp*compaph 95 & +zprefc*compapoc+zprefd*compadi2+rtrn) 96 97 graze = grazrat*zstep*tgfunc(ji,jj,jk) 98 & *trn(ji,jj,jk,jpzoo) 98 99 # if defined key_off_degrad 99 100 & *facvol(ji,jj,jk) 100 101 # endif 101 zdenom = 1./(xkgraz+zprefp*compaph102 & +zprefc*trn(ji,jj,jk,jppoc)+zprefd*compadi2)103 102 104 zinano=zprefp*trn(ji,jj,jk,jpphy)/ 105 & (zprefp*trn(ji,jj,jk,jpphy) 106 & +zprefc*trn(ji,jj,jk,jppoc) 107 & +zprefd*trn(ji,jj,jk,jpdia)+rtrn) 103 zinano=zprefp*compaph*zdenom2 104 zipoc=zprefc*compapoc*zdenom2 105 zidiat=zprefd*compadi2*zdenom2 108 106 109 zipoc=zprefc*trn(ji,jj,jk,jppoc)/ 110 & (zprefp*trn(ji,jj,jk,jpphy) 111 & +zprefc*trn(ji,jj,jk,jppoc) 112 & +zprefd*trn(ji,jj,jk,jpdia)+rtrn) 113 114 zidiat=zprefd*trn(ji,jj,jk,jpdia)/ 115 & (zprefp*trn(ji,jj,jk,jpphy) 116 & +zprefc*trn(ji,jj,jk,jppoc) 117 & +zprefd*trn(ji,jj,jk,jpdia)+rtrn) 107 zdenom = 1./(xkgraz+zinano*compaph 108 & +zipoc*compapoc+zidiat*compadi2) 118 109 119 110 grazp(ji,jj,jk) = graze*zinano*compaph*zdenom 120 & *trn(ji,jj,jk,jpzoo) 111 grazm(ji,jj,jk) = graze*zipoc*compapoc*zdenom 112 grazsd(ji,jj,jk) = graze*zidiat*compadi2*zdenom 121 113 122 114 grazpf(ji,jj,jk) = grazp(ji,jj,jk)* … … 126 118 & trn(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn) 127 119 128 grazm(ji,jj,jk) = graze*zipoc*compapoc129 & *zdenom*trn(ji,jj,jk,jpzoo)130 131 120 grazmf(ji,jj,jk) = grazm(ji,jj,jk) 132 121 & *trn(ji,jj,jk,jpsfe)/(trn(ji,jj,jk,jppoc)+rtrn) 133 134 grazsd(ji,jj,jk) = graze*zidiat*compadi2*zdenom135 & *trn(ji,jj,jk,jpzoo)136 122 137 123 grazsf(ji,jj,jk) = grazsd(ji,jj,jk) -
trunk/NEMO/TOP_SRC/SMS/p4znano.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 p4znano … … 46 42 CC ================== 47 43 INTEGER ji, jj, jk 48 REAL compaph 44 REAL zfact,zstep,compaph 45 C 46 C Time step duration for biology 47 C ------------------------------ 48 C 49 zstep=rfact2/rjjss 49 50 C 50 51 DO jk = 1,jpkm1 … … 53 54 C 54 55 compaph = max((trn(ji,jj,jk,jpphy)-1E-8),0.) 56 zfact=1./(trn(ji,jj,jk,jpphy)+rtrn) 55 57 C 56 58 C Squared mortality of Phyto similar to a sedimentation term during … … 58 60 C ----------------------------------------------------------------- 59 61 C 60 respp(ji,jj,jk) = wchl*1e6* rfact2/rjjss*zdiss(ji,jj,jk)61 & *compaph*trn(ji,jj,jk,jpphy) *tmask(ji,jj,jk)62 respp(ji,jj,jk) = wchl*1e6*zstep*zdiss(ji,jj,jk) 63 & *compaph*trn(ji,jj,jk,jpphy) 62 64 # if defined key_off_degrad 63 65 & *facvol(ji,jj,jk) 64 66 # endif 65 67 66 68 respnf(ji,jj,jk) = respp(ji,jj,jk) 67 & *trn(ji,jj,jk,jpnfe) /(trn(ji,jj,jk,jpphy)+rtrn)68 69 & *trn(ji,jj,jk,jpnfe)*zfact 70 69 71 respnch(ji,jj,jk) = respp(ji,jj,jk) 70 & *trn(ji,jj,jk,jpnch) /(trn(ji,jj,jk,jpphy)+rtrn)71 72 & *trn(ji,jj,jk,jpnch)*zfact 73 C 72 74 C Phytoplankton mortality. This mortality loss is slightly 73 75 C increased when nutrients are limiting phytoplankton growth … … 75 77 C ---------------------------------------------------------- 76 78 C 77 tortp(ji,jj,jk) = mprat* rfact2/rjjss*trn(ji,jj,jk,jpphy)78 $ /(xkmort+trn(ji,jj,jk,jpphy))*compaph *tmask(ji,jj,jk)79 tortp(ji,jj,jk) = mprat*zstep*trn(ji,jj,jk,jpphy) 80 $ /(xkmort+trn(ji,jj,jk,jpphy))*compaph 79 81 # if defined key_off_degrad 80 82 & *facvol(ji,jj,jk) 81 83 # endif 82 84 83 85 tortnf(ji,jj,jk)=tortp(ji,jj,jk) 84 & *trn(ji,jj,jk,jpnfe) /(trn(ji,jj,jk,jpphy)+rtrn)85 86 & *trn(ji,jj,jk,jpnfe)*zfact 87 86 88 tortnch(ji,jj,jk)=tortp(ji,jj,jk) 87 & *trn(ji,jj,jk,jpnch) /(trn(ji,jj,jk,jpphy)+rtrn)89 & *trn(ji,jj,jk,jpnch)*zfact 88 90 C 89 91 END DO -
trunk/NEMO/TOP_SRC/SMS/p4zopt.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 p4zopt … … 8 4 CCC--------------------------------------------------------------------- 9 5 CCC 10 CCC ROUTINE p4zopt11 CCC 6 CCC ROUTINE p4zopt : PISCES MODEL 7 CCC ***************************** 12 8 CCC 13 9 CCC PURPOSE : … … 16 12 CCC depending on the depth and the chlorophyll concentration 17 13 CCC 18 CC METHOD :19 CC -------20 CC21 CC22 14 CC INPUT : 23 15 CC ----- … … 31 23 CC ------ 32 24 CC 33 CC WORKSPACE :34 CC ---------35 CC36 CC EXTERNAL :37 CC --------38 CC39 25 CC MODIFICATIONS: 40 26 CC -------------- 41 CC original : O. Aumont (200 2)27 CC original : O. Aumont (2004) 42 28 CC---------------------------------------------------------------------- 43 29 CC parameters and commons 44 30 CC ====================== 31 CDIR$ NOLIST 45 32 USE oce_trc 46 33 USE trp_trc 47 34 USE sms 35 IMPLICIT NONE 48 36 #include "domzgr_substitute.h90" 37 CDIR$ LIST 49 38 CC---------------------------------------------------------------------- 50 39 CC local declarations 51 40 CC ================== 52 41 INTEGER ji, jj, jk, mrgb 53 REAL xchl,ekg,ekr,ekb,xlim1,xlim2,xlim3,xlim4 42 REAL xchl,ekg(jpi,jpj,jpk),ekr(jpi,jpj,jpk) 43 REAL ekb(jpi,jpj,jpk) 54 44 REAL parlux,e1(jpi,jpj,jpk),e2(jpi,jpj,jpk),e3(jpi,jpj,jpk) 55 45 REAL zdepmoy(jpi,jpj) 56 REAL e3lum(jpi,jpj,jpk),e4lum(jpi,jpj,jpk) 57 REAL e5lum(jpi,jpj,jpk),etmp(jpi,jpj) 58 REAL e6lum(jpi,jpj,jpk) 59 46 REAL etmp(jpi,jpj) 47 REAL zrlight,zblight,zglight 48 C 60 49 C Initialisation of variables used to compute PAR 61 50 C ----------------------------------------------- … … 64 53 e2 = 0. 65 54 e3 = 0. 66 e3lum = 0.67 e4lum = 0.68 e5lum = 0.69 e6lum = 0.70 55 etot = 0. 71 etot3 = 0.72 56 parlux = 0.43/3. 57 58 DO jk=1,jpkm1 59 DO jj=1,jpj 60 DO ji=1,jpi 73 61 C 74 DO jj = 1,jpj 75 DO ji = 1,jpi 62 C Separation in three light bands: red, green, blue 63 C ------------------------------------------------- 76 64 C 77 C Computation of a variable par fraction78 C79 e1(ji,jj,1)=parlux*qsr(ji,jj)80 e2(ji,jj,1)=parlux*qsr(ji,jj)81 e3(ji,jj,1)=parlux*qsr(ji,jj)82 e3lum(ji,jj,1)=parlux*qsr(ji,jj)83 e4lum(ji,jj,1)=parlux*qsr(ji,jj)84 e5lum(ji,jj,1)=parlux*qsr(ji,jj)85 e6lum(ji,jj,1)=1.-3.*parlux*qsr(ji,jj)86 C87 END DO88 END DO89 90 C91 C Tuning of the iron concentration to a minimum92 C level that is set to the detection limit93 C -------------------------------------94 C95 trn(:,:,:,jpfer)=max(trn(:,:,:,jpfer),1.E-11)96 C97 DO jk = 1,jpkm198 DO jj = 1,jpj99 DO ji = 1,jpi100 C101 C Separation in two light bands: red and green102 C --------------------------------------------103 C104 65 xchl=(trn(ji,jj,jk,jpnch)+trn(ji,jj,jk,jpdch)+rtrn)*1.E6 105 xchl=max(0.0 1,xchl)66 xchl=max(0.03,xchl) 106 67 xchl=min(10.,xchl) 107 68 108 69 mrgb = int(41+20.*log10(xchl)+rtrn) 109 110 ekb=xkrgb(1,mrgb) 111 ekg=xkrgb(2,mrgb) 112 ekr=xkrgb(3,mrgb) 113 114 e1(ji,jj,jk+1) = e1(ji,jj,jk)*exp(-ekb*fse3t(ji,jj,jk)/2.) 115 e2(ji,jj,jk+1) = e2(ji,jj,jk)*exp(-ekg*fse3t(ji,jj,jk)/2.) 116 e3(ji,jj,jk+1) = e3(ji,jj,jk)*exp(-ekr*fse3t(ji,jj,jk)/2.) 117 118 119 etot(ji,jj,jk) = e1(ji,jj,jk+1)+e2(ji,jj,jk+1)+e3(ji,jj,jk+1) 120 C 121 C Computation of irradiance below level T 122 C --------------------------------------- 123 C 124 e1(ji,jj,jk+1) = e1(ji,jj,jk+1)*exp(-ekb*fse3t(ji,jj,jk)/2.) 125 e2(ji,jj,jk+1) = e2(ji,jj,jk+1)*exp(-ekg*fse3t(ji,jj,jk)/2.) 126 e3(ji,jj,jk+1) = e3(ji,jj,jk+1)*exp(-ekr*fse3t(ji,jj,jk)/2.) 127 128 e3lum(ji,jj,jk+1)=e3lum(ji,jj,jk)*exp(-ekb*fse3t(ji,jj,jk)) 129 e4lum(ji,jj,jk+1)=e4lum(ji,jj,jk)*exp(-ekg*fse3t(ji,jj,jk)) 130 e5lum(ji,jj,jk+1)=e5lum(ji,jj,jk)*exp(-ekr*fse3t(ji,jj,jk)) 131 e6lum(ji,jj,jk+1)=e6lum(ji,jj,jk)*exp(-fse3t(ji,jj,jk)/xsi1) 132 C 133 END DO 134 END DO 135 END DO 136 137 C 138 C modif pour le couplage avec la physique 139 C 140 etot3=e3lum+e4lum+e5lum+e6lum 141 C 142 DO jk = 1,jpkm1 143 DO jj = 1,jpj 144 DO ji = 1,jpi 145 C 146 C Michaelis-Menten Limitation term for nutrients 147 C Small flagellates 148 C ----------------------------------------------- 149 C 150 xnanono3(ji,jj,jk)=trn(ji,jj,jk,jpno3)*concnnh4 151 & /(conc0*concnnh4+concnnh4*trn(ji,jj,jk,jpno3)+ 152 & conc0*trn(ji,jj,jk,jpnh4)) 153 xnanonh4(ji,jj,jk)=trn(ji,jj,jk,jpnh4)*conc0 154 & /(conc0*concnnh4+concnnh4*trn(ji,jj,jk,jpno3)+ 155 & conc0*trn(ji,jj,jk,jpnh4)) 156 xlim1=xnanono3(ji,jj,jk)+xnanonh4(ji,jj,jk) 157 xlim2=trn(ji,jj,jk,jppo4)/(trn(ji,jj,jk,jppo4)+conc0) 158 xlim3=trn(ji,jj,jk,jpfer)/(trn(ji,jj,jk,jpfer)+conc2) 159 xlimphy(ji,jj,jk)=min(xlim1,xlim2,xlim3) 160 xlim4=trn(ji,jj,jk,jpdoc)/(trn(ji,jj,jk,jpdoc)+xkdoc2) 161 xlimbac(ji,jj,jk)=min(xlim1,xlim2,xlim3,xlim4) 70 71 ekb(ji,jj,jk)=xkrgb(1,mrgb) 72 ekg(ji,jj,jk)=xkrgb(2,mrgb) 73 ekr(ji,jj,jk)=xkrgb(3,mrgb) 162 74 C 163 75 END DO … … 165 77 END DO 166 78 C 167 DO jk = 1,jpkm1168 79 DO jj = 1,jpj 169 80 DO ji = 1,jpi 170 C Diatoms 171 C ------- 172 xdiatno3(ji,jj,jk)=trn(ji,jj,jk,jpno3)*concdnh4 173 & /(conc1*concdnh4+concdnh4*trn(ji,jj,jk,jpno3)+ 174 & conc1*trn(ji,jj,jk,jpnh4)) 175 xdiatnh4(ji,jj,jk)=trn(ji,jj,jk,jpnh4)*conc1 176 & /(conc1*concdnh4+concdnh4*trn(ji,jj,jk,jpno3)+ 177 & conc1*trn(ji,jj,jk,jpnh4)) 178 179 xlim1=xdiatno3(ji,jj,jk)+xdiatnh4(ji,jj,jk) 180 xlim2=trn(ji,jj,jk,jppo4)/(trn(ji,jj,jk,jppo4)+conc1) 181 xlim3=trn(ji,jj,jk,jpsil)/(trn(ji,jj,jk,jpsil)+xksi(ji,jj)) 182 xlim4=trn(ji,jj,jk,jpfer)/(trn(ji,jj,jk,jpfer)+conc3) 183 xlimdia(ji,jj,jk)=min(xlim1,xlim2,xlim3,xlim4) 81 C 82 C Separation in three light bands: red, green, blue 83 C ------------------------------------------------- 84 C 85 zblight=0.5*ekb(ji,jj,1)*fse3t(ji,jj,1) 86 zglight=0.5*ekg(ji,jj,1)*fse3t(ji,jj,1) 87 zrlight=0.5*ekr(ji,jj,1)*fse3t(ji,jj,1) 88 C 89 e1(ji,jj,1) = parlux*qsr(ji,jj)*exp(-zblight) 90 e2(ji,jj,1) = parlux*qsr(ji,jj)*exp(-zglight) 91 e3(ji,jj,1) = parlux*qsr(ji,jj)*exp(-zrlight) 92 C 93 END DO 94 END DO 95 96 97 DO jk = 2,jpkm1 98 DO jj = 1,jpj 99 DO ji = 1,jpi 100 C 101 C Separation in three light bands: red, green, blue 102 C ------------------------------------------------- 103 C 104 zblight=0.5*(ekb(ji,jj,jk-1)*fse3t(ji,jj,jk-1) 105 & +ekb(ji,jj,jk)*fse3t(ji,jj,jk)) 106 zglight=0.5*(ekg(ji,jj,jk-1)*fse3t(ji,jj,jk-1) 107 & +ekg(ji,jj,jk)*fse3t(ji,jj,jk)) 108 zrlight=0.5*(ekr(ji,jj,jk-1)*fse3t(ji,jj,jk-1) 109 & +ekr(ji,jj,jk)*fse3t(ji,jj,jk)) 110 C 111 e1(ji,jj,jk) = e1(ji,jj,jk-1)*exp(-zblight) 112 e2(ji,jj,jk) = e2(ji,jj,jk-1)*exp(-zglight) 113 e3(ji,jj,jk) = e3(ji,jj,jk-1)*exp(-zrlight) 184 114 C 185 115 END DO 186 116 END DO 187 117 END DO 188 C 189 C Initialisation of the euphotic depth 190 C ------------------------------------ 191 C 192 zmeu(:,:)=fsdept(:,:,jkopt+1) 118 C 119 etot(:,:,:) = e1(:,:,:)+e2(:,:,:)+e3(:,:,:) 193 120 C 194 121 C Computation of the euphotic depth 195 122 C --------------------------------- 196 123 C 197 DO jk = 2,jkopt 124 zmeu(:,:) = 300. 125 126 DO jk = 2,jpkm1 198 127 DO jj = 1,jpj 199 128 DO ji = 1,jpi … … 204 133 END DO 205 134 END DO 135 C 136 zmeu(:,:)=min(300.,zmeu(:,:)) 206 137 C 207 138 C Computation of the mean light over the mixed layer depth … … 215 146 DO jj = 1,jpj 216 147 DO ji = 1,jpi 217 etmp(ji,jj) = etmp(ji,jj)+etot(ji,jj,jk) 218 $ *fse3t(ji,jj,jk)* 219 $ (0.5+sign(0.5,(hmld(ji,jj) 220 $ -fsdept(ji,jj,jk)))) 221 zdepmoy(ji,jj)=zdepmoy(ji,jj)+ 222 $ fse3t(ji,jj,jk)* 223 $ (0.5+sign(0.5,(hmld(ji,jj) 224 $ -fsdept(ji,jj,jk)))) 148 if (fsdepw(ji,jj,jk+1).le.hmld(ji,jj)) then 149 etmp(ji,jj) = etmp(ji,jj)+etot(ji,jj,jk)*fse3t(ji,jj,jk) 150 zdepmoy(ji,jj)=zdepmoy(ji,jj)+fse3t(ji,jj,jk) 151 endif 225 152 END DO 226 153 END DO 227 154 END DO 228 155 229 emoy =etot156 emoy(:,:,:) = etot(:,:,:) 230 157 231 DO jk =1,jpkm1158 DO jk = 1,jpkm1 232 159 DO jj = 1,jpj 233 160 DO ji = 1,jpi 234 IF (fsdep t(ji,jj,jk).LE.hmld(ji,jj)) THEN161 IF (fsdepw(ji,jj,jk+1).LE.hmld(ji,jj)) THEN 235 162 emoy(ji,jj,jk) = etmp(ji,jj)/(zdepmoy(ji,jj)+rtrn) 236 163 ENDIF -
trunk/NEMO/TOP_SRC/SMS/p4zprg.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 p4zprg(kt) … … 52 48 CC local declarations 53 49 CC ================== 50 54 51 INTEGER kt 52 #if defined key_passivetrc && defined key_trc_pisces 55 53 INTEGER jnt, jn 56 54 57 #if defined key_passivetrc && defined key_trc_pisces58 55 C 59 56 C this part is without macrotasking coding 60 57 C 58 C Call an intermediate routine that in turns, calls chemistry 59 C and another routine on a daily basis 60 C ----------------------------------------------------------- 61 61 C 62 C Compute chemical variables 63 C -------------------------- 64 C 62 CALL p4zslow(kt) 65 63 66 CALL p4zche67 C......................................................................68 C69 C Interpolate chemical variables70 C ------------------------------71 C72 CALL p4zint(kt)73 C74 C......................................................................75 C76 C Compute CaCO3 saturation77 C ------------------------78 C79 CALL p4zlys80 64 C...................................................................... 81 65 C … … 85 69 do jnt=1,nrdttrc 86 70 C 87 CALL p4zbio 71 CALL p4zbio 72 88 73 C 89 74 C...................................................................... … … 93 78 C 94 79 CALL p4zsed 80 95 81 C 96 82 trb=trn 97 end DO 98 83 END DO 84 C 85 C...................................................................... 86 C 87 C Compute CaCO3 saturation 88 C ------------------------ 89 C 90 CALL p4zlys 99 91 100 92 C … … 106 98 CALL p4zflx 107 99 100 108 101 DO jn=1 , jptra 109 102 CALL lbc_lnk(trn(:,:,:,jn), 'T', 1. ) … … 111 104 CALL lbc_lnk(tra(:,:,:,jn), 'T', 1. ) 112 105 END DO 106 113 107 C 114 108 C...................................................................... -
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 -
trunk/NEMO/TOP_SRC/SMS/p4zrem.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 p4zrem … … 39 35 USE sms 40 36 IMPLICIT NONE 37 #include "domzgr_substitute.h90" 41 38 CDIR$ LIST 42 39 CC---------------------------------------------------------------------- … … 46 43 REAL remip,remik,xlam1b 47 44 REAL xkeq,xfeequi,siremin 48 REAL zsatur,zsatur2,znusil 49 REAL fesatur(jpi,jpj,jpk) 50 CC---------------------------------------------------------------------- 51 CC statement functions 52 CC =================== 53 CDIR$ NOLIST 54 #include "domzgr_substitute.h90" 55 CDIR$ LIST 45 REAL zsatur,zsatur2,znusil,zdepbac(jpi,jpj,jpk) 46 REAL zlamfac,zstep,fesatur(jpi,jpj,jpk) 47 C 48 C Time step duration for the biology 49 C 50 zstep=rfact2/rjjss 56 51 C 57 52 C Computation of the mean phytoplankton concentration as … … 59 54 C -------------------------------------------------- 60 55 C 61 DO jj=1,jpj 62 DO ji=1,jpi 63 phymoy(ji,jj)=min((trn(ji,jj,1,jpphy)+trn(ji,jj,1,jpdia)) 64 . ,3.E-6) 65 END DO 66 END DO 67 68 DO jk = 1,jpk-1 56 DO jk=1,12 57 zdepbac(:,:,jk)=min(0.7*(trn(:,:,jk,jpzoo)+2*trn(:,:,jk,jpmes)) 58 & ,4E-6) 59 END DO 60 C 61 C Vertical decay of the bacterial activity 62 C ---------------------------------------- 63 C 64 do jk=13,jpk 65 do jj=1,jpj 66 do ji=1,jpi 67 zdepbac(ji,jj,jk)=min(1.,fsdept(ji,jj,12)/fsdept(ji,jj,jk)) 68 & *zdepbac(ji,jj,12) 69 end do 70 end do 71 end do 72 73 DO jk = 1,jpkm1 69 74 DO jj = 1,jpj 70 75 DO ji = 1,jpi … … 76 81 & max(0.,0.4*(6.E-6-trn(ji,jj,jk,jpoxy))/(oxymin+ 77 82 & trn(ji,jj,jk,jpoxy))) 78 nitrfac(ji,jj,jk)=min(1.,nitrfac(ji,jj,jk)) 79 END DO 80 END DO 81 END DO 83 END DO 84 END DO 85 END DO 86 87 nitrfac(:,:,:)=min(1.,nitrfac(:,:,:)) 82 88 83 89 DO jk = 1,jpkm1 … … 89 95 C of the bacterial activity. 90 96 C ---------------------------------------------------------------- 91 remik= 92 & xremik*rfact2/(rjjss*1.E-6)*tmask(ji,jj,jk)93 & * xlimbac(ji,jj,jk)*phymoy(ji,jj)*max(0.194 & ,exp(-max(0.,(fsdept(ji,jj,jk)-hmld(ji,jj)))/200.)) 95 # if defined key_off_degrad 96 & *facvol(ji,jj,jk) 97 # endif 97 C 98 remik = xremik*zstep/1E-6*xlimbac(ji,jj,jk) 99 & *zdepbac(ji,jj,jk) 100 # if defined key_off_degrad 101 & *facvol(ji,jj,jk) 102 # endif 103 remik=max(remik,5.5E-4*zstep) 98 104 C 99 105 C Ammonification in oxic waters with oxygen consumption … … 102 108 olimi(ji,jj,jk)=min((trn(ji,jj,jk,jpoxy)-rtrn)/o2ut, 103 109 & remik*(1.-nitrfac(ji,jj,jk))*trn(ji,jj,jk,jpdoc)) 104 olimi(ji,jj,jk)=max(0.,olimi(ji,jj,jk))105 110 C 106 111 C Ammonification in suboxic waters with denitrification 107 112 C ------------------------------------------------------- 108 113 C 109 denitr(ji,jj,jk)=min((trn(ji,jj,jk,jpno3)-rtrn)/ 6.1,114 denitr(ji,jj,jk)=min((trn(ji,jj,jk,jpno3)-rtrn)/rdenit, 110 115 & remik*nitrfac(ji,jj,jk)*trn(ji,jj,jk,jpdoc)) 111 116 END DO 112 117 END DO 113 118 END DO 114 119 C 120 olimi(:,:,:)=max(0.,olimi(:,:,:)) 121 denitr(:,:,:)=max(0.,denitr(:,:,:)) 122 C 115 123 DO jk = 1,jpkm1 116 124 DO jj = 1,jpj … … 121 129 C ---------------------------------------------------------- 122 130 C 123 onitr(ji,jj,jk)=nitrif*rfact2/rjjss*trn(ji,jj,jk,jpnh4) 124 & *1./(1.+emoy(ji,jj,jk))*tmask(ji,jj,jk) 125 & *(1.-nitrfac(ji,jj,jk)) 131 onitr(ji,jj,jk)=nitrif*zstep*trn(ji,jj,jk,jpnh4)/(1. 132 & +emoy(ji,jj,jk))*(1.-nitrfac(ji,jj,jk)) 126 133 # if defined key_off_degrad 127 134 & *facvol(ji,jj,jk) … … 141 148 C ---------------------------------------------------------- 142 149 C 143 xbactfer(ji,jj,jk)=0.02*20E-6*rfact2 144 & *prmax(ji,jj,jk)*tmask(ji,jj,jk)*xlimphy(ji,jj,jk) 145 & *xlimdia(ji,jj,jk)*phymoy(ji,jj)*exp(-max 146 & (fsdept(ji,jj,jk)-hmld(ji,jj),0.)/200.) 150 xbactfer(ji,jj,jk)=15E-6*rfact2*4.*0.4*prmax(ji,jj,jk) 151 & *(xlimphy(ji,jj,jk)*zdepbac(ji,jj,jk))**2 152 & /(xkgraz2+zdepbac(ji,jj,jk)) 153 & *(0.5+sign(0.5,trn(ji,jj,jk,jpfer)-2E-11)) 154 C 147 155 END DO 148 156 END DO … … 156 164 C ------------------------------------------------------------- 157 165 C 158 remip=xremip/rjjss*rfact2*tmask(ji,jj,jk)*(0.25+0.75 159 & *exp(-max((fsdept(ji,jj,jk)-150.),0.)/1000.)) 166 remip=xremip*zstep*tgfunc(ji,jj,jk)*(1.-0.5*nitrfac(ji,jj,jk)) 160 167 # if defined key_off_degrad 161 168 & *facvol(ji,jj,jk) … … 168 175 C ----------------------------------------------------------------- 169 176 C 170 remip=remip*(1.-0.5*nitrfac(ji,jj,jk))171 C172 177 orem(ji,jj,jk)=remip*trn(ji,jj,jk,jppoc) 173 178 orem2(ji,jj,jk)=remip*trn(ji,jj,jk,jpgoc) … … 188 193 zsatur=(sio3eq(ji,jj,jk)-trn(ji,jj,jk,jpsil))/ 189 194 & (sio3eq(ji,jj,jk)+rtrn) 190 zsatur2=zsatur*(1.+tn(ji,jj,jk)/400.)**2* 191 & (1.+tn(ji,jj,jk)/400.)**2 192 193 znusil=0.225*(1.+tn(ji,jj,jk)/15.)*zsatur+0.775 194 & *exp(9.25*log(zsatur2)) 195 196 siremin=xsirem/rjjss*rfact2*tmask(ji,jj,jk)*znusil 195 zsatur=max(rtrn,zsatur) 196 zsatur2=zsatur*(1.+tn(ji,jj,jk)/400.)**4 197 znusil=0.225*(1.+tn(ji,jj,jk)/15.)*zsatur+0.775*zsatur2**9 198 199 siremin=xsirem*zstep*znusil 197 200 # if defined key_off_degrad 198 201 & *facvol(ji,jj,jk) … … 203 206 END DO 204 207 END DO 205 208 C 209 fesatur(:,:,:)=0.6E-9 210 C 206 211 DO jk = 1,jpkm1 207 212 DO jj = 1,jpj … … 214 219 C 215 220 xkeq=fekeq(ji,jj,jk) 216 fesatur(ji,jj,jk)=0.6E-9217 221 xfeequi=(-(1.+fesatur(ji,jj,jk)*xkeq-xkeq*trn(ji,jj,jk,jpfer))+ 218 222 & sqrt((1.+fesatur(ji,jj,jk)*xkeq-xkeq*trn(ji,jj,jk,jpfer))**2 … … 223 227 & trn(ji,jj,jk,jpdsi))*1E6 224 228 225 xscave(ji,jj,jk)=xfeequi*xlam1b /rjjss*rfact2*tmask(ji,jj,jk)229 xscave(ji,jj,jk)=xfeequi*xlam1b*zstep 226 230 # if defined key_off_degrad 227 231 & *facvol(ji,jj,jk) … … 233 237 C ----------------------------------------------------------- 234 238 C 235 xaggdfe(ji,jj,jk)=2.*xlam1*rfact2/rjjss*max(0., 236 & (trn(ji,jj,jk,jpfer)*1E9-1.))*trn(ji,jj,jk,jpfer) 237 & *tmask(ji,jj,jk) 238 # if defined key_off_degrad 239 & *facvol(ji,jj,jk) 240 # endif 239 zlamfac=max(0.,(gphit(ji,jj)+55.)/30.) 240 zlamfac=min(1.,zlamfac) 241 xlam1b=(80.*(trn(ji,jj,jk,jpdoc)+40E-6)+698. 242 & *trn(ji,jj,jk,jppoc)+1.05E4*trn(ji,jj,jk,jpgoc)) 243 & *zdiss(ji,jj,jk)+1E-5*(1.-zlamfac)+xlam1*max(0., 244 & (trn(ji,jj,jk,jpfer)*1E9-1.)) 245 246 xaggdfe(ji,jj,jk)=xlam1b*zstep*0.76*(trn(ji,jj,jk,jpfer) 247 & -xfeequi) 248 # if defined key_off_degrad 249 & *facvol(ji,jj,jk) 250 # endif 251 241 252 C 242 253 END DO -
trunk/NEMO/TOP_SRC/SMS/p4zsed.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 p4zsed … … 36 32 CC parameters and commons 37 33 CC ====================== 34 CDIR$ NOLIST 38 35 USE oce_trc 39 36 USE trp_trc … … 41 38 USE lib_mpp 42 39 IMPLICIT NONE 40 #include "domzgr_substitute.h90" 41 CDIR$ LIST 43 42 CC---------------------------------------------------------------------- 44 43 CC local declarations … … 46 45 INTEGER ji, jj, jk, ikt 47 46 REAL sumsedsi,sumsedpo4,sumsedcal 48 REAL xconctmp,denitot,nitrpottot,nitrpot(jpi,jpj) 49 50 CC 51 CC---------------------------------------------------------------------- 52 CC statement functions 53 CC =================== 54 CDIR$ NOLIST 55 #include "domzgr_substitute.h90" 56 CDIR$ LIST 57 C 47 REAL xconctmp,denitot,nitrpottot,nitrpot(jpi,jpj,jpk) 48 REAL xlim,xconctmp2,zstep,zfact 49 REAL irondep(jpi,jpj,jpk),sidep(jpi,jpj) 50 CC 51 C 52 C Time step duration for the biology 53 C ---------------------------------- 54 C 55 zstep=rfact2/rjjss 56 C 57 C 58 C Initialisation of variables used to compute deposition 59 C ------------------------------------------------------ 60 C 61 irondep = 0. 62 sidep = 0. 63 C 64 C Iron and Si deposition at the surface 65 C ------------------------------------- 66 C 67 do jj=1,jpj 68 do ji=1,jpi 69 irondep(ji,jj,1)=(0.014*dust(ji,jj)/(55.85*rmoss) 70 & +3E-10/raass)*rfact2/fse3t(ji,jj,1) 71 sidep(ji,jj)=8.8*0.075*dust(ji,jj)*rfact2 72 & /(fse3t(ji,jj,1)*28.1*rmoss) 73 end do 74 end do 75 C 76 C Iron solubilization of particles in the water column 77 C ---------------------------------------------------- 78 C 79 do jk=2,jpk-1 80 do jj=1,jpj 81 do ji=1,jpi 82 irondep(ji,jj,jk)=dust(ji,jj)/(10.*55.85*rmoss)*rfact2 83 & *0.0001 84 end do 85 end do 86 end do 87 C 88 C Add the external input of nutrients, carbon and alkalinity 89 C ---------------------------------------------------------- 90 C 91 DO jj = 1,jpj 92 DO ji = 1,jpi 93 trn(ji,jj,1,jppo4) = trn(ji,jj,1,jppo4) 94 & +rivinp(ji,jj)*rfact2 95 trn(ji,jj,1,jpno3) = trn(ji,jj,1,jpno3) 96 & +(rivinp(ji,jj)+nitdep(ji,jj))*rfact2 97 trn(ji,jj,1,jpfer) = trn(ji,jj,1,jpfer) 98 & +rivinp(ji,jj)*9E-5*rfact2 99 trn(ji,jj,1,jpsil) = trn(ji,jj,1,jpsil) 100 & +sidep(ji,jj)+cotdep(ji,jj)*rfact2/6. 101 trn(ji,jj,1,jpdic) = trn(ji,jj,1,jpdic) 102 & +rivinp(ji,jj)*rfact2*2.631 103 trn(ji,jj,1,jptal) = trn(ji,jj,1,jptal) 104 & +(cotdep(ji,jj)-rno3*(rivinp(ji,jj) 105 & +nitdep(ji,jj)))*rfact2 106 END DO 107 END DO 108 C 109 C Add the external input of iron which is 3D distributed 110 C (dust, river and sediment mobilization) 111 C ------------------------------------------------------ 112 C 113 DO jk=1,jpkm1 114 DO jj=1,jpj 115 DO ji=1,jpi 116 trn(ji,jj,jk,jpfer) = trn(ji,jj,jk,jpfer) 117 & +irondep(ji,jj,jk)+ironsed(ji,jj,jk)*rfact2 118 END DO 119 END DO 120 END DO 58 121 C 59 122 C Initialisation of variables used to compute Sinking Speed … … 72 135 DO ji=2,jpim1 73 136 ikt=max(mbathy(ji,jj)-1,1) 74 sumsedsi=sumsedsi+trn(ji,jj,ikt,jpdsi)*e1t(ji,jj) 75 & *e2t(ji,jj)*wsbio4(ji,jj,ikt)*tmask(ji,jj,ikt) 76 & *tmask_i(ji,jj)/rjjss 77 sumsedcal=sumsedcal+trn(ji,jj,ikt,jpcal)*e1t(ji,jj) 78 & *e2t(ji,jj)*wsbio4(ji,jj,ikt)*tmask(ji,jj,ikt)*2. 79 & *tmask_i(ji,jj)/rjjss 137 zfact=e1t(ji,jj)*e2t(ji,jj)/rjjss 138 sumsedsi=sumsedsi+trn(ji,jj,ikt,jpdsi)*wsbio4(ji,jj,ikt) 139 & *zfact 140 sumsedcal=sumsedcal+trn(ji,jj,ikt,jpcal)*wscal(ji,jj,ikt) 141 & *2.*zfact 80 142 sumsedpo4=sumsedpo4+(trn(ji,jj,ikt,jpgoc)*wsbio4(ji,jj,ikt) 81 & +trn(ji,jj,ikt,jppoc)*wsbio3(ji,jj,ikt))/rjjss 82 & *tmask(ji,jj,ikt)*tmask_i(ji,jj)*e1t(ji,jj)*e2t(ji,jj) 143 & +trn(ji,jj,ikt,jppoc)*wsbio3(ji,jj,ikt))*zfact 83 144 END DO 84 145 END DO … … 99 160 DO ji=1,jpi 100 161 ikt=max(mbathy(ji,jj)-1,1) 101 xconctmp=trn(ji,jj,ikt,jpdsi) 102 trn(ji,jj,ikt,jpdsi)=trn(ji,jj,ikt,jpdsi) 103 & -xconctmp*wsbio4(ji,jj,ikt) 104 & *rfact2/rjjss/fse3t(ji,jj,ikt) 105 trn(ji,jj,ikt,jpsil)=trn(ji,jj,ikt,jpsil) 106 & +xconctmp*wsbio4(ji,jj,ikt) 107 & *rfact2/rjjss/fse3t(ji,jj,ikt)*(1.-(sumdepsi+rivalkinput 108 & /raass/6.)/sumsedsi) 109 END DO 110 END DO 111 112 DO jj=1,jpj 113 DO ji=1,jpi 114 ikt=max(mbathy(ji,jj)-1,1) 115 xconctmp=trn(ji,jj,ikt,jpcal) 116 trn(ji,jj,ikt,jpcal)=trn(ji,jj,ikt,jpcal) 117 & -xconctmp*wsbio4(ji,jj,ikt) 118 & *rfact2/rjjss/fse3t(ji,jj,ikt) 119 trn(ji,jj,ikt,jptal)=trn(ji,jj,ikt,jptal) 120 & +xconctmp*wsbio4(ji,jj,ikt) 121 & *rfact2/rjjss/fse3t(ji,jj,ikt)*(1.-(rivalkinput 122 & /raass)/sumsedcal)*2. 123 trn(ji,jj,ikt,jpdic)=trn(ji,jj,ikt,jpdic) 124 & +xconctmp*wsbio4(ji,jj,ikt) 125 & *rfact2/rjjss/fse3t(ji,jj,ikt)*(1.-(rivalkinput 126 & /raass)/sumsedcal) 162 xconctmp=trn(ji,jj,ikt,jpdsi)*wsbio4(ji,jj,ikt)*zstep 163 & /fse3t(ji,jj,ikt) 164 trn(ji,jj,ikt,jpdsi)=trn(ji,jj,ikt,jpdsi)-xconctmp 165 trn(ji,jj,ikt,jpsil)=trn(ji,jj,ikt,jpsil)+xconctmp 166 & *(1.-(sumdepsi+rivalkinput/raass/6.)/sumsedsi) 167 END DO 168 END DO 169 170 DO jj=1,jpj 171 DO ji=1,jpi 172 ikt=max(mbathy(ji,jj)-1,1) 173 xconctmp=trn(ji,jj,ikt,jpcal)*wscal(ji,jj,ikt)*zstep 174 & /fse3t(ji,jj,ikt) 175 trn(ji,jj,ikt,jpcal)=trn(ji,jj,ikt,jpcal)-xconctmp 176 trn(ji,jj,ikt,jptal)=trn(ji,jj,ikt,jptal)+xconctmp 177 & *(1.-(rivalkinput/raass)/sumsedcal)*2. 178 trn(ji,jj,ikt,jpdic)=trn(ji,jj,ikt,jpdic)+xconctmp 179 & *(1.-(rivalkinput/raass)/sumsedcal) 127 180 END DO 128 181 END DO … … 131 184 DO ji=1,jpi 132 185 ikt=max(mbathy(ji,jj)-1,1) 186 xconctmp=trn(ji,jj,ikt,jpgoc) 187 xconctmp2=trn(ji,jj,ikt,jppoc) 133 188 trn(ji,jj,ikt,jpgoc)=trn(ji,jj,ikt,jpgoc) 134 & -trn(ji,jj,ikt,jpgoc)*wsbio4(ji,jj,ikt)*rfact2 135 & /fse3t(ji,jj,ikt)/rjjss*rivpo4input/(raass*sumsedpo4) 189 & -xconctmp*wsbio4(ji,jj,ikt)*zstep/fse3t(ji,jj,ikt) 136 190 trn(ji,jj,ikt,jppoc)=trn(ji,jj,ikt,jppoc) 137 & -trn(ji,jj,ikt,jppoc)*wsbio3(ji,jj,ikt)*rfact2 138 & /fse3t(ji,jj,ikt)/rjjss*rivpo4input/(raass*sumsedpo4) 191 & -xconctmp2*wsbio3(ji,jj,ikt)*zstep/fse3t(ji,jj,ikt) 192 trn(ji,jj,ikt,jpdoc)=trn(ji,jj,ikt,jpdoc) 193 & +(xconctmp*wsbio4(ji,jj,ikt)+xconctmp2*wsbio3(ji,jj,ikt)) 194 & *zstep/fse3t(ji,jj,ikt)*(1.-rivpo4input 195 & /(raass*sumsedpo4)) 139 196 trn(ji,jj,ikt,jpbfe)=trn(ji,jj,ikt,jpbfe) 140 & -trn(ji,jj,ikt,jpbfe)*wsbio4(ji,jj,ikt)* rfact2141 & /fse3t(ji,jj,ikt) /rjjss*rivpo4input/(raass*sumsedpo4)197 & -trn(ji,jj,ikt,jpbfe)*wsbio4(ji,jj,ikt)*zstep 198 & /fse3t(ji,jj,ikt) 142 199 trn(ji,jj,ikt,jpsfe)=trn(ji,jj,ikt,jpsfe) 143 & -trn(ji,jj,ikt,jpsfe)*wsbio3(ji,jj,ikt)* rfact2144 & /fse3t(ji,jj,ikt) /rjjss*rivpo4input/(raass*sumsedpo4)200 & -trn(ji,jj,ikt,jpsfe)*wsbio3(ji,jj,ikt)*zstep 201 & /fse3t(ji,jj,ikt) 145 202 END DO 146 203 END DO … … 153 210 denitot=0. 154 211 DO jk=1,jpk-1 155 DO jj= 1,jpj156 DO ji= 1,jpi212 DO jj=2,jpj-1 213 DO ji=2,jpi-1 157 214 denitot=denitot+denitr(ji,jj,jk)*rdenit*e1t(ji,jj)*e2t(ji,jj) 158 & *fse3t(ji,jj,jk)*tmask(ji,jj,jk)* tmask_i(ji,jj)215 & *fse3t(ji,jj,jk)*tmask(ji,jj,jk)*znegtr(ji,jj,jk) 159 216 END DO 160 217 END DO 161 218 END DO 162 219 163 220 IF( lk_mpp ) CALL mpp_sum( denitot ) ! sum over the global domain 164 221 C … … 167 224 C ---------------------------------------------------- 168 225 C 169 nitrpot(:,:)= 0. 226 DO jk=1,jpk 227 DO jj=1,jpj 228 DO ji=1,jpi 229 xlim=(1.-xnanono3(ji,jj,jk)-xnanonh4(ji,jj,jk)) 230 if (xlim.le.0.2) xlim=0.01 231 nitrpot(ji,jj,jk)=max(0.,(prmax(ji,jj,jk)-2.15/rjjss)) 232 & *xlim*rfact2*trn(ji,jj,jk,jpfer)/(conc3 233 & +trn(ji,jj,jk,jpfer))*(1.-exp(-etot(ji,jj,jk)/50.)) 234 END DO 235 END DO 236 END DO 237 C 170 238 nitrpottot=0. 171 DO jj=1,jpj 172 DO ji=1,jpi 173 nitrpot(ji,jj)=prmax(ji,jj,1)*max(0.,(0.1*tn(ji,jj,1) 174 & -2.))*conc0/(trn(ji,jj,1,jpno3)+conc0)*rfact2 175 & *trn(ji,jj,1,jpfer)/(conc3+trn(ji,jj,1,jpfer)) 176 & *trn(ji,jj,1,jppo4)/(conc0+trn(ji,jj,1,jppo4)) 177 nitrpottot=nitrpottot+nitrpot(ji,jj)*e1t(ji,jj) 178 & *e2t(ji,jj)*tmask_i(ji,jj)*fse3t(ji,jj,1) 179 END DO 180 END DO 181 C 239 DO jk=1,jpkm1 240 DO jj=2,jpj-1 241 DO ji=2,jpi-1 242 nitrpottot=nitrpottot+nitrpot(ji,jj,jk)*e1t(ji,jj) 243 & *e2t(ji,jj)*tmask(ji,jj,jk)*fse3t(ji,jj,jk) 244 END DO 245 END DO 246 END DO 247 182 248 IF( lk_mpp ) CALL mpp_sum( nitrpottot ) ! sum over the global domain 183 249 C … … 185 251 C ---------------------------------------- 186 252 C 187 188 189 DO jj=1,jpj 190 DO ji=1,jpi 191 trn(ji,jj,1,jpnh4)=trn(ji,jj,1,jpnh4)+nitrpot(ji,jj) 192 & *(denitot-rivnitinput/raass*rfact2)/(nitrpottot+rtrn) 193 trn(ji,jj,1,jpoxy)=trn(ji,jj,1,jpoxy)+nitrpot(ji,jj) 194 & *(denitot-rivnitinput/raass*rfact2)/(nitrpottot+rtrn) 195 & *o2nit 196 END DO 197 END DO 198 199 253 DO jk=1,jpk 254 DO jj=1,jpj 255 DO ji=1,jpi 256 zfact=nitrpot(ji,jj,jk)*1.E-7 257 trn(ji,jj,jk,jpnh4)=trn(ji,jj,jk,jpnh4)+zfact 258 trn(ji,jj,jk,jpoxy)=trn(ji,jj,jk,jpoxy)+zfact*o2nit 259 trn(ji,jj,jk,jppo4)=trn(ji,jj,jk,jppo4)+30./46.*zfact 260 END DO 261 END DO 262 END DO 200 263 C 201 264 # if defined key_trc_diaadd 202 265 DO jj = 1,jpj 203 266 DO ji = 1,jpi 204 trc2d(ji,jj,13) = nitrpot(ji,jj) 205 & *(denitot-rivnitinput/raass*rfact2)/(nitrpottot+rtrn) 206 & /rfact2*fse3t(ji,jj,1) 267 trc2d(ji,jj,13) = nitrpot(ji,jj,1)*1E-7*fse3t(ji,jj,1)*1E3 268 & /rfact2 269 trc2d(ji,jj,12) = irondep(ji,jj,1)*1e3*rfact2r 270 & *fse3t(ji,jj,1) 207 271 END DO 208 272 END DO -
trunk/NEMO/TOP_SRC/SMS/p4zsink.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 p4zsink … … 40 36 USE sms 41 37 IMPLICIT NONE 38 #include "domzgr_substitute.h90" 42 39 CDIR$ LIST 43 40 CC---------------------------------------------------------------------- … … 46 43 INTEGER jksed, ji, jj, jk 47 44 REAL xagg1,xagg2,xagg3,xagg4 48 REAL zdepfact 49 CC---------------------------------------------------------------------- 50 CC statement functions 51 CC =================== 52 CDIR$ NOLIST 53 #include "domzgr_substitute.h90" 54 CDIR$ LIST 45 REAL zfact,zstep,wsmax 55 46 C 47 C Time step duration for biology 48 C ------------------------------ 49 C 50 zstep=rfact2/rjjss 56 51 C 57 52 C Sinking speeds of detritus is increased with depth as shown … … 59 54 C ----------------------------------------------------------- 60 55 C 61 56 jksed=10 62 57 C 63 58 DO jk=1,jpk-1 64 59 DO jj=1,jpj 65 60 DO ji=1,jpi 66 zdepfact=sqrt(max(0.,fsdepw(ji,jj,jk+1)-hmld(ji,jj))/5000.) 67 & *(max(0.,fsdepw(ji,jj,jk+1)-hmld(ji,jj))/5000.) 68 & *tmask(ji,jj,jk) 69 wsbio4(ji,jj,jk)=wsbio2+(200.-wsbio2)*zdepfact 70 wsbio3(ji,jj,jk)=wsbio+(10.-wsbio)*zdepfact 61 zfact=max(0.,fsdepw(ji,jj,jk+1)-hmld(ji,jj))/2000. 62 wsbio4(ji,jj,jk)=wsbio2+(200.-wsbio2)*zfact 71 63 END DO 72 64 END DO 73 65 END DO 74 CCC Chris 75 DO jk=1,jpk-1 76 DO jj=1,jpj 77 DO ji=1,jpi 78 wsbio4(ji,jj,jk) = min( wsbio4(ji,jj,jk), 79 $ 0.75*fse3t(ji,jj,jk)/(rfact2/rjjss) ) 80 wsbio3(ji,jj,jk) = min( wsbio3(ji,jj,jk), 81 $ 0.75*fse3t(ji,jj,jk)/(rfact2/rjjss) ) 82 END DO 83 END DO 84 END DO 85 CCC Chris 66 C 67 C LIMIT THE VALUES OF THE SINKING SPEEDS 68 C TO AVOID NUMERICAL INSTABILITIES 69 C 70 wsbio3(:,:,:)=wsbio 71 72 Do jk=1,jpk-1 73 DO jj=1,jpj 74 DO ji=1,jpi 75 wsmax=0.8*fse3t(ji,jj,jk)/zstep 76 wsbio4(ji,jj,jk)=min(wsbio4(ji,jj,jk),wsmax) 77 wsbio3(ji,jj,jk)=min(wsbio3(ji,jj,jk),wsmax) 78 END DO 79 END DO 80 END DO 81 82 wscal(:,:,:)=wsbio4(:,:,:) 83 C 86 84 C 87 85 C INITIALIZE TO ZERO ALL THE SINKING ARRAYS … … 99 97 C ----------------------------------------------------- 100 98 C 101 102 103 104 105 106 CALL p4zsink2(wsbio4,sinkcal,jpcal)99 CALL p4zsink2(wsbio3,sinking,jppoc) 100 CALL p4zsink2(wsbio3,sinkfer,jpsfe) 101 CALL p4zsink2(wsbio4,sinking2,jpgoc) 102 CALL p4zsink2(wsbio4,sinkfer2,jpbfe) 103 CALL p4zsink2(wsbio4,sinksil,jpdsi) 104 CALL p4zsink2(wscal,sinkcal,jpcal) 107 105 C 108 106 C Exchange between organic matter compartments due to … … 110 108 C --------------------------------------------------- 111 109 C 112 DO jk = 1,jpk -1110 DO jk = 1,jpkm1 113 111 DO jj = 1,jpj 114 112 DO ji = 1,jpi 113 C 114 zfact=zstep*zdiss(ji,jj,jk) 115 115 C 116 116 C Part I : Coagulation dependent on turbulence 117 117 C ---------------------------------------------- 118 118 C 119 xagg1=15./rjjss*rfact2*zdiss(ji,jj,jk) 120 & *trn(ji,jj,jk,jppoc)*trn(ji,jj,jk,jppoc) 119 xagg1=940.*zfact*trn(ji,jj,jk,jppoc)*trn(ji,jj,jk,jppoc) 121 120 # if defined key_off_degrad 122 121 & *facvol(ji,jj,jk) 123 122 # endif 124 123 125 xagg2=7.2E3/rjjss*rfact2*zdiss(ji,jj,jk) 126 & *trn(ji,jj,jk,jppoc)*trn(ji,jj,jk,jpgoc) 124 xagg2=1.054E4*zfact*trn(ji,jj,jk,jppoc)*trn(ji,jj,jk,jpgoc) 127 125 # if defined key_off_degrad 128 126 & *facvol(ji,jj,jk) … … 133 131 C ---------------------------------------------- 134 132 C 135 xagg3=0.2/rjjss*rfact2 136 & *trn(ji,jj,jk,jppoc)*trn(ji,jj,jk,jpgoc) 133 xagg3=0.66*zstep*trn(ji,jj,jk,jppoc)*trn(ji,jj,jk,jppoc) 137 134 # if defined key_off_degrad 138 135 & *facvol(ji,jj,jk) 139 136 # endif 140 137 141 xagg4=0./rjjss*rfact2 142 & *trn(ji,jj,jk,jppoc)*trn(ji,jj,jk,jppoc) 138 xagg4=0.*zstep*trn(ji,jj,jk,jppoc)*trn(ji,jj,jk,jpgoc) 143 139 # if defined key_off_degrad 144 140 & *facvol(ji,jj,jk) 145 141 # endif 146 142 C 147 143 xagg(ji,jj,jk)=xagg1+xagg2+xagg3+xagg4 148 144 xaggfe(ji,jj,jk)=xagg(ji,jj,jk)*trn(ji,jj,jk,jpsfe)/ … … 152 148 C -------------------------------------- 153 149 C 154 xaggdoc(ji,jj,jk)=(0.4*trn(ji,jj,jk,jpdoc) 155 & +1018.*trn(ji,jj,jk,jppoc))/rjjss*rfact2 156 & *zdiss(ji,jj,jk)*trn(ji,jj,jk,jpdoc) 150 xaggdoc(ji,jj,jk)=(80*trn(ji,jj,jk,jpdoc)+698. 151 & *trn(ji,jj,jk,jppoc))*zfact*trn(ji,jj,jk,jpdoc) 157 152 # if defined key_off_degrad 158 153 & *facvol(ji,jj,jk) 159 154 # endif 160 155 161 xaggdoc2(ji,jj,jk)= 7.1E3*trn(ji,jj,jk,jpgoc)*rfact2162 & /rjjss*zdiss(ji,jj,jk)*trn(ji,jj,jk,jpdoc)156 xaggdoc2(ji,jj,jk)=1.05E4*zfact*trn(ji,jj,jk,jpgoc) 157 & *trn(ji,jj,jk,jpdoc) 163 158 # if defined key_off_degrad 164 & *facvol(ji,jj,jk)159 & *facvol(ji,jj,jk) 165 160 # endif 166 161 C -
trunk/NEMO/TOP_SRC/SMS/p4zsink2.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 SUBROUTINE p4zsink2(wstmp,sinktemp,jn) 6 2 CDIR$ LIST … … 45 41 USE sms 46 42 IMPLICIT NONE 43 #include "domzgr_substitute.h90" 47 44 CDIR$ LIST 48 45 CC----------------------------------------------------------------- … … 57 54 REAL wstmp2(jpi,jpj,jpk) 58 55 59 !!----------------------------------------------------------------------60 !! statement functions61 !! ===================62 !DIR$ NOLIST63 #include "domzgr_substitute.h90"64 !DIR$ LIST65 56 !!!--------------------------------------------------------------------- 66 57 !!! OPA8, LODYC (01/00) … … 135 126 sinktemp(:,:,1)=0. 136 127 sinktemp(:,:,jpk)=0. 128 C 129 DO jk=1,jpkm1 130 DO jj = 1,jpj 131 DO ji = 1, jpi 132 ! 133 trn(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 134 & + (sinktemp(ji,jj,jk)-sinktemp(ji,jj,jk+1)) 135 & /fse3t(ji,jj,jk) 136 ! 137 ENDDO 138 ENDDO 139 ENDDO 140 ! 141 trb(:,:,:,jn)=trn(:,:,:,jn) 137 142 ! 138 143 #endif -
trunk/NEMO/TOP_SRC/SMS/trcbio.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 CDIR$ LIST6 1 SUBROUTINE trcbio(kt) 2 #if defined key_passivetrc && defined key_trc_lobster1 7 3 CCC--------------------------------------------------------------------- 8 4 CCC … … 17 13 CCC Three options: 18 14 CCC Default option : no biological trend 19 CCC If 'key_trc_npzd' : NPZD model20 15 CCC IF 'key_trc_lobster1' : LOBSTER1 model 21 16 CCC … … 39 34 CC multitasked on vertical slab (jj-loop) 40 35 CC 41 CCC MODIFICATIONS: 36 CC ----- 37 CC argument 38 CC ktask : task identificator 39 CC kt : time step 40 CC COMMON 41 CC /comcoo/ : orthogonal curvilinear coordinates 42 CC and scale factors 43 CC depths 44 CC /cottrp/ : present and next fields for passive 45 CC : tracers 46 CC /comtsk/ : multitasking 47 CC /comtke/ : emin, en() 48 CC /cotbio/ : biological parameters 49 CC 50 CC OUTPUT : 51 CC ------ 52 CC COMMON 53 CC /cottrp/ tra : general tracer trend increased by the 54 CC now horizontal tracer advection trend 55 CC /cottbd/ trbio : now horizontal tracer advection trend 56 CC (IF 'key_trc_diabio' is activated) 57 CC 58 CC WORKSPACE : 59 CC --------- 60 CC local 61 CC zdet,zzoo,zphy,znh4,zno3,zdom : now concentrations 62 CC zlt,zlno3,zlnh4,zle : limitation terms for phyto 63 CC zfno3phy and so on.. : fluxes between bio boxes 64 CC zphya,zzooa,zdeta, ... : after bio trends 65 CC zppz, zpdz, zpppz, zppdz, zfood : preferences terms 66 CC zfilpz, zfilpd : filtration terms 67 CC COMMON 68 CC 69 CC EXTERNAL : no 70 CC -------- 71 CC 72 CC REFERENCES : no 73 CC ---------- 74 CC 75 CC MODIFICATIONS: 42 76 CC -------------- 43 CC original : 95-02 (M. Levy, NPZD model) 44 CC 99-07 (M. Levy, LOBSTER1 model) 77 CC original : 99-07 (M. Levy) 78 CC 00-12 (E. Kestenare): assign a parameter 79 CC to name individual tracers 80 CC 01-03 (M. Levy) LNO3 + dia2d 81 CC---------------------------------------------------------------------- 82 CC---------------------------------------------------------------------- 83 USE oce_trc 84 USE trp_trc 85 USE sms 86 USE lbclnk 87 IMPLICIT NONE 88 CC local declarations 89 CC ================== 90 INTEGER kt 91 INTEGER ji,jj,jk,jn 92 REAL ztot(jpi), ze3t(jpk) 93 REAL zdet,zzoo,zphy,zno3,znh4,zdom,zlno3,zlnh4,zle,zlt 94 REAL zno3phy, znh4phy, zphynh4, zphydom, zphydet, zphyzoo, zdetzoo 95 $ ,zzoonh4, zzoodom, zzoodet, zdetnh4, zdetdom, znh4no3, zdomnh4 96 $ ,zppz,zpdz,zpppz,zppdz,zfood,zfilpz,zfildz,zphya,zzooa,zno3a 97 $ ,znh4a,zdeta,zdoma, ztra, zzoobod, zboddet, zdomaju 98 99 CC---------------------------------------------------------------------- 100 CC statement functions 101 CC =================== 102 CDIR$ NOLIST 103 #include "domzgr_substitute.h90" 104 CDIR$ LIST 45 105 CCC--------------------------------------------------------------------- 46 CCC OPA8, LODYC ( 15/11/96)106 CCC OPA8, LODYC (07/99) 47 107 CCC--------------------------------------------------------------------- 48 #if defined key_passivetrc 49 # if defined key_trc_npzd 50 # include "trcbio.npzd.h" 51 # elif defined key_trc_lobster1 52 # include "trcbio.lobster1.h" 108 C | --------------| 109 C | LOBSTER1 MODEL| 110 C | --------------| 111 112 #if defined key_trc_diaadd 113 C convert fluxes in per day 114 DO jk=1,jpkbm1 115 ze3t(jk)=e3t(jk)*86400. 116 END DO 117 DO jk=jpkb,jpk 118 ze3t(jk)=0. 119 END DO 120 #endif 121 C 122 C vertical slab 123 C ============= 124 C 125 DO 1000 jj = 2,jpjm1 126 C 127 C 1. biological level 128 C =================== 129 C 130 DO ji = 2,jpim1 131 fbod(ji,jj)=0. 132 #if defined key_trc_diaadd 133 DO jn=1,jpdia2d 134 trc2d(ji,jj,jn)=0. 135 END DO 136 #endif 137 END DO 138 139 DO jk=1,jpkbm1 140 DO ji = 2,jpim1 141 C 142 C 143 C 1.1 trophic variables( det, zoo, phy, no3, nh4, dom) 144 C --------------------------------------------------- 145 C 146 C negative trophic variables DO not contribute to the fluxes 147 C 148 zdet = max(0.,trn(ji,jj,jk,jpdet)) 149 zzoo = max(0.,trn(ji,jj,jk,jpzoo)) 150 zphy = max(0.,trn(ji,jj,jk,jpphy)) 151 zno3 = max(0.,trn(ji,jj,jk,jpno3)) 152 znh4 = max(0.,trn(ji,jj,jk,jpnh4)) 153 zdom = max(0.,trn(ji,jj,jk,jpdom)) 154 C 155 C 156 C 1.2 Limitations 157 C ---------------- 158 C 159 zlt = 1. 160 zle = 1. - exp( -xpar(ji,jj,jk)/aki/zlt) 161 C psinut,akno3,aknh4 added by asklod AS Kremeur 2005-03 162 zlno3 = zno3* exp(-psinut*znh4) / (akno3+zno3) 163 zlnh4 = znh4 / (znh4+aknh4) 164 165 C 166 C 167 C 1.3 sinks and sources 168 C --------------------- 169 C 170 C 171 C 1. phytoplankton production and exsudation 172 C 173 zno3phy = tmumax * zle * zlt * zlno3 * zphy 174 znh4phy = tmumax * zle * zlt * zlnh4 * zphy 175 176 C fphylab added by asklod AS Kremeur 2005-03 177 zphydom = rgamma * (1 - fphylab) * (zno3phy + znh4phy) 178 zphynh4 = rgamma * fphylab * (zno3phy + znh4phy) 179 180 C 181 C 2. zooplankton production 182 C 183 C preferences 184 C 185 zppz = rppz 186 zpdz = 1. - rppz 187 zpppz = ( zppz * zphy ) / 188 $ ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 ) 189 zppdz = ( zpdz * zdet ) / 190 $ ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 ) 191 zfood = zpppz * zphy + zppdz * zdet 192 C 193 C filtration 194 C 195 zfilpz = taus * zpppz / (aks + zfood) 196 zfildz = taus * zppdz / (aks + zfood) 197 C 198 C grazing 199 C 200 zphyzoo = zfilpz * zphy * zzoo 201 zdetzoo = zfildz * zdet * zzoo 202 C 203 C 3. fecal pellets production 204 C 205 zzoodet = rpnaz * zphyzoo + rdnaz * zdetzoo 206 C 207 C 4. zooplankton liquide excretion 208 C 209 zzoonh4 = tauzn * zzoo * fdoml 210 zzoodom = tauzn * zzoo * (1-fdoml) 211 212 C 5. mortality 213 C 214 C phytoplankton mortality 215 C 216 zphydet = tmminp * zphy 217 C 218 C 219 C zooplankton mortality 220 c closure : flux fbod is redistributed below level jpkbio 221 C 222 zzoobod = tmminz * zzoo * zzoo 223 fbod(ji,jj) = fbod(ji,jj) + zzoobod * fse3t(ji,jj,jk) 224 C 225 C 226 C 6. detritus and dom breakdown 227 C 228 C 229 zdetnh4 = taudn * fdoml * zdet 230 zdetdom = taudn * (1 - fdoml) * zdet 231 zdomnh4 = taudomn * zdom 232 C 233 C 234 C 7. Nitrification 235 C 236 znh4no3 = taunn * znh4 237 C 238 C 239 C 240 C 1.4 determination of trends 241 C --------------------------- 242 C 243 C total trend for each biological tracer 244 C 245 zphya = zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo 246 $ - zphydet 247 zzooa = zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 248 $ - zzoobod 249 zno3a = - zno3phy + znh4no3 250 znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 251 $ + zdetnh4 252 zdeta = zphydet + zzoodet - zdetzoo - zdetnh4 - zdetdom 253 zdoma = zphydom + zzoodom + zdetdom - zdomnh4 254 C 255 #if defined key_trc_diabio 256 trbio(ji,jj,jk,1) = zno3phy 257 trbio(ji,jj,jk,2) = znh4phy 258 trbio(ji,jj,jk,3) = zphynh4 259 trbio(ji,jj,jk,4) = zphydom 260 trbio(ji,jj,jk,5) = zphyzoo 261 trbio(ji,jj,jk,6) = zphydet 262 trbio(ji,jj,jk,7) = zdetzoo 263 trbio(ji,jj,jk,9) = zzoodet 264 trbio(ji,jj,jk,10) = zzoobod 265 trbio(ji,jj,jk,11) = zzoonh4 266 trbio(ji,jj,jk,12) = zzoodom 267 trbio(ji,jj,jk,13) = znh4no3 268 trbio(ji,jj,jk,14) = zdomnh4 269 trbio(ji,jj,jk,15) = zdetnh4 270 #endif 271 #if defined key_trc_diaadd 272 trc2d(ji,jj,1)=trc2d(ji,jj,1)+zno3phy*ze3t(jk) 273 trc2d(ji,jj,2)=trc2d(ji,jj,2)+znh4phy*ze3t(jk) 274 trc2d(ji,jj,3)=trc2d(ji,jj,3)+zphydom*ze3t(jk) 275 trc2d(ji,jj,4)=trc2d(ji,jj,4)+zphynh4*ze3t(jk) 276 trc2d(ji,jj,5)=trc2d(ji,jj,5)+zphyzoo*ze3t(jk) 277 trc2d(ji,jj,6)=trc2d(ji,jj,6)+zphydet*ze3t(jk) 278 trc2d(ji,jj,7)=trc2d(ji,jj,7)+zdetzoo*ze3t(jk) 279 c trend number 8 is in trcsed.F 280 trc2d(ji,jj,9)=trc2d(ji,jj,9)+zzoodet*ze3t(jk) 281 trc2d(ji,jj,10)=trc2d(ji,jj,10)+zzoobod*ze3t(jk) 282 trc2d(ji,jj,11)=trc2d(ji,jj,11)+zzoonh4*ze3t(jk) 283 trc2d(ji,jj,12)=trc2d(ji,jj,12)+zzoodom*ze3t(jk) 284 trc2d(ji,jj,13)=trc2d(ji,jj,13)+znh4no3*ze3t(jk) 285 trc2d(ji,jj,14)=trc2d(ji,jj,14)+zdomnh4*ze3t(jk) 286 trc2d(ji,jj,15)=trc2d(ji,jj,15)+zdetnh4*ze3t(jk) 287 288 trc2d(ji,jj,16)=trc2d(ji,jj,16)+(zno3phy+znh4phy-zphynh4 289 $ -zphydom-zphyzoo-zphydet)*ze3t(jk) 290 trc2d(ji,jj,17)=trc2d(ji,jj,17)+(zphyzoo+zdetzoo-zzoodet 291 $ -zzoobod-zzoonh4-zzoodom) *ze3t(jk) 292 trc2d(ji,jj,18)=trc2d(ji,jj,18)+zdetdom*ze3t(jk) 293 294 trc3d(ji,jj,jk,1)= zno3phy *86400 295 trc3d(ji,jj,jk,2)= znh4phy *86400 296 trc3d(ji,jj,jk,3)= znh4no3 *86400 297 #endif 298 C 299 C tracer flux at totox-point added to the general trend 300 C 301 tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta 302 tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa 303 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya 304 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a 305 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a 306 tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 307 C 308 END DO 309 END DO 310 C 311 C 2. under biological level 312 C ========================= 313 C 314 DO jk = jpkb,jpk 315 C 316 C 2.1 compute the remineralisation of all quantities towards nitrate 317 C ------------------------------------------------------------------ 318 C 319 DO ji = 2,jpim1 320 C 321 C 2.1.1 trophic variables( det, zoo, phy, no3, nh4, dom) 322 C ----------------------------------------------------- 323 C 324 C negative trophic variables DO not contribute to the fluxes 325 C 326 zdet = max(0.,trn(ji,jj,jk,jpdet)) 327 zzoo = max(0.,trn(ji,jj,jk,jpzoo)) 328 zphy = max(0.,trn(ji,jj,jk,jpphy)) 329 zno3 = max(0.,trn(ji,jj,jk,jpno3)) 330 znh4 = max(0.,trn(ji,jj,jk,jpnh4)) 331 zdom = max(0.,trn(ji,jj,jk,jpdom)) 332 CC 333 CC 2.1.2 Limitations 334 CC ---------------- 335 CC 336 zlt = 0. 337 zle = 0. 338 zlno3 = 0. 339 zlnh4 = 0. 340 CC 341 CC 342 CC 2.1.3 sinks and sources 343 CC --------------------- 344 CC 345 CC 346 CC 1. phytoplankton production and exsudation 347 CC 348 zno3phy = 0. 349 znh4phy = 0. 350 C 351 zphydom = 0. 352 zphynh4 = 0. 353 CC 354 CC 2. zooplankton production 355 CC 356 CC grazing 357 CC 358 zphyzoo = 0. 359 zdetzoo = 0. 360 CC 361 CC 3. fecal pellets production 362 CC 363 zzoodet = 0. 364 CC 365 CC 4. zooplankton liquide excretion 366 CC 367 zzoonh4 = tauzn * fzoolab * zzoo 368 zzoodom = tauzn * (1 - fzoolab) * zzoo 369 CC 370 CC 5. mortality 371 CC 372 CC phytoplankton mortality 373 CC 374 zphydet = tmminp * zphy 375 CC 376 CC 377 CC zooplankton mortality 378 Cc closure : flux fbod is redistributed below level jpkbio 379 CC 380 zzoobod = 0. 381 zboddet = 0. 382 CC 383 CC 384 CC 6. detritus and dom breakdown 385 CC 386 zdetnh4 = taudn * fdetlab * zdet 387 zdetdom = taudn * (1 - fdetlab) * zdet 388 C 389 zdomnh4 = taudomn * zdom 390 zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 391 CC 392 CC 7. Nitrification 393 CC 394 znh4no3 = taunn * znh4 395 CC 396 CC 397 CC 2.1.4 determination of trends 398 CC --------------------------- 399 CC 400 CC total trend for each biological tracer 401 CC 402 zphya = zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo 403 $ - zphydet 404 zzooa = zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 405 $ - zzoobod 406 zno3a = - zno3phy + znh4no3 407 znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 408 $ + zdetnh4 + zdomaju 409 zdeta = zphydet + zzoodet - zdetzoo - zdetnh4 - zdetdom + 410 $ zboddet 411 zdoma = zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju 412 CC 413 #if defined key_trc_diabio 414 trbio(ji,jj,jk,1) = zno3phy 415 trbio(ji,jj,jk,2) = znh4phy 416 trbio(ji,jj,jk,3) = zphynh4 417 trbio(ji,jj,jk,4) = zphydom 418 trbio(ji,jj,jk,5) = zphyzoo 419 trbio(ji,jj,jk,6) = zphydet 420 trbio(ji,jj,jk,7) = zdetzoo 421 trbio(ji,jj,jk,9) = zzoodet 422 trbio(ji,jj,jk,10) = zzoobod 423 trbio(ji,jj,jk,11) = zzoonh4 424 trbio(ji,jj,jk,12) = zzoodom 425 trbio(ji,jj,jk,13) = znh4no3 426 trbio(ji,jj,jk,14) = zdomnh4 427 trbio(ji,jj,jk,15) = zdetnh4 428 #endif 429 #if defined key_trc_diaadd 430 trc2d(ji,jj,1)=trc2d(ji,jj,1)+zno3phy*ze3t(jk) 431 trc2d(ji,jj,2)=trc2d(ji,jj,2)+znh4phy*ze3t(jk) 432 trc2d(ji,jj,3)=trc2d(ji,jj,3)+zphydom*ze3t(jk) 433 trc2d(ji,jj,4)=trc2d(ji,jj,4)+zphynh4*ze3t(jk) 434 trc2d(ji,jj,5)=trc2d(ji,jj,5)+zphyzoo*ze3t(jk) 435 trc2d(ji,jj,6)=trc2d(ji,jj,6)+zphydet*ze3t(jk) 436 trc2d(ji,jj,7)=trc2d(ji,jj,7)+zdetzoo*ze3t(jk) 437 Cc trend number 8 is in trcsed.F 438 trc2d(ji,jj,9)=trc2d(ji,jj,9)+zzoodet*ze3t(jk) 439 trc2d(ji,jj,10)=trc2d(ji,jj,10)+zzoobod*ze3t(jk) 440 trc2d(ji,jj,11)=trc2d(ji,jj,11)+zzoonh4*ze3t(jk) 441 trc2d(ji,jj,12)=trc2d(ji,jj,12)+zzoodom*ze3t(jk) 442 trc2d(ji,jj,13)=trc2d(ji,jj,13)+znh4no3*ze3t(jk) 443 trc2d(ji,jj,14)=trc2d(ji,jj,14)+zdomnh4*ze3t(jk) 444 trc2d(ji,jj,15)=trc2d(ji,jj,15)+zdetnh4*ze3t(jk) 445 446 trc2d(ji,jj,16)=trc2d(ji,jj,16)+(zno3phy+znh4phy-zphynh4 447 $ -zphydom-zphyzoo-zphydet)*ze3t(jk) 448 trc2d(ji,jj,17)=trc2d(ji,jj,17)+(zphyzoo+zdetzoo-zzoodet 449 $ -zzoobod-zzoonh4-zzoodom) *ze3t(jk) 450 trc2d(ji,jj,18)=trc2d(ji,jj,18)+zdetdom*ze3t(jk) 451 452 trc3d(ji,jj,jk,1)= zno3phy *86400 453 trc3d(ji,jj,jk,2)= znh4phy *86400 454 trc3d(ji,jj,jk,3)= znh4no3 *86400 455 #endif 456 CC 457 CC tracer flux at totox-point added to the general trend 458 CC 459 tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta 460 tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa 461 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya 462 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a 463 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a 464 tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 465 CC 466 END DO 467 END DO 468 469 470 471 472 c$$$ DO jk = jpkb,jpk 473 c$$$C 474 c$$$C 2.1 Old way to compute the remineralisation : asklod AS Kremeur (before 2005-03) 475 c$$$C ------------------------------------------------------------------ 476 c$$$C 477 c$$$ DO ji=2,jpim1 478 c$$$ ztot(ji) = 0. 479 c$$$ END DO 480 c$$$ DO jn=1,jptra 481 c$$$ IF (ctrcnm(jn).NE.'NO3') THEN 482 c$$$ DO ji=2,jpim1 483 c$$$ ztra = remdmp(jk,jn) * trn(ji,jj,jk,jn) 484 c$$$ tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) - ztra 485 c$$$ ztot(ji) = ztot(ji) + ztra 486 c$$$ END DO 487 c$$$ ENDIF 488 c$$$ END DO 489 c$$$ DO jn=1,jptra 490 c$$$ IF (ctrcnm(jn).EQ.'NO3') THEN 491 c$$$ DO ji=2,jpim1 492 c$$$ tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztot(ji) 493 c$$$ END DO 494 c$$$#if defined key_trc_diabio 495 c$$$ trbio(ji,jj,jk,1)=ztot(ji) 496 c$$$#endif 497 c$$$ ENDIF 498 c$$$ END DO 499 c$$$ END DO 500 501 C 502 C 503 C END of slab 504 C =========== 505 C 506 1000 CONTINUE 507 508 #if defined key_trc_diaadd 509 510 C Lateral boundary conditions on trc2d 511 DO jn=1,jpdia2d 512 CALL lbc_lnk(trc2d(:,:,jn),'T',1. ) 513 END DO 514 515 C Lateral boundary conditions on trc3d 516 DO jn=1,jpdia3d 517 CALL lbc_lnk(trc3d(:,:,1,jn),'T',1. ) 518 END DO 519 520 #endif 521 522 #if defined key_trc_diabio 523 C Lateral boundary conditions on trcbio 524 DO jn=1,jpdiabio 525 CALL lbc_lnk(trbio(:,:,1,jn),'T',1. ) 526 END DO 527 #endif 528 53 529 # else 54 530 C … … 56 532 C 57 533 # endif 58 #endif 534 59 535 C 60 536 C -
trunk/NEMO/TOP_SRC/SMS/trcexp.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.txt 4 C --------------------------------------------------------------------------- 5 SUBROUTINE trcexp 6 #if defined key_passivetrc 7 #if defined key_trc_npzd || defined key_trc_lobster1 || defined key_trc_hamocc3 1 CCC $Header$ 2 SUBROUTINE trcexp(kt) 3 #if defined key_passivetrc && defined key_trc_lobster1 8 4 CCC--------------------------------------------------------------------- 9 5 CCC … … 38 34 CC additions : 01-05 (O. Aumont, E. Kestenare): 39 35 CC add sediment computations 36 CC : 05-06 (AS. Kremeur) new temporal integration for sedpoc 40 37 CC --------------------------------------------------------------------- 41 38 c ------ … … 47 44 USE sms 48 45 USE lbclnk 46 USE trc 47 USE trctrp_lec 49 48 50 49 IMPLICIT NONE … … 54 53 CC ================== 55 54 C 55 INTEGER kt 56 56 INTEGER ji, jj, jk, zkbot(jpi,jpj) 57 REAL zwork(jpi,jpj), zgeolpoc 57 REAL zwork(jpi,jpj), zgeolpoc, zfact 58 58 CC---------------------------------------------------------------------- 59 59 CC statement functions … … 73 73 DO jj = 2,jpjm1 74 74 DO ji = 2,jpim1 75 # if defined key_trc_p3zd76 trn(ji,jj,jk,jppoc) = trn(ji,jj,jk,jppoc)+77 & (1./fse3t(ji,jj,jk))*rdt*78 & dmin3(ji,jj,jk) *fbod(ji,jj)79 # elif defined key_trc_hamocc3 && ! defined key_trc_p3zd80 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc)+81 & (1./fse3t(ji,jj,jk))*82 & dmin3(ji,jj,jk) *fbod(ji,jj)83 # else84 75 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3)+ 85 76 & (1./fse3t(ji,jj,jk))* 86 77 & dmin3(ji,jj,jk) *fbod(ji,jj) 87 # endif88 78 ENDDO 89 79 ENDDO … … 101 91 DO ji = 2,jpim1 102 92 103 IF (tmask(ji,jj,jk).eq.1.and. 104 . tmask(ji,jj,jk+1).eq.0) THEN 105 C 93 IF ( tmask(ji,jj,jk) .eq. 1 .and. 94 . tmask(ji,jj,jk+1). eq. 0 ) THEN 106 95 zkbot(ji,jj) = jk 107 # if ! defined key_trc_hamocc3108 96 zwork(ji,jj) = vsed * trn(ji,jj,jk,jpdet) 109 # endif110 C111 97 ENDIF 112 98 … … 122 108 DO jj = 2,jpjm1 123 109 DO ji = 2,jpim1 124 125 # if defined key_trc_p3zd126 trn(ji,jj,zkbot(ji,jj),jppo4) =127 . trn(ji,jj,zkbot(ji,jj),jppo4) +128 . sedlam*sedpoc(ji,jj)*rdt/fse3t(ji,jj,zkbot(ji,jj))129 # elif defined key_trc_hamocc3 && ! defined key_trc_p3zd130 tra(ji,jj,zkbot(ji,jj),jppo4) =131 . tra(ji,jj,zkbot(ji,jj),jppo4) +132 . sedlam*sedpoc(ji,jj)/fse3t(ji,jj,zkbot(ji,jj))133 # else134 110 tra(ji,jj,zkbot(ji,jj),jpno3) = 135 111 . tra(ji,jj,zkbot(ji,jj),jpno3) + 136 . sedlam*sedpoc(ji,jj)/fse3t(ji,jj,zkbot(ji,jj)) 137 # endif 138 C 112 . sedlam*sedpocn(ji,jj)/fse3t(ji,jj,zkbot(ji,jj)) 113 139 114 C Deposition of organic matter in the sediment 140 115 C 141 zgeolpoc = zgeolpoc + sedlostpoc*sedpoc (ji,jj)*116 zgeolpoc = zgeolpoc + sedlostpoc*sedpocn(ji,jj)* 142 117 . e1t(ji,jj)*e2t(ji,jj) 143 118 144 sedpoc(ji,jj) = sedpoc(ji,jj) + 145 . zwork(ji,jj)*rdt + 119 sedpoca(ji,jj) = zwork(ji,jj)*rdt + 146 120 . dminl(ji,jj)*fbod(ji,jj)*rdt - 147 . sedlam*sedpoc (ji,jj)*rdt -148 . sedlostpoc*sedpoc (ji,jj)*rdt121 . sedlam*sedpocn(ji,jj)*rdt - 122 . sedlostpoc*sedpocn(ji,jj)*rdt 149 123 C 150 124 ENDDO … … 153 127 DO jj = 2,jpjm1 154 128 DO ji = 2,jpim1 155 156 # if defined key_trc_p3zd157 trn(ji,jj,1,jppo4) = trn(ji,jj,1,jppo4) + zgeolpoc*rdt*158 . cmask(ji,jj)/areacot/fse3t(ji,jj,1)159 # elif defined key_trc_hamocc3 && ! defined key_trc_p3zd160 tra(ji,jj,1,jppo4) = tra(ji,jj,1,jppo4) + zgeolpoc*161 . cmask(ji,jj)/areacot/fse3t(ji,jj,1)162 # else163 129 tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc* 164 130 . cmask(ji,jj)/areacot/fse3t(ji,jj,1) 165 # endif 166 167 ENDDO 131 ENDDO 168 132 ENDDO 169 133 170 CALL lbc_lnk( sedpoc , 'T', 1. )134 CALL lbc_lnk( sedpocn, 'T', 1. ) 171 135 172 136 C Oa & Ek: diagnostics depending on jpdia2d … … 175 139 do jj=1,jpj 176 140 do ji=1,jpi 177 trc2d(ji,jj,11)=sedpoc(ji,jj) 178 C trc2d(ji,jj,5) = fbod(ji,jj) 141 trc2d(ji,jj,19)=sedpocn(ji,jj) 179 142 end do 180 143 end do 181 144 # endif 182 145 183 # if defined key_trc_p3zd 184 CALL lbc_lnk( trn,'T',1) 185 # endif 186 C 187 #endif 146 c ! 1. Leap-frog scheme (only in explicit case, otherwise the 147 c ! ------------------- time stepping is already done in trczdf) 148 IF(l_trczdf_exp .AND. (ln_trcadv_cen2 .OR. ln_trcadv_tvd)) THEN 149 zfact = 2. * rdttra(jk) * FLOAT(ndttrc) 150 IF( neuler == 0 .AND. kt == nittrc000 ) 151 . zfact = rdttra(jk) * FLOAT(ndttrc) 152 sedpoca(:,:) = ( sedpocb(:,:) + zfact * sedpoca(:,:) ) 153 ENDIF 154 155 156 c ! 2. Time filter and swap of arrays 157 c ! --------------------------------- 158 IF ( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN 159 IF( neuler == 0 .AND. kt == nittrc000 ) THEN 160 DO jj = 1, jpj 161 DO ji = 1, jpi 162 sedpocb(ji,jj) = sedpocn(ji,jj) 163 sedpocn(ji,jj) = sedpoca(ji,jj) 164 sedpoca(ji,jj) = 0. 165 END DO 166 END DO 167 ELSE 168 DO jj = 1, jpj 169 DO ji = 1, jpi 170 sedpocb(ji,jj) = atfp*(sedpocb(ji,jj)+sedpoca(ji,jj)) 171 . + atfp1 * sedpocn(ji,jj) 172 sedpocn(ji,jj) = sedpoca(ji,jj) 173 sedpoca(ji,jj) = 0. 174 END DO 175 END DO 176 ENDIF 177 178 ELSE 179 c ! case of smolar scheme or muscl 180 DO jj = 1, jpj 181 DO ji = 1, jpi 182 sedpocb(ji,jj) = sedpoca(ji,jj) 183 sedpocn(ji,jj) = sedpoca(ji,jj) 184 sedpoca(ji,jj) = 0. 185 END DO 186 END DO 187 188 ENDIF 189 188 190 #endif 189 191 RETURN -
trunk/NEMO/TOP_SRC/SMS/trcopt.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.txt 4 C --------------------------------------------------------------------------- 1 CC $Header$ 5 2 CDIR$ LIST 6 3 SUBROUTINE trcopt(kt) … … 86 83 INTEGER kt 87 84 88 #if defined key_passivetrc 89 # if defined key_trc_lobster1 || defined key_trc_npzd 85 #if defined key_passivetrc && defined key_trc_lobster1 90 86 C 91 87 INTEGER ji,jj,jk,jn,in … … 210 206 1000 CONTINUE 211 207 C 212 # else213 C214 C No optical model215 C216 # endif217 208 #else 218 209 C -
trunk/NEMO/TOP_SRC/SMS/trcsed.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.txt 4 C --------------------------------------------------------------------------- 1 CC $Header$ 5 2 CDIR$ LIST 6 3 SUBROUTINE trcsed(kt) … … 85 82 INTEGER kt 86 83 87 #if defined key_passivetrc 88 89 # if defined key_trc_npzd || defined key_trc_lobster1 84 #if defined key_passivetrc && defined key_trc_lobster1 90 85 91 86 INTEGER ji,jj,jk … … 135 130 C with simplification : no e1*e2 136 131 C 137 DO jk = 2,jpk m1132 DO jk = 2,jpk 138 133 DO ji = 1,jpi 139 134 zwork(ji,jk) = -vsed * trn(ji,jj,jk - 1,jpdet) … … 171 166 #endif 172 167 C 173 # else 174 C 175 C no Sedimentation 176 C 177 # endif 168 178 169 #else 179 170 C
Note: See TracChangeset
for help on using the changeset viewer.
