Changeset 777
- Timestamp:
- 2007-12-19T19:40:57+01:00 (16 years ago)
- Location:
- branches/dev_001_GM/NEMO/TOP_SRC
- Files:
-
- 1 edited
- 4 moved
-
LOBSTER/trcbio.F90 (moved) (moved from branches/dev_001_GM/NEMO/TOP_SRC/LOBSTER/trcbio.F) (1 diff)
-
LOBSTER/trcexp.F90 (moved) (moved from branches/dev_001_GM/NEMO/TOP_SRC/LOBSTER/trcexp.F) (1 diff)
-
LOBSTER/trcopt.F90 (moved) (moved from branches/dev_001_GM/NEMO/TOP_SRC/LOBSTER/trcopt.F) (1 diff)
-
LOBSTER/trcsed.F90 (moved) (moved from branches/dev_001_GM/NEMO/TOP_SRC/LOBSTER/trcsed.F) (1 diff)
-
trcsms.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_001_GM/NEMO/TOP_SRC/LOBSTER/trcbio.F90
r774 r777 1 2 CCC $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/SMS/trcbio.F,v 1.9 2007/10/12 09:36:28 opalod Exp $ 3 CCC TOP 1.0 , LOCEAN-IPSL (2005) 4 C This software is governed by CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 5 C --------------------------------------------------------------------------- 6 SUBROUTINE trcbio(kt) 7 #if defined key_top && defined key_lobster 8 CCC--------------------------------------------------------------------- 9 CCC 10 CCC ROUTINE trcbio 11 CCC ******************* 12 CCC 13 CCC PURPOSE : 14 CCC --------- 15 CCC compute the now trend due to biogeochemical processes 16 CCC and add it to the general trend of passive tracers equations. 17 CCC 18 CCC Three options: 19 CCC Default option : no biological trend 20 CCC IF 'key_lobster' : LOBSTER1 bio-model 21 CCC 22 CC METHOD : 23 CC ------- 24 CC each now biological flux is calculated in FUNCTION of now 25 CC concentrations of tracers. 26 CC depending on the tracer, these fluxes are sources or sinks. 27 CC the total of the sources and sinks for each tracer 28 CC is added to the general trend. 29 CC 30 CC tra = tra + zf...tra - zftra... 31 CC | | 32 CC | | 33 CC source sink 34 CC 35 CC 36 CC IF 'key_trc_diabio' key is activated, the biogeochemical 37 CC trends for passive tracers are saved for futher diagnostics. 38 CC 39 CC multitasked on vertical slab (jj-loop) 40 CC 41 CC ----- 42 CC argument 43 CC ktask : task identificator 44 CC kt : time step 45 CC COMMON 46 CC /comcoo/ : orthogonal curvilinear coordinates 47 CC and scale factors 48 CC depths 49 CC /cottrp/ : present and next fields for passive 50 CC : tracers 51 CC /comtsk/ : multitasking 52 CC /comtke/ : emin, en() 53 CC /cotbio/ : biological parameters 54 CC 55 CC OUTPUT : 56 CC ------ 57 CC COMMON 58 CC /cottrp/ tra : general tracer trend increased by the 59 CC now horizontal tracer advection trend 60 CC /cottbd/ trbio : now horizontal tracer advection trend 61 CC (IF 'key_trc_diabio' is activated) 62 CC 63 CC WORKSPACE : 64 CC --------- 65 CC local 66 CC zdet,zzoo,zphy,znh4,zno3,zdom : now concentrations 67 CC zlt,zlno3,zlnh4,zle : limitation terms for phyto 68 CC zfno3phy and so on.. : fluxes between bio boxes 69 CC zphya,zzooa,zdeta, ... : after bio trends 70 CC zppz, zpdz, zpppz, zppdz, zfood : preferences terms 71 CC zfilpz, zfilpd : filtration terms 72 CC COMMON 73 CC 74 CC EXTERNAL : no 75 CC -------- 76 CC 77 CC REFERENCES : no 78 CC ---------- 79 CC 80 CC MODIFICATIONS: 81 CC -------------- 82 CC original : 99-07 (M. Levy) 83 CC 00-12 (E. Kestenare): assign a parameter 84 CC to name individual tracers 85 CC 01-03 (M. Levy) LNO3 + dia2d 86 CC---------------------------------------------------------------------- 87 CC---------------------------------------------------------------------- 88 USE oce_trc 89 USE trp_trc 90 USE sms 91 USE lbclnk 92 IMPLICIT NONE 93 CC local declarations 94 CC ================== 95 INTEGER kt 96 INTEGER ji,jj,jk,jn 97 REAL ztot(jpi) 98 #if defined key_trc_diaadd 99 REAL ze3t(jpi,jpj,jpk) 100 #endif 101 REAL zdet,zzoo,zphy,zno3,znh4,zdom,zlno3,zlnh4,zle,zlt 102 REAL zno3phy, znh4phy, zphynh4, zphydom, zphydet, zphyzoo, zdetzoo 103 $ ,zzoonh4, zzoodom, zzoodet, zdetnh4, zdetdom, znh4no3, zdomnh4 104 $ ,zppz,zpdz,zpppz,zppdz,zfood,zfilpz,zfildz,zphya,zzooa,zno3a 105 $ ,znh4a,zdeta,zdoma, ztra, zzoobod, zboddet, zdomaju 106 107 CC---------------------------------------------------------------------- 108 CC statement functions 109 CC =================== 110 CDIR$ NOLIST 111 #include "domzgr_substitute.h90" 112 CDIR$ LIST 113 CCC--------------------------------------------------------------------- 114 CCC OPA8, LODYC (07/99) 115 CCC--------------------------------------------------------------------- 116 C | --------------| 117 C | LOBSTER1 MODEL| 118 C | --------------| 119 120 #if defined key_trc_diaadd 121 C convert fluxes in per day 122 ze3t(:,:,:) = 0. 123 DO jk=1,jpkbm1 124 DO jj = 2, jpjm1 125 DO ji = 2, jpim1 126 ze3t(ji,jj,jk)=fse3t(ji,jj,jk)*86400. 127 END DO 128 END DO 129 END DO 130 #endif 131 C 132 C vertical slab 133 C ============= 134 C 135 DO 1000 jj = 2,jpjm1 136 C 137 C 1. biological level 138 C =================== 139 C 140 DO ji = 2,jpim1 141 fbod(ji,jj)=0. 142 #if defined key_trc_diaadd 143 DO jn=1,jpdia2d 144 trc2d(ji,jj,jn)=0. 145 END DO 146 #endif 147 END DO 148 149 DO jk=1,jpkbm1 150 DO ji = 2,jpim1 151 C 152 C 153 C 1.1 trophic variables( det, zoo, phy, no3, nh4, dom) 154 C --------------------------------------------------- 155 C 156 C negative trophic variables DO not contribute to the fluxes 157 C 158 zdet = max(0.,trn(ji,jj,jk,jpdet)) 159 zzoo = max(0.,trn(ji,jj,jk,jpzoo)) 160 zphy = max(0.,trn(ji,jj,jk,jpphy)) 161 zno3 = max(0.,trn(ji,jj,jk,jpno3)) 162 znh4 = max(0.,trn(ji,jj,jk,jpnh4)) 163 zdom = max(0.,trn(ji,jj,jk,jpdom)) 164 C 165 C 166 C 1.2 Limitations 167 C ---------------- 168 C 169 zlt = 1. 170 zle = 1. - exp( -xpar(ji,jj,jk)/aki/zlt) 171 C psinut,akno3,aknh4 added by asklod AS Kremeur 2005-03 172 zlno3 = zno3* exp(-psinut*znh4) / (akno3+zno3) 173 zlnh4 = znh4 / (znh4+aknh4) 174 175 C 176 C 177 C 1.3 sinks and sources 178 C --------------------- 179 C 180 C 181 C 1. phytoplankton production and exsudation 182 C 183 zno3phy = tmumax * zle * zlt * zlno3 * zphy 184 znh4phy = tmumax * zle * zlt * zlnh4 * zphy 185 186 C fphylab added by asklod AS Kremeur 2005-03 187 zphydom = rgamma * (1 - fphylab) * (zno3phy + znh4phy) 188 zphynh4 = rgamma * fphylab * (zno3phy + znh4phy) 189 190 C 191 C 2. zooplankton production 192 C 193 C preferences 194 C 195 zppz = rppz 196 zpdz = 1. - rppz 197 zpppz = ( zppz * zphy ) / 198 $ ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 ) 199 zppdz = ( zpdz * zdet ) / 200 $ ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 ) 201 zfood = zpppz * zphy + zppdz * zdet 202 C 203 C filtration 204 C 205 zfilpz = taus * zpppz / (aks + zfood) 206 zfildz = taus * zppdz / (aks + zfood) 207 C 208 C grazing 209 C 210 zphyzoo = zfilpz * zphy * zzoo 211 zdetzoo = zfildz * zdet * zzoo 212 C 213 C 3. fecal pellets production 214 C 215 zzoodet = rpnaz * zphyzoo + rdnaz * zdetzoo 216 C 217 C 4. zooplankton liquide excretion 218 C 219 zzoonh4 = tauzn * fzoolab * zzoo 220 zzoodom = tauzn * (1 - fzoolab) * zzoo 221 C 222 C 5. mortality 223 C 224 C phytoplankton mortality 225 C 226 zphydet = tmminp * zphy 227 C 228 C 229 C zooplankton mortality 230 c closure : flux fbod is redistributed below level jpkbio 231 C 232 zzoobod = tmminz * zzoo * zzoo 233 fbod(ji,jj) = fbod(ji,jj) 234 $ + (1-fdbod) * zzoobod * fse3t(ji,jj,jk) 235 zboddet = fdbod * zzoobod 236 C 237 C 238 C 6. detritus and dom breakdown 239 C 240 C 241 zdetnh4 = taudn * fdetlab * zdet 242 zdetdom = taudn * (1 - fdetlab) * zdet 243 244 zdomnh4 = taudomn * zdom 245 C 246 C flux added to express how the excess of nitrogen from 247 C PHY, ZOO and DET to DOM goes directly to NH4 (flux of ajustment) 248 zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 249 C 250 C 7. Nitrification 251 C 252 znh4no3 = taunn * znh4 253 C 254 C 255 C 256 C 1.4 determination of trends 257 C --------------------------- 258 C 259 C total trend for each biological tracer 260 C 261 zphya = zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo 262 $ - zphydet 263 zzooa = zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 264 $ - zzoobod 265 zno3a = - zno3phy + znh4no3 266 znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 267 $ + zdetnh4 + zdomaju 268 zdeta = zphydet + zzoodet - zdetzoo - zdetnh4 - zdetdom + 269 $ zboddet 270 zdoma = zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju 271 C 1 MODULE trcbio 2 !!====================================================================== 3 !! *** MODULE trcbio *** 4 !! TOP : LOBSTER 5 !!====================================================================== 6 !! History : - ! 1999-07 (M. Levy) Original code 7 !! - ! 2000-12 (E. Kestenare) assign a parameter to name individual tracers 8 !! - ! 2001-03 (M. Levy) LNO3 + dia2d 9 !! 2.0 ! 2007-12 (C. Deltel, G. Madec) F90 10 !!---------------------------------------------------------------------- 11 #if defined key_lobster 12 !!---------------------------------------------------------------------- 13 !! 'key_lobster' LOBSTER bio-model 14 !!---------------------------------------------------------------------- 15 !! trc_bio : 16 !!---------------------------------------------------------------------- 17 USE oce_trc ! 18 USE trp_trc ! 19 USE sms ! 20 USE lbclnk ! 21 22 IMPLICIT NONE 23 PRIVATE 24 25 PUBLIC trc_bio ! called in ??? 26 27 !!* Substitution 28 # include "domzgr_substitute.h90" 29 !!---------------------------------------------------------------------- 30 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 31 !! $Id:$ 32 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 33 !!---------------------------------------------------------------------- 34 35 CONTAINS 36 37 SUBROUTINE trc_bio( kt ) 38 !!--------------------------------------------------------------------- 39 !! *** ROUTINE trc_bio *** 40 !! 41 !! ** Purpose : compute the now trend due to biogeochemical processes 42 !! and add it to the general trend of passive tracers equations 43 !! 44 !! ** Method : each now biological flux is calculated in function of now 45 !! concentrations of tracers. 46 !! depending on the tracer, these fluxes are sources or sinks. 47 !! the total of the sources and sinks for each tracer 48 !! is added to the general trend. 49 !! 50 !! tra = tra + zf...tra - zftra... 51 !! | | 52 !! | | 53 !! source sink 54 !! 55 !! IF 'key_trc_diabio' defined , the biogeochemical trends 56 !! for passive tracers are saved for futher diagnostics. 57 !!--------------------------------------------------------------------- 58 INTEGER, INTENT( in ) :: kt ! ocean time-step index 59 !! 60 INTEGER :: ji, jj, jk 61 REAL(wp) :: zdet, zzoo, zphy, zno3, znh4, zdom ! now concentrations 62 REAL(wp) :: zlno3, zlnh4, zle, zlt ! limitation terms for phyto 63 REAL(wp) :: zno3phy, znh4phy, zphynh4, zphydom 64 REAL(wp) :: zphydet, zphyzoo, zdetzoo 65 REAL(wp) :: zzoonh4, zzoodom, zzoodet, zdetnh4, zdetdom 66 REAL(wp) :: znh4no3, zdomnh4, zppz, zpdz, zpppz, zppdz, zfood 67 REAL(wp) :: zfilpz, zfildz, zphya, zzooa, zno3a 68 REAL(wp) :: znh4a, zdeta, zdoma, zzoobod, zboddet, zdomaju 69 #if defined key_trc_diaadd 70 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t 71 #endif 72 !!--------------------------------------------------------------------- 73 74 IF( kt == nit000 ) THEN 75 IF(lwp) WRITE(numout,*) 76 IF(lwp) WRITE(numout,*) ' trc_bio: LOBSTER bio-model' 77 IF(lwp) WRITE(numout,*) ' ~~~~~~~' 78 ENDIF 79 80 #if defined key_trc_diaadd 81 ! convert fluxes in per day 82 ze3t(:,:,:) = 0.e0 83 DO jk = 1, jpkbm1 84 ze3t(:,:,jk) = fse3t(:,:,jk) * 86400. 85 END DO 86 #endif 87 88 fbod(:,:) = 0.e0 89 #if defined key_trc_diaadd 90 DO ji = 1, jpdia2d 91 trc2d(:,:,ji) = 0.e0 92 END DO 93 #endif 94 95 96 ! ! -------------------------- ! 97 DO jk = 1, jpkbm1 ! Upper ocean (bio-layers) ! 98 ! ! -------------------------- ! 99 DO jj = 2, jpjm1 100 DO ji = 2, jpim1 !!gm use of fs_2 fs_jpm1 required here 101 102 ! trophic variables( det, zoo, phy, no3, nh4, dom) 103 ! ------------------------------------------------ 104 105 ! negative trophic variables DO not contribute to the fluxes 106 zdet = MAX( 0.e0, trn(ji,jj,jk,jpdet) ) 107 zzoo = MAX( 0.e0, trn(ji,jj,jk,jpzoo) ) 108 zphy = MAX( 0.e0, trn(ji,jj,jk,jpphy) ) 109 zno3 = MAX( 0.e0, trn(ji,jj,jk,jpno3) ) 110 znh4 = MAX( 0.e0, trn(ji,jj,jk,jpnh4) ) 111 zdom = MAX( 0.e0, trn(ji,jj,jk,jpdom) ) 112 113 ! Limitations 114 zlt = 1. 115 zle = 1. - EXP( -xpar(ji,jj,jk) / aki / zlt ) 116 ! psinut,akno3,aknh4 added by asklod AS Kremeur 2005-03 117 zlno3 = zno3 * EXP( -psinut * znh4 ) / ( akno3 + zno3 ) 118 zlnh4 = znh4 / (znh4+aknh4) 119 120 121 ! sinks and sources 122 ! phytoplankton production and exsudation 123 zno3phy = tmumax * zle * zlt * zlno3 * zphy 124 znh4phy = tmumax * zle * zlt * zlnh4 * zphy 125 126 ! fphylab added by asklod AS Kremeur 2005-03 127 zphydom = rgamma * (1 - fphylab) * (zno3phy + znh4phy) 128 zphynh4 = rgamma * fphylab * (zno3phy + znh4phy) 129 130 ! zooplankton production 131 ! preferences 132 zppz = rppz 133 zpdz = 1. - rppz 134 zpppz = ( zppz * zphy ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 ) 135 zppdz = ( zpdz * zdet ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 ) 136 zfood = zpppz * zphy + zppdz * zdet 137 ! filtration 138 zfilpz = taus * zpppz / (aks + zfood) 139 zfildz = taus * zppdz / (aks + zfood) 140 ! grazing 141 zphyzoo = zfilpz * zphy * zzoo 142 zdetzoo = zfildz * zdet * zzoo 143 144 ! fecal pellets production 145 zzoodet = rpnaz * zphyzoo + rdnaz * zdetzoo 146 147 ! zooplankton liquide excretion 148 zzoonh4 = tauzn * fzoolab * zzoo 149 zzoodom = tauzn * (1 - fzoolab) * zzoo 150 151 ! mortality 152 ! phytoplankton mortality 153 zphydet = tmminp * zphy 154 155 ! zooplankton mortality 156 ! closure : flux fbod is redistributed below level jpkbio 157 zzoobod = tmminz * zzoo * zzoo 158 fbod(ji,jj) = fbod(ji,jj) + (1-fdbod) * zzoobod * fse3t(ji,jj,jk) 159 zboddet = fdbod * zzoobod 160 161 ! detritus and dom breakdown 162 zdetnh4 = taudn * fdetlab * zdet 163 zdetdom = taudn * (1 - fdetlab) * zdet 164 165 zdomnh4 = taudomn * zdom 166 167 ! flux added to express how the excess of nitrogen from 168 ! PHY, ZOO and DET to DOM goes directly to NH4 (flux of ajustment) 169 zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 170 171 ! Nitrification 172 znh4no3 = taunn * znh4 173 174 ! determination of trends 175 ! total trend for each biological tracer 176 zphya = zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet 177 zzooa = zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod 178 zno3a = - zno3phy + znh4no3 179 znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju 180 zdeta = zphydet + zzoodet - zdetzoo - zdetnh4 - zdetdom + zboddet 181 zdoma = zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju 182 272 183 #if defined key_trc_diabio 273 trbio(ji,jj,jk,1) = zno3phy274 trbio(ji,jj,jk,2) = znh4phy275 trbio(ji,jj,jk,3) = zphynh4276 trbio(ji,jj,jk,4) = zphydom277 trbio(ji,jj,jk,5) = zphyzoo278 trbio(ji,jj,jk,6) = zphydet279 trbio(ji,jj,jk,7) = zdetzoo280 trbio(ji,jj,jk,9) = zzoodet281 trbio(ji,jj,jk,10) = zzoobod282 trbio(ji,jj,jk,11) = zzoonh4283 trbio(ji,jj,jk,12) = zzoodom284 trbio(ji,jj,jk,13) = znh4no3285 trbio(ji,jj,jk,14) = zdomnh4286 trbio(ji,jj,jk,15) = zdetnh4287 #endif 288 #if defined key_trc_diaadd 289 trc2d(ji,jj,1)=trc2d(ji,jj,1)+zno3phy*ze3t(ji,jj,jk)290 trc2d(ji,jj,2)=trc2d(ji,jj,2)+znh4phy*ze3t(ji,jj,jk)291 trc2d(ji,jj,3)=trc2d(ji,jj,3)+zphydom*ze3t(ji,jj,jk)292 trc2d(ji,jj,4)=trc2d(ji,jj,4)+zphynh4*ze3t(ji,jj,jk)293 trc2d(ji,jj,5)=trc2d(ji,jj,5)+zphyzoo*ze3t(ji,jj,jk)294 trc2d(ji,jj,6)=trc2d(ji,jj,6)+zphydet*ze3t(ji,jj,jk)295 trc2d(ji,jj,7)=trc2d(ji,jj,7)+zdetzoo*ze3t(ji,jj,jk)296 ctrend number 8 is in trcsed.F297 trc2d(ji,jj,9)=trc2d(ji,jj,9)+zzoodet*ze3t(ji,jj,jk)298 trc2d(ji,jj,10)=trc2d(ji,jj,10)+zzoobod*ze3t(ji,jj,jk)299 trc2d(ji,jj,11)=trc2d(ji,jj,11)+zzoonh4*ze3t(ji,jj,jk)300 trc2d(ji,jj,12)=trc2d(ji,jj,12)+zzoodom*ze3t(ji,jj,jk)301 trc2d(ji,jj,13)=trc2d(ji,jj,13)+znh4no3*ze3t(ji,jj,jk)302 trc2d(ji,jj,14)=trc2d(ji,jj,14)+zdomnh4*ze3t(ji,jj,jk)303 trc2d(ji,jj,15)=trc2d(ji,jj,15)+zdetnh4*ze3t(ji,jj,jk)184 trbio(ji,jj,jk, 1) = zno3phy 185 trbio(ji,jj,jk, 2) = znh4phy 186 trbio(ji,jj,jk, 3) = zphynh4 187 trbio(ji,jj,jk, 4) = zphydom 188 trbio(ji,jj,jk, 5) = zphyzoo 189 trbio(ji,jj,jk, 6) = zphydet 190 trbio(ji,jj,jk, 7) = zdetzoo 191 trbio(ji,jj,jk, 9) = zzoodet 192 trbio(ji,jj,jk,10) = zzoobod 193 trbio(ji,jj,jk,11) = zzoonh4 194 trbio(ji,jj,jk,12) = zzoodom 195 trbio(ji,jj,jk,13) = znh4no3 196 trbio(ji,jj,jk,14) = zdomnh4 197 trbio(ji,jj,jk,15) = zdetnh4 198 #endif 199 #if defined key_trc_diaadd 200 trc2d(ji,jj, 1) = trc2d(ji,jj, 1) + zno3phy * ze3t(ji,jj,jk) 201 trc2d(ji,jj, 2) = trc2d(ji,jj, 2) + znh4phy * ze3t(ji,jj,jk) 202 trc2d(ji,jj, 3) = trc2d(ji,jj, 3) + zphydom * ze3t(ji,jj,jk) 203 trc2d(ji,jj, 4) = trc2d(ji,jj, 4) + zphynh4 * ze3t(ji,jj,jk) 204 trc2d(ji,jj, 5) = trc2d(ji,jj, 5) + zphyzoo * ze3t(ji,jj,jk) 205 trc2d(ji,jj, 6) = trc2d(ji,jj, 6) + zphydet * ze3t(ji,jj,jk) 206 trc2d(ji,jj, 7) = trc2d(ji,jj, 7) + zdetzoo * ze3t(ji,jj,jk) 207 ! trend number 8 is in trcsed.F 208 trc2d(ji,jj, 9) = trc2d(ji,jj, 9) + zzoodet * ze3t(ji,jj,jk) 209 trc2d(ji,jj,10) = trc2d(ji,jj,10) + zzoobod * ze3t(ji,jj,jk) 210 trc2d(ji,jj,11) = trc2d(ji,jj,11) + zzoonh4 * ze3t(ji,jj,jk) 211 trc2d(ji,jj,12) = trc2d(ji,jj,12) + zzoodom * ze3t(ji,jj,jk) 212 trc2d(ji,jj,13) = trc2d(ji,jj,13) + znh4no3 * ze3t(ji,jj,jk) 213 trc2d(ji,jj,14) = trc2d(ji,jj,14) + zdomnh4 * ze3t(ji,jj,jk) 214 trc2d(ji,jj,15) = trc2d(ji,jj,15) + zdetnh4 * ze3t(ji,jj,jk) 304 215 305 trc2d(ji,jj,16)=trc2d(ji,jj,16)+(zno3phy+znh4phy-zphynh4 306 $ -zphydom-zphyzoo-zphydet)*ze3t(ji,jj,jk) 307 trc2d(ji,jj,17)=trc2d(ji,jj,17)+(zphyzoo+zdetzoo-zzoodet 308 $ -zzoobod-zzoonh4-zzoodom) *ze3t(ji,jj,jk) 309 trc2d(ji,jj,18)=trc2d(ji,jj,18)+zdetdom*ze3t(ji,jj,jk) 310 c trend number 19 is in trcexp.F 311 trc3d(ji,jj,jk,1)= zno3phy *86400 312 trc3d(ji,jj,jk,2)= znh4phy *86400 313 trc3d(ji,jj,jk,3)= znh4no3 *86400 314 #endif 315 C 316 C tracer flux at totox-point added to the general trend 317 C 318 tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta 319 tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa 320 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya 321 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a 322 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a 323 tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 324 C 325 END DO 326 END DO 327 C 328 C 2. under biological level 329 C ========================= 330 C 331 DO jk = jpkb,jpk 332 C 333 C 2.1 compute the remineralisation of all quantities towards nitrate 334 C ------------------------------------------------------------------ 335 C 336 DO ji = 2,jpim1 337 C 338 C 2.1.1 trophic variables( det, zoo, phy, no3, nh4, dom) 339 C ----------------------------------------------------- 340 C 341 C negative trophic variables DO not contribute to the fluxes 342 C 343 zdet = max(0.,trn(ji,jj,jk,jpdet)) 344 zzoo = max(0.,trn(ji,jj,jk,jpzoo)) 345 zphy = max(0.,trn(ji,jj,jk,jpphy)) 346 zno3 = max(0.,trn(ji,jj,jk,jpno3)) 347 znh4 = max(0.,trn(ji,jj,jk,jpnh4)) 348 zdom = max(0.,trn(ji,jj,jk,jpdom)) 349 CC 350 CC 2.1.2 Limitations 351 CC ---------------- 352 CC 353 zlt = 0. 354 zle = 0. 355 zlno3 = 0. 356 zlnh4 = 0. 357 CC 358 CC 359 CC 2.1.3 sinks and sources 360 CC --------------------- 361 CC 362 CC 363 CC 1. phytoplankton production and exsudation 364 CC 365 zno3phy = 0. 366 znh4phy = 0. 367 C 368 zphydom = 0. 369 zphynh4 = 0. 370 CC 371 CC 2. zooplankton production 372 CC 373 CC grazing 374 CC 375 zphyzoo = 0. 376 zdetzoo = 0. 377 CC 378 CC 3. fecal pellets production 379 CC 380 zzoodet = 0. 381 CC 382 CC 4. zooplankton liquide excretion 383 CC 384 zzoonh4 = tauzn * fzoolab * zzoo 385 zzoodom = tauzn * (1 - fzoolab) * zzoo 386 CC 387 CC 5. mortality 388 CC 389 CC phytoplankton mortality 390 CC 391 zphydet = tmminp * zphy 392 CC 393 CC 394 CC zooplankton mortality 395 Cc closure : flux fbod is redistributed below level jpkbio 396 CC 397 zzoobod = 0. 398 zboddet = 0. 399 CC 400 CC 401 CC 6. detritus and dom breakdown 402 CC 403 zdetnh4 = taudn * fdetlab * zdet 404 zdetdom = taudn * (1 - fdetlab) * zdet 405 C 406 zdomnh4 = taudomn * zdom 407 zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 408 CC 409 CC 7. Nitrification 410 CC 411 znh4no3 = taunn * znh4 412 CC 413 CC 414 CC 2.1.4 determination of trends 415 CC --------------------------- 416 CC 417 CC total trend for each biological tracer 418 CC 419 zphya = zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo 420 $ - zphydet 421 zzooa = zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 422 $ - zzoobod 423 zno3a = - zno3phy + znh4no3 424 znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 425 $ + zdetnh4 + zdomaju 426 zdeta = zphydet + zzoodet - zdetzoo - zdetnh4 - zdetdom + 427 $ zboddet 428 zdoma = zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju 429 CC 216 trc2d(ji,jj,16) = trc2d(ji,jj,16) + ( zno3phy + znh4phy - zphynh4 & 217 & - zphydom - zphyzoo - zphydet ) * ze3t(ji,jj,jk) 218 trc2d(ji,jj,17) = trc2d(ji,jj,17) + ( zphyzoo + zdetzoo - zzoodet & 219 & - zzoobod - zzoonh4 - zzoodom ) * ze3t(ji,jj,jk) 220 trc2d(ji,jj,18) = trc2d(ji,jj,18) + zdetdom * ze3t(ji,jj,jk) 221 ! trend number 19 is in trcexp.F 222 trc3d(ji,jj,jk,1) = zno3phy * 86400 223 trc3d(ji,jj,jk,2) = znh4phy * 86400 224 trc3d(ji,jj,jk,3) = znh4no3 * 86400 225 #endif 226 227 ! tracer flux at totox-point added to the general trend 228 tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta 229 tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa 230 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya 231 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a 232 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a 233 tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 234 235 END DO 236 END DO 237 END DO 238 239 !!gm do loop until jpkm1 only! 240 ! ! -------------------------- ! 241 DO jk = jpkb, jpk ! Upper ocean (bio-layers) ! 242 ! ! -------------------------- ! 243 244 DO jj = 2, jpjm1 245 DO ji = 2,jpim1 !!gm use of fs_2 & fs_jpim1 required 246 247 ! remineralisation of all quantities towards nitrate 248 249 ! trophic variables( det, zoo, phy, no3, nh4, dom) 250 ! negative trophic variables DO not contribute to the fluxes 251 zdet = MAX( 0.e0, trn(ji,jj,jk,jpdet) ) 252 zzoo = MAX( 0.e0, trn(ji,jj,jk,jpzoo) ) 253 zphy = MAX( 0.e0, trn(ji,jj,jk,jpphy) ) 254 zno3 = MAX( 0.e0, trn(ji,jj,jk,jpno3) ) 255 znh4 = MAX( 0.e0, trn(ji,jj,jk,jpnh4) ) 256 zdom = MAX( 0.e0, trn(ji,jj,jk,jpdom) ) 257 258 ! Limitations 259 zlt = 0.e0 260 zle = 0.e0 261 zlno3 = 0.e0 262 zlnh4 = 0.e0 263 264 ! sinks and sources 265 ! phytoplankton production and exsudation 266 zno3phy = 0.e0 267 znh4phy = 0.e0 268 zphydom = 0.e0 269 zphynh4 = 0.e0 270 271 ! zooplankton production 272 zphyzoo = 0.e0 ! grazing 273 zdetzoo = 0.e0 274 275 zzoodet = 0.e0 ! fecal pellets production 276 277 zzoonh4 = tauzn * fzoolab * zzoo ! zooplankton liquide excretion 278 zzoodom = tauzn * (1 - fzoolab) * zzoo 279 280 ! mortality 281 zphydet = tmminp * zphy ! phytoplankton mortality 282 283 zzoobod = 0.e0 ! zooplankton mortality 284 zboddet = 0.e0 ! closure : flux fbod is redistributed below level jpkbio 285 286 ! detritus and dom breakdown 287 zdetnh4 = taudn * fdetlab * zdet 288 zdetdom = taudn * (1 - fdetlab) * zdet 289 290 zdomnh4 = taudomn * zdom 291 zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 292 293 ! Nitrification 294 znh4no3 = taunn * znh4 295 296 297 ! determination of trends 298 ! total trend for each biological tracer 299 zphya = zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet 300 zzooa = zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod 301 zno3a = - zno3phy + znh4no3 302 znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju 303 zdeta = zphydet + zzoodet - zdetzoo - zdetnh4 - zdetdom + zboddet 304 zdoma = zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju 305 430 306 #if defined key_trc_diabio 431 trbio(ji,jj,jk,1) = zno3phy432 trbio(ji,jj,jk,2) = znh4phy433 trbio(ji,jj,jk,3) = zphynh4434 trbio(ji,jj,jk,4) = zphydom435 trbio(ji,jj,jk,5) = zphyzoo436 trbio(ji,jj,jk,6) = zphydet437 trbio(ji,jj,jk,7) = zdetzoo438 trbio(ji,jj,jk,9) = zzoodet439 trbio(ji,jj,jk,10) = zzoobod440 trbio(ji,jj,jk,11) = zzoonh4441 trbio(ji,jj,jk,12) = zzoodom442 trbio(ji,jj,jk,13) = znh4no3443 trbio(ji,jj,jk,14) = zdomnh4444 trbio(ji,jj,jk,15) = zdetnh4445 #endif 446 #if defined key_trc_diaadd 447 trc2d(ji,jj,1)=trc2d(ji,jj,1)+zno3phy*ze3t(ji,jj,jk)448 trc2d(ji,jj,2)=trc2d(ji,jj,2)+znh4phy*ze3t(ji,jj,jk)449 trc2d(ji,jj,3)=trc2d(ji,jj,3)+zphydom*ze3t(ji,jj,jk)450 trc2d(ji,jj,4)=trc2d(ji,jj,4)+zphynh4*ze3t(ji,jj,jk)451 trc2d(ji,jj,5)=trc2d(ji,jj,5)+zphyzoo*ze3t(ji,jj,jk)452 trc2d(ji,jj,6)=trc2d(ji,jj,6)+zphydet*ze3t(ji,jj,jk)453 trc2d(ji,jj,7)=trc2d(ji,jj,7)+zdetzoo*ze3t(ji,jj,jk)454 Cctrend number 8 is in trcsed.F455 trc2d(ji,jj,9)=trc2d(ji,jj,9)+zzoodet*ze3t(ji,jj,jk)456 trc2d(ji,jj,10)=trc2d(ji,jj,10)+zzoobod*ze3t(ji,jj,jk)457 trc2d(ji,jj,11)=trc2d(ji,jj,11)+zzoonh4*ze3t(ji,jj,jk)458 trc2d(ji,jj,12)=trc2d(ji,jj,12)+zzoodom*ze3t(ji,jj,jk)459 trc2d(ji,jj,13)=trc2d(ji,jj,13)+znh4no3*ze3t(ji,jj,jk)460 trc2d(ji,jj,14)=trc2d(ji,jj,14)+zdomnh4*ze3t(ji,jj,jk)461 trc2d(ji,jj,15)=trc2d(ji,jj,15)+zdetnh4*ze3t(ji,jj,jk)307 trbio(ji,jj,jk, 1) = zno3phy 308 trbio(ji,jj,jk, 2) = znh4phy 309 trbio(ji,jj,jk, 3) = zphynh4 310 trbio(ji,jj,jk, 4) = zphydom 311 trbio(ji,jj,jk, 5) = zphyzoo 312 trbio(ji,jj,jk, 6) = zphydet 313 trbio(ji,jj,jk, 7) = zdetzoo 314 trbio(ji,jj,jk, 9) = zzoodet 315 trbio(ji,jj,jk,10) = zzoobod 316 trbio(ji,jj,jk,11) = zzoonh4 317 trbio(ji,jj,jk,12) = zzoodom 318 trbio(ji,jj,jk,13) = znh4no3 319 trbio(ji,jj,jk,14) = zdomnh4 320 trbio(ji,jj,jk,15) = zdetnh4 321 #endif 322 #if defined key_trc_diaadd 323 trc2d(ji,jj, 1) = trc2d(ji,jj, 1) + zno3phy * ze3t(ji,jj,jk) 324 trc2d(ji,jj, 2) = trc2d(ji,jj, 2) + znh4phy * ze3t(ji,jj,jk) 325 trc2d(ji,jj, 3) = trc2d(ji,jj, 3) + zphydom * ze3t(ji,jj,jk) 326 trc2d(ji,jj, 4) = trc2d(ji,jj, 4) + zphynh4 * ze3t(ji,jj,jk) 327 trc2d(ji,jj, 5) = trc2d(ji,jj, 5) + zphyzoo * ze3t(ji,jj,jk) 328 trc2d(ji,jj, 6) = trc2d(ji,jj, 6) + zphydet * ze3t(ji,jj,jk) 329 trc2d(ji,jj, 7) = trc2d(ji,jj, 7) + zdetzoo * ze3t(ji,jj,jk) 330 ! trend number 8 is in trcsed.F 331 trc2d(ji,jj, 9) = trc2d(ji,jj, 9) + zzoodet * ze3t(ji,jj,jk) 332 trc2d(ji,jj,10) = trc2d(ji,jj,10) + zzoobod * ze3t(ji,jj,jk) 333 trc2d(ji,jj,11) = trc2d(ji,jj,11) + zzoonh4 * ze3t(ji,jj,jk) 334 trc2d(ji,jj,12) = trc2d(ji,jj,12) + zzoodom * ze3t(ji,jj,jk) 335 trc2d(ji,jj,13) = trc2d(ji,jj,13) + znh4no3 * ze3t(ji,jj,jk) 336 trc2d(ji,jj,14) = trc2d(ji,jj,14) + zdomnh4 * ze3t(ji,jj,jk) 337 trc2d(ji,jj,15) = trc2d(ji,jj,15) + zdetnh4 * ze3t(ji,jj,jk) 462 338 463 trc2d(ji,jj,16)=trc2d(ji,jj,16)+(zno3phy+znh4phy-zphynh4 464 $ -zphydom-zphyzoo-zphydet)*ze3t(ji,jj,jk) 465 trc2d(ji,jj,17)=trc2d(ji,jj,17)+(zphyzoo+zdetzoo-zzoodet 466 $ -zzoobod-zzoonh4-zzoodom) *ze3t(ji,jj,jk) 467 trc2d(ji,jj,18)=trc2d(ji,jj,18)+zdetdom*ze3t(ji,jj,jk) 468 469 trc3d(ji,jj,jk,1)= zno3phy *86400 470 trc3d(ji,jj,jk,2)= znh4phy *86400 471 trc3d(ji,jj,jk,3)= znh4no3 *86400 472 #endif 473 CC 474 CC tracer flux at totox-point added to the general trend 475 CC 476 tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta 477 tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa 478 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya 479 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a 480 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a 481 tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 482 CC 483 END DO 484 END DO 485 486 487 488 489 c$$$ DO jk = jpkb,jpk 490 c$$$C 491 c$$$C 2.1 Old way to compute the remineralisation : asklod AS Kremeur (before 2005-03) 492 c$$$C ------------------------------------------------------------------ 493 c$$$C 494 c$$$ DO ji=2,jpim1 495 c$$$ ztot(ji) = 0. 496 c$$$ END DO 497 c$$$ DO jn=1,jptra 498 c$$$ IF (ctrcnm(jn).NE.'NO3') THEN 499 c$$$ DO ji=2,jpim1 500 c$$$ ztra = remdmp(jk,jn) * trn(ji,jj,jk,jn) 501 c$$$ tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) - ztra 502 c$$$ ztot(ji) = ztot(ji) + ztra 503 c$$$ END DO 504 c$$$ ENDIF 505 c$$$ END DO 506 c$$$ DO jn=1,jptra 507 c$$$ IF (ctrcnm(jn).EQ.'NO3') THEN 508 c$$$ DO ji=2,jpim1 509 c$$$ tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztot(ji) 510 c$$$ END DO 511 c$$$#if defined key_trc_diabio 512 c$$$ trbio(ji,jj,jk,1)=ztot(ji) 513 c$$$#endif 514 c$$$ ENDIF 515 c$$$ END DO 516 c$$$ END DO 517 518 C 519 C 520 C END of slab 521 C =========== 522 C 523 1000 CONTINUE 524 525 #if defined key_trc_diaadd 526 527 C Lateral boundary conditions on trc2d 528 DO jn=1,jpdia2d 529 CALL lbc_lnk(trc2d(:,:,jn),'T',1. ) 530 END DO 531 532 C Lateral boundary conditions on trc3d 533 DO jn=1,jpdia3d 534 CALL lbc_lnk(trc3d(:,:,1,jn),'T',1. ) 535 END DO 536 339 trc2d(ji,jj,16) = trc2d(ji,jj,16) + ( zno3phy + znh4phy - zphynh4 & 340 & - zphydom - zphyzoo - zphydet ) * ze3t(ji,jj,jk) 341 trc2d(ji,jj,17) = trc2d(ji,jj,17) + ( zphyzoo + zdetzoo - zzoodet & 342 & - zzoobod - zzoonh4 - zzoodom ) * ze3t(ji,jj,jk) 343 trc2d(ji,jj,18) = trc2d(ji,jj,18) + zdetdom * ze3t(ji,jj,jk) 344 345 trc3d(ji,jj,jk,1) = zno3phy * 86400 346 trc3d(ji,jj,jk,2) = znh4phy * 86400 347 trc3d(ji,jj,jk,3) = znh4no3 * 86400 348 #endif 349 350 ! tracer flux at totox-point added to the general trend 351 tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta 352 tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa 353 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya 354 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a 355 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a 356 tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 357 ! 358 END DO 359 END DO 360 END DO 361 362 #if defined key_trc_diaadd 363 ! Lateral boundary conditions on trc2d and trc3d 364 DO ji = 1, jpdia2d 365 CALL lbc_lnk( trc2d(:,:,ji),'T', 1. ) 366 END DO 367 DO ji = 1, jpdia3d 368 CALL lbc_lnk( trc3d(:,:,1,ji),'T', 1. ) 369 END DO 537 370 #endif 538 371 539 372 #if defined key_trc_diabio 540 C Lateral boundary conditions on trcbio 541 DO jn=1,jpdiabio 542 CALL lbc_lnk(trbio(:,:,1,jn),'T',1. ) 543 END DO 544 #endif 545 546 # else 547 C 548 C no biological model 549 C 550 # endif 551 552 C 553 C 554 RETURN 555 END 373 ! Lateral boundary conditions on trcbio 374 DO ji = 1, jpdiabio 375 CALL lbc_lnk( trbio(:,:,1,ji),'T', 1. ) 376 END DO 377 #endif 378 ! 379 END SUBROUTINE trc_bio 380 381 #else 382 !!====================================================================== 383 !! Dummy module : No PISCES bio-model 384 !!====================================================================== 385 CONTAINS 386 SUBROUTINE trc_bio( kt ) ! Empty routine 387 INTEGER, INTENT( in ) :: kt 388 WRITE(*,*) 'trc_bio: You should not have seen this print! error?', kt 389 END SUBROUTINE trc_bio 390 #endif 391 392 !!====================================================================== 393 END MODULE trcbio -
branches/dev_001_GM/NEMO/TOP_SRC/LOBSTER/trcexp.F90
r774 r777 1 CCC $Header$ 2 SUBROUTINE trcexp(kt) 3 #if defined key_top && defined key_lobster 4 CCC--------------------------------------------------------------------- 5 CCC 6 CCC ROUTINE trcexp 7 CCC ****************** 8 CCC 9 CC 10 CC PURPOSE. 11 CC -------- 12 CC *TRCEXP* MODELS EXPORT OF BIOGENIC MATTER (POC ''SOFT 13 CC TISSUE'') AND ITS DISTRIBUTION IN WATER COLUMN 14 CC 15 CC METHOD. 16 CC ------- 17 CC IN THE SURFACE LAYER POC IS PRODUCED ACCORDING TO 18 CC NURTRIENTS AVAILABLE AND GROWTH CONDITIONS. NUTRIENT UPTAKE 19 CC KINETICS FOLLOW MICHAELIS-MENTON FORMULATION. 20 CC THE TOTAL PARTICLE AMOUNT PRODUCED, IS DISTRIBUTED IN THE WATER 21 CC COLUMN BELOW THE SURFACE LAYER. 22 CC 23 CC EXTERNALS. 24 CC ---------- 25 CC NONE. 26 CC 27 CC REFERENCE. 28 CC ---------- 29 CC 30 CC MODIFICATIONS: 31 CC -------------- 32 CC original : 1999 O. Aumont 33 CC modifications : 1999 C. Le Quere 34 CC additions : 01-05 (O. Aumont, E. Kestenare): 35 CC add sediment computations 36 CC : 05-06 (AS. Kremeur) new temporal integration for sedpoc 37 CC --------------------------------------------------------------------- 38 c ------ 39 CC parameters and commons 40 CC ====================== 41 CDIR$ NOLIST 42 USE oce_trc 43 USE trp_trc 44 USE sms 45 USE lbclnk 46 USE trc 47 USE trctrp_lec 1 MODULE trcexp 2 !!====================================================================== 3 !! *** MODULE p4sed *** 4 !! TOP : PISCES Compute loss of organic matter in the sediments 5 !!====================================================================== 6 !! History : - ! 1999 (O. Aumont, C. Le Quere) original code 7 !! - ! 2001-05 (O. Aumont, E. Kestenare) add sediment computations 8 !! 1.0 ! 2005-06 (A.-S. Kremeur) new temporal integration for sedpoc 9 !! 2.0 ! 2007-12 (C. Deltel, G. Madec) F90 10 !!---------------------------------------------------------------------- 11 #if defined key_lobster 12 !!---------------------------------------------------------------------- 13 !! 'key_lobster' LOBSTER bio-model 14 !!---------------------------------------------------------------------- 15 !! trc_exp : Compute loss of organic matter in the sediments 16 !!---------------------------------------------------------------------- 17 USE oce_trc ! 18 USE trp_trc 19 USE sms 20 USE lbclnk 21 USE trc 22 USE trctrp_lec 48 23 49 IMPLICIT NONE 50 CDIR$ LIST 51 CC---------------------------------------------------------------------- 52 CC local declarations 53 CC ================== 54 C 55 INTEGER kt 56 INTEGER ji, jj, jk, zkbot(jpi,jpj) 57 REAL zwork(jpi,jpj), zgeolpoc, zfact 58 CC---------------------------------------------------------------------- 59 CC statement functions 60 CC =================== 61 CDIR$ NOLIST 62 #include "domzgr_substitute.h90" 63 CDIR$ LIST 64 C 65 C VERTICAL DISTRIBUTION OF NEWLY PRODUCED BIOGENIC 66 C POC IN THE WATER COLUMN 67 C (PARTS OF NEWLY FORMED MATTER REMAINING IN THE DIFFERENT 68 C LAYERS IS DETERMINED BY DMIN3 DEFINED IN common.passivetrc.*.h 69 C ---------------------------------------------------------------------- 70 C 71 C 72 DO jk = 1,jpkm1 73 DO jj = 2,jpjm1 74 DO ji = 2,jpim1 75 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3)+ 76 & (1./fse3t(ji,jj,jk))* 77 & dmin3(ji,jj,jk) *fbod(ji,jj) 78 ENDDO 79 ENDDO 80 ENDDO 81 C 82 C Find the last level of the water column 83 C Compute fluxes due to sinking particles (slow) 84 C 85 zkbot = jpk 86 zwork = 0. 87 C 88 C 89 DO jk = 1,jpkm1 90 DO jj = 2,jpjm1 91 DO ji = 2,jpim1 24 IMPLICIT NONE 25 PRIVATE 26 27 PUBLIC trc_exp ! called in p4zprg.F90 28 29 !!* Substitution 30 # include "domzgr_substitute.h90" 31 !!---------------------------------------------------------------------- 32 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 33 !! $Id:$ 34 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 35 !!---------------------------------------------------------------------- 36 37 CONTAINS 38 39 SUBROUTINE trc_exp( kt ) 40 !!--------------------------------------------------------------------- 41 !! *** ROUTINE trc_exp *** 42 !! 43 !! ** Purpose : MODELS EXPORT OF BIOGENIC MATTER (POC ''SOFT 44 !! TISSUE'') AND ITS DISTRIBUTION IN WATER COLUMN 45 !! 46 !! ** Method : - IN THE SURFACE LAYER POC IS PRODUCED ACCORDING TO 47 !! NURTRIENTS AVAILABLE AND GROWTH CONDITIONS. NUTRIENT UPTAKE 48 !! KINETICS FOLLOW MICHAELIS-MENTON FORMULATION. 49 !! THE TOTAL PARTICLE AMOUNT PRODUCED, IS DISTRIBUTED IN THE WATER 50 !! COLUMN BELOW THE SURFACE LAYER. 51 !!--------------------------------------------------------------------- 52 INTEGER, INTENT( in ) :: kt ! ocean time-step index 53 !! 54 INTEGER :: ji, jj, jk 55 REAL(wp) :: zgeolpoc, zfact 56 INTEGER , DIMENSION(jpi,jpj) :: ikbot 57 REAL(wp), DIMENSION(jpi,jpj) :: zwork 58 !!--------------------------------------------------------------------- 59 60 IF( kt == nit000 ) THEN 61 IF(lwp) WRITE(numout,*) 62 IF(lwp) WRITE(numout,*) ' trc_exp: LOBSTER export' 63 IF(lwp) WRITE(numout,*) ' ~~~~~~~' 64 ENDIF 65 66 ! VERTICAL DISTRIBUTION OF NEWLY PRODUCED BIOGENIC 67 ! POC IN THE WATER COLUMN 68 ! (PARTS OF NEWLY FORMED MATTER REMAINING IN THE DIFFERENT 69 ! LAYERS IS DETERMINED BY DMIN3 DEFINED IN common.passivetrc.*.h 70 ! ---------------------------------------------------------------------- 71 72 DO jk = 1, jpkm1 73 DO jj = 2, jpjm1 74 DO ji = 2, jpim1 75 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) & 76 & + (1./fse3t(ji,jj,jk)) * dmin3(ji,jj,jk) * fbod(ji,jj) 77 END DO 78 END DO 79 END DO 80 81 ! Find the last level of the water column 82 ! Compute fluxes due to sinking particles (slow) 92 83 93 IF ( tmask(ji,jj,jk) .eq. 1 .and. 94 . tmask(ji,jj,jk+1). eq. 0 ) THEN 95 zkbot(ji,jj) = jk 84 ikbot(:,:) = jpk 85 zwork(:,:) = 0.e0 86 87 !!gm ikbot already exist in opa... 88 DO jk = 1, jpkm1 89 DO jj = 2, jpjm1 90 DO ji = 2, jpim1 91 IF( tmask(ji,jj,jk) == 1 .AND. tmask(ji,jj,jk+1) == 0 ) THEN 92 ikbot(ji,jj) = jk 96 93 zwork(ji,jj) = vsed * trn(ji,jj,jk,jpdet) 97 ENDIF 98 99 ENDDO 100 ENDDO 101 ENDDO 102 C 103 C Initialization 104 zgeolpoc = 0. 94 ENDIF 95 END DO 96 END DO 97 END DO 105 98 106 C Release of nutrients from the "simple" sediment 107 C 108 DO jj = 2,jpjm1 109 DO ji = 2,jpim1 110 tra(ji,jj,zkbot(ji,jj),jpno3) = 111 . tra(ji,jj,zkbot(ji,jj),jpno3) + 112 . sedlam*sedpocn(ji,jj)/fse3t(ji,jj,zkbot(ji,jj)) 99 zgeolpoc = 0.e0 ! Initialization 113 100 114 C Deposition of organic matter in the sediment 115 C 116 zgeolpoc = zgeolpoc + sedlostpoc*sedpocn(ji,jj)* 117 . e1t(ji,jj)*e2t(ji,jj) 101 ! Release of nutrients from the "simple" sediment 102 DO jj = 2, jpjm1 103 DO ji = 2, jpim1 104 tra(ji,jj,ikbot(ji,jj),jpno3) = tra(ji,jj,ikbot(ji,jj),jpno3) & 105 & + sedlam * sedpocn(ji,jj) / fse3t(ji,jj,ikbot(ji,jj)) 118 106 119 sedpoca(ji,jj) = zwork(ji,jj)*rdt + 120 . dminl(ji,jj)*fbod(ji,jj)*rdt - 121 . sedlam*sedpocn(ji,jj)*rdt - 122 . sedlostpoc*sedpocn(ji,jj)*rdt 123 C 124 ENDDO 125 ENDDO 126 C 127 DO jj = 2,jpjm1 128 DO ji = 2,jpim1 129 tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc* 130 . cmask(ji,jj)/areacot/fse3t(ji,jj,1) 131 ENDDO 132 ENDDO 107 ! Deposition of organic matter in the sediment 108 zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1t(ji,jj) * e2t(ji,jj) 133 109 134 CALL lbc_lnk( sedpocn, 'T', 1. ) 110 !!gm factorisationof rdt just bellow... 111 sedpoca(ji,jj) = zwork(ji,jj) * rdt + dminl(ji,jj) * fbod(ji,jj) * rdt & 112 & - sedlam * sedpocn(ji,jj) * rdt - sedlostpoc * sedpocn(ji,jj) * rdt 113 114 END DO 115 END DO 116 117 DO jj = 2,jpjm1 118 DO ji = 2,jpim1 119 tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc * cmask(ji,jj) / areacot / fse3t(ji,jj,1) 120 END DO 121 END DO 122 123 CALL lbc_lnk( sedpocn, 'T', 1. ) 135 124 136 C Oa & Ek: diagnostics depending on jpdia2d 137 C left as example 138 # if defined key_trc_diaadd 139 do jj=1,jpj 140 do ji=1,jpi 141 trc2d(ji,jj,19)=sedpocn(ji,jj) 142 end do 143 end do 144 # endif 125 ! Oa & Ek: diagnostics depending on jpdia2d ! left as example 126 # if defined key_trc_diaadd 127 trc2d(:,:,19) = sedpocn(:,:) 128 # endif 145 129 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(:,:) ) 130 ! Leap-frog scheme (only in explicit case, otherwise the 131 ! ---------------- time stepping is already done in trczdf) 132 IF( l_trczdf_exp .AND. (ln_trcadv_cen2 .OR. ln_trcadv_tvd) ) THEN 133 zfact = 2. * rdttra(jk) * FLOAT( ndttrc ) 134 IF( neuler == 0 .AND. kt == nittrc000 ) zfact = rdttra(jk) * FLOAT(ndttrc) 135 sedpoca(:,:) = sedpocb(:,:) + zfact * sedpoca(:,:) 153 136 ENDIF 154 137 155 138 156 c ! 2.Time filter and swap of arrays157 c ! ---------------------------------158 IF ( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN159 160 161 139 ! Time filter and swap of arrays 140 ! ------------------------------ 141 IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN ! centred or tvd scheme 142 IF( neuler == 0 .AND. kt == nittrc000 ) THEN 143 DO jj = 1, jpj 144 DO ji = 1, jpi 162 145 sedpocb(ji,jj) = sedpocn(ji,jj) 163 146 sedpocn(ji,jj) = sedpoca(ji,jj) 164 sedpoca(ji,jj) = 0. 165 166 147 sedpoca(ji,jj) = 0.e0 148 END DO 149 END DO 167 150 ELSE 168 151 DO jj = 1, jpj 169 152 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.153 sedpocb(ji,jj) = atfp * ( sedpocb(ji,jj) + sedpoca(ji,jj) ) & 154 & + atfp1 * sedpocn(ji,jj) 155 sedpocn(ji,jj) = sedpoca(ji,jj) 156 sedpoca(ji,jj) = 0.e0 174 157 END DO 175 158 END DO 176 159 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 160 ELSE ! case of smolar scheme or muscl 161 sedpocb(:,:) = sedpoca(:,:) 162 sedpocn(:,:) = sedpoca(:,:) 163 sedpoca(:,:) = 0.e0 188 164 ENDIF 165 ! 166 END SUBROUTINE trc_exp 189 167 190 #endif 191 RETURN 192 END 168 #else 169 !!====================================================================== 170 !! Dummy module : No PISCES bio-model 171 !!====================================================================== 172 CONTAINS 173 SUBROUTINE trc_exp( kt ) ! Empty routine 174 INTEGER, INTENT( in ) :: kt 175 WRITE(*,*) 'trc_exp: You should not have seen this print! error?', kt 176 END SUBROUTINE trc_exp 177 #endif 178 179 !!====================================================================== 180 END MODULE trcexp -
branches/dev_001_GM/NEMO/TOP_SRC/LOBSTER/trcopt.F90
r774 r777 1 CC $Header$ 2 CDIR$ LIST 3 SUBROUTINE trcopt(kt) 4 CCC--------------------------------------------------------------------- 5 CCC 6 CCC ROUTINE trcopt 7 CCC ******************* 8 CCC 9 CCC PURPOSE : 10 CCC --------- 11 CCC computes the light propagation in the water column 12 CCC and the euphotic layer depth 13 CCC 14 CCC 15 CC METHOD : 16 CC ------- 17 CC 18 CC multitasked on vertical slab (jj-loop) 19 CC local par is computed in w layers using light propagation 20 CC mean par in t layers are computed by integration 21 CC 22 CC 23 CC INPUT : 24 CC ----- 25 CC argument 26 CC ktask : task identificator 27 CC kt : time step 28 CC COMMON 29 CC /comcoo/ : orthogonal curvilinear coordinates 30 CC and scale factors 31 CC depths 32 CC /comzdf/ : avt vertical eddy diffusivity 33 CC /comqsr/ : solar radiation 34 CC /comtsk/ : multitasking 35 CC /cotopt/ : optical parameters 36 CC /cotbio/ : biological parameters 37 CC 38 CC OUTPUT : 39 CC ------ 40 CC COMMON 41 CC /cotopt/ : optical parameters 42 CC 43 CC WORKSPACE : 44 CC --------- 45 CC local zparr : red compound of par 46 CC zparg : green compound of par 47 CC zpar0m : irradiance just below the surface 48 CC zpar100 : irradiance at euphotic layer depth 49 CC zkr : total absorption coefficient in red 50 CC zkg : total absorption coefficient in green 51 CC zpig : total pigment 52 CC imaske : euphotic layer mask 53 CC itabe : euphotic layer last k index 54 CC 55 CC COMMON 56 CC 57 CC EXTERNAL : no 58 CC -------- 59 CC 60 CC REFERENCES : no 61 CC ---------- 62 CC 63 CC MODIFICATIONS: 64 CC -------------- 65 CC original : 95-05 (M. Levy) 66 CC 99-09 (J-M Andre & M. Levy) 67 CC modifications : 99-11 (C. Menkes M.A. Foujols) itabe initial. 68 CC modifications : 00-02 (M.A. Foujols) change x**y par exp(y*log(x)) 69 CC---------------------------------------------------------------------- 70 CDIR$ NOLIST 1 MODULE trcopt 2 !!====================================================================== 3 !! *** MODULE trcopt *** 4 !! TOP : LOBSTER Compute the light availability in the water column 5 !!====================================================================== 6 !! History : - ! 1995-05 (M. Levy) Original code 7 !! - ! 1999-09 (J.-M. Andre, M. Levy) 8 !! - ! 1999-11 (C. Menkes, M.-A. Foujols) itabe initial 9 !! - ! 2000-02 (M.A. Foujols) change x**y par exp(y*log(x)) 10 !! 2.0 ! 2007-12 (C. Deltel, G. Madec) F90 11 !!---------------------------------------------------------------------- 12 #if defined key_lobster 13 !!---------------------------------------------------------------------- 14 !! 'key_lobster' LOBSTER bio-model 15 !!---------------------------------------------------------------------- 16 !! trc_opt : Compute the light availability in the water column 17 !!---------------------------------------------------------------------- 18 USE oce_trc ! 19 USE trp_trc 20 USE sms 71 21 72 USE oce_trc 73 USE trp_trc 74 USE sms 75 IMPLICIT NONE 76 CDIR$ LIST 77 CCC--------------------------------------------------------------------- 78 CCC OPA8, LODYC (11/96) 79 CCC--------------------------------------------------------------------- 80 CC---------------------------------------------------------------------- 81 CC local declarations 82 CC ================== 83 INTEGER kt 22 IMPLICIT NONE 23 PRIVATE 84 24 85 #if defined key_top && defined key_lobster 86 C 87 INTEGER ji,jj,jk,jn,in 25 PUBLIC trc_opt ! called in trcprg.F90 88 26 89 REAL zpig,zkr,zkg 27 !!* Substitution 28 # include "domzgr_substitute.h90" 29 !!---------------------------------------------------------------------- 30 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 31 !! $Id:$ 32 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 33 !!---------------------------------------------------------------------- 90 34 91 REAL zparr(jpi,jpk),zparg(jpi,jpk) 92 REAL zpar0m(jpi),zpar100(jpi) 93 INTEGER itabe(jpi),imaske(jpi,jpk) 94 CC---------------------------------------------------------------------- 95 CC statement functions 96 CC =================== 97 CDIR$ NOLIST 98 #include "domzgr_substitute.h90" 99 CDIR$ LIST 100 CCC--------------------------------------------------------------------- 101 CCC OPA8, LODYC (15/11/96) 102 CCC--------------------------------------------------------------------- 103 C 104 C 105 C find Phytoplancton index - test CTRCNM 106 C 107 in=0 108 DO jn = 1,jptra 109 IF ((ctrcnm(jn) .EQ. 'PHY') .OR. 110 $ (ctrcnm(jn) .EQ. 'PHYTO') ) THEN 111 112 in = jn 113 END IF 35 CONTAINS 36 37 SUBROUTINE trc_opt( kt ) 38 !!--------------------------------------------------------------------- 39 !! *** ROUTINE trc_opt *** 40 !! 41 !! ** Purpose : computes the light propagation in the water column 42 !! and the euphotic layer depth 43 !! 44 !! ** Method : local par is computed in w layers using light propagation 45 !! mean par in t layers are computed by integration 46 !!--------------------------------------------------------------------- 47 INTEGER, INTENT( in ) :: kt ! index of the time stepping 48 INTEGER :: ji, jj, jk 49 INTEGER , DIMENSION(jpi,jpj) :: itabe ! euphotic layer last k index 50 INTEGER , DIMENSION(jpi,jpj,jpk) :: imaske ! euphotic layer mask 51 REAL(wp) :: zpig ! total pigment 52 REAL(wp) :: zkr ! total absorption coefficient in red 53 REAL(wp) :: zkg ! total absorption coefficient in green 54 REAL(wp), DIMENSION(jpi,jpj) :: zpar100 ! irradiance at euphotic layer depth 55 REAL(wp), DIMENSION(jpi,jpj) :: zpar0m ! irradiance just below the surface 56 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zparr, zparg ! red and green compound of par 57 !!--------------------------------------------------------------------- 58 59 IF( kt == nit000 ) THEN 60 IF(lwp) WRITE(numout,*) 61 IF(lwp) WRITE(numout,*) ' trc_opt: LOBSTER optic-model' 62 IF(lwp) WRITE(numout,*) ' ~~~~~~~' 63 ENDIF 64 65 ! determination of surface irradiance 66 ! ----------------------------------- 67 zpar0m (:,:) = qsr (:,:) * 0.43 68 zpar100(:,:) = zpar0m(:,:) * 0.01 69 xpar (:,:,1) = zpar0m(:,:) 70 zparr (:,:,1) = 0.5 * zpar0m(:,:) 71 zparg (:,:,1) = 0.5 * zpar0m(:,:) 72 73 74 ! determination of xpar 75 ! --------------------- 76 77 DO jk = 2, jpk ! determination of local par in w levels 78 DO jj = 1, jpj 79 DO ji = 1, jpi 80 zpig = MAX( TINY(0.), trn(ji,jj,jk-1,jpphy) ) * 12 * redf / rcchl / rpig 81 zkr = xkr0 + xkrp * EXP( xlr * LOG( zpig ) ) 82 zkg = xkg0 + xkgp * EXP( xlg * LOG( zpig ) ) 83 zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * fse3t(ji,jj,jk-1) ) 84 zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * fse3t(ji,jj,jk-1) ) 85 END DO 86 END DO 114 87 END DO 115 IF (in.eq.0) THEN116 IF (lwp) THEN117 WRITE (numout,*)118 $ ' Problem trcopt : PHY or PHYTO not found '119 CALL FLUSH(numout)120 ENDIF121 ENDIF122 C123 C vertical slab124 C ===============125 C126 DO 1000 jj = 1,jpj127 C128 C129 C 1. determination of surface irradiance130 C --------------------------------------131 C132 C133 DO ji = 1,jpi134 zpar0m(ji) = qsr(ji,jj)*0.43135 zpar100(ji) = zpar0m(ji)*0.01136 xpar(ji,jj,1) = zpar0m(ji)137 zparr(ji,1) = 0.5* zpar0m(ji)138 zparg(ji,1) = 0.5* zpar0m(ji)139 END DO140 88 141 C 142 C 2. determination of xpar 143 C ------------------------ 144 C 145 C determination of local par in w levels 146 DO jk = 2,jpk 147 DO ji = 1,jpi 148 zpig = max(tiny(0.),trn(ji,jj,jk - 1,in))*12*redf/rcchl/rpig 149 zkr = xkr0 + xkrp*exp(xlr*log(zpig)) 150 zkg = xkg0 + xkgp*exp(xlg*log(zpig)) 151 zparr(ji,jk) = zparr(ji,jk - 1) 152 $ *exp( -zkr*fse3t(ji,jj,jk - 1) ) 153 zparg(ji,jk) = zparg(ji,jk - 1) 154 $ *exp( -zkg*fse3t(ji,jj,jk - 1) ) 155 END DO 156 END DO 89 DO jk = 1, jpkm1 ! mean par in t levels 90 DO jj = 1, jpj 91 DO ji = 1, jpi 92 zpig = MAX( TINY(0.), trn(ji,jj,jk,jpphy) ) * 12 * redf / rcchl / rpig 93 zkr = xkr0 + xkrp * EXP( xlr * LOG( zpig ) ) 94 zkg = xkg0 + xkgp * EXP( xlg * LOG( zpig ) ) 95 zparr(ji,jj,jk) = zparr(ji,jj,jk) / zkr / fse3t(ji,jj,jk) * ( 1 - EXP( -zkr*fse3t(ji,jj,jk) ) ) 96 zparg(ji,jj,jk) = zparg(ji,jj,jk) / zkg / fse3t(ji,jj,jk) * ( 1 - EXP( -zkg*fse3t(ji,jj,jk) ) ) 97 xpar (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 ) 98 END DO 99 END DO 100 END DO 157 101 158 C 159 C mean par in t levels 160 DO jk = 1,jpkm1 161 DO ji = 1,jpi 162 zpig = max(tiny(0.),trn(ji,jj,jk ,in))*12*redf/rcchl/rpig 163 zkr = xkr0 + xkrp*exp(xlr*log(zpig)) 164 zkg = xkg0 + xkgp*exp(xlg*log(zpig)) 165 zparr(ji,jk) = zparr(ji,jk) / zkr / fse3t(ji,jj,jk) 166 $ * ( 1 - exp( -zkr*fse3t(ji,jj,jk) ) ) 167 zparg(ji,jk) = zparg(ji,jk) / zkg / fse3t(ji,jj,jk) 168 $ * ( 1 - exp( -zkg*fse3t(ji,jj,jk) ) ) 169 xpar(ji,jj,jk) = max(zparr(ji,jk) 170 $ + zparg(ji,jk),1.e-15) 171 END DO 172 END DO 173 C 174 C 175 C 4. determination of euphotic layer depth 176 C ---------------------------------------- 177 C 178 C imaske equal 1 in the euphotic layer, and 0 without 179 C 180 DO jk = 1,jpk 181 DO ji = 1,jpi 182 imaske(ji,jk) = 0 183 IF (xpar(ji,jj,jk) .GE. zpar100(ji)) imaske(ji,jk) = 1 184 END DO 185 END DO 186 C 187 DO ji = 1,jpi 188 itabe(ji) = 0 189 END DO 190 C 191 DO jk = 1,jpk 192 DO ji = 1,jpi 193 itabe(ji) = itabe(ji) + imaske(ji,jk) 194 END DO 195 END DO 196 C 197 DO ji = 1,jpi 198 itabe(ji) = max(1,itabe(ji)) 199 xze(ji,jj) = fsdepw(ji,jj,itabe(ji) + 1) 200 END DO 201 C 202 C 203 C END of slab 204 C =========== 205 C 206 1000 CONTINUE 207 C 102 ! determination of euphotic layer depth (xze) 103 ! ------------------------------------- 104 105 DO jk = 1, jpk ! imaske equal 1 in the euphotic layer, and 0 without 106 DO jj = 1, jpj 107 DO ji = 1,jpi 108 IF( xpar(ji,jj,jk) >= zpar100(ji,jj) ) THEN 109 imaske(ji,jj,jk) = 1 110 ELSE 111 imaske(ji,jj,jk) = 0 112 ENDIF 113 END DO 114 END DO 115 END DO 116 ! ! sum of imaske Cover the vertical with a minimim value of 1 117 itabe(:,:) = 1 ! surface value setto 1 <=> set a ninimum value to 1 118 DO jk = 2, jpk 119 DO jj = 1, jpj 120 DO ji = 1,jpi 121 itabe(ji,jj) = itabe(ji,jj) + imaske(ji,jj,jk) 122 END DO 123 END DO 124 END DO 125 DO jj = 1, jpj ! converte the number of level into depth 126 DO ji = 1,jpi 127 xze(ji,jj) = fsdepw(ji,jj,itabe(ji,jj)+1) 128 END DO 129 END DO 130 ! 131 END SUBROUTINE trc_opt 132 208 133 #else 209 C 210 C no passive tracers 211 C 212 #endif 213 C 214 RETURN 215 END 134 !!====================================================================== 135 !! Dummy module : No PISCES bio-model 136 !!====================================================================== 137 CONTAINS 138 SUBROUTINE trc_opt( kt ) ! Empty routine 139 INTEGER, INTENT( in ) :: kt 140 WRITE(*,*) 'trc_opt: You should not have seen this print! error?', kt 141 END SUBROUTINE trc_opt 142 #endif 143 144 !!====================================================================== 145 END MODULE trcopt -
branches/dev_001_GM/NEMO/TOP_SRC/LOBSTER/trcsed.F90
r774 r777 1 CC $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/SMS/trcsed.F,v 1.7 2007/10/12 09:36:28 opalod Exp $ 2 CDIR$ LIST 3 SUBROUTINE trcsed(kt) 4 CCC--------------------------------------------------------------------- 5 CCC 6 CCC ROUTINE trcsed 7 CCC ******************* 8 CCC 9 CCC PURPOSE : 10 CCC --------- 11 CCC compute the now trend due to the vertical sedimentation of 12 CCC detritus and add it to the general trend of detritus equations. 13 CCC 14 CCC 15 CC METHOD : 16 CC ------- 17 CC this ROUTINE compute not exactly the advection but the 18 CC transport term, i.e. dz(wt) and dz(ws)., dz(wtr) 19 CC using an upstream scheme 20 CC 21 CC the now vertical advection of tracers is given by: 22 CC 23 CC dz(trn wn) = 1/bt dk+1( e1t e2t vsed (trn) ) 24 CC 25 CC add this trend now to the general trend of tracer (ta,sa,tra): 26 CC 27 CC tra = tra + dz(trn wn) 28 CC 29 CC IF 'key_trc_diabio' key is activated, the now vertical advection 30 CC trend of passive tracers is saved for futher diagnostics. 31 CC 32 CC multitasked on vertical slab (jj-loop) 33 CC 34 CC 35 CC INPUT : 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 /cottrp/ : passive tracer fields 44 CC /comtsk/ : multitasking 45 CC 46 CC OUTPUT : 47 CC ------ 48 CC COMMON 49 CC /cottrp/tra : general tracer trend increased by the 50 CC now vertical tracer advection trend 51 CC /cottbd/ trbio : now vertical passive tracer advection 52 CC trend 53 CC (IF 'key_trc_diabio' key is activated) 54 CC 55 CC WORKSPACE : 56 CC --------- 57 CC local 58 CC ze1e2w, ze3tr, ztra 59 CC COMMON 60 CC 61 CC EXTERNAL : no 62 CC -------- 63 CC 64 CC REFERENCES : no 65 CC ---------- 66 CC 67 CC MODIFICATIONS: 68 CC -------------- 69 CC original : 95-06 (M. Levy) 70 CC additions: 00-12 (E. Kestenare): clean up 71 CC---------------------------------------------------------------------- 72 CDIR$ NOLIST 73 USE oce_trc 74 USE trp_trc 75 USE sms 76 USE lbclnk 77 IMPLICIT NONE 78 CDIR$ LIST 79 CC---------------------------------------------------------------------- 80 CC local declarations 81 CC ================== 82 INTEGER kt 1 MODULE trcsed 2 !!====================================================================== 3 !! *** MODULE p4sed *** 4 !! TOP : PISCES Compute loss of organic matter in the sediments 5 !!====================================================================== 6 !! History : - ! 1995-06 (M. Levy) original code 7 !! - ! 2000-12 (E. Kestenare) clean up 8 !! 2.0 ! 2007-12 (C. Deltel, G. Madec) F90 + simplifications 9 !!---------------------------------------------------------------------- 10 #if defined key_lobster 11 !!---------------------------------------------------------------------- 12 !! 'key_lobster' LOBSTER bio-model 13 !!---------------------------------------------------------------------- 14 !! trc_sed : Compute loss of organic matter in the sediments 15 !!---------------------------------------------------------------------- 16 USE oce_trc ! 17 USE trp_trc 18 USE sms 19 USE lbclnk 83 20 84 #if defined key_top && defined key_lobster 21 IMPLICIT NONE 22 PRIVATE 85 23 86 INTEGER ji,jj,jk 87 REAL ze3tr,ztra 88 REAL zwork(jpi,jpk) 89 #if defined key_trc_diaadd 90 REAL ze3t(jpi,jpj,jpk) 91 #endif 92 CC---------------------------------------------------------------------- 93 CC statement functions 94 CC =================== 95 CDIR$ NOLIST 96 #include "domzgr_substitute.h90" 97 CDIR$ LIST 98 CCC--------------------------------------------------------------------- 99 CCC OPA8, LODYC (15/11/96) 100 CCC--------------------------------------------------------------------- 101 C 102 #if defined key_trc_diaadd 103 C convert fluxes in per day 104 ze3t(:,:,:) = 0. 105 DO jk=1,jpkbm1 106 DO jj = 2, jpjm1 107 DO ji = 2, jpim1 108 ze3t(ji,jj,jk)=fse3t(ji,jj,jk)*86400. 109 END DO 110 END DO 111 END DO 112 #endif 24 PUBLIC trc_sed ! called in ??? 113 25 114 C 115 C vertical slab 116 C ============= 117 C 118 DO 1000 jj = 1,jpj 26 !!* Substitution 27 # include "domzgr_substitute.h90" 28 !!---------------------------------------------------------------------- 29 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 30 !! $Id:$ 31 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 32 !!---------------------------------------------------------------------- 119 33 120 C 121 C 122 C 1. sedimentation of detritus : upstream scheme 123 C ----------------------------------------------- 124 C 125 C 126 C for detritus sedimentation only - jpdet 127 C 128 C 1.1 initialisation needed for bottom and surface value 129 C 130 DO jk=1,jpk 131 DO ji = 1,jpi 132 zwork(ji,jk) = 0. 133 END DO 134 END DO 135 C 136 C 1.2 tracer flux at w-point: we use -vsed (downward flux) 137 C with simplification : no e1*e2 138 C 139 DO jk = 2,jpk 140 DO ji = 1,jpi 141 zwork(ji,jk) = -vsed * trn(ji,jj,jk - 1,jpdet) 142 END DO 143 END DO 144 C 145 C 1.3 tracer flux divergence at t-point added to the general trend 146 C 147 DO jk = 1,jpkm1 148 DO ji = 1,jpi 149 ze3tr = 1./fse3t(ji,jj,jk) 150 ztra = -ze3tr * (zwork(ji,jk) - zwork(ji,jk + 1)) 151 tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra 152 # if defined key_trc_diabio 153 trbio(ji,jj,jk,8) = ztra 154 # endif 155 #if defined key_trc_diaadd 156 trc2d(ji,jj,8)=trc2d(ji,jj,8)+ztra*ze3t(ji,jj,jk) 157 #endif 158 END DO 159 END DO 160 C 161 C END of slab 162 C =========== 34 CONTAINS 163 35 164 1000 CONTINUE 165 C 36 SUBROUTINE trc_sed( kt ) 37 !!--------------------------------------------------------------------- 38 !! *** ROUTINE trc_sed *** 39 !! 40 !! ** Purpose : compute the now trend due to the vertical sedimentation of 41 !! detritus and add it to the general trend of detritus equations 42 !! 43 !! ** Method : this ROUTINE compute not exactly the advection but the 44 !! transport term, i.e. dz(wt) and dz(ws)., dz(wtr) 45 !! using an upstream scheme 46 !! the now vertical advection of tracers is given by: 47 !! dz(trn wn) = 1/bt dk+1( e1t e2t vsed (trn) ) 48 !! add this trend now to the general trend of tracer (ta,sa,tra): 49 !! tra = tra + dz(trn wn) 50 !! 51 !! IF 'key_trc_diabio' is defined, the now vertical advection 52 !! trend of passive tracers is saved for futher diagnostics. 53 !!--------------------------------------------------------------------- 54 INTEGER, INTENT( in ) :: kt ! ocean time-step index 55 !! 56 INTEGER :: ji, jj, jk 57 REAL(wp) :: ztra 58 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwork 59 !!--------------------------------------------------------------------- 60 61 IF( kt == nit000 ) THEN 62 IF(lwp) WRITE(numout,*) 63 IF(lwp) WRITE(numout,*) ' trc_sed: LOBSTER sedimentation' 64 IF(lwp) WRITE(numout,*) ' ~~~~~~~' 65 ENDIF 66 67 ! sedimentation of detritus : upstream scheme 68 ! -------------------------------------------- 69 70 ! for detritus sedimentation only - jpdet 71 72 zwork(:,:,1 ) = 0.e0 ! surface value set to zero 73 zwork(:,:,jpk) = 0.e0 ! bottom value set to zero 74 75 ! tracer flux at w-point: we use -vsed (downward flux) with simplification : no e1*e2 76 77 DO jk = 2, jpkm1 78 zwork(:,:,jk) = -vsed * trn(:,:,jk-1,jpdet) 79 END DO 80 81 ! tracer flux divergence at t-point added to the general trend 82 83 DO jk = 1, jpkm1 84 DO jj = 1, jpj 85 DO ji = 1,jpi 86 ztra = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 87 tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra 88 # if defined key_trc_diabio 89 trbio(ji,jj,jk,8) = ztra 90 # endif 91 # if defined key_trc_diaadd 92 trc2d(ji,jj,8) = trc2d(ji,jj,8) + ztra * fse3t(ji,jj,jk) * 86400. 93 # endif 94 END DO 95 END DO 96 END DO 97 166 98 #if defined key_trc_diabio 167 C Lateral boundary conditions on trcbio 168 CALL lbc_lnk (trbio(:,:,1,8), 'T', 1. ) 99 CALL lbc_lnk (trbio(:,:,1,8), 'T', 1. ) ! Lateral boundary conditions on trcbio 169 100 #endif 170 101 #if defined key_trc_diaadd 171 C Lateral boundary conditions on trc2d 172 CALL lbc_lnk (trc2d(:,:,8), 'T', 1. ) 102 CALL lbc_lnk( trc2d(:,:,8), 'T', 1. ) ! Lateral boundary conditions on trc2d 173 103 #endif 174 C 104 ! 105 END SUBROUTINE trc_sed 175 106 176 107 #else 177 C 178 C no passive tracer 179 C 180 #endif 181 C 182 RETURN 183 END 108 !!====================================================================== 109 !! Dummy module : No PISCES bio-model 110 !!====================================================================== 111 CONTAINS 112 SUBROUTINE trc_sed( kt ) ! Empty routine 113 INTEGER, INTENT( in ) :: kt 114 WRITE(*,*) 'trc_sed: You should not have seen this print! error?', kt 115 END SUBROUTINE trc_sed 116 #endif 117 118 !!====================================================================== 119 END MODULE trcsed -
branches/dev_001_GM/NEMO/TOP_SRC/trcsms.F90
r772 r777 17 17 USE trccfc ! CFC 11 & 12 18 18 USE prtctl_trc ! Print control for debbuging 19 USE trcbio 20 USE trcopt 21 USE trcsed 22 USE trcexp 19 23 20 24 IMPLICIT NONE … … 51 55 ! ------------------------ 52 56 53 CALL trc opt( kt ) ! optical model57 CALL trc_opt( kt ) ! optical model 54 58 55 59 IF(ln_ctl) THEN ! print mean trends (used for debugging) … … 59 63 ENDIF 60 64 61 CALL trc bio( kt ) ! biological model65 CALL trc_bio( kt ) ! biological model 62 66 63 67 IF(ln_ctl) THEN ! print mean trends (used for debugging) … … 67 71 ENDIF 68 72 69 CALL trc sed( kt ) ! sedimentation model73 CALL trc_sed( kt ) ! sedimentation model 70 74 71 75 IF(ln_ctl) THEN ! print mean trends (used for debugging) … … 75 79 ENDIF 76 80 77 CALL trc exp( kt ) ! export81 CALL trc_exp( kt ) ! export 78 82 79 83 IF(ln_ctl) THEN ! print mean trends (used for debugging)
Note: See TracChangeset
for help on using the changeset viewer.
