Changeset 12377 for NEMO/trunk/src/TOP/PISCES
- Timestamp:
- 2020-02-12T15:39:06+01:00 (4 years ago)
- Location:
- NEMO/trunk
- Files:
-
- 1 deleted
- 46 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEAD ext/AGRIF5 ^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL
-
- Property svn:externals
-
NEMO/trunk/src/TOP/PISCES/P2Z/p2zbio.F90
r11536 r12377 57 57 58 58 !! * Substitutions 59 # include " vectopt_loop_substitute.h90"59 # include "do_loop_substitute.h90" 60 60 !!---------------------------------------------------------------------- 61 61 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 65 65 CONTAINS 66 66 67 SUBROUTINE p2z_bio( kt )67 SUBROUTINE p2z_bio( kt, Kmm, Krhs ) 68 68 !!--------------------------------------------------------------------- 69 69 !! *** ROUTINE p2z_bio *** … … 78 78 !! is added to the general trend. 79 79 !! 80 !! tr a = tra + zf...tra- zftra...80 !! tr(Krhs) = tr(Krhs) + zf...tr(Krhs) - zftra... 81 81 !! | | 82 82 !! | | … … 84 84 !! 85 85 !!--------------------------------------------------------------------- 86 INTEGER, INTENT( in ) :: kt ! ocean time-step index 86 INTEGER, INTENT( in ) :: kt ! ocean time-step index 87 INTEGER, INTENT( in ) :: Kmm, Krhs ! time level indices 87 88 ! 88 89 INTEGER :: ji, jj, jk, jl … … 120 121 DO jk = 1, jpkbm1 ! Upper ocean (bio-layers) ! 121 122 ! ! -------------------------- ! 122 DO jj = 2, jpjm1 123 DO ji = fs_2, fs_jpim1 124 ! trophic variables( det, zoo, phy, no3, nh4, dom) 125 ! ------------------------------------------------ 126 127 ! negative trophic variables DO not contribute to the fluxes 128 zdet = MAX( 0.e0, trn(ji,jj,jk,jpdet) ) 129 zzoo = MAX( 0.e0, trn(ji,jj,jk,jpzoo) ) 130 zphy = MAX( 0.e0, trn(ji,jj,jk,jpphy) ) 131 zno3 = MAX( 0.e0, trn(ji,jj,jk,jpno3) ) 132 znh4 = MAX( 0.e0, trn(ji,jj,jk,jpnh4) ) 133 zdom = MAX( 0.e0, trn(ji,jj,jk,jpdom) ) 134 135 ! Limitations 136 zlt = 1. 137 zle = 1. - EXP( -etot(ji,jj,jk) / aki / zlt ) 138 ! psinut,akno3,aknh4 added by asklod AS Kremeur 2005-03 139 zlno3 = zno3 * EXP( -psinut * znh4 ) / ( akno3 + zno3 ) 140 zlnh4 = znh4 / (znh4+aknh4) 141 142 ! sinks and sources 143 ! phytoplankton production and exsudation 144 zno3phy = tmumax * zle * zlt * zlno3 * zphy 145 znh4phy = tmumax * zle * zlt * zlnh4 * zphy 146 147 ! fphylab added by asklod AS Kremeur 2005-03 148 zphydom = rgamma * (1 - fphylab) * (zno3phy + znh4phy) 149 zphynh4 = rgamma * fphylab * (zno3phy + znh4phy) 150 ! zooplankton production 151 ! preferences 152 zppz = rppz 153 zpdz = 1. - rppz 154 zpppz = ( zppz * zphy ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 ) 155 zppdz = ( zpdz * zdet ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 ) 156 zfood = zpppz * zphy + zppdz * zdet 157 ! filtration 158 zfilpz = taus * zpppz / (aks + zfood) 159 zfildz = taus * zppdz / (aks + zfood) 160 ! grazing 161 zphyzoo = zfilpz * zphy * zzoo 162 zdetzoo = zfildz * zdet * zzoo 163 164 ! fecal pellets production 165 zzoodet = rpnaz * zphyzoo + rdnaz * zdetzoo 166 167 ! zooplankton liquide excretion 168 zzoonh4 = tauzn * fzoolab * zzoo 169 zzoodom = tauzn * (1 - fzoolab) * zzoo 170 171 ! mortality 172 ! phytoplankton mortality 173 zphydet = tmminp * zphy 174 175 ! zooplankton mortality 176 ! closure : flux grazing is redistributed below level jpkbio 177 zzoobod = tmminz * zzoo * zzoo 178 xksi(ji,jj) = xksi(ji,jj) + (1-fdbod) * zzoobod * e3t_n(ji,jj,jk) 179 zboddet = fdbod * zzoobod 180 181 ! detritus and dom breakdown 182 zdetnh4 = taudn * fdetlab * zdet 183 zdetdom = taudn * (1 - fdetlab) * zdet 184 185 zdomnh4 = taudomn * zdom 186 187 ! flux added to express how the excess of nitrogen from 188 ! PHY, ZOO and DET to DOM goes directly to NH4 (flux of ajustment) 189 zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 190 191 ! Nitrification 192 znh4no3 = taunn * znh4 193 194 ! determination of trends 195 ! total trend for each biological tracer 196 zphya = zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet 197 zzooa = zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod 198 zno3a = - zno3phy + znh4no3 199 znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju 200 zdeta = zphydet + zzoodet - zdetzoo - zdetnh4 - zdetdom + zboddet 201 zdoma = zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju 202 203 ! tracer flux at totox-point added to the general trend 204 tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta 205 tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa 206 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya 207 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a 208 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a 209 tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 210 211 IF( lk_iomput ) THEN 212 ! convert fluxes in per day 213 ze3t = e3t_n(ji,jj,jk) * 86400._wp 214 zw2d(ji,jj,1) = zw2d(ji,jj,1) + zno3phy * ze3t 215 zw2d(ji,jj,2) = zw2d(ji,jj,2) + znh4phy * ze3t 216 zw2d(ji,jj,3) = zw2d(ji,jj,3) + zphydom * ze3t 217 zw2d(ji,jj,4) = zw2d(ji,jj,4) + zphynh4 * ze3t 218 zw2d(ji,jj,5) = zw2d(ji,jj,5) + zphyzoo * ze3t 219 zw2d(ji,jj,6) = zw2d(ji,jj,6) + zphydet * ze3t 220 zw2d(ji,jj,7) = zw2d(ji,jj,7) + zdetzoo * ze3t 221 zw2d(ji,jj,8) = zw2d(ji,jj,8) + zzoodet * ze3t 222 zw2d(ji,jj,9) = zw2d(ji,jj,9) + zzoobod * ze3t 223 zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t 224 zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t 225 zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t 226 zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t 227 zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t 228 zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t 229 zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t 230 zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 231 ! 232 zw3d(ji,jj,jk,1) = zno3phy * 86400 233 zw3d(ji,jj,jk,2) = znh4phy * 86400 234 zw3d(ji,jj,jk,3) = znh4no3 * 86400 235 ! 236 ENDIF 237 END DO 238 END DO 123 DO_2D_00_00 124 ! trophic variables( det, zoo, phy, no3, nh4, dom) 125 ! ------------------------------------------------ 126 127 ! negative trophic variables DO not contribute to the fluxes 128 zdet = MAX( 0.e0, tr(ji,jj,jk,jpdet,Kmm) ) 129 zzoo = MAX( 0.e0, tr(ji,jj,jk,jpzoo,Kmm) ) 130 zphy = MAX( 0.e0, tr(ji,jj,jk,jpphy,Kmm) ) 131 zno3 = MAX( 0.e0, tr(ji,jj,jk,jpno3,Kmm) ) 132 znh4 = MAX( 0.e0, tr(ji,jj,jk,jpnh4,Kmm) ) 133 zdom = MAX( 0.e0, tr(ji,jj,jk,jpdom,Kmm) ) 134 135 ! Limitations 136 zlt = 1. 137 zle = 1. - EXP( -etot(ji,jj,jk) / aki / zlt ) 138 ! psinut,akno3,aknh4 added by asklod AS Kremeur 2005-03 139 zlno3 = zno3 * EXP( -psinut * znh4 ) / ( akno3 + zno3 ) 140 zlnh4 = znh4 / (znh4+aknh4) 141 142 ! sinks and sources 143 ! phytoplankton production and exsudation 144 zno3phy = tmumax * zle * zlt * zlno3 * zphy 145 znh4phy = tmumax * zle * zlt * zlnh4 * zphy 146 147 ! fphylab added by asklod AS Kremeur 2005-03 148 zphydom = rgamma * (1 - fphylab) * (zno3phy + znh4phy) 149 zphynh4 = rgamma * fphylab * (zno3phy + znh4phy) 150 ! zooplankton production 151 ! preferences 152 zppz = rppz 153 zpdz = 1. - rppz 154 zpppz = ( zppz * zphy ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 ) 155 zppdz = ( zpdz * zdet ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 ) 156 zfood = zpppz * zphy + zppdz * zdet 157 ! filtration 158 zfilpz = taus * zpppz / (aks + zfood) 159 zfildz = taus * zppdz / (aks + zfood) 160 ! grazing 161 zphyzoo = zfilpz * zphy * zzoo 162 zdetzoo = zfildz * zdet * zzoo 163 164 ! fecal pellets production 165 zzoodet = rpnaz * zphyzoo + rdnaz * zdetzoo 166 167 ! zooplankton liquide excretion 168 zzoonh4 = tauzn * fzoolab * zzoo 169 zzoodom = tauzn * (1 - fzoolab) * zzoo 170 171 ! mortality 172 ! phytoplankton mortality 173 zphydet = tmminp * zphy 174 175 ! zooplankton mortality 176 ! closure : flux grazing is redistributed below level jpkbio 177 zzoobod = tmminz * zzoo * zzoo 178 xksi(ji,jj) = xksi(ji,jj) + (1-fdbod) * zzoobod * e3t(ji,jj,jk,Kmm) 179 zboddet = fdbod * zzoobod 180 181 ! detritus and dom breakdown 182 zdetnh4 = taudn * fdetlab * zdet 183 zdetdom = taudn * (1 - fdetlab) * zdet 184 185 zdomnh4 = taudomn * zdom 186 187 ! flux added to express how the excess of nitrogen from 188 ! PHY, ZOO and DET to DOM goes directly to NH4 (flux of ajustment) 189 zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 190 191 ! Nitrification 192 znh4no3 = taunn * znh4 193 194 ! determination of trends 195 ! total trend for each biological tracer 196 zphya = zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet 197 zzooa = zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod 198 zno3a = - zno3phy + znh4no3 199 znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju 200 zdeta = zphydet + zzoodet - zdetzoo - zdetnh4 - zdetdom + zboddet 201 zdoma = zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju 202 203 ! tracer flux at totox-point added to the general trend 204 tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + zdeta 205 tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) + zzooa 206 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zphya 207 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + zno3a 208 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + znh4a 209 tr(ji,jj,jk,jpdom,Krhs) = tr(ji,jj,jk,jpdom,Krhs) + zdoma 210 211 IF( lk_iomput ) THEN 212 ! convert fluxes in per day 213 ze3t = e3t(ji,jj,jk,Kmm) * 86400._wp 214 zw2d(ji,jj,1) = zw2d(ji,jj,1) + zno3phy * ze3t 215 zw2d(ji,jj,2) = zw2d(ji,jj,2) + znh4phy * ze3t 216 zw2d(ji,jj,3) = zw2d(ji,jj,3) + zphydom * ze3t 217 zw2d(ji,jj,4) = zw2d(ji,jj,4) + zphynh4 * ze3t 218 zw2d(ji,jj,5) = zw2d(ji,jj,5) + zphyzoo * ze3t 219 zw2d(ji,jj,6) = zw2d(ji,jj,6) + zphydet * ze3t 220 zw2d(ji,jj,7) = zw2d(ji,jj,7) + zdetzoo * ze3t 221 zw2d(ji,jj,8) = zw2d(ji,jj,8) + zzoodet * ze3t 222 zw2d(ji,jj,9) = zw2d(ji,jj,9) + zzoobod * ze3t 223 zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t 224 zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t 225 zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t 226 zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t 227 zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t 228 zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t 229 zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t 230 zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 231 ! 232 zw3d(ji,jj,jk,1) = zno3phy * 86400 233 zw3d(ji,jj,jk,2) = znh4phy * 86400 234 zw3d(ji,jj,jk,3) = znh4no3 * 86400 235 ! 236 ENDIF 237 END_2D 239 238 END DO 240 239 … … 242 241 DO jk = jpkb, jpkm1 ! Upper ocean (bio-layers) ! 243 242 ! ! -------------------------- ! 244 DO jj = 2, jpjm1 245 DO ji = fs_2, fs_jpim1 246 ! remineralisation of all quantities towards nitrate 247 248 ! trophic variables( det, zoo, phy, no3, nh4, dom) 249 ! negative trophic variables DO not contribute to the fluxes 250 zdet = MAX( 0.e0, trn(ji,jj,jk,jpdet) ) 251 zzoo = MAX( 0.e0, trn(ji,jj,jk,jpzoo) ) 252 zphy = MAX( 0.e0, trn(ji,jj,jk,jpphy) ) 253 zno3 = MAX( 0.e0, trn(ji,jj,jk,jpno3) ) 254 znh4 = MAX( 0.e0, trn(ji,jj,jk,jpnh4) ) 255 zdom = MAX( 0.e0, trn(ji,jj,jk,jpdom) ) 256 257 ! Limitations 258 zlt = 0.e0 259 zle = 0.e0 260 zlno3 = 0.e0 261 zlnh4 = 0.e0 262 263 ! sinks and sources 264 ! phytoplankton production and exsudation 265 zno3phy = 0.e0 266 znh4phy = 0.e0 267 zphydom = 0.e0 268 zphynh4 = 0.e0 269 270 ! zooplankton production 271 zphyzoo = 0.e0 ! grazing 272 zdetzoo = 0.e0 273 274 zzoodet = 0.e0 ! fecal pellets production 275 276 zzoonh4 = tauzn * fzoolab * zzoo ! zooplankton liquide excretion 277 zzoodom = tauzn * (1 - fzoolab) * zzoo 278 279 ! mortality 280 zphydet = tmminp * zphy ! phytoplankton mortality 281 282 zzoobod = 0.e0 ! zooplankton mortality 283 zboddet = 0.e0 ! closure : flux fbod is redistributed below level jpkbio 284 285 ! detritus and dom breakdown 286 zdetnh4 = taudn * fdetlab * zdet 287 zdetdom = taudn * (1 - fdetlab) * zdet 288 289 zdomnh4 = taudomn * zdom 290 zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 291 292 ! Nitrification 293 znh4no3 = taunn * znh4 294 295 296 ! determination of trends 297 ! total trend for each biological tracer 298 zphya = zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet 299 zzooa = zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod 300 zno3a = - zno3phy + znh4no3 301 znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju 302 zdeta = zphydet + zzoodet - zdetzoo - zdetnh4 - zdetdom + zboddet 303 zdoma = zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju 304 305 ! tracer flux at totox-point added to the general trend 306 tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta 307 tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa 308 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya 309 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a 310 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a 311 tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 243 DO_2D_00_00 244 ! remineralisation of all quantities towards nitrate 245 246 ! trophic variables( det, zoo, phy, no3, nh4, dom) 247 ! negative trophic variables DO not contribute to the fluxes 248 zdet = MAX( 0.e0, tr(ji,jj,jk,jpdet,Kmm) ) 249 zzoo = MAX( 0.e0, tr(ji,jj,jk,jpzoo,Kmm) ) 250 zphy = MAX( 0.e0, tr(ji,jj,jk,jpphy,Kmm) ) 251 zno3 = MAX( 0.e0, tr(ji,jj,jk,jpno3,Kmm) ) 252 znh4 = MAX( 0.e0, tr(ji,jj,jk,jpnh4,Kmm) ) 253 zdom = MAX( 0.e0, tr(ji,jj,jk,jpdom,Kmm) ) 254 255 ! Limitations 256 zlt = 0.e0 257 zle = 0.e0 258 zlno3 = 0.e0 259 zlnh4 = 0.e0 260 261 ! sinks and sources 262 ! phytoplankton production and exsudation 263 zno3phy = 0.e0 264 znh4phy = 0.e0 265 zphydom = 0.e0 266 zphynh4 = 0.e0 267 268 ! zooplankton production 269 zphyzoo = 0.e0 ! grazing 270 zdetzoo = 0.e0 271 272 zzoodet = 0.e0 ! fecal pellets production 273 274 zzoonh4 = tauzn * fzoolab * zzoo ! zooplankton liquide excretion 275 zzoodom = tauzn * (1 - fzoolab) * zzoo 276 277 ! mortality 278 zphydet = tmminp * zphy ! phytoplankton mortality 279 280 zzoobod = 0.e0 ! zooplankton mortality 281 zboddet = 0.e0 ! closure : flux fbod is redistributed below level jpkbio 282 283 ! detritus and dom breakdown 284 zdetnh4 = taudn * fdetlab * zdet 285 zdetdom = taudn * (1 - fdetlab) * zdet 286 287 zdomnh4 = taudomn * zdom 288 zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 289 290 ! Nitrification 291 znh4no3 = taunn * znh4 292 293 294 ! determination of trends 295 ! total trend for each biological tracer 296 zphya = zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet 297 zzooa = zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod 298 zno3a = - zno3phy + znh4no3 299 znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju 300 zdeta = zphydet + zzoodet - zdetzoo - zdetnh4 - zdetdom + zboddet 301 zdoma = zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju 302 303 ! tracer flux at totox-point added to the general trend 304 tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + zdeta 305 tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) + zzooa 306 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zphya 307 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + zno3a 308 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + znh4a 309 tr(ji,jj,jk,jpdom,Krhs) = tr(ji,jj,jk,jpdom,Krhs) + zdoma 310 ! 311 IF( lk_iomput ) THEN ! convert fluxes in per day 312 ze3t = e3t(ji,jj,jk,Kmm) * 86400._wp 313 zw2d(ji,jj,1) = zw2d(ji,jj,1) + zno3phy * ze3t 314 zw2d(ji,jj,2) = zw2d(ji,jj,2) + znh4phy * ze3t 315 zw2d(ji,jj,3) = zw2d(ji,jj,3) + zphydom * ze3t 316 zw2d(ji,jj,4) = zw2d(ji,jj,4) + zphynh4 * ze3t 317 zw2d(ji,jj,5) = zw2d(ji,jj,5) + zphyzoo * ze3t 318 zw2d(ji,jj,6) = zw2d(ji,jj,6) + zphydet * ze3t 319 zw2d(ji,jj,7) = zw2d(ji,jj,7) + zdetzoo * ze3t 320 zw2d(ji,jj,8) = zw2d(ji,jj,8) + zzoodet * ze3t 321 zw2d(ji,jj,9) = zw2d(ji,jj,9) + zzoobod * ze3t 322 zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t 323 zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t 324 zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t 325 zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t 326 zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t 327 zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t 328 zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t 329 zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 330 ! 331 zw3d(ji,jj,jk,1) = zno3phy * 86400._wp 332 zw3d(ji,jj,jk,2) = znh4phy * 86400._wp 333 zw3d(ji,jj,jk,3) = znh4no3 * 86400._wp 312 334 ! 313 IF( lk_iomput ) THEN ! convert fluxes in per day 314 ze3t = e3t_n(ji,jj,jk) * 86400._wp 315 zw2d(ji,jj,1) = zw2d(ji,jj,1) + zno3phy * ze3t 316 zw2d(ji,jj,2) = zw2d(ji,jj,2) + znh4phy * ze3t 317 zw2d(ji,jj,3) = zw2d(ji,jj,3) + zphydom * ze3t 318 zw2d(ji,jj,4) = zw2d(ji,jj,4) + zphynh4 * ze3t 319 zw2d(ji,jj,5) = zw2d(ji,jj,5) + zphyzoo * ze3t 320 zw2d(ji,jj,6) = zw2d(ji,jj,6) + zphydet * ze3t 321 zw2d(ji,jj,7) = zw2d(ji,jj,7) + zdetzoo * ze3t 322 zw2d(ji,jj,8) = zw2d(ji,jj,8) + zzoodet * ze3t 323 zw2d(ji,jj,9) = zw2d(ji,jj,9) + zzoobod * ze3t 324 zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t 325 zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t 326 zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t 327 zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t 328 zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t 329 zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t 330 zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t 331 zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 332 ! 333 zw3d(ji,jj,jk,1) = zno3phy * 86400._wp 334 zw3d(ji,jj,jk,2) = znh4phy * 86400._wp 335 zw3d(ji,jj,jk,3) = znh4no3 * 86400._wp 336 ! 337 ENDIF 338 END DO 339 END DO 335 ENDIF 336 END_2D 340 337 END DO 341 338 ! … … 367 364 ENDIF 368 365 369 IF( ln_ctl) THEN ! print mean trends (used for debugging)366 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 370 367 WRITE(charout, FMT="('bio')") 371 368 CALL prt_ctl_trc_info(charout) 372 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)369 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 373 370 ENDIF 374 371 ! … … 402 399 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~' 403 400 ! 404 REWIND( numnatp_ref ) ! Namelist namlobphy in reference namelist : Lobster biological parameters405 401 READ ( numnatp_ref, namlobphy, IOSTAT = ios, ERR = 901) 406 402 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobphy in reference namelist' ) 407 REWIND( numnatp_cfg ) ! Namelist namlobphy in configuration namelist : Lobster biological parameters408 403 READ ( numnatp_cfg, namlobphy, IOSTAT = ios, ERR = 902 ) 409 404 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namlobphy in configuration namelist' ) … … 419 414 ENDIF 420 415 421 REWIND( numnatp_ref ) ! Namelist namlobnut in reference namelist : Lobster nutriments parameters422 416 READ ( numnatp_ref, namlobnut, IOSTAT = ios, ERR = 903) 423 417 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobnut in reference namelist' ) 424 REWIND( numnatp_cfg ) ! Namelist namlobnut in configuration namelist : Lobster nutriments parameters425 418 READ ( numnatp_cfg, namlobnut, IOSTAT = ios, ERR = 904 ) 426 419 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namlobnut in configuration namelist' ) … … 436 429 ENDIF 437 430 438 REWIND( numnatp_ref ) ! Namelist namlobzoo in reference namelist : Lobster zooplankton parameters439 431 READ ( numnatp_ref, namlobzoo, IOSTAT = ios, ERR = 905) 440 432 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobzoo in reference namelist' ) 441 REWIND( numnatp_cfg ) ! Namelist namlobzoo in configuration namelist : Lobster zooplankton parameters442 433 READ ( numnatp_cfg, namlobzoo, IOSTAT = ios, ERR = 906 ) 443 434 906 IF( ios > 0 ) CALL ctl_nam ( ios , 'namlobzoo in configuration namelist' ) … … 458 449 ENDIF 459 450 460 REWIND( numnatp_ref ) ! Namelist namlobdet in reference namelist : Lobster detritus parameters461 451 READ ( numnatp_ref, namlobdet, IOSTAT = ios, ERR = 907) 462 452 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobdet in reference namelist' ) 463 REWIND( numnatp_cfg ) ! Namelist namlobdet in configuration namelist : Lobster detritus parameters464 453 READ ( numnatp_cfg, namlobdet, IOSTAT = ios, ERR = 908 ) 465 454 908 IF( ios > 0 ) CALL ctl_nam ( ios , 'namlobdet in configuration namelist' ) … … 473 462 ENDIF 474 463 475 REWIND( numnatp_ref ) ! Namelist namlobdom in reference namelist : Lobster DOM breakdown rate476 464 READ ( numnatp_ref, namlobdom, IOSTAT = ios, ERR = 909) 477 465 909 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobdom in reference namelist' ) 478 REWIND( numnatp_cfg ) ! Namelist namlobdom in configuration namelist : Lobster DOM breakdown rate479 466 READ ( numnatp_cfg, namlobdom, IOSTAT = ios, ERR = 910 ) 480 467 910 IF( ios > 0 ) CALL ctl_nam ( ios , 'namlobdom in configuration namelist' ) -
NEMO/trunk/src/TOP/PISCES/P2Z/p2zexp.F90
r10425 r12377 38 38 39 39 !! * Substitutions 40 # include " vectopt_loop_substitute.h90"40 # include "do_loop_substitute.h90" 41 41 !!---------------------------------------------------------------------- 42 42 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 46 46 CONTAINS 47 47 48 SUBROUTINE p2z_exp( kt )48 SUBROUTINE p2z_exp( kt, Kmm, Krhs ) 49 49 !!--------------------------------------------------------------------- 50 50 !! *** ROUTINE p2z_exp *** … … 60 60 !!--------------------------------------------------------------------- 61 61 !! 62 INTEGER, INTENT( in ) :: kt ! ocean time-step index 62 INTEGER, INTENT( in ) :: kt ! ocean time-step index 63 INTEGER, INTENT( in ) :: Kmm, Krhs ! time level indices 63 64 !! 64 65 INTEGER :: ji, jj, jk, jl, ikt … … 70 71 IF( ln_timing ) CALL timing_start('p2z_exp') 71 72 ! 72 IF( kt == nittrc000 ) CALL p2z_exp_init 73 IF( kt == nittrc000 ) CALL p2z_exp_init( Kmm ) 73 74 74 75 zsedpoca(:,:) = 0. … … 80 81 ! LAYERS IS DETERMINED BY DMIN3 DEFINED IN sms_p2z.F90 81 82 ! ---------------------------------------------------------------------- 82 DO jk = 1, jpkm1 83 DO jj = 2, jpjm1 84 DO ji = fs_2, fs_jpim1 85 ze3t = 1. / e3t_n(ji,jj,jk) 86 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj) 87 END DO 88 END DO 89 END DO 83 DO_3D_00_00( 1, jpkm1 ) 84 ze3t = 1. / e3t(ji,jj,jk,Kmm) 85 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj) 86 END_3D 90 87 91 88 ! Find the last level of the water column … … 95 92 zgeolpoc = 0.e0 ! Initialization 96 93 ! Release of nutrients from the "simple" sediment 97 DO jj = 2, jpjm1 98 DO ji = fs_2, fs_jpim1 99 ikt = mbkt(ji,jj) 100 tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) + sedlam * sedpocn(ji,jj) / e3t_n(ji,jj,ikt) 101 ! Deposition of organic matter in the sediment 102 zwork = vsed * trn(ji,jj,ikt,jpdet) 103 zsedpoca(ji,jj) = ( zwork + dminl(ji,jj) * xksi(ji,jj) & 104 & - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rdt 105 zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1e2t(ji,jj) 106 END DO 107 END DO 108 109 DO jj = 2, jpjm1 110 DO ji = fs_2, fs_jpim1 111 tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc * cmask(ji,jj) / areacot / e3t_n(ji,jj,1) 112 END DO 113 END DO 94 DO_2D_00_00 95 ikt = mbkt(ji,jj) 96 tr(ji,jj,ikt,jpno3,Krhs) = tr(ji,jj,ikt,jpno3,Krhs) + sedlam * sedpocn(ji,jj) / e3t(ji,jj,ikt,Kmm) 97 ! Deposition of organic matter in the sediment 98 zwork = vsed * tr(ji,jj,ikt,jpdet,Kmm) 99 zsedpoca(ji,jj) = ( zwork + dminl(ji,jj) * xksi(ji,jj) & 100 & - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rdt 101 zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1e2t(ji,jj) 102 END_2D 103 104 DO_2D_00_00 105 tr(ji,jj,1,jpno3,Krhs) = tr(ji,jj,1,jpno3,Krhs) + zgeolpoc * cmask(ji,jj) / areacot / e3t(ji,jj,1,Kmm) 106 END_2D 114 107 115 108 CALL lbc_lnk( 'p2zexp', sedpocn, 'T', 1. ) … … 127 120 ELSE 128 121 ! 129 DO jj = 1, jpj 130 DO ji = 1, jpi 131 zsedpocd = zsedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj) ! time laplacian on tracers 132 sedpocb(ji,jj) = sedpocn(ji,jj) + atfp * zsedpocd ! sedpocb <-- filtered sedpocn 133 sedpocn(ji,jj) = zsedpoca(ji,jj) ! sedpocn <-- sedpoca 134 END DO 135 END DO 122 DO_2D_11_11 123 zsedpocd = zsedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj) ! time laplacian on tracers 124 sedpocb(ji,jj) = sedpocn(ji,jj) + atfp * zsedpocd ! sedpocb <-- filtered sedpocn 125 sedpocn(ji,jj) = zsedpoca(ji,jj) ! sedpocn <-- sedpoca 126 END_2D 136 127 ! 137 128 ENDIF … … 146 137 ENDIF 147 138 ! 148 IF( ln_ctl) THEN ! print mean trends (used for debugging)139 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 149 140 WRITE(charout, FMT="('exp')") 150 141 CALL prt_ctl_trc_info(charout) 151 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)142 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 152 143 ENDIF 153 144 ! … … 157 148 158 149 159 SUBROUTINE p2z_exp_init 150 SUBROUTINE p2z_exp_init( Kmm ) 160 151 !!---------------------------------------------------------------------- 161 152 !! *** ROUTINE p4z_exp_init *** 162 153 !! ** purpose : specific initialisation for export 163 154 !!---------------------------------------------------------------------- 155 INTEGER, INTENT(in) :: Kmm ! time level index 164 156 INTEGER :: ji, jj, jk 165 157 REAL(wp) :: zmaskt, zfluo, zfluu … … 181 173 zdm0 = 0._wp 182 174 zrro = 1._wp 183 DO jk = jpkb, jpkm1 184 DO jj = 1, jpj 185 DO ji = 1, jpi 186 zfluo = ( gdepw_n(ji,jj,jk ) / gdepw_n(ji,jj,jpkb) )**xhr 187 zfluu = ( gdepw_n(ji,jj,jk+1) / gdepw_n(ji,jj,jpkb) )**xhr 188 IF( zfluo.GT.1. ) zfluo = 1._wp 189 zdm0(ji,jj,jk) = zfluo - zfluu 190 IF( jk <= jpkb-1 ) zdm0(ji,jj,jk) = 0._wp 191 zrro(ji,jj) = zrro(ji,jj) - zdm0(ji,jj,jk) 192 END DO 193 END DO 194 END DO 175 DO_3D_11_11( jpkb, jpkm1 ) 176 zfluo = ( gdepw(ji,jj,jk ,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr 177 zfluu = ( gdepw(ji,jj,jk+1,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr 178 IF( zfluo.GT.1. ) zfluo = 1._wp 179 zdm0(ji,jj,jk) = zfluo - zfluu 180 IF( jk <= jpkb-1 ) zdm0(ji,jj,jk) = 0._wp 181 zrro(ji,jj) = zrro(ji,jj) - zdm0(ji,jj,jk) 182 END_3D 195 183 ! 196 184 zdm0(:,:,jpk) = zrro(:,:) … … 202 190 dminl(:,:) = 0._wp 203 191 dmin3(:,:,:) = zdm0 204 DO jk = 1, jpk 205 DO jj = 1, jpj 206 DO ji = 1, jpi 207 IF( tmask(ji,jj,jk) == 0._wp ) THEN 208 dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk) 209 dmin3(ji,jj,jk) = 0._wp 210 ENDIF 211 END DO 212 END DO 213 END DO 214 215 DO jj = 1, jpj 216 DO ji = 1, jpi 217 IF( tmask(ji,jj,1) == 0 ) dmin3(ji,jj,1) = 0._wp 218 END DO 219 END DO 192 DO_3D_11_11( 1, jpk ) 193 IF( tmask(ji,jj,jk) == 0._wp ) THEN 194 dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk) 195 dmin3(ji,jj,jk) = 0._wp 196 ENDIF 197 END_3D 198 199 DO_2D_11_11 200 IF( tmask(ji,jj,1) == 0 ) dmin3(ji,jj,1) = 0._wp 201 END_2D 220 202 221 203 ! Coastal mask 222 204 cmask(:,:) = 0._wp 223 DO jj = 2, jpjm1 224 DO ji = fs_2, fs_jpim1 225 IF( tmask(ji,jj,1) /= 0. ) THEN 226 zmaskt = tmask(ji+1,jj,1) * tmask(ji-1,jj,1) * tmask(ji,jj+1,1) * tmask(ji,jj-1,1) 227 IF( zmaskt == 0. ) cmask(ji,jj) = 1._wp 228 END IF 229 END DO 230 END DO 205 DO_2D_00_00 206 IF( tmask(ji,jj,1) /= 0. ) THEN 207 zmaskt = tmask(ji+1,jj,1) * tmask(ji-1,jj,1) * tmask(ji,jj+1,1) * tmask(ji,jj-1,1) 208 IF( zmaskt == 0. ) cmask(ji,jj) = 1._wp 209 END IF 210 END_2D 231 211 CALL lbc_lnk( 'p2zexp', cmask , 'T', 1. ) ! lateral boundary conditions on cmask (sign unchanged) 232 212 areacot = glob_sum( 'p2zexp', e1e2t(:,:) * cmask(:,:) ) -
NEMO/trunk/src/TOP/PISCES/P2Z/p2zopt.F90
r11536 r12377 38 38 REAL(wp), PUBLIC :: reddom ! redfield ratio (C:N) for DOM 39 39 40 !! * Substitutions 41 # include "do_loop_substitute.h90" 40 42 !!---------------------------------------------------------------------- 41 43 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 45 47 CONTAINS 46 48 47 SUBROUTINE p2z_opt( kt )49 SUBROUTINE p2z_opt( kt, Kmm ) 48 50 !!--------------------------------------------------------------------- 49 51 !! *** ROUTINE p2z_opt *** … … 61 63 !! 62 64 INTEGER, INTENT( in ) :: kt ! index of the time stepping 65 INTEGER, INTENT( in ) :: Kmm ! time level index 63 66 !! 64 67 INTEGER :: ji, jj, jk ! dummy loop indices … … 91 94 ! ! Photosynthetically Available Radiation (PAR) 92 95 zcoef = 12 * redf / rcchl / rpig ! -------------------------------------- 93 DO jk = 2, jpk ! local par at w-levels 94 DO jj = 1, jpj 95 DO ji = 1, jpi 96 zpig = LOG( MAX( TINY(0.), trn(ji,jj,jk-1,jpphy) ) * zcoef ) 97 zkr = xkr0 + xkrp * EXP( xlr * zpig ) 98 zkg = xkg0 + xkgp * EXP( xlg * zpig ) 99 zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * e3t_n(ji,jj,jk-1) ) 100 zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t_n(ji,jj,jk-1) ) 101 END DO 102 END DO 103 END DO 104 DO jk = 1, jpkm1 ! mean par at t-levels 105 DO jj = 1, jpj 106 DO ji = 1, jpi 107 zpig = LOG( MAX( TINY(0.), trn(ji,jj,jk,jpphy) ) * zcoef ) 108 zkr = xkr0 + xkrp * EXP( xlr * zpig ) 109 zkg = xkg0 + xkgp * EXP( xlg * zpig ) 110 zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * e3t_n(ji,jj,jk) ) * ( 1 - EXP( -zkr * e3t_n(ji,jj,jk) ) ) 111 zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * e3t_n(ji,jj,jk) ) * ( 1 - EXP( -zkg * e3t_n(ji,jj,jk) ) ) 112 etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 ) 113 END DO 114 END DO 115 END DO 96 DO_3D_11_11( 2, jpk ) 97 zpig = LOG( MAX( TINY(0.), tr(ji,jj,jk-1,jpphy,Kmm) ) * zcoef ) 98 zkr = xkr0 + xkrp * EXP( xlr * zpig ) 99 zkg = xkg0 + xkgp * EXP( xlg * zpig ) 100 zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * e3t(ji,jj,jk-1,Kmm) ) 101 zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t(ji,jj,jk-1,Kmm) ) 102 END_3D 103 DO_3D_11_11( 1, jpkm1 ) 104 zpig = LOG( MAX( TINY(0.), tr(ji,jj,jk,jpphy,Kmm) ) * zcoef ) 105 zkr = xkr0 + xkrp * EXP( xlr * zpig ) 106 zkg = xkg0 + xkgp * EXP( xlg * zpig ) 107 zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * e3t(ji,jj,jk,Kmm) ) * ( 1 - EXP( -zkr * e3t(ji,jj,jk,Kmm) ) ) 108 zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * e3t(ji,jj,jk,Kmm) ) * ( 1 - EXP( -zkg * e3t(ji,jj,jk,Kmm) ) ) 109 etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 ) 110 END_3D 116 111 117 112 ! ! Euphotic layer 118 113 ! ! -------------- 119 114 neln(:,:) = 1 ! euphotic layer level 120 DO jk = 1, jpkm1 ! (i.e. 1rst T-level strictly below EL bottom) 121 DO jj = 1, jpj 122 DO ji = 1, jpi 123 IF( etot(ji,jj,jk) >= zpar100(ji,jj) ) neln(ji,jj) = jk + 1 124 END DO 125 END DO 126 END DO 115 DO_3D_11_11( 1, jpkm1 ) 116 IF( etot(ji,jj,jk) >= zpar100(ji,jj) ) neln(ji,jj) = jk + 1 117 END_3D 127 118 ! ! Euphotic layer depth 128 DO jj = 1, jpj 129 DO ji = 1, jpi 130 heup(ji,jj) = gdepw_n(ji,jj,neln(ji,jj)) 131 END DO 132 END DO 119 DO_2D_11_11 120 heup(ji,jj) = gdepw(ji,jj,neln(ji,jj),Kmm) 121 END_2D 133 122 134 123 135 IF( ln_ctl) THEN ! print mean trends (used for debugging)124 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 136 125 WRITE(charout, FMT="('opt')") 137 126 CALL prt_ctl_trc_info( charout ) 138 CALL prt_ctl_trc( tab4d=tr n, mask=tmask, clinfo=ctrcnm )127 CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm ) 139 128 ENDIF 140 129 ! … … 159 148 !!---------------------------------------------------------------------- 160 149 161 REWIND( numnatp_ref ) ! Namelist namlobopt in reference namelist : Lobster options162 150 READ ( numnatp_ref, namlobopt, IOSTAT = ios, ERR = 901) 163 151 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobopt in reference namelist' ) 164 152 165 REWIND( numnatp_cfg ) ! Namelist namlobopt in configuration namelist : Lobster options166 153 READ ( numnatp_cfg, namlobopt, IOSTAT = ios, ERR = 902 ) 167 154 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namlobopt in configuration namelist' ) … … 181 168 ENDIF 182 169 ! 183 REWIND( numnatp_ref ) ! Namelist namlobrat in reference namelist : Lobster ratios184 170 READ ( numnatp_ref, namlobrat, IOSTAT = ios, ERR = 903) 185 171 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobrat in reference namelist' ) 186 172 187 REWIND( numnatp_cfg ) ! Namelist namlobrat in configuration namelist : Lobster ratios188 173 READ ( numnatp_cfg, namlobrat, IOSTAT = ios, ERR = 904 ) 189 174 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namlobrat in configuration namelist' ) -
NEMO/trunk/src/TOP/PISCES/P2Z/p2zsed.F90
r11536 r12377 31 31 REAL(wp), PUBLIC :: xhr !: coeff for martin''s remineralisation profile 32 32 33 !! * Substitutions 34 # include "do_loop_substitute.h90" 33 35 !!---------------------------------------------------------------------- 34 36 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 38 40 CONTAINS 39 41 40 SUBROUTINE p2z_sed( kt )42 SUBROUTINE p2z_sed( kt, Kmm, Krhs ) 41 43 !!--------------------------------------------------------------------- 42 44 !! *** ROUTINE p2z_sed *** … … 49 51 !! using an upstream scheme 50 52 !! the now vertical advection of tracers is given by: 51 !! dz(tr n wn) = 1/bt dk+1( e1t e2t vsed (trn) )52 !! add this trend now to the general trend of tracer (ta,sa,tr a):53 !! tr a = tra + dz(trn wn)53 !! dz(tr(:,:,:,:,Kmm) ww) = 1/bt dk+1( e1t e2t vsed (tr(:,:,:,:,Kmm)) ) 54 !! add this trend now to the general trend of tracer (ta,sa,tr(:,:,:,:,Krhs)): 55 !! tr(:,:,:,:,Krhs) = tr(:,:,:,:,Krhs) + dz(tr(:,:,:,:,Kmm) ww) 54 56 !! 55 57 !! IF 'key_diabio' is defined, the now vertical advection 56 58 !! trend of passive tracers is saved for futher diagnostics. 57 59 !!--------------------------------------------------------------------- 58 INTEGER, INTENT( in ) :: kt ! ocean time-step index 60 INTEGER, INTENT( in ) :: kt ! ocean time-step index 61 INTEGER, INTENT( in ) :: Kmm, Krhs ! time level indices 59 62 ! 60 63 INTEGER :: ji, jj, jk, jl, ierr … … 81 84 ! tracer flux at w-point: we use -vsed (downward flux) with simplification : no e1*e2 82 85 DO jk = 2, jpkm1 83 zwork(:,:,jk) = -vsed * tr n(:,:,jk-1,jpdet)86 zwork(:,:,jk) = -vsed * tr(:,:,jk-1,jpdet,Kmm) 84 87 END DO 85 88 86 89 ! tracer flux divergence at t-point added to the general trend 87 DO jk = 1, jpkm1 88 DO jj = 1, jpj 89 DO ji = 1, jpi 90 ztra(ji,jj,jk) = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / e3t_n(ji,jj,jk) 91 tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra(ji,jj,jk) 92 END DO 93 END DO 94 END DO 90 DO_3D_11_11( 1, jpkm1 ) 91 ztra(ji,jj,jk) = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 92 tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + ztra(ji,jj,jk) 93 END_3D 95 94 96 95 IF( lk_iomput ) THEN 97 96 IF( iom_use( "TDETSED" ) ) THEN 98 97 ALLOCATE( zw2d(jpi,jpj) ) 99 zw2d(:,:) = ztra(:,:,1) * e3t _n(:,:,1) * 86400._wp98 zw2d(:,:) = ztra(:,:,1) * e3t(:,:,1,Kmm) * 86400._wp 100 99 DO jk = 2, jpkm1 101 zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t _n(:,:,jk) * 86400._wp100 zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t(:,:,jk,Kmm) * 86400._wp 102 101 END DO 103 102 CALL iom_put( "TDETSED", zw2d ) … … 107 106 ! 108 107 109 IF( ln_ctl) THEN ! print mean trends (used for debugging)108 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 110 109 WRITE(charout, FMT="('sed')") 111 110 CALL prt_ctl_trc_info(charout) 112 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)111 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 113 112 ENDIF 114 113 ! … … 132 131 !!---------------------------------------------------------------------- 133 132 ! 134 REWIND( numnatp_ref ) ! Namelist namlobsed in reference namelist : Lobster sediments135 133 READ ( numnatp_ref, namlobsed, IOSTAT = ios, ERR = 901) 136 134 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlosed in reference namelist' ) 137 REWIND( numnatp_cfg ) ! Namelist namlobsed in configuration namelist : Lobster sediments138 135 READ ( numnatp_cfg, namlobsed, IOSTAT = ios, ERR = 902 ) 139 136 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namlobsed in configuration namelist' ) -
NEMO/trunk/src/TOP/PISCES/P2Z/p2zsms.F90
r10068 r12377 35 35 CONTAINS 36 36 37 SUBROUTINE p2z_sms( kt )37 SUBROUTINE p2z_sms( kt, Kmm, Krhs ) 38 38 !!--------------------------------------------------------------------- 39 39 !! *** ROUTINE p2z_sms *** … … 44 44 !! ** Method : - ??? 45 45 !! -------------------------------------------------------------------- 46 INTEGER, INTENT( in ) :: kt ! ocean time-step index 46 INTEGER, INTENT( in ) :: kt ! ocean time-step index 47 INTEGER, INTENT( in ) :: Kmm, Krhs ! ocean time level index 47 48 ! 48 49 INTEGER :: jn ! dummy loop index … … 51 52 IF( ln_timing ) CALL timing_start('p2z_sms') 52 53 ! 53 CALL p2z_opt( kt ) ! optical model54 CALL p2z_bio( kt ) ! biological model55 CALL p2z_sed( kt ) ! sedimentation model56 CALL p2z_exp( kt ) ! export54 CALL p2z_opt( kt, Kmm ) ! optical model 55 CALL p2z_bio( kt, Kmm, Krhs ) ! biological model 56 CALL p2z_sed( kt, Kmm, Krhs ) ! sedimentation model 57 CALL p2z_exp( kt, Kmm, Krhs ) ! export 57 58 ! 58 59 IF( l_trdtrc ) THEN 59 60 DO jn = jp_pcs0, jp_pcs1 60 CALL trd_trc( tr a(:,:,:,jn), jn, jptra_sms, kt) ! save trends61 CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm ) ! save trends 61 62 END DO 62 63 END IF -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zagg.F90
r10069 r12377 24 24 PUBLIC p4z_agg ! called in p4zbio.F90 25 25 26 !! * Substitutions 27 # include "do_loop_substitute.h90" 26 28 !!---------------------------------------------------------------------- 27 29 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 31 33 CONTAINS 32 34 33 SUBROUTINE p4z_agg ( kt, knt )35 SUBROUTINE p4z_agg ( kt, knt, Kbb, Krhs ) 34 36 !!--------------------------------------------------------------------- 35 37 !! *** ROUTINE p4z_agg *** … … 40 42 !!--------------------------------------------------------------------- 41 43 INTEGER, INTENT(in) :: kt, knt ! 44 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 42 45 ! 43 46 INTEGER :: ji, jj, jk … … 57 60 IF( ln_p4z ) THEN 58 61 ! 59 DO jk = 1, jpkm1 60 DO jj = 1, jpj 61 DO ji = 1, jpi 62 ! 63 zfact = xstep * xdiss(ji,jj,jk) 64 ! Part I : Coagulation dependent on turbulence 65 zagg1 = 25.9 * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc) 66 zagg2 = 4452. * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc) 62 DO_3D_11_11( 1, jpkm1 ) 63 ! 64 zfact = xstep * xdiss(ji,jj,jk) 65 ! Part I : Coagulation dependent on turbulence 66 zagg1 = 25.9 * zfact * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jppoc,Kbb) 67 zagg2 = 4452. * zfact * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpgoc,Kbb) 67 68 68 69 ! Part II : Differential settling 69 70 70 71 zagg3 = 47.1 * xstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc)72 zagg4 = 3.3 * xstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc)71 ! Aggregation of small into large particles 72 zagg3 = 47.1 * xstep * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpgoc,Kbb) 73 zagg4 = 3.3 * xstep * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jppoc,Kbb) 73 74 74 75 zaggfe = zagg * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn )75 zagg = zagg1 + zagg2 + zagg3 + zagg4 76 zaggfe = zagg * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 76 77 77 78 79 80 81 zaggdoc = ( ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * zfact &82 & + 2.4 * xstep * trb(ji,jj,jk,jppoc) ) * 0.3 * trb(ji,jj,jk,jpdoc)83 84 85 86 zaggdoc2 = ( 3.53E3 * zfact + 0.1 * xstep ) * trb(ji,jj,jk,jpgoc) * 0.3 * trb(ji,jj,jk,jpdoc)87 88 zaggdoc3 = 114. * 0.3 * trb(ji,jj,jk,jpdoc) *xstep * 0.3 * trb(ji,jj,jk,jpdoc)78 ! Aggregation of DOC to POC : 79 ! 1st term is shear aggregation of DOC-DOC 80 ! 2nd term is shear aggregation of DOC-POC 81 ! 3rd term is differential settling of DOC-POC 82 zaggdoc = ( ( 0.369 * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4 * tr(ji,jj,jk,jppoc,Kbb) ) * zfact & 83 & + 2.4 * xstep * tr(ji,jj,jk,jppoc,Kbb) ) * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 84 ! transfer of DOC to GOC : 85 ! 1st term is shear aggregation 86 ! 2nd term is differential settling 87 zaggdoc2 = ( 3.53E3 * zfact + 0.1 * xstep ) * tr(ji,jj,jk,jpgoc,Kbb) * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 88 ! tranfer of DOC to POC due to brownian motion 89 zaggdoc3 = 114. * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) *xstep * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 89 90 90 ! Update the trends 91 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc + zaggdoc3 92 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zagg + zaggdoc2 93 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe 94 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe 95 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 - zaggdoc3 96 ! 97 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zagg + zaggdoc + zaggdoc3 98 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zagg + zaggdoc2 99 ! 100 END DO 101 END DO 102 END DO 91 ! Update the trends 92 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zagg + zaggdoc + zaggdoc3 93 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zagg + zaggdoc2 94 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zaggfe 95 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zaggfe 96 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zaggdoc - zaggdoc2 - zaggdoc3 97 ! 98 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zagg + zaggdoc + zaggdoc3 99 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zagg + zaggdoc2 100 ! 101 END_3D 103 102 ELSE ! ln_p5z 104 103 ! 105 DO jk = 1, jpkm1 106 DO jj = 1, jpj 107 DO ji = 1, jpi 108 ! 109 zfact = xstep * xdiss(ji,jj,jk) 110 ! Part I : Coagulation dependent on turbulence 111 zaggtmp = 25.9 * zfact * trb(ji,jj,jk,jppoc) 112 zaggpoc1 = zaggtmp * trb(ji,jj,jk,jppoc) 113 zaggtmp = 4452. * zfact * trb(ji,jj,jk,jpgoc) 114 zaggpoc2 = zaggtmp * trb(ji,jj,jk,jppoc) 104 DO_3D_11_11( 1, jpkm1 ) 105 ! 106 zfact = xstep * xdiss(ji,jj,jk) 107 ! Part I : Coagulation dependent on turbulence 108 zaggtmp = 25.9 * zfact * tr(ji,jj,jk,jppoc,Kbb) 109 zaggpoc1 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 110 zaggtmp = 4452. * zfact * tr(ji,jj,jk,jpgoc,Kbb) 111 zaggpoc2 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 115 112 116 ! Part II : Differential settling 117 118 ! Aggregation of small into large particles 119 zaggtmp = 47.1 * xstep * trb(ji,jj,jk,jpgoc) 120 zaggpoc3 = zaggtmp * trb(ji,jj,jk,jppoc) 121 zaggtmp = 3.3 * xstep * trb(ji,jj,jk,jppoc) 122 zaggpoc4 = zaggtmp * trb(ji,jj,jk,jppoc) 113 ! Part II : Differential settling 123 114 124 zaggpoc = zaggpoc1 + zaggpoc2 + zaggpoc3 + zaggpoc4 125 zaggpon = zaggpoc * trb(ji,jj,jk,jppon) / ( trb(ji,jj,jk,jppoc) + rtrn) 126 zaggpop = zaggpoc * trb(ji,jj,jk,jppop) / ( trb(ji,jj,jk,jppoc) + rtrn) 127 zaggfe = zaggpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn ) 115 ! Aggregation of small into large particles 116 zaggtmp = 47.1 * xstep * tr(ji,jj,jk,jpgoc,Kbb) 117 zaggpoc3 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 118 zaggtmp = 3.3 * xstep * tr(ji,jj,jk,jppoc,Kbb) 119 zaggpoc4 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 128 120 129 ! Aggregation of DOC to POC : 130 ! 1st term is shear aggregation of DOC-DOC 131 ! 2nd term is shear aggregation of DOC-POC 132 ! 3rd term is differential settling of DOC-POC 133 zaggtmp = ( ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * zfact & 134 & + 2.4 * xstep * trb(ji,jj,jk,jppoc) ) 135 zaggdoc = zaggtmp * 0.3 * trb(ji,jj,jk,jpdoc) 136 zaggdon = zaggtmp * 0.3 * trb(ji,jj,jk,jpdon) 137 zaggdop = zaggtmp * 0.3 * trb(ji,jj,jk,jpdop) 121 zaggpoc = zaggpoc1 + zaggpoc2 + zaggpoc3 + zaggpoc4 122 zaggpon = zaggpoc * tr(ji,jj,jk,jppon,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 123 zaggpop = zaggpoc * tr(ji,jj,jk,jppop,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 124 zaggfe = zaggpoc * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 138 125 139 ! transfer of DOC to GOC : 140 ! 1st term is shear aggregation 141 ! 2nd term is differential settling 142 zaggtmp = ( 3.53E3 * zfact + 0.1 * xstep ) * trb(ji,jj,jk,jpgoc) 143 zaggdoc2 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdoc) 144 zaggdon2 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdon) 145 zaggdop2 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdop) 126 ! Aggregation of DOC to POC : 127 ! 1st term is shear aggregation of DOC-DOC 128 ! 2nd term is shear aggregation of DOC-POC 129 ! 3rd term is differential settling of DOC-POC 130 zaggtmp = ( ( 0.369 * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4 * tr(ji,jj,jk,jppoc,Kbb) ) * zfact & 131 & + 2.4 * xstep * tr(ji,jj,jk,jppoc,Kbb) ) 132 zaggdoc = zaggtmp * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 133 zaggdon = zaggtmp * 0.3 * tr(ji,jj,jk,jpdon,Kbb) 134 zaggdop = zaggtmp * 0.3 * tr(ji,jj,jk,jpdop,Kbb) 146 135 147 ! tranfer of DOC to POC due to brownian motion 148 zaggtmp = ( 114. * 0.3 * trb(ji,jj,jk,jpdoc) ) * xstep 149 zaggdoc3 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdoc) 150 zaggdon3 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdon) 151 zaggdop3 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdop) 136 ! transfer of DOC to GOC : 137 ! 1st term is shear aggregation 138 ! 2nd term is differential settling 139 zaggtmp = ( 3.53E3 * zfact + 0.1 * xstep ) * tr(ji,jj,jk,jpgoc,Kbb) 140 zaggdoc2 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 141 zaggdon2 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdon,Kbb) 142 zaggdop2 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdop,Kbb) 152 143 153 ! Update the trends 154 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zaggpoc + zaggdoc + zaggdoc3 155 tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) - zaggpon + zaggdon + zaggdon3 156 tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) - zaggpop + zaggdop + zaggdop3 157 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zaggpoc + zaggdoc2 158 tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zaggpon + zaggdon2 159 tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + zaggpop + zaggdop2 160 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe 161 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe 162 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 - zaggdoc3 163 tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) - zaggdon - zaggdon2 - zaggdon3 164 tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) - zaggdop - zaggdop2 - zaggdop3 165 ! 166 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zaggpoc + zaggdoc + zaggdoc3 167 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zaggpoc + zaggdoc2 168 ! 169 END DO 170 END DO 171 END DO 144 ! tranfer of DOC to POC due to brownian motion 145 zaggtmp = ( 114. * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) ) * xstep 146 zaggdoc3 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 147 zaggdon3 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdon,Kbb) 148 zaggdop3 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdop,Kbb) 149 150 ! Update the trends 151 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zaggpoc + zaggdoc + zaggdoc3 152 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) - zaggpon + zaggdon + zaggdon3 153 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) - zaggpop + zaggdop + zaggdop3 154 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zaggpoc + zaggdoc2 155 tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zaggpon + zaggdon2 156 tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + zaggpop + zaggdop2 157 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zaggfe 158 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zaggfe 159 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zaggdoc - zaggdoc2 - zaggdoc3 160 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) - zaggdon - zaggdon2 - zaggdon3 161 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) - zaggdop - zaggdop2 - zaggdop3 162 ! 163 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zaggpoc + zaggdoc + zaggdoc3 164 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zaggpoc + zaggdoc2 165 ! 166 END_3D 172 167 ! 173 168 ENDIF 174 169 ! 175 IF( ln_ctl) THEN ! print mean trends (used for debugging)170 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 176 171 WRITE(charout, FMT="('agg')") 177 172 CALL prt_ctl_trc_info(charout) 178 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)173 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 179 174 ENDIF 180 175 ! -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zbio.F90
r10227 r12377 38 38 PUBLIC p4z_bio 39 39 40 !! * Substitutions 41 # include "do_loop_substitute.h90" 40 42 !!---------------------------------------------------------------------- 41 43 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 45 47 CONTAINS 46 48 47 SUBROUTINE p4z_bio ( kt, knt )49 SUBROUTINE p4z_bio ( kt, knt, Kbb, Kmm, Krhs ) 48 50 !!--------------------------------------------------------------------- 49 51 !! *** ROUTINE p4z_bio *** … … 56 58 !!--------------------------------------------------------------------- 57 59 INTEGER, INTENT(in) :: kt, knt 60 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 58 61 ! 59 62 INTEGER :: ji, jj, jk, jn … … 68 71 xdiss(:,:,:) = 1. 69 72 !!gm the use of nmld should be better here? 70 DO jk = 2, jpkm1 71 DO jj = 1, jpj 72 DO ji = 1, jpi 73 DO_3D_11_11( 2, jpkm1 ) 73 74 !!gm : use nmln and test on jk ... less memory acces 74 IF( gdepw_n(ji,jj,jk+1) > hmld(ji,jj) ) xdiss(ji,jj,jk) = 0.01 75 END DO 76 END DO 77 END DO 75 IF( gdepw(ji,jj,jk+1,Kmm) > hmld(ji,jj) ) xdiss(ji,jj,jk) = 0.01 76 END_3D 78 77 79 CALL p4z_opt ( kt, knt ) ! Optic: PAR in the water column80 CALL p4z_sink ( kt, knt ) ! vertical flux of particulate organic matter81 CALL p4z_fechem ( kt, knt ) ! Iron chemistry/scavenging78 CALL p4z_opt ( kt, knt, Kbb, Kmm ) ! Optic: PAR in the water column 79 CALL p4z_sink ( kt, knt, Kbb, Kmm, Krhs ) ! vertical flux of particulate organic matter 80 CALL p4z_fechem ( kt, knt, Kbb, Kmm, Krhs ) ! Iron chemistry/scavenging 82 81 ! 83 82 IF( ln_p4z ) THEN 84 CALL p4z_lim ( kt, knt ) ! co-limitations by the various nutrients85 CALL p4z_prod ( kt, knt ) ! phytoplankton growth rate over the global ocean.86 ! ! (for each element : C, Si, Fe, Chl )87 CALL p4z_mort ( kt 88 ! ! zooplankton sources/sinks routines89 CALL p4z_micro( kt, knt )! microzooplankton90 CALL p4z_meso ( kt, knt )! mesozooplankton83 CALL p4z_lim ( kt, knt, Kbb, Kmm ) ! co-limitations by the various nutrients 84 CALL p4z_prod ( kt, knt, Kbb, Kmm, Krhs ) ! phytoplankton growth rate over the global ocean. 85 ! ! (for each element : C, Si, Fe, Chl ) 86 CALL p4z_mort ( kt, Kbb, Krhs ) ! phytoplankton mortality 87 ! ! zooplankton sources/sinks routines 88 CALL p4z_micro( kt, knt, Kbb, Krhs ) ! microzooplankton 89 CALL p4z_meso ( kt, knt, Kbb, Krhs ) ! mesozooplankton 91 90 ELSE 92 CALL p5z_lim ( kt, knt ) ! co-limitations by the various nutrients93 CALL p5z_prod ( kt, knt ) ! phytoplankton growth rate over the global ocean.94 ! ! (for each element : C, Si, Fe, Chl )95 CALL p5z_mort ( kt ) ! phytoplankton mortality96 ! ! zooplankton sources/sinks routines97 CALL p5z_micro( kt, knt ) ! microzooplankton98 CALL p5z_meso ( kt, knt ) ! mesozooplankton91 CALL p5z_lim ( kt, knt, Kbb, Kmm ) ! co-limitations by the various nutrients 92 CALL p5z_prod ( kt, knt, Kbb, Kmm, Krhs ) ! phytoplankton growth rate over the global ocean. 93 ! ! (for each element : C, Si, Fe, Chl ) 94 CALL p5z_mort ( kt, Kbb, Krhs ) ! phytoplankton mortality 95 ! ! zooplankton sources/sinks routines 96 CALL p5z_micro( kt, knt, Kbb, Krhs ) ! microzooplankton 97 CALL p5z_meso ( kt, knt, Kbb, Krhs ) ! mesozooplankton 99 98 ENDIF 100 99 ! 101 CALL p4z_agg ( kt, knt ) ! Aggregation of particles102 CALL p4z_rem ( kt, knt ) ! remineralization terms of organic matter+scavenging of Fe103 CALL p4z_poc ( kt, knt ) ! Remineralization of organic particles100 CALL p4z_agg ( kt, knt, Kbb, Krhs ) ! Aggregation of particles 101 CALL p4z_rem ( kt, knt, Kbb, Kmm, Krhs ) ! remineralization terms of organic matter+scavenging of Fe 102 CALL p4z_poc ( kt, knt, Kbb, Kmm, Krhs ) ! Remineralization of organic particles 104 103 ! 105 104 IF( ln_ligand ) & 106 & CALL p4z_ligand( kt, knt )105 & CALL p4z_ligand( kt, knt, Kbb, Krhs ) 107 106 ! ! 108 IF( ln_ctl) THEN ! print mean trends (used for debugging)107 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 109 108 WRITE(charout, FMT="('bio ')") 110 109 CALL prt_ctl_trc_info(charout) 111 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)110 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 112 111 ENDIF 113 112 ! -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zche.F90
r10425 r12377 130 130 INTEGER :: niter_atgen = jp_maxniter_atgen 131 131 132 !! * Substitutions 133 # include "do_loop_substitute.h90" 132 134 !!---------------------------------------------------------------------- 133 135 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 137 139 CONTAINS 138 140 139 SUBROUTINE p4z_che 141 SUBROUTINE p4z_che( Kbb, Kmm ) 140 142 !!--------------------------------------------------------------------- 141 143 !! *** ROUTINE p4z_che *** … … 145 147 !! ** Method : - ... 146 148 !!--------------------------------------------------------------------- 149 INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices 147 150 INTEGER :: ji, jj, jk 148 151 REAL(wp) :: ztkel, ztkel1, zt , zsal , zsal2 , zbuf1 , zbuf2 … … 164 167 ! ------------------------------------------------------------- 165 168 IF (neos == -1) THEN 166 salinprac(:,:,:) = ts n(:,:,:,jp_sal) * 35.0 / 35.16504169 salinprac(:,:,:) = ts(:,:,:,jp_sal,Kmm) * 35.0 / 35.16504 167 170 ELSE 168 salinprac(:,:,:) = ts n(:,:,:,jp_sal)171 salinprac(:,:,:) = ts(:,:,:,jp_sal,Kmm) 169 172 ENDIF 170 173 … … 175 178 ! 0.04°C relative to an exact computation 176 179 ! --------------------------------------------------------------------- 177 DO jk = 1, jpk 178 DO jj = 1, jpj 179 DO ji = 1, jpi 180 zpres = gdept_n(ji,jj,jk) / 1000. 181 za1 = 0.04 * ( 1.0 + 0.185 * tsn(ji,jj,jk,jp_tem) + 0.035 * (salinprac(ji,jj,jk) - 35.0) ) 182 za2 = 0.0075 * ( 1.0 - tsn(ji,jj,jk,jp_tem) / 30.0 ) 183 tempis(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) - za1 * zpres + za2 * zpres**2 184 END DO 185 END DO 186 END DO 180 DO_3D_11_11( 1, jpk ) 181 zpres = gdept(ji,jj,jk,Kmm) / 1000. 182 za1 = 0.04 * ( 1.0 + 0.185 * ts(ji,jj,jk,jp_tem,Kmm) + 0.035 * (salinprac(ji,jj,jk) - 35.0) ) 183 za2 = 0.0075 * ( 1.0 - ts(ji,jj,jk,jp_tem,Kmm) / 30.0 ) 184 tempis(ji,jj,jk) = ts(ji,jj,jk,jp_tem,Kmm) - za1 * zpres + za2 * zpres**2 185 END_3D 187 186 ! 188 187 ! CHEMICAL CONSTANTS - SURFACE LAYER … … 245 244 zplat = SIN ( ABS(gphit(ji,jj)*3.141592654/180.) ) 246 245 zc1 = 5.92E-3 + zplat**2 * 5.25E-3 247 zpres = ((1-zc1)-SQRT(((1-zc1)**2)-(8.84E-6*gdept _n(ji,jj,jk)))) / 4.42E-6246 zpres = ((1-zc1)-SQRT(((1-zc1)**2)-(8.84E-6*gdept(ji,jj,jk,Kmm)))) / 4.42E-6 248 247 zpres = zpres / 10.0 249 248 … … 448 447 END SUBROUTINE p4z_che 449 448 450 SUBROUTINE ahini_for_at(p_hini )449 SUBROUTINE ahini_for_at(p_hini, Kbb ) 451 450 !!--------------------------------------------------------------------- 452 451 !! *** ROUTINE ahini_for_at *** … … 462 461 !!--------------------------------------------------------------------- 463 462 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_hini 463 INTEGER, INTENT(in) :: Kbb ! time level indices 464 464 INTEGER :: ji, jj, jk 465 465 REAL(wp) :: zca1, zba1 … … 471 471 IF( ln_timing ) CALL timing_start('ahini_for_at') 472 472 ! 473 DO jk = 1, jpk 474 DO jj = 1, jpj 475 DO ji = 1, jpi 476 p_alkcb = trb(ji,jj,jk,jptal) * 1000. / (rhop(ji,jj,jk) + rtrn) 477 p_dictot = trb(ji,jj,jk,jpdic) * 1000. / (rhop(ji,jj,jk) + rtrn) 478 p_bortot = borat(ji,jj,jk) 479 IF (p_alkcb <= 0.) THEN 480 p_hini(ji,jj,jk) = 1.e-3 481 ELSEIF (p_alkcb >= (2.*p_dictot + p_bortot)) THEN 482 p_hini(ji,jj,jk) = 1.e-10_wp 473 DO_3D_11_11( 1, jpk ) 474 p_alkcb = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 475 p_dictot = tr(ji,jj,jk,jpdic,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 476 p_bortot = borat(ji,jj,jk) 477 IF (p_alkcb <= 0.) THEN 478 p_hini(ji,jj,jk) = 1.e-3 479 ELSEIF (p_alkcb >= (2.*p_dictot + p_bortot)) THEN 480 p_hini(ji,jj,jk) = 1.e-10_wp 481 ELSE 482 zca1 = p_dictot/( p_alkcb + rtrn ) 483 zba1 = p_bortot/ (p_alkcb + rtrn ) 484 ! Coefficients of the cubic polynomial 485 za2 = aKb3(ji,jj,jk)*(1. - zba1) + ak13(ji,jj,jk)*(1.-zca1) 486 za1 = ak13(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - zca1) & 487 & + ak13(ji,jj,jk)*ak23(ji,jj,jk)*(1. - (zca1+zca1)) 488 za0 = ak13(ji,jj,jk)*ak23(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - (zca1+zca1)) 489 ! Taylor expansion around the minimum 490 zd = za2*za2 - 3.*za1 ! Discriminant of the quadratic equation 491 ! for the minimum close to the root 492 493 IF(zd > 0.) THEN ! If the discriminant is positive 494 zsqrtd = SQRT(zd) 495 IF(za2 < 0) THEN 496 zhmin = (-za2 + zsqrtd)/3. 483 497 ELSE 484 zca1 = p_dictot/( p_alkcb + rtrn ) 485 zba1 = p_bortot/ (p_alkcb + rtrn ) 486 ! Coefficients of the cubic polynomial 487 za2 = aKb3(ji,jj,jk)*(1. - zba1) + ak13(ji,jj,jk)*(1.-zca1) 488 za1 = ak13(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - zca1) & 489 & + ak13(ji,jj,jk)*ak23(ji,jj,jk)*(1. - (zca1+zca1)) 490 za0 = ak13(ji,jj,jk)*ak23(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - (zca1+zca1)) 491 ! Taylor expansion around the minimum 492 zd = za2*za2 - 3.*za1 ! Discriminant of the quadratic equation 493 ! for the minimum close to the root 494 495 IF(zd > 0.) THEN ! If the discriminant is positive 496 zsqrtd = SQRT(zd) 497 IF(za2 < 0) THEN 498 zhmin = (-za2 + zsqrtd)/3. 499 ELSE 500 zhmin = -za1/(za2 + zsqrtd) 501 ENDIF 502 p_hini(ji,jj,jk) = zhmin + SQRT(-(za0 + zhmin*(za1 + zhmin*(za2 + zhmin)))/zsqrtd) 503 ELSE 504 p_hini(ji,jj,jk) = 1.e-7 505 ENDIF 506 ! 507 ENDIF 508 END DO 509 END DO 510 END DO 498 zhmin = -za1/(za2 + zsqrtd) 499 ENDIF 500 p_hini(ji,jj,jk) = zhmin + SQRT(-(za0 + zhmin*(za1 + zhmin*(za2 + zhmin)))/zsqrtd) 501 ELSE 502 p_hini(ji,jj,jk) = 1.e-7 503 ENDIF 504 ! 505 ENDIF 506 END_3D 511 507 ! 512 508 IF( ln_timing ) CALL timing_stop('ahini_for_at') … … 516 512 !=============================================================================== 517 513 518 SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup )514 SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup, Kbb ) 519 515 520 516 ! Subroutine returns the lower and upper bounds of "non-water-selfionization" … … 525 521 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_inf 526 522 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_sup 527 528 p_alknw_inf(:,:,:) = -trb(:,:,:,jppo4) * 1000. / (rhop(:,:,:) + rtrn) - sulfat(:,:,:) & 523 INTEGER, INTENT(in) :: Kbb ! time level indices 524 525 p_alknw_inf(:,:,:) = -tr(:,:,:,jppo4,Kbb) * 1000. / (rhop(:,:,:) + rtrn) - sulfat(:,:,:) & 529 526 & - fluorid(:,:,:) 530 p_alknw_sup(:,:,:) = (2. * tr b(:,:,:,jpdic) + 2. * trb(:,:,:,jppo4) + trb(:,:,:,jpsil) ) &527 p_alknw_sup(:,:,:) = (2. * tr(:,:,:,jpdic,Kbb) + 2. * tr(:,:,:,jppo4,Kbb) + tr(:,:,:,jpsil,Kbb) ) & 531 528 & * 1000. / (rhop(:,:,:) + rtrn) + borat(:,:,:) 532 529 … … 534 531 535 532 536 SUBROUTINE solve_at_general( p_hini, zhi )533 SUBROUTINE solve_at_general( p_hini, zhi, Kbb ) 537 534 538 535 ! Universal pH solver that converges from any given initial value, … … 543 540 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: p_hini 544 541 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: zhi 542 INTEGER, INTENT(in) :: Kbb ! time level indices 545 543 546 544 ! Local variables … … 565 563 IF( ln_timing ) CALL timing_start('solve_at_general') 566 564 567 CALL anw_infsup( zalknw_inf, zalknw_sup )565 CALL anw_infsup( zalknw_inf, zalknw_sup, Kbb ) 568 566 569 567 rmask(:,:,:) = tmask(:,:,:) … … 571 569 572 570 ! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree 573 DO jk = 1, jpk 574 DO jj = 1, jpj 575 DO ji = 1, jpi 576 IF (rmask(ji,jj,jk) == 1.) THEN 577 p_alktot = trb(ji,jj,jk,jptal) * 1000. / (rhop(ji,jj,jk) + rtrn) 578 aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 579 zh_ini = p_hini(ji,jj,jk) 580 581 zdelta = (p_alktot-zalknw_inf(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 582 583 IF(p_alktot >= zalknw_inf(ji,jj,jk)) THEN 584 zh_min(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_inf(ji,jj,jk) + SQRT(zdelta) ) 585 ELSE 586 zh_min(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_inf(ji,jj,jk)) + SQRT(zdelta) ) / 2. 587 ENDIF 588 589 zdelta = (p_alktot-zalknw_sup(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 590 591 IF(p_alktot <= zalknw_sup(ji,jj,jk)) THEN 592 zh_max(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_sup(ji,jj,jk)) + SQRT(zdelta) ) / 2. 593 ELSE 594 zh_max(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_sup(ji,jj,jk) + SQRT(zdelta) ) 595 ENDIF 596 597 zhi(ji,jj,jk) = MAX(MIN(zh_max(ji,jj,jk), zh_ini), zh_min(ji,jj,jk)) 571 DO_3D_11_11( 1, jpk ) 572 IF (rmask(ji,jj,jk) == 1.) THEN 573 p_alktot = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 574 aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 575 zh_ini = p_hini(ji,jj,jk) 576 577 zdelta = (p_alktot-zalknw_inf(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 578 579 IF(p_alktot >= zalknw_inf(ji,jj,jk)) THEN 580 zh_min(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_inf(ji,jj,jk) + SQRT(zdelta) ) 581 ELSE 582 zh_min(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_inf(ji,jj,jk)) + SQRT(zdelta) ) / 2. 583 ENDIF 584 585 zdelta = (p_alktot-zalknw_sup(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 586 587 IF(p_alktot <= zalknw_sup(ji,jj,jk)) THEN 588 zh_max(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_sup(ji,jj,jk)) + SQRT(zdelta) ) / 2. 589 ELSE 590 zh_max(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_sup(ji,jj,jk) + SQRT(zdelta) ) 591 ENDIF 592 593 zhi(ji,jj,jk) = MAX(MIN(zh_max(ji,jj,jk), zh_ini), zh_min(ji,jj,jk)) 594 ENDIF 595 END_3D 596 597 zeqn_absmin(:,:,:) = HUGE(1._wp) 598 599 DO jn = 1, jp_maxniter_atgen 600 DO_3D_11_11( 1, jpk ) 601 IF (rmask(ji,jj,jk) == 1.) THEN 602 zfact = rhop(ji,jj,jk) / 1000. + rtrn 603 p_alktot = tr(ji,jj,jk,jptal,Kbb) / zfact 604 zdic = tr(ji,jj,jk,jpdic,Kbb) / zfact 605 zbot = borat(ji,jj,jk) 606 zpt = tr(ji,jj,jk,jppo4,Kbb) / zfact * po4r 607 zsit = tr(ji,jj,jk,jpsil,Kbb) / zfact 608 zst = sulfat (ji,jj,jk) 609 zft = fluorid(ji,jj,jk) 610 aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 611 zh = zhi(ji,jj,jk) 612 zh_prev = zh 613 614 ! H2CO3 - HCO3 - CO3 : n=2, m=0 615 znumer_dic = 2.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk) 616 zdenom_dic = ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*(ak13(ji,jj,jk) + zh) 617 zalk_dic = zdic * (znumer_dic/zdenom_dic) 618 zdnumer_dic = ak13(ji,jj,jk)*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh & 619 *(4.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk)) 620 zdalk_dic = -zdic*(zdnumer_dic/zdenom_dic**2) 621 622 623 ! B(OH)3 - B(OH)4 : n=1, m=0 624 znumer_bor = akb3(ji,jj,jk) 625 zdenom_bor = akb3(ji,jj,jk) + zh 626 zalk_bor = zbot * (znumer_bor/zdenom_bor) 627 zdnumer_bor = akb3(ji,jj,jk) 628 zdalk_bor = -zbot*(zdnumer_bor/zdenom_bor**2) 629 630 631 ! H3PO4 - H2PO4 - HPO4 - PO4 : n=3, m=1 632 znumer_po4 = 3.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk) & 633 & + zh*(2.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh* ak1p3(ji,jj,jk)) 634 zdenom_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk) & 635 & + zh*( ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh*(ak1p3(ji,jj,jk) + zh)) 636 zalk_po4 = zpt * (znumer_po4/zdenom_po4 - 1.) ! Zero level of H3PO4 = 1 637 zdnumer_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk) & 638 & + zh*(4.*ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk) & 639 & + zh*(9.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk) & 640 & + ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) & 641 & + zh*(4.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh * ak1p3(ji,jj,jk) ) ) ) 642 zdalk_po4 = -zpt * (zdnumer_po4/zdenom_po4**2) 643 644 ! H4SiO4 - H3SiO4 : n=1, m=0 645 znumer_sil = aksi3(ji,jj,jk) 646 zdenom_sil = aksi3(ji,jj,jk) + zh 647 zalk_sil = zsit * (znumer_sil/zdenom_sil) 648 zdnumer_sil = aksi3(ji,jj,jk) 649 zdalk_sil = -zsit * (zdnumer_sil/zdenom_sil**2) 650 651 ! HSO4 - SO4 : n=1, m=1 652 aphscale = 1.0 + zst/aks3(ji,jj,jk) 653 znumer_so4 = aks3(ji,jj,jk) * aphscale 654 zdenom_so4 = aks3(ji,jj,jk) * aphscale + zh 655 zalk_so4 = zst * (znumer_so4/zdenom_so4 - 1.) 656 zdnumer_so4 = aks3(ji,jj,jk) 657 zdalk_so4 = -zst * (zdnumer_so4/zdenom_so4**2) 658 659 ! HF - F : n=1, m=1 660 znumer_flu = akf3(ji,jj,jk) 661 zdenom_flu = akf3(ji,jj,jk) + zh 662 zalk_flu = zft * (znumer_flu/zdenom_flu - 1.) 663 zdnumer_flu = akf3(ji,jj,jk) 664 zdalk_flu = -zft * (zdnumer_flu/zdenom_flu**2) 665 666 ! H2O - OH 667 aphscale = 1.0 + zst/aks3(ji,jj,jk) 668 zalk_wat = akw3(ji,jj,jk)/zh - zh/aphscale 669 zdalk_wat = -akw3(ji,jj,jk)/zh**2 - 1./aphscale 670 671 ! CALCULATE [ALK]([CO3--], [HCO3-]) 672 zeqn = zalk_dic + zalk_bor + zalk_po4 + zalk_sil & 673 & + zalk_so4 + zalk_flu & 674 & + zalk_wat - p_alktot 675 676 zalka = p_alktot - (zalk_bor + zalk_po4 + zalk_sil & 677 & + zalk_so4 + zalk_flu + zalk_wat) 678 679 zdeqndh = zdalk_dic + zdalk_bor + zdalk_po4 + zdalk_sil & 680 & + zdalk_so4 + zdalk_flu + zdalk_wat 681 682 ! Adapt bracketing interval 683 IF(zeqn > 0._wp) THEN 684 zh_min(ji,jj,jk) = zh_prev 685 ELSEIF(zeqn < 0._wp) THEN 686 zh_max(ji,jj,jk) = zh_prev 687 ENDIF 688 689 IF(ABS(zeqn) >= 0.5_wp*zeqn_absmin(ji,jj,jk)) THEN 690 ! if the function evaluation at the current point is 691 ! not decreasing faster than with a bisection step (at least linearly) 692 ! in absolute value take one bisection step on [ph_min, ph_max] 693 ! ph_new = (ph_min + ph_max)/2d0 694 ! 695 ! In terms of [H]_new: 696 ! [H]_new = 10**(-ph_new) 697 ! = 10**(-(ph_min + ph_max)/2d0) 698 ! = SQRT(10**(-(ph_min + phmax))) 699 ! = SQRT(zh_max * zh_min) 700 zh = SQRT(zh_max(ji,jj,jk) * zh_min(ji,jj,jk)) 701 zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 702 ELSE 703 ! dzeqn/dpH = dzeqn/d[H] * d[H]/dpH 704 ! = -zdeqndh * LOG(10) * [H] 705 ! \Delta pH = -zeqn/(zdeqndh*d[H]/dpH) = zeqn/(zdeqndh*[H]*LOG(10)) 706 ! 707 ! pH_new = pH_old + \deltapH 708 ! 709 ! [H]_new = 10**(-pH_new) 710 ! = 10**(-pH_old - \Delta pH) 711 ! = [H]_old * 10**(-zeqn/(zdeqndh*[H]_old*LOG(10))) 712 ! = [H]_old * EXP(-LOG(10)*zeqn/(zdeqndh*[H]_old*LOG(10))) 713 ! = [H]_old * EXP(-zeqn/(zdeqndh*[H]_old)) 714 715 zh_lnfactor = -zeqn/(zdeqndh*zh_prev) 716 717 IF(ABS(zh_lnfactor) > pz_exp_threshold) THEN 718 zh = zh_prev*EXP(zh_lnfactor) 719 ELSE 720 zh_delta = zh_lnfactor*zh_prev 721 zh = zh_prev + zh_delta 598 722 ENDIF 599 END DO 600 END DO 601 END DO 602 603 zeqn_absmin(:,:,:) = HUGE(1._wp) 604 605 DO jn = 1, jp_maxniter_atgen 606 DO jk = 1, jpk 607 DO jj = 1, jpj 608 DO ji = 1, jpi 609 IF (rmask(ji,jj,jk) == 1.) THEN 610 zfact = rhop(ji,jj,jk) / 1000. + rtrn 611 p_alktot = trb(ji,jj,jk,jptal) / zfact 612 zdic = trb(ji,jj,jk,jpdic) / zfact 613 zbot = borat(ji,jj,jk) 614 zpt = trb(ji,jj,jk,jppo4) / zfact * po4r 615 zsit = trb(ji,jj,jk,jpsil) / zfact 616 zst = sulfat (ji,jj,jk) 617 zft = fluorid(ji,jj,jk) 618 aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 619 zh = zhi(ji,jj,jk) 620 zh_prev = zh 621 622 ! H2CO3 - HCO3 - CO3 : n=2, m=0 623 znumer_dic = 2.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk) 624 zdenom_dic = ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*(ak13(ji,jj,jk) + zh) 625 zalk_dic = zdic * (znumer_dic/zdenom_dic) 626 zdnumer_dic = ak13(ji,jj,jk)*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh & 627 *(4.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk)) 628 zdalk_dic = -zdic*(zdnumer_dic/zdenom_dic**2) 629 630 631 ! B(OH)3 - B(OH)4 : n=1, m=0 632 znumer_bor = akb3(ji,jj,jk) 633 zdenom_bor = akb3(ji,jj,jk) + zh 634 zalk_bor = zbot * (znumer_bor/zdenom_bor) 635 zdnumer_bor = akb3(ji,jj,jk) 636 zdalk_bor = -zbot*(zdnumer_bor/zdenom_bor**2) 637 638 639 ! H3PO4 - H2PO4 - HPO4 - PO4 : n=3, m=1 640 znumer_po4 = 3.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk) & 641 & + zh*(2.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh* ak1p3(ji,jj,jk)) 642 zdenom_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk) & 643 & + zh*( ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh*(ak1p3(ji,jj,jk) + zh)) 644 zalk_po4 = zpt * (znumer_po4/zdenom_po4 - 1.) ! Zero level of H3PO4 = 1 645 zdnumer_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk) & 646 & + zh*(4.*ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk) & 647 & + zh*(9.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk) & 648 & + ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) & 649 & + zh*(4.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh * ak1p3(ji,jj,jk) ) ) ) 650 zdalk_po4 = -zpt * (zdnumer_po4/zdenom_po4**2) 651 652 ! H4SiO4 - H3SiO4 : n=1, m=0 653 znumer_sil = aksi3(ji,jj,jk) 654 zdenom_sil = aksi3(ji,jj,jk) + zh 655 zalk_sil = zsit * (znumer_sil/zdenom_sil) 656 zdnumer_sil = aksi3(ji,jj,jk) 657 zdalk_sil = -zsit * (zdnumer_sil/zdenom_sil**2) 658 659 ! HSO4 - SO4 : n=1, m=1 660 aphscale = 1.0 + zst/aks3(ji,jj,jk) 661 znumer_so4 = aks3(ji,jj,jk) * aphscale 662 zdenom_so4 = aks3(ji,jj,jk) * aphscale + zh 663 zalk_so4 = zst * (znumer_so4/zdenom_so4 - 1.) 664 zdnumer_so4 = aks3(ji,jj,jk) 665 zdalk_so4 = -zst * (zdnumer_so4/zdenom_so4**2) 666 667 ! HF - F : n=1, m=1 668 znumer_flu = akf3(ji,jj,jk) 669 zdenom_flu = akf3(ji,jj,jk) + zh 670 zalk_flu = zft * (znumer_flu/zdenom_flu - 1.) 671 zdnumer_flu = akf3(ji,jj,jk) 672 zdalk_flu = -zft * (zdnumer_flu/zdenom_flu**2) 673 674 ! H2O - OH 675 aphscale = 1.0 + zst/aks3(ji,jj,jk) 676 zalk_wat = akw3(ji,jj,jk)/zh - zh/aphscale 677 zdalk_wat = -akw3(ji,jj,jk)/zh**2 - 1./aphscale 678 679 ! CALCULATE [ALK]([CO3--], [HCO3-]) 680 zeqn = zalk_dic + zalk_bor + zalk_po4 + zalk_sil & 681 & + zalk_so4 + zalk_flu & 682 & + zalk_wat - p_alktot 683 684 zalka = p_alktot - (zalk_bor + zalk_po4 + zalk_sil & 685 & + zalk_so4 + zalk_flu + zalk_wat) 686 687 zdeqndh = zdalk_dic + zdalk_bor + zdalk_po4 + zdalk_sil & 688 & + zdalk_so4 + zdalk_flu + zdalk_wat 689 690 ! Adapt bracketing interval 691 IF(zeqn > 0._wp) THEN 692 zh_min(ji,jj,jk) = zh_prev 693 ELSEIF(zeqn < 0._wp) THEN 694 zh_max(ji,jj,jk) = zh_prev 695 ENDIF 696 697 IF(ABS(zeqn) >= 0.5_wp*zeqn_absmin(ji,jj,jk)) THEN 698 ! if the function evaluation at the current point is 699 ! not decreasing faster than with a bisection step (at least linearly) 700 ! in absolute value take one bisection step on [ph_min, ph_max] 701 ! ph_new = (ph_min + ph_max)/2d0 702 ! 723 724 IF( zh < zh_min(ji,jj,jk) ) THEN 725 ! if [H]_new < [H]_min 726 ! i.e., if ph_new > ph_max then 727 ! take one bisection step on [ph_prev, ph_max] 728 ! ph_new = (ph_prev + ph_max)/2d0 703 729 ! In terms of [H]_new: 704 730 ! [H]_new = 10**(-ph_new) 705 ! = 10**(-(ph_min + ph_max)/2d0) 706 ! = SQRT(10**(-(ph_min + phmax))) 707 ! = SQRT(zh_max * zh_min) 708 zh = SQRT(zh_max(ji,jj,jk) * zh_min(ji,jj,jk)) 709 zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 710 ELSE 711 ! dzeqn/dpH = dzeqn/d[H] * d[H]/dpH 712 ! = -zdeqndh * LOG(10) * [H] 713 ! \Delta pH = -zeqn/(zdeqndh*d[H]/dpH) = zeqn/(zdeqndh*[H]*LOG(10)) 714 ! 715 ! pH_new = pH_old + \deltapH 716 ! 717 ! [H]_new = 10**(-pH_new) 718 ! = 10**(-pH_old - \Delta pH) 719 ! = [H]_old * 10**(-zeqn/(zdeqndh*[H]_old*LOG(10))) 720 ! = [H]_old * EXP(-LOG(10)*zeqn/(zdeqndh*[H]_old*LOG(10))) 721 ! = [H]_old * EXP(-zeqn/(zdeqndh*[H]_old)) 722 723 zh_lnfactor = -zeqn/(zdeqndh*zh_prev) 724 725 IF(ABS(zh_lnfactor) > pz_exp_threshold) THEN 726 zh = zh_prev*EXP(zh_lnfactor) 727 ELSE 728 zh_delta = zh_lnfactor*zh_prev 729 zh = zh_prev + zh_delta 730 ENDIF 731 732 IF( zh < zh_min(ji,jj,jk) ) THEN 733 ! if [H]_new < [H]_min 734 ! i.e., if ph_new > ph_max then 735 ! take one bisection step on [ph_prev, ph_max] 736 ! ph_new = (ph_prev + ph_max)/2d0 737 ! In terms of [H]_new: 738 ! [H]_new = 10**(-ph_new) 739 ! = 10**(-(ph_prev + ph_max)/2d0) 740 ! = SQRT(10**(-(ph_prev + phmax))) 741 ! = SQRT([H]_old*10**(-ph_max)) 742 ! = SQRT([H]_old * zh_min) 743 zh = SQRT(zh_prev * zh_min(ji,jj,jk)) 744 zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 745 ENDIF 746 747 IF( zh > zh_max(ji,jj,jk) ) THEN 748 ! if [H]_new > [H]_max 749 ! i.e., if ph_new < ph_min, then 750 ! take one bisection step on [ph_min, ph_prev] 751 ! ph_new = (ph_prev + ph_min)/2d0 752 ! In terms of [H]_new: 753 ! [H]_new = 10**(-ph_new) 754 ! = 10**(-(ph_prev + ph_min)/2d0) 755 ! = SQRT(10**(-(ph_prev + ph_min))) 756 ! = SQRT([H]_old*10**(-ph_min)) 757 ! = SQRT([H]_old * zhmax) 758 zh = SQRT(zh_prev * zh_max(ji,jj,jk)) 759 zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 760 ENDIF 761 ENDIF 762 763 zeqn_absmin(ji,jj,jk) = MIN( ABS(zeqn), zeqn_absmin(ji,jj,jk)) 764 765 ! Stop iterations once |\delta{[H]}/[H]| < rdel 766 ! <=> |(zh - zh_prev)/zh_prev| = |EXP(-zeqn/(zdeqndh*zh_prev)) -1| < rdel 767 ! |EXP(-zeqn/(zdeqndh*zh_prev)) -1| ~ |zeqn/(zdeqndh*zh_prev)| 768 769 ! Alternatively: 770 ! |\Delta pH| = |zeqn/(zdeqndh*zh_prev*LOG(10))| 771 ! ~ 1/LOG(10) * |\Delta [H]|/[H] 772 ! < 1/LOG(10) * rdel 773 774 ! Hence |zeqn/(zdeqndh*zh)| < rdel 775 776 ! rdel <-- pp_rdel_ah_target 777 l_exitnow = (ABS(zh_lnfactor) < pp_rdel_ah_target) 778 779 IF(l_exitnow) THEN 780 rmask(ji,jj,jk) = 0. 781 ENDIF 782 783 zhi(ji,jj,jk) = zh 784 785 IF(jn >= jp_maxniter_atgen) THEN 786 zhi(ji,jj,jk) = -1._wp 787 ENDIF 788 731 ! = 10**(-(ph_prev + ph_max)/2d0) 732 ! = SQRT(10**(-(ph_prev + phmax))) 733 ! = SQRT([H]_old*10**(-ph_max)) 734 ! = SQRT([H]_old * zh_min) 735 zh = SQRT(zh_prev * zh_min(ji,jj,jk)) 736 zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 789 737 ENDIF 790 END DO 791 END DO 792 END DO 738 739 IF( zh > zh_max(ji,jj,jk) ) THEN 740 ! if [H]_new > [H]_max 741 ! i.e., if ph_new < ph_min, then 742 ! take one bisection step on [ph_min, ph_prev] 743 ! ph_new = (ph_prev + ph_min)/2d0 744 ! In terms of [H]_new: 745 ! [H]_new = 10**(-ph_new) 746 ! = 10**(-(ph_prev + ph_min)/2d0) 747 ! = SQRT(10**(-(ph_prev + ph_min))) 748 ! = SQRT([H]_old*10**(-ph_min)) 749 ! = SQRT([H]_old * zhmax) 750 zh = SQRT(zh_prev * zh_max(ji,jj,jk)) 751 zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 752 ENDIF 753 ENDIF 754 755 zeqn_absmin(ji,jj,jk) = MIN( ABS(zeqn), zeqn_absmin(ji,jj,jk)) 756 757 ! Stop iterations once |\delta{[H]}/[H]| < rdel 758 ! <=> |(zh - zh_prev)/zh_prev| = |EXP(-zeqn/(zdeqndh*zh_prev)) -1| < rdel 759 ! |EXP(-zeqn/(zdeqndh*zh_prev)) -1| ~ |zeqn/(zdeqndh*zh_prev)| 760 761 ! Alternatively: 762 ! |\Delta pH| = |zeqn/(zdeqndh*zh_prev*LOG(10))| 763 ! ~ 1/LOG(10) * |\Delta [H]|/[H] 764 ! < 1/LOG(10) * rdel 765 766 ! Hence |zeqn/(zdeqndh*zh)| < rdel 767 768 ! rdel <-- pp_rdel_ah_target 769 l_exitnow = (ABS(zh_lnfactor) < pp_rdel_ah_target) 770 771 IF(l_exitnow) THEN 772 rmask(ji,jj,jk) = 0. 773 ENDIF 774 775 zhi(ji,jj,jk) = zh 776 777 IF(jn >= jp_maxniter_atgen) THEN 778 zhi(ji,jj,jk) = -1._wp 779 ENDIF 780 781 ENDIF 782 END_3D 793 783 END DO 794 784 ! -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zfechem.F90
r12276 r12377 15 15 USE sms_pisces ! PISCES Source Minus Sink variables 16 16 USE p4zche ! chemical model 17 USE p4z sbc ! Boundary conditions from sediments17 USE p4zbc ! Boundary conditions from sediments 18 18 USE prtctl_trc ! print control for debugging 19 19 USE iom ! I/O manager … … 31 31 REAL(wp), PUBLIC :: kfep !: rate constant for nanoparticle formation 32 32 33 !! * Substitutions 34 # include "do_loop_substitute.h90" 33 35 !!---------------------------------------------------------------------- 34 36 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 38 40 CONTAINS 39 41 40 SUBROUTINE p4z_fechem( kt, knt )42 SUBROUTINE p4z_fechem( kt, knt, Kbb, Kmm, Krhs ) 41 43 !!--------------------------------------------------------------------- 42 44 !! *** ROUTINE p4z_fechem *** … … 48 50 !!--------------------------------------------------------------------- 49 51 INTEGER, INTENT(in) :: kt, knt ! ocean time step 52 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 50 53 ! 51 54 INTEGER :: ji, jj, jk, jic, jn … … 71 74 IF( ln_timing ) CALL timing_start('p4z_fechem') 72 75 ! 73 74 76 ! Total ligand concentration : Ligands can be chosen to be constant or variable 75 77 ! Parameterization from Tagliabue and Voelker (2011) 76 78 ! ------------------------------------------------- 77 79 IF( ln_ligvar ) THEN 78 ztotlig(:,:,:) = 0.09 * tr b(:,:,:,jpdoc) * 1E6 + ligand * 1E980 ztotlig(:,:,:) = 0.09 * tr(:,:,:,jpdoc,Kbb) * 1E6 + ligand * 1E9 79 81 ztotlig(:,:,:) = MIN( ztotlig(:,:,:), 10. ) 80 82 ELSE 81 IF( ln_ligand ) THEN ; ztotlig(:,:,:) = tr b(:,:,:,jplgw) * 1E983 IF( ln_ligand ) THEN ; ztotlig(:,:,:) = tr(:,:,:,jplgw,Kbb) * 1E9 82 84 ELSE ; ztotlig(:,:,:) = ligand * 1E9 83 85 ENDIF … … 89 91 ! Chemistry is supposed to be fast enough to be at equilibrium 90 92 ! ------------------------------------------------------------ 91 DO jk = 1, jpkm1 92 DO jj = 1, jpj 93 DO ji = 1, jpi 94 zTL1(ji,jj,jk) = ztotlig(ji,jj,jk) 95 zkeq = fekeq(ji,jj,jk) 96 zfesatur = zTL1(ji,jj,jk) * 1E-9 97 ztfe = trb(ji,jj,jk,jpfer) 98 ! Fe' is the root of a 2nd order polynom 99 zFe3 (ji,jj,jk) = ( -( 1. + zfesatur * zkeq - zkeq * ztfe ) & 100 & + SQRT( ( 1. + zfesatur * zkeq - zkeq * ztfe )**2 & 101 & + 4. * ztfe * zkeq) ) / ( 2. * zkeq ) 102 zFe3 (ji,jj,jk) = zFe3(ji,jj,jk) * 1E9 103 zFeL1(ji,jj,jk) = MAX( 0., trb(ji,jj,jk,jpfer) * 1E9 - zFe3(ji,jj,jk) ) 104 END DO 105 END DO 106 END DO 93 DO_3D_11_11( 1, jpkm1 ) 94 zTL1(ji,jj,jk) = ztotlig(ji,jj,jk) 95 zkeq = fekeq(ji,jj,jk) 96 zfesatur = zTL1(ji,jj,jk) * 1E-9 97 ztfe = tr(ji,jj,jk,jpfer,Kbb) 98 ! Fe' is the root of a 2nd order polynom 99 zFe3 (ji,jj,jk) = ( -( 1. + zfesatur * zkeq - zkeq * ztfe ) & 100 & + SQRT( ( 1. + zfesatur * zkeq - zkeq * ztfe )**2 & 101 & + 4. * ztfe * zkeq) ) / ( 2. * zkeq ) 102 zFe3 (ji,jj,jk) = zFe3(ji,jj,jk) * 1E9 103 zFeL1(ji,jj,jk) = MAX( 0., tr(ji,jj,jk,jpfer,Kbb) * 1E9 - zFe3(ji,jj,jk) ) 104 END_3D 107 105 ! 108 106 109 107 zdust = 0. ! if no dust available 110 DO jk = 1, jpkm1 111 DO jj = 1, jpj 112 DO ji = 1, jpi 113 ! Scavenging rate of iron. This scavenging rate depends on the load of particles of sea water. 114 ! This parameterization assumes a simple second order kinetics (k[Particles][Fe]). 115 ! Scavenging onto dust is also included as evidenced from the DUNE experiments. 116 ! -------------------------------------------------------------------------------------- 117 zhplus = max( rtrn, hi(ji,jj,jk) ) 118 fe3sol = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2 & 119 & + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4) & 120 & + fesol(ji,jj,jk,5) / zhplus ) 121 ! 122 zfeequi = zFe3(ji,jj,jk) * 1E-9 123 zhplus = max( rtrn, hi(ji,jj,jk) ) 124 fe3sol = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2 & 125 & + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4) & 126 & + fesol(ji,jj,jk,5) / zhplus ) 127 zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9 128 ! precipitation of Fe3+, creation of nanoparticles 129 precip(ji,jj,jk) = MAX( 0., ( zFe3(ji,jj,jk) * 1E-9 - fe3sol ) ) * kfep * xstep 130 ! 131 ztrc = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6 132 IF( ln_dust ) zdust = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) & 133 & * EXP( -gdept_n(ji,jj,jk) / 540. ) 134 IF (ln_ligand) THEN 135 zxlam = xlam1 * MAX( 1.E-3, EXP(-2 * etot(ji,jj,jk) / 10. ) * (1. - EXP(-2 * trb(ji,jj,jk,jpoxy) / 100.E-6 ) )) 136 ELSE 137 zxlam = xlam1 * 1.0 138 ENDIF 139 zlam1b = 3.e-5 + xlamdust * zdust + zxlam * ztrc 140 zscave = zfeequi * zlam1b * xstep 141 142 ! Compute the different ratios for scavenging of iron 143 ! to later allocate scavenged iron to the different organic pools 144 ! --------------------------------------------------------- 145 zdenom1 = zxlam * trb(ji,jj,jk,jppoc) / zlam1b 146 zdenom2 = zxlam * trb(ji,jj,jk,jpgoc) / zlam1b 147 148 ! Increased scavenging for very high iron concentrations found near the coasts 149 ! due to increased lithogenic particles and let say it is unknown processes (precipitation, ...) 150 ! ----------------------------------------------------------- 151 zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 152 zlamfac = MIN( 1. , zlamfac ) 153 zdep = MIN( 1., 1000. / gdept_n(ji,jj,jk) ) 154 zcoag = 1E-4 * ( 1. - zlamfac ) * zdep * xstep * trb(ji,jj,jk,jpfer) 155 156 ! Compute the coagulation of colloidal iron. This parameterization 157 ! could be thought as an equivalent of colloidal pumping. 158 ! It requires certainly some more work as it is very poorly constrained. 159 ! ---------------------------------------------------------------- 160 zlam1a = ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk) & 161 & + ( 114. * 0.3 * trb(ji,jj,jk,jpdoc) ) 162 zaggdfea = zlam1a * xstep * zfecoll 163 ! 164 zlam1b = 3.53E3 * trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk) 165 zaggdfeb = zlam1b * xstep * zfecoll 166 ! 167 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfea - zaggdfeb & 168 & - zcoag - precip(ji,jj,jk) 169 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea 170 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zscave * zdenom2 + zaggdfeb 171 zscav3d(ji,jj,jk) = zscave 172 zcoll3d(ji,jj,jk) = zaggdfea + zaggdfeb 173 ! 174 END DO 175 END DO 176 END DO 108 DO_3D_11_11( 1, jpkm1 ) 109 ! Scavenging rate of iron. This scavenging rate depends on the load of particles of sea water. 110 ! This parameterization assumes a simple second order kinetics (k[Particles][Fe]). 111 ! Scavenging onto dust is also included as evidenced from the DUNE experiments. 112 ! -------------------------------------------------------------------------------------- 113 zhplus = max( rtrn, hi(ji,jj,jk) ) 114 fe3sol = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2 & 115 & + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4) & 116 & + fesol(ji,jj,jk,5) / zhplus ) 117 ! 118 zfeequi = zFe3(ji,jj,jk) * 1E-9 119 zhplus = max( rtrn, hi(ji,jj,jk) ) 120 fe3sol = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2 & 121 & + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4) & 122 & + fesol(ji,jj,jk,5) / zhplus ) 123 zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9 124 ! precipitation of Fe3+, creation of nanoparticles 125 precip(ji,jj,jk) = MAX( 0., ( zFe3(ji,jj,jk) * 1E-9 - fe3sol ) ) * kfep * xstep 126 ! 127 ztrc = ( tr(ji,jj,jk,jppoc,Kbb) + tr(ji,jj,jk,jpgoc,Kbb) + tr(ji,jj,jk,jpcal,Kbb) + tr(ji,jj,jk,jpgsi,Kbb) ) * 1.e6 128 IF( ll_dust ) zdust = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) & 129 & * EXP( -gdept(ji,jj,jk,Kmm) / 540. ) 130 IF (ln_ligand) THEN 131 zxlam = xlam1 * MAX( 1.E-3, EXP(-2 * etot(ji,jj,jk) / 10. ) * (1. - EXP(-2 * tr(ji,jj,jk,jpoxy,Kbb) / 100.E-6 ) )) 132 ELSE 133 zxlam = xlam1 * 1.0 134 ENDIF 135 zlam1b = 3.e-5 + xlamdust * zdust + zxlam * ztrc 136 zscave = zfeequi * zlam1b * xstep 137 138 ! Compute the different ratios for scavenging of iron 139 ! to later allocate scavenged iron to the different organic pools 140 ! --------------------------------------------------------- 141 zdenom1 = zxlam * tr(ji,jj,jk,jppoc,Kbb) / zlam1b 142 zdenom2 = zxlam * tr(ji,jj,jk,jpgoc,Kbb) / zlam1b 143 144 ! Increased scavenging for very high iron concentrations found near the coasts 145 ! due to increased lithogenic particles and let say it is unknown processes (precipitation, ...) 146 ! ----------------------------------------------------------- 147 zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 148 zlamfac = MIN( 1. , zlamfac ) 149 zdep = MIN( 1., 1000. / gdept(ji,jj,jk,Kmm) ) 150 zcoag = 1E-4 * ( 1. - zlamfac ) * zdep * xstep * tr(ji,jj,jk,jpfer,Kbb) 151 152 ! Compute the coagulation of colloidal iron. This parameterization 153 ! could be thought as an equivalent of colloidal pumping. 154 ! It requires certainly some more work as it is very poorly constrained. 155 ! ---------------------------------------------------------------- 156 zlam1a = ( 0.369 * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4 * tr(ji,jj,jk,jppoc,Kbb) ) * xdiss(ji,jj,jk) & 157 & + ( 114. * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) ) 158 zaggdfea = zlam1a * xstep * zfecoll 159 ! 160 zlam1b = 3.53E3 * tr(ji,jj,jk,jpgoc,Kbb) * xdiss(ji,jj,jk) 161 zaggdfeb = zlam1b * xstep * zfecoll 162 ! 163 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zscave - zaggdfea - zaggdfeb & 164 & - zcoag - precip(ji,jj,jk) 165 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zscave * zdenom1 + zaggdfea 166 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zscave * zdenom2 + zaggdfeb 167 zscav3d(ji,jj,jk) = zscave 168 zcoll3d(ji,jj,jk) = zaggdfea + zaggdfeb 169 ! 170 END_3D 177 171 ! 178 172 ! Define the bioavailable fraction of iron 179 173 ! ---------------------------------------- 180 biron(:,:,:) = tr b(:,:,:,jpfer)174 biron(:,:,:) = tr(:,:,:,jpfer,Kbb) 181 175 ! 182 176 IF( ln_ligand ) THEN 183 177 ! 184 DO jk = 1, jpkm1 185 DO jj = 1, jpj 186 DO ji = 1, jpi 187 zlam1a = ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk) & 188 & + ( 114. * 0.3 * trb(ji,jj,jk,jpdoc) ) 189 ! 190 zlam1b = 3.53E3 * trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk) 191 zligco = 0.5 * trn(ji,jj,jk,jplgw) 192 zaggliga = zlam1a * xstep * zligco 193 zaggligb = zlam1b * xstep * zligco 194 tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) - zaggliga - zaggligb 195 zlcoll3d(ji,jj,jk) = zaggliga + zaggligb 196 END DO 197 END DO 198 END DO 199 ! 200 plig(:,:,:) = MAX( 0., ( ( zFeL1(:,:,:) * 1E-9 ) / ( trb(:,:,:,jpfer) +rtrn ) ) ) 178 DO_3D_11_11( 1, jpkm1 ) 179 zlam1a = ( 0.369 * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4 * tr(ji,jj,jk,jppoc,Kbb) ) * xdiss(ji,jj,jk) & 180 & + ( 114. * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) ) 181 ! 182 zlam1b = 3.53E3 * tr(ji,jj,jk,jpgoc,Kbb) * xdiss(ji,jj,jk) 183 zligco = 0.5 * tr(ji,jj,jk,jplgw,Kmm) 184 zaggliga = zlam1a * xstep * zligco 185 zaggligb = zlam1b * xstep * zligco 186 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) - zaggliga - zaggligb 187 zlcoll3d(ji,jj,jk) = zaggliga + zaggligb 188 END_3D 189 ! 190 plig(:,:,:) = MAX( 0., ( ( zFeL1(:,:,:) * 1E-9 ) / ( tr(:,:,:,jpfer,Kbb) +rtrn ) ) ) 201 191 ! 202 192 ENDIF … … 215 205 zTL1(:,:,jpk) = 0. ; CALL iom_put("TL1" , zTL1(:,:,:) * tmask(:,:,:) ) ! TL1 216 206 ENDIF 217 CALL iom_put("Totlig" , ztotlig(:,:,:) * tmask(:,:,:) ) ! TL218 CALL iom_put("Biron" , biron (:,:,:) * 1e9 * tmask(:,:,:) ) ! biron207 IF( iom_use("Totlig") ) CALL iom_put("Totlig" , ztotlig(:,:,:) * tmask(:,:,:) ) ! TL 208 IF( iom_use("Biron") ) CALL iom_put("Biron" , biron (:,:,:) * 1e9 * tmask(:,:,:) ) ! biron 219 209 IF( iom_use("FESCAV") ) THEN 220 210 zscav3d (:,:,jpk) = 0. ; CALL iom_put("FESCAV" , zscav3d(:,:,:) * 1e9 * tmask(:,:,:) * zrfact2 ) … … 226 216 zlcoll3d(:,:,jpk) = 0. ; CALL iom_put("LGWCOLL", zlcoll3d(:,:,:) * 1e9 * tmask(:,:,:) * zrfact2 ) 227 217 ENDIF 228 ENDIF229 ENDIF 230 231 IF( ln_ctl) THEN ! print mean trends (used for debugging)218 ENDIF 219 ENDIF 220 221 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 232 222 WRITE(charout, FMT="('fechem')") 233 223 CALL prt_ctl_trc_info(charout) 234 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)224 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 235 225 ENDIF 236 226 ! … … 263 253 ENDIF 264 254 ! 265 REWIND( numnatp_ref )266 255 READ ( numnatp_ref, nampisfer, IOSTAT = ios, ERR = 901) 267 256 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisfer in reference namelist' ) 268 269 REWIND( numnatp_cfg )270 257 READ ( numnatp_cfg, nampisfer, IOSTAT = ios, ERR = 902 ) 271 258 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisfer in configuration namelist' ) -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zflx.F90
r12277 r12377 52 52 REAL(wp) :: xconv = 0.01_wp / 3600._wp !: coefficients for conversion 53 53 54 !! * Substitutions 55 # include "do_loop_substitute.h90" 54 56 !!---------------------------------------------------------------------- 55 57 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 59 61 CONTAINS 60 62 61 SUBROUTINE p4z_flx ( kt, knt )63 SUBROUTINE p4z_flx ( kt, knt, Kbb, Kmm, Krhs ) 62 64 !!--------------------------------------------------------------------- 63 65 !! *** ROUTINE p4z_flx *** … … 71 73 !!--------------------------------------------------------------------- 72 74 INTEGER, INTENT(in) :: kt, knt ! 75 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 73 76 ! 74 77 INTEGER :: ji, jj, jm, iind, iindm1 … … 106 109 IF( l_co2cpl ) satmco2(:,:) = atm_co2(:,:) 107 110 108 DO jj = 1, jpj 109 DO ji = 1, jpi 110 ! DUMMY VARIABLES FOR DIC, H+, AND BORATE 111 zfact = rhop(ji,jj,1) / 1000. + rtrn 112 zdic = trb(ji,jj,1,jpdic) 113 zph = MAX( hi(ji,jj,1), 1.e-10 ) / zfact 114 ! CALCULATE [H2CO3] 115 zh2co3(ji,jj) = zdic/(1. + ak13(ji,jj,1)/zph + ak13(ji,jj,1)*ak23(ji,jj,1)/zph**2) 116 END DO 117 END DO 111 DO_2D_11_11 112 ! DUMMY VARIABLES FOR DIC, H+, AND BORATE 113 zfact = rhop(ji,jj,1) / 1000. + rtrn 114 zdic = tr(ji,jj,1,jpdic,Kbb) 115 zph = MAX( hi(ji,jj,1), 1.e-10 ) / zfact 116 ! CALCULATE [H2CO3] 117 zh2co3(ji,jj) = zdic/(1. + ak13(ji,jj,1)/zph + ak13(ji,jj,1)*ak23(ji,jj,1)/zph**2) 118 END_2D 118 119 119 120 ! -------------- … … 124 125 ! ------------------------------------------- 125 126 126 DO jj = 1, jpj 127 DO ji = 1, jpi 128 ztc = MIN( 35., tsn(ji,jj,1,jp_tem) ) 129 ztc2 = ztc * ztc 130 ztc3 = ztc * ztc2 131 ztc4 = ztc2 * ztc2 132 ! Compute the schmidt Number both O2 and CO2 133 zsch_co2 = 2116.8 - 136.25 * ztc + 4.7353 * ztc2 - 0.092307 * ztc3 + 0.0007555 * ztc4 134 zsch_o2 = 1920.4 - 135.6 * ztc + 5.2122 * ztc2 - 0.109390 * ztc3 + 0.0009377 * ztc4 135 ! wind speed 136 zws = wndm(ji,jj) * wndm(ji,jj) 137 ! Compute the piston velocity for O2 and CO2 138 zkgwan = 0.251 * zws 139 zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) 140 ! compute gas exchange for CO2 and O2 141 zkgco2(ji,jj) = zkgwan * SQRT( 660./ zsch_co2 ) 142 zkgo2 (ji,jj) = zkgwan * SQRT( 660./ zsch_o2 ) 143 END DO 144 END DO 145 146 147 DO jj = 1, jpj 148 DO ji = 1, jpi 149 ztkel = tempis(ji,jj,1) + 273.15 150 zsal = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35. 151 zvapsw = EXP(24.4543 - 67.4509*(100.0/ztkel) - 4.8489*LOG(ztkel/100) - 0.000544*zsal) 152 zpco2atm(ji,jj) = satmco2(ji,jj) * ( patm(ji,jj) - zvapsw ) 153 zxc2 = ( 1.0 - zpco2atm(ji,jj) * 1E-6 )**2 154 zfugcoeff = EXP( patm(ji,jj) * (chemc(ji,jj,2) + 2.0 * zxc2 * chemc(ji,jj,3) ) & 155 & / ( 82.05736 * ztkel )) 156 zfco2 = zpco2atm(ji,jj) * zfugcoeff 157 158 ! Compute CO2 flux for the sea and air 159 zfld = zfco2 * chemc(ji,jj,1) * zkgco2(ji,jj) ! (mol/L) * (m/s) 160 zflu = zh2co3(ji,jj) * zkgco2(ji,jj) ! (mol/L) (m/s) ? 161 oce_co2(ji,jj) = ( zfld - zflu ) * tmask(ji,jj,1) 162 ! compute the trend 163 tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + oce_co2(ji,jj) * rfact2 / e3t_n(ji,jj,1) 164 165 ! Compute O2 flux 166 zfld16 = patm(ji,jj) * chemo2(ji,jj,1) * zkgo2(ji,jj) ! (mol/L) * (m/s) 167 zflu16 = trb(ji,jj,1,jpoxy) * zkgo2(ji,jj) 168 zoflx(ji,jj) = ( zfld16 - zflu16 ) * tmask(ji,jj,1) 169 tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) * rfact2 / e3t_n(ji,jj,1) 170 END DO 171 END DO 127 DO_2D_11_11 128 ztc = MIN( 35., ts(ji,jj,1,jp_tem,Kmm) ) 129 ztc2 = ztc * ztc 130 ztc3 = ztc * ztc2 131 ztc4 = ztc2 * ztc2 132 ! Compute the schmidt Number both O2 and CO2 133 zsch_co2 = 2116.8 - 136.25 * ztc + 4.7353 * ztc2 - 0.092307 * ztc3 + 0.0007555 * ztc4 134 zsch_o2 = 1920.4 - 135.6 * ztc + 5.2122 * ztc2 - 0.109390 * ztc3 + 0.0009377 * ztc4 135 ! wind speed 136 zws = wndm(ji,jj) * wndm(ji,jj) 137 ! Compute the piston velocity for O2 and CO2 138 zkgwan = 0.251 * zws 139 zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) 140 ! compute gas exchange for CO2 and O2 141 zkgco2(ji,jj) = zkgwan * SQRT( 660./ zsch_co2 ) 142 zkgo2 (ji,jj) = zkgwan * SQRT( 660./ zsch_o2 ) 143 END_2D 144 145 146 DO_2D_11_11 147 ztkel = tempis(ji,jj,1) + 273.15 148 zsal = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35. 149 zvapsw = EXP(24.4543 - 67.4509*(100.0/ztkel) - 4.8489*LOG(ztkel/100) - 0.000544*zsal) 150 zpco2atm(ji,jj) = satmco2(ji,jj) * ( patm(ji,jj) - zvapsw ) 151 zxc2 = ( 1.0 - zpco2atm(ji,jj) * 1E-6 )**2 152 zfugcoeff = EXP( patm(ji,jj) * (chemc(ji,jj,2) + 2.0 * zxc2 * chemc(ji,jj,3) ) & 153 & / ( 82.05736 * ztkel )) 154 zfco2 = zpco2atm(ji,jj) * zfugcoeff 155 156 ! Compute CO2 flux for the sea and air 157 zfld = zfco2 * chemc(ji,jj,1) * zkgco2(ji,jj) ! (mol/L) * (m/s) 158 zflu = zh2co3(ji,jj) * zkgco2(ji,jj) ! (mol/L) (m/s) ? 159 oce_co2(ji,jj) = ( zfld - zflu ) * tmask(ji,jj,1) 160 ! compute the trend 161 tr(ji,jj,1,jpdic,Krhs) = tr(ji,jj,1,jpdic,Krhs) + oce_co2(ji,jj) * rfact2 / e3t(ji,jj,1,Kmm) 162 163 ! Compute O2 flux 164 zfld16 = patm(ji,jj) * chemo2(ji,jj,1) * zkgo2(ji,jj) ! (mol/L) * (m/s) 165 zflu16 = tr(ji,jj,1,jpoxy,Kbb) * zkgo2(ji,jj) 166 zoflx(ji,jj) = ( zfld16 - zflu16 ) * tmask(ji,jj,1) 167 tr(ji,jj,1,jpoxy,Krhs) = tr(ji,jj,1,jpoxy,Krhs) + zoflx(ji,jj) * rfact2 / e3t(ji,jj,1,Kmm) 168 END_2D 172 169 173 170 IF( iom_use("tcflx") .OR. iom_use("tcflxcum") .OR. kt == nitrst & … … 178 175 t_atm_co2_flx = atcco2 ! Total atmospheric pCO2 179 176 180 IF( ln_ctl) THEN ! print mean trends (used for debugging)177 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 181 178 WRITE(charout, FMT="('flx ')") 182 179 CALL prt_ctl_trc_info(charout) 183 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)180 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 184 181 ENDIF 185 182 … … 191 188 CALL iom_put( "Dpco2" , ( zpco2atm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) ) 192 189 CALL iom_put( "pCO2sea" , ( zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) ) 193 CALL iom_put( "Dpo2" , ( atcox * patm(:,:) - atcox * tr b(:,:,1,jpoxy) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1) )190 CALL iom_put( "Dpo2" , ( atcox * patm(:,:) - atcox * tr(:,:,1,jpoxy,Kbb) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1) ) 194 191 CALL iom_put( "tcflx" , t_oce_co2_flx ) ! molC/s 195 192 CALL iom_put( "tcflxcum", t_oce_co2_flx_cum ) ! molC … … 222 219 ENDIF 223 220 ! 224 REWIND( numnatp_ref )225 221 READ ( numnatp_ref, nampisext, IOSTAT = ios, ERR = 901) 226 222 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisext in reference namelist' ) 227 228 REWIND( numnatp_cfg )229 223 READ ( numnatp_cfg, nampisext, IOSTAT = ios, ERR = 902 ) 230 224 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisext in configuration namelist' ) … … 304 298 ENDIF 305 299 ! 306 REWIND( numnatp_ref )307 300 READ ( numnatp_ref, nampisatm, IOSTAT = ios, ERR = 901) 308 301 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisatm in reference namelist' ) 309 310 REWIND( numnatp_cfg )311 302 READ ( numnatp_cfg, nampisatm, IOSTAT = ios, ERR = 902 ) 312 303 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisatm in configuration namelist' ) -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zint.F90
r10068 r12377 26 26 CONTAINS 27 27 28 SUBROUTINE p4z_int( kt )28 SUBROUTINE p4z_int( kt, Kbb, Kmm ) 29 29 !!--------------------------------------------------------------------- 30 30 !! *** ROUTINE p4z_int *** … … 33 33 !! 34 34 !!--------------------------------------------------------------------- 35 INTEGER, INTENT( in ) :: kt ! ocean time-step index 35 INTEGER, INTENT( in ) :: kt ! ocean time-step index 36 INTEGER, INTENT( in ) :: Kbb, Kmm ! time level indices 36 37 ! 37 38 INTEGER :: ji, jj ! dummy loop indices … … 43 44 ! Computation of phyto and zoo metabolic rate 44 45 ! ------------------------------------------- 45 tgfunc (:,:,:) = EXP( 0.063913 * ts n(:,:,:,jp_tem) )46 tgfunc2(:,:,:) = EXP( 0.07608 * ts n(:,:,:,jp_tem) )46 tgfunc (:,:,:) = EXP( 0.063913 * ts(:,:,:,jp_tem,Kmm) ) 47 tgfunc2(:,:,:) = EXP( 0.07608 * ts(:,:,:,jp_tem,Kmm) ) 47 48 48 49 ! Computation of the silicon dependant half saturation constant for silica uptake … … 50 51 DO ji = 1, jpi 51 52 DO jj = 1, jpj 52 zvar = tr b(ji,jj,1,jpsil) * trb(ji,jj,1,jpsil)53 zvar = tr(ji,jj,1,jpsil,Kbb) * tr(ji,jj,1,jpsil,Kbb) 53 54 xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zvar / ( xksilim * xksilim + zvar ) ) * 1e-6 ) 54 55 END DO -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zligand.F90
r12276 r12377 26 26 REAL(wp), PUBLIC :: prlgw !: Photochemical of weak ligand 27 27 28 !! * Substitutions 29 # include "do_loop_substitute.h90" 28 30 !!---------------------------------------------------------------------- 29 31 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 33 35 CONTAINS 34 36 35 SUBROUTINE p4z_ligand( kt, knt )37 SUBROUTINE p4z_ligand( kt, knt, Kbb, Krhs ) 36 38 !!--------------------------------------------------------------------- 37 39 !! *** ROUTINE p4z_ligand *** … … 39 41 !! ** Purpose : Compute remineralization/scavenging of organic ligands 40 42 !!--------------------------------------------------------------------- 41 INTEGER, INTENT(in) :: kt, knt ! ocean time step 43 INTEGER, INTENT(in) :: kt, knt ! ocean time step 44 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 42 45 ! 43 46 INTEGER :: ji, jj, jk … … 49 52 IF( ln_timing ) CALL timing_start('p4z_ligand') 50 53 ! 51 DO jk = 1, jpkm1 52 DO jj = 1, jpj 53 DO ji = 1, jpi 54 ! 55 ! ------------------------------------------------------------------ 56 ! Remineralization of iron ligands 57 ! ------------------------------------------------------------------ 58 ! production from remineralisation of organic matter 59 zlgwp = orem(ji,jj,jk) * rlig 60 ! decay of weak ligand 61 ! This is based on the idea that as LGW is lower 62 ! there is a larger fraction of refractory OM 63 zlgwr = max( rlgs , rlgw * exp( -2 * (trb(ji,jj,jk,jplgw)*1e9) ) ) ! years 64 zlgwr = 1. / zlgwr * tgfunc(ji,jj,jk) * ( xstep / nyear_len(1) ) * blim(ji,jj,jk) * trb(ji,jj,jk,jplgw) 65 ! photochem loss of weak ligand 66 zlgwpr = prlgw * xstep * etot(ji,jj,jk) * trb(ji,jj,jk,jplgw) * (1. - fr_i(ji,jj)) 67 tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zlgwp - zlgwr - zlgwpr 68 zligrem(ji,jj,jk) = zlgwr 69 zligpr(ji,jj,jk) = zlgwpr 70 zligprod(ji,jj,jk) = zlgwp 71 ! 72 END DO 73 END DO 74 END DO 54 DO_3D_11_11( 1, jpkm1 ) 55 ! 56 ! ------------------------------------------------------------------ 57 ! Remineralization of iron ligands 58 ! ------------------------------------------------------------------ 59 ! production from remineralisation of organic matter 60 zlgwp = orem(ji,jj,jk) * rlig 61 ! decay of weak ligand 62 ! This is based on the idea that as LGW is lower 63 ! there is a larger fraction of refractory OM 64 zlgwr = max( rlgs , rlgw * exp( -2 * (tr(ji,jj,jk,jplgw,Kbb)*1e9) ) ) ! years 65 zlgwr = 1. / zlgwr * tgfunc(ji,jj,jk) * ( xstep / nyear_len(1) ) * blim(ji,jj,jk) * tr(ji,jj,jk,jplgw,Kbb) 66 ! photochem loss of weak ligand 67 zlgwpr = prlgw * xstep * etot(ji,jj,jk) * tr(ji,jj,jk,jplgw,Kbb) * (1. - fr_i(ji,jj)) 68 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zlgwp - zlgwr - zlgwpr 69 zligrem(ji,jj,jk) = zlgwr 70 zligpr(ji,jj,jk) = zlgwpr 71 zligprod(ji,jj,jk) = zlgwp 72 ! 73 END_3D 75 74 ! 76 75 ! Output of some diagnostics variables … … 88 87 ENDIF 89 88 ! 90 IF( ln_ctl) THEN ! print mean trends (used for debugging)89 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 91 90 WRITE(charout, FMT="('ligand1')") 92 91 CALL prt_ctl_trc_info(charout) 93 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)92 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 94 93 ENDIF 95 94 ! … … 119 118 WRITE(numout,*) '~~~~~~~~~~~~~~~' 120 119 ENDIF 121 122 REWIND( numnatp_ref )123 120 READ ( numnatp_ref, nampislig, IOSTAT = ios, ERR = 901) 124 121 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampislig in reference namelist' ) 125 126 REWIND( numnatp_cfg )127 122 READ ( numnatp_cfg, nampislig, IOSTAT = ios, ERR = 902 ) 128 123 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampislig in configuration namelist' ) -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zlim.F90
r12276 r12377 67 67 REAL(wp) :: xcoef3 = 1.15E-4 * 14. / 55.85 / 7.625 * 0.5 68 68 69 !! * Substitutions 70 # include "do_loop_substitute.h90" 69 71 !!---------------------------------------------------------------------- 70 72 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 74 76 CONTAINS 75 77 76 SUBROUTINE p4z_lim( kt, knt )78 SUBROUTINE p4z_lim( kt, knt, Kbb, Kmm ) 77 79 !!--------------------------------------------------------------------- 78 80 !! *** ROUTINE p4z_lim *** … … 84 86 !!--------------------------------------------------------------------- 85 87 INTEGER, INTENT(in) :: kt, knt 88 INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices 86 89 ! 87 90 INTEGER :: ji, jj, jk … … 95 98 IF( ln_timing ) CALL timing_start('p4z_lim') 96 99 ! 97 DO jk = 1, jpkm1 98 DO jj = 1, jpj 99 DO ji = 1, jpi 100 101 ! Tuning of the iron concentration to a minimum level that is set to the detection limit 102 !------------------------------------- 103 zno3 = trb(ji,jj,jk,jpno3) / 40.e-6 104 zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 ) 105 zferlim = MIN( zferlim, 7e-11 ) 106 trb(ji,jj,jk,jpfer) = MAX( trb(ji,jj,jk,jpfer), zferlim ) 107 108 ! Computation of a variable Ks for iron on diatoms taking into account 109 ! that increasing biomass is made of generally bigger cells 110 !------------------------------------------------ 111 zconcd = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia ) 112 zconcd2 = trb(ji,jj,jk,jpdia) - zconcd 113 zconcn = MAX( 0.e0 , trb(ji,jj,jk,jpphy) - xsizephy ) 114 zconcn2 = trb(ji,jj,jk,jpphy) - zconcn 115 z1_trbphy = 1. / ( trb(ji,jj,jk,jpphy) + rtrn ) 116 z1_trbdia = 1. / ( trb(ji,jj,jk,jpdia) + rtrn ) 117 118 concdfe(ji,jj,jk) = MAX( concdfer, ( zconcd2 * concdfer + concdfer * xsizerd * zconcd ) * z1_trbdia ) 119 zconc1d = MAX( concdno3, ( zconcd2 * concdno3 + concdno3 * xsizerd * zconcd ) * z1_trbdia ) 120 zconc1dnh4 = MAX( concdnh4, ( zconcd2 * concdnh4 + concdnh4 * xsizerd * zconcd ) * z1_trbdia ) 121 122 concnfe(ji,jj,jk) = MAX( concnfer, ( zconcn2 * concnfer + concnfer * xsizern * zconcn ) * z1_trbphy ) 123 zconc0n = MAX( concnno3, ( zconcn2 * concnno3 + concnno3 * xsizern * zconcn ) * z1_trbphy ) 124 zconc0nnh4 = MAX( concnnh4, ( zconcn2 * concnnh4 + concnnh4 * xsizern * zconcn ) * z1_trbphy ) 125 126 ! Michaelis-Menten Limitation term for nutrients Small bacteria 127 ! ------------------------------------------------------------- 128 zdenom = 1. / ( concbno3 * concbnh4 + concbnh4 * trb(ji,jj,jk,jpno3) + concbno3 * trb(ji,jj,jk,jpnh4) ) 129 xnanono3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * concbnh4 * zdenom 130 xnanonh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * concbno3 * zdenom 131 ! 132 zlim1 = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 133 zlim2 = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concbnh4 ) 134 zlim3 = trb(ji,jj,jk,jpfer) / ( concbfe + trb(ji,jj,jk,jpfer) ) 135 zlim4 = trb(ji,jj,jk,jpdoc) / ( xkdoc + trb(ji,jj,jk,jpdoc) ) 136 xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 137 xlimbac (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4 138 139 ! Michaelis-Menten Limitation term for nutrients Small flagellates 140 ! ----------------------------------------------- 141 zdenom = 1. / ( zconc0n * zconc0nnh4 + zconc0nnh4 * trb(ji,jj,jk,jpno3) + zconc0n * trb(ji,jj,jk,jpnh4) ) 142 xnanono3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * zconc0nnh4 * zdenom 143 xnanonh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * zconc0n * zdenom 144 ! 145 zlim1 = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 146 zlim2 = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zconc0nnh4 ) 147 zratio = trb(ji,jj,jk,jpnfe) * z1_trbphy 148 zironmin = xcoef1 * trb(ji,jj,jk,jpnch) * z1_trbphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk) 149 zlim3 = MAX( 0.,( zratio - zironmin ) / qnfelim ) 150 xnanopo4(ji,jj,jk) = zlim2 151 xlimnfe (ji,jj,jk) = MIN( 1., zlim3 ) 152 xlimphy (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 153 ! 154 ! Michaelis-Menten Limitation term for nutrients Diatoms 155 ! ---------------------------------------------- 156 zdenom = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * trb(ji,jj,jk,jpno3) + zconc1d * trb(ji,jj,jk,jpnh4) ) 157 xdiatno3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * zconc1dnh4 * zdenom 158 xdiatnh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * zconc1d * zdenom 159 ! 160 zlim1 = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 161 zlim2 = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zconc1dnh4 ) 162 zlim3 = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi(ji,jj) ) 163 zratio = trb(ji,jj,jk,jpdfe) * z1_trbdia 164 zironmin = xcoef1 * trb(ji,jj,jk,jpdch) * z1_trbdia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk) 165 zlim4 = MAX( 0., ( zratio - zironmin ) / qdfelim ) 166 xdiatpo4(ji,jj,jk) = zlim2 167 xlimdfe (ji,jj,jk) = MIN( 1., zlim4 ) 168 xlimdia (ji,jj,jk) = MIN( zlim1, zlim2, zlim3, zlim4 ) 169 xlimsi (ji,jj,jk) = MIN( zlim1, zlim2, zlim4 ) 170 END DO 171 END DO 172 END DO 100 DO_3D_11_11( 1, jpkm1 ) 101 102 ! Tuning of the iron concentration to a minimum level that is set to the detection limit 103 !------------------------------------- 104 zno3 = tr(ji,jj,jk,jpno3,Kbb) / 40.e-6 105 zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 ) 106 zferlim = MIN( zferlim, 7e-11 ) 107 tr(ji,jj,jk,jpfer,Kbb) = MAX( tr(ji,jj,jk,jpfer,Kbb), zferlim ) 108 109 ! Computation of a variable Ks for iron on diatoms taking into account 110 ! that increasing biomass is made of generally bigger cells 111 !------------------------------------------------ 112 zconcd = MAX( 0.e0 , tr(ji,jj,jk,jpdia,Kbb) - xsizedia ) 113 zconcd2 = tr(ji,jj,jk,jpdia,Kbb) - zconcd 114 zconcn = MAX( 0.e0 , tr(ji,jj,jk,jpphy,Kbb) - xsizephy ) 115 zconcn2 = tr(ji,jj,jk,jpphy,Kbb) - zconcn 116 z1_trbphy = 1. / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 117 z1_trbdia = 1. / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 118 119 concdfe(ji,jj,jk) = MAX( concdfer, ( zconcd2 * concdfer + concdfer * xsizerd * zconcd ) * z1_trbdia ) 120 zconc1d = MAX( concdno3, ( zconcd2 * concdno3 + concdno3 * xsizerd * zconcd ) * z1_trbdia ) 121 zconc1dnh4 = MAX( concdnh4, ( zconcd2 * concdnh4 + concdnh4 * xsizerd * zconcd ) * z1_trbdia ) 122 123 concnfe(ji,jj,jk) = MAX( concnfer, ( zconcn2 * concnfer + concnfer * xsizern * zconcn ) * z1_trbphy ) 124 zconc0n = MAX( concnno3, ( zconcn2 * concnno3 + concnno3 * xsizern * zconcn ) * z1_trbphy ) 125 zconc0nnh4 = MAX( concnnh4, ( zconcn2 * concnnh4 + concnnh4 * xsizern * zconcn ) * z1_trbphy ) 126 127 ! Michaelis-Menten Limitation term for nutrients Small bacteria 128 ! ------------------------------------------------------------- 129 zdenom = 1. / ( concbno3 * concbnh4 + concbnh4 * tr(ji,jj,jk,jpno3,Kbb) + concbno3 * tr(ji,jj,jk,jpnh4,Kbb) ) 130 xnanono3(ji,jj,jk) = tr(ji,jj,jk,jpno3,Kbb) * concbnh4 * zdenom 131 xnanonh4(ji,jj,jk) = tr(ji,jj,jk,jpnh4,Kbb) * concbno3 * zdenom 132 ! 133 zlim1 = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 134 zlim2 = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concbnh4 ) 135 zlim3 = tr(ji,jj,jk,jpfer,Kbb) / ( concbfe + tr(ji,jj,jk,jpfer,Kbb) ) 136 zlim4 = tr(ji,jj,jk,jpdoc,Kbb) / ( xkdoc + tr(ji,jj,jk,jpdoc,Kbb) ) 137 xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 138 xlimbac (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4 139 140 ! Michaelis-Menten Limitation term for nutrients Small flagellates 141 ! ----------------------------------------------- 142 zdenom = 1. / ( zconc0n * zconc0nnh4 + zconc0nnh4 * tr(ji,jj,jk,jpno3,Kbb) + zconc0n * tr(ji,jj,jk,jpnh4,Kbb) ) 143 xnanono3(ji,jj,jk) = tr(ji,jj,jk,jpno3,Kbb) * zconc0nnh4 * zdenom 144 xnanonh4(ji,jj,jk) = tr(ji,jj,jk,jpnh4,Kbb) * zconc0n * zdenom 145 ! 146 zlim1 = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 147 zlim2 = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zconc0nnh4 ) 148 zratio = tr(ji,jj,jk,jpnfe,Kbb) * z1_trbphy 149 zironmin = xcoef1 * tr(ji,jj,jk,jpnch,Kbb) * z1_trbphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk) 150 zlim3 = MAX( 0.,( zratio - zironmin ) / qnfelim ) 151 xnanopo4(ji,jj,jk) = zlim2 152 xlimnfe (ji,jj,jk) = MIN( 1., zlim3 ) 153 xlimphy (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 154 ! 155 ! Michaelis-Menten Limitation term for nutrients Diatoms 156 ! ---------------------------------------------- 157 zdenom = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * tr(ji,jj,jk,jpno3,Kbb) + zconc1d * tr(ji,jj,jk,jpnh4,Kbb) ) 158 xdiatno3(ji,jj,jk) = tr(ji,jj,jk,jpno3,Kbb) * zconc1dnh4 * zdenom 159 xdiatnh4(ji,jj,jk) = tr(ji,jj,jk,jpnh4,Kbb) * zconc1d * zdenom 160 ! 161 zlim1 = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 162 zlim2 = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zconc1dnh4 ) 163 zlim3 = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi(ji,jj) ) 164 zratio = tr(ji,jj,jk,jpdfe,Kbb) * z1_trbdia 165 zironmin = xcoef1 * tr(ji,jj,jk,jpdch,Kbb) * z1_trbdia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk) 166 zlim4 = MAX( 0., ( zratio - zironmin ) / qdfelim ) 167 xdiatpo4(ji,jj,jk) = zlim2 168 xlimdfe (ji,jj,jk) = MIN( 1., zlim4 ) 169 xlimdia (ji,jj,jk) = MIN( zlim1, zlim2, zlim3, zlim4 ) 170 xlimsi (ji,jj,jk) = MIN( zlim1, zlim2, zlim4 ) 171 END_3D 173 172 174 173 ! Compute the fraction of nanophytoplankton that is made of calcifiers 175 174 ! -------------------------------------------------------------------- 176 DO jk = 1, jpkm1 177 DO jj = 1, jpj 178 DO ji = 1, jpi 179 zlim1 = ( trb(ji,jj,jk,jpno3) * concnnh4 + trb(ji,jj,jk,jpnh4) * concnno3 ) & 180 & / ( concnno3 * concnnh4 + concnnh4 * trb(ji,jj,jk,jpno3) + concnno3 * trb(ji,jj,jk,jpnh4) ) 181 zlim2 = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concnnh4 ) 182 zlim3 = trb(ji,jj,jk,jpfer) / ( trb(ji,jj,jk,jpfer) + 5.E-11 ) 183 ztem1 = MAX( 0., tsn(ji,jj,jk,jp_tem) ) 184 ztem2 = tsn(ji,jj,jk,jp_tem) - 10. 185 zetot1 = MAX( 0., etot_ndcy(ji,jj,jk) - 1.) / ( 4. + etot_ndcy(ji,jj,jk) ) 186 zetot2 = 30. / ( 30. + etot_ndcy(ji,jj,jk) ) 187 188 xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 ) & 189 & * ztem1 / ( 0.1 + ztem1 ) & 190 & * MAX( 1., trb(ji,jj,jk,jpphy) * 1.e6 / 2. ) & 191 & * zetot1 * zetot2 & 192 & * ( 1. + EXP(-ztem2 * ztem2 / 25. ) ) & 193 & * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) ) 194 xfracal(ji,jj,jk) = MIN( 0.8 , xfracal(ji,jj,jk) ) 195 xfracal(ji,jj,jk) = MAX( 0.02, xfracal(ji,jj,jk) ) 196 END DO 197 END DO 198 END DO 199 ! 200 DO jk = 1, jpkm1 201 DO jj = 1, jpj 202 DO ji = 1, jpi 203 ! denitrification factor computed from O2 levels 204 nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - trb(ji,jj,jk,jpoxy) ) & 205 & / ( oxymin + trb(ji,jj,jk,jpoxy) ) ) 206 nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 207 ! 208 ! denitrification factor computed from NO3 levels 209 nitrfac2(ji,jj,jk) = MAX( 0.e0, ( 1.E-6 - trb(ji,jj,jk,jpno3) ) & 210 & / ( 1.E-6 + trb(ji,jj,jk,jpno3) ) ) 211 nitrfac2(ji,jj,jk) = MIN( 1., nitrfac2(ji,jj,jk) ) 212 END DO 213 END DO 214 END DO 175 DO_3D_11_11( 1, jpkm1 ) 176 zlim1 = ( tr(ji,jj,jk,jpno3,Kbb) * concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) * concnno3 ) & 177 & / ( concnno3 * concnnh4 + concnnh4 * tr(ji,jj,jk,jpno3,Kbb) + concnno3 * tr(ji,jj,jk,jpnh4,Kbb) ) 178 zlim2 = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concnnh4 ) 179 zlim3 = tr(ji,jj,jk,jpfer,Kbb) / ( tr(ji,jj,jk,jpfer,Kbb) + 5.E-11 ) 180 ztem1 = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) ) 181 ztem2 = ts(ji,jj,jk,jp_tem,Kmm) - 10. 182 zetot1 = MAX( 0., etot_ndcy(ji,jj,jk) - 1.) / ( 4. + etot_ndcy(ji,jj,jk) ) 183 zetot2 = 30. / ( 30. + etot_ndcy(ji,jj,jk) ) 184 185 xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 ) & 186 & * ztem1 / ( 0.1 + ztem1 ) & 187 & * MAX( 1., tr(ji,jj,jk,jpphy,Kbb) * 1.e6 / 2. ) & 188 & * zetot1 * zetot2 & 189 & * ( 1. + EXP(-ztem2 * ztem2 / 25. ) ) & 190 & * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) ) 191 xfracal(ji,jj,jk) = MIN( 0.8 , xfracal(ji,jj,jk) ) 192 xfracal(ji,jj,jk) = MAX( 0.02, xfracal(ji,jj,jk) ) 193 END_3D 194 ! 195 DO_3D_11_11( 1, jpkm1 ) 196 ! denitrification factor computed from O2 levels 197 nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - tr(ji,jj,jk,jpoxy,Kbb) ) & 198 & / ( oxymin + tr(ji,jj,jk,jpoxy,Kbb) ) ) 199 nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 200 ! 201 ! denitrification factor computed from NO3 levels 202 nitrfac2(ji,jj,jk) = MAX( 0.e0, ( 1.E-6 - tr(ji,jj,jk,jpno3,Kbb) ) & 203 & / ( 1.E-6 + tr(ji,jj,jk,jpno3,Kbb) ) ) 204 nitrfac2(ji,jj,jk) = MIN( 1., nitrfac2(ji,jj,jk) ) 205 END_3D 215 206 ! 216 207 IF( lk_iomput .AND. knt == nrdttrc ) THEN ! save output diagnostics … … 252 243 ENDIF 253 244 ! 254 REWIND( numnatp_ref )255 245 READ ( numnatp_ref, namp4zlim, IOSTAT = ios, ERR = 901) 256 246 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zlim in reference namelist' ) 257 258 REWIND( numnatp_cfg )259 247 READ ( numnatp_cfg, namp4zlim, IOSTAT = ios, ERR = 902 ) 260 248 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namp4zlim in configuration namelist' ) -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zlys.F90
r12276 r12377 35 35 REAL(wp) :: calcon = 1.03E-2 ! mean calcite concentration [Ca2+] in sea water [mole/kg solution] 36 36 37 !! * Substitutions 38 # include "do_loop_substitute.h90" 37 39 !!---------------------------------------------------------------------- 38 40 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 43 45 CONTAINS 44 46 45 SUBROUTINE p4z_lys( kt, knt )47 SUBROUTINE p4z_lys( kt, knt, Kbb, Krhs ) 46 48 !!--------------------------------------------------------------------- 47 49 !! *** ROUTINE p4z_lys *** … … 54 56 !!--------------------------------------------------------------------- 55 57 INTEGER, INTENT(in) :: kt, knt ! ocean time step and ??? 58 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 56 59 ! 57 60 INTEGER :: ji, jj, jk, jn … … 70 73 ! ------------------------------------------- 71 74 72 CALL solve_at_general( zhinit, zhi )75 CALL solve_at_general( zhinit, zhi, Kbb ) 73 76 74 DO jk = 1, jpkm1 75 DO jj = 1, jpj 76 DO ji = 1, jpi 77 zco3(ji,jj,jk) = trb(ji,jj,jk,jpdic) * ak13(ji,jj,jk) * ak23(ji,jj,jk) / (zhi(ji,jj,jk)**2 & 78 & + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn ) 79 hi (ji,jj,jk) = zhi(ji,jj,jk) * rhop(ji,jj,jk) / 1000. 80 END DO 81 END DO 82 END DO 77 DO_3D_11_11( 1, jpkm1 ) 78 zco3(ji,jj,jk) = tr(ji,jj,jk,jpdic,Kbb) * ak13(ji,jj,jk) * ak23(ji,jj,jk) / (zhi(ji,jj,jk)**2 & 79 & + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn ) 80 hi (ji,jj,jk) = zhi(ji,jj,jk) * rhop(ji,jj,jk) / 1000. 81 END_3D 83 82 84 83 ! --------------------------------------------------------- … … 88 87 ! --------------------------------------------------------- 89 88 90 DO jk = 1, jpkm1 91 DO jj = 1, jpj 92 DO ji = 1, jpi 89 DO_3D_11_11( 1, jpkm1 ) 93 90 94 95 96 97 98 99 91 ! DEVIATION OF [CO3--] FROM SATURATION VALUE 92 ! Salinity dependance in zomegaca and divide by rhop/1000 to have good units 93 zcalcon = calcon * ( salinprac(ji,jj,jk) / 35._wp ) 94 zfact = rhop(ji,jj,jk) / 1000._wp 95 zomegaca = ( zcalcon * zco3(ji,jj,jk) ) / ( aksp(ji,jj,jk) * zfact + rtrn ) 96 zco3sat(ji,jj,jk) = aksp(ji,jj,jk) * zfact / ( zcalcon + rtrn ) 100 97 101 102 103 104 98 ! SET DEGREE OF UNDER-/SUPERSATURATION 99 excess(ji,jj,jk) = 1._wp - zomegaca 100 zexcess0 = MAX( 0., excess(ji,jj,jk) ) 101 zexcess = zexcess0**nca 105 102 106 ! AMOUNT CACO3 (12C) THAT RE-ENTERS SOLUTION 107 ! (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE 108 ! CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION) 109 zdispot = kdca * zexcess * trb(ji,jj,jk,jpcal) 110 ! CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3], 111 ! AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION 112 zcaldiss(ji,jj,jk) = zdispot * rfact2 / rmtss ! calcite dissolution 113 ! 114 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zcaldiss(ji,jj,jk) 115 tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) - zcaldiss(ji,jj,jk) 116 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zcaldiss(ji,jj,jk) 117 END DO 118 END DO 119 END DO 103 ! AMOUNT CACO3 (12C) THAT RE-ENTERS SOLUTION 104 ! (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE 105 ! CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION) 106 zdispot = kdca * zexcess * tr(ji,jj,jk,jpcal,Kbb) 107 ! CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3], 108 ! AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION 109 zcaldiss(ji,jj,jk) = zdispot * rfact2 / rmtss ! calcite dissolution 110 ! 111 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + 2. * zcaldiss(ji,jj,jk) 112 tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) - zcaldiss(ji,jj,jk) 113 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zcaldiss(ji,jj,jk) 114 END_3D 120 115 ! 121 116 122 117 IF( lk_iomput .AND. knt == nrdttrc ) THEN 123 CALL iom_put( "PH" 118 CALL iom_put( "PH" , -1. * LOG10( MAX( hi(:,:,:), rtrn ) ) * tmask(:,:,:) ) 124 119 IF( iom_use( "CO3" ) ) THEN 125 120 zco3(:,:,jpk) = 0. ; CALL iom_put( "CO3" , zco3(:,:,:) * 1.e+3 * tmask(:,:,:) ) … … 130 125 IF( iom_use( "DCAL" ) ) THEN 131 126 zcaldiss(:,:,jpk) = 0. ; CALL iom_put( "DCAL" , zcaldiss(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) 132 ENDIF 127 ENDIF 133 128 ENDIF 134 129 ! 135 IF( ln_ctl) THEN ! print mean trends (used for debugging)130 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 136 131 WRITE(charout, FMT="('lys ')") 137 132 CALL prt_ctl_trc_info(charout) 138 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)133 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 139 134 ENDIF 140 135 ! … … 166 161 ENDIF 167 162 ! 168 REWIND( numnatp_ref )169 163 READ ( numnatp_ref, nampiscal, IOSTAT = ios, ERR = 901) 170 164 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiscal in reference namelist' ) 171 172 REWIND( numnatp_cfg )173 165 READ ( numnatp_cfg, nampiscal, IOSTAT = ios, ERR = 902 ) 174 166 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampiscal in configuration namelist' ) -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zmeso.F90
r12276 r12377 44 44 REAL(wp), PUBLIC :: grazflux !: mesozoo flux feeding rate 45 45 46 !! * Substitutions 47 # include "do_loop_substitute.h90" 46 48 !!---------------------------------------------------------------------- 47 49 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 51 53 CONTAINS 52 54 53 SUBROUTINE p4z_meso( kt, knt )55 SUBROUTINE p4z_meso( kt, knt, Kbb, Krhs ) 54 56 !!--------------------------------------------------------------------- 55 57 !! *** ROUTINE p4z_meso *** … … 60 62 !!--------------------------------------------------------------------- 61 63 INTEGER, INTENT(in) :: kt, knt ! ocean time step and ??? 64 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 62 65 ! 63 66 INTEGER :: ji, jj, jk … … 77 80 IF( ln_timing ) CALL timing_start('p4z_meso') 78 81 ! 79 DO jk = 1, jpkm1 80 DO jj = 1, jpj 81 DO ji = 1, jpi 82 zcompam = MAX( ( trb(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 ) 83 zfact = xstep * tgfunc2(ji,jj,jk) * zcompam 84 85 ! Respiration rates of both zooplankton 86 ! ------------------------------------- 87 zrespz = resrat2 * zfact * ( trb(ji,jj,jk,jpmes) / ( xkmort + trb(ji,jj,jk,jpmes) ) & 88 & + 3. * nitrfac(ji,jj,jk) ) 89 90 ! Zooplankton mortality. A square function has been selected with 91 ! no real reason except that it seems to be more stable and may mimic predation 92 ! --------------------------------------------------------------- 93 ztortz = mzrat2 * 1.e6 * zfact * trb(ji,jj,jk,jpmes) * (1. - nitrfac(ji,jj,jk) ) 94 ! 95 zcompadi = MAX( ( trb(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 ) 96 zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 ) 97 zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 ) 98 ! Size effect of nanophytoplankton on grazing : the smaller it is, the less prone 99 ! it is to predation by mesozooplankton 100 ! ------------------------------------------------------------------------------- 101 zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) & 102 & * MIN(1., MAX( 0., ( quotan(ji,jj,jk) - 0.2) / 0.3 ) ) 103 104 ! Mesozooplankton grazing 105 ! ------------------------ 106 zfood = xpref2d * zcompadi + xpref2z * zcompaz + xpref2n * zcompaph + xpref2c * zcompapoc 107 zfoodlim = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) ) 108 zdenom = zfoodlim / ( xkgraz2 + zfoodlim ) 109 zdenom2 = zdenom / ( zfood + rtrn ) 110 zgraze2 = grazrat2 * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes) * (1. - nitrfac(ji,jj,jk)) 111 112 zgrazd = zgraze2 * xpref2d * zcompadi * zdenom2 113 zgrazz = zgraze2 * xpref2z * zcompaz * zdenom2 114 zgrazn = zgraze2 * xpref2n * zcompaph * zdenom2 115 zgrazpoc = zgraze2 * xpref2c * zcompapoc * zdenom2 116 117 zgraznf = zgrazn * trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn) 118 zgrazf = zgrazd * trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn) 119 zgrazpof = zgrazpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn) 120 121 ! Mesozooplankton flux feeding on GOC 122 ! ---------------------------------- 123 zgrazffeg = grazflux * xstep * wsbio4(ji,jj,jk) & 124 & * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes) & 125 & * (1. - nitrfac(ji,jj,jk)) 126 zgrazfffg = zgrazffeg * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn) 127 zgrazffep = grazflux * xstep * wsbio3(ji,jj,jk) & 128 & * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpmes) & 129 & * (1. - nitrfac(ji,jj,jk)) 130 zgrazfffp = zgrazffep * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn) 131 ! 132 zgraztotc = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg 133 ! Compute the proportion of filter feeders 134 zproport = (zgrazffep + zgrazffeg)/(rtrn + zgraztotc) 135 ! Compute fractionation of aggregates. It is assumed that 136 ! diatoms based aggregates are more prone to fractionation 137 ! since they are more porous (marine snow instead of fecal pellets) 138 zratio = trb(ji,jj,jk,jpgsi) / ( trb(ji,jj,jk,jpgoc) + rtrn ) 139 zratio2 = zratio * zratio 140 zfrac = zproport * grazflux * xstep * wsbio4(ji,jj,jk) & 141 & * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes) & 142 & * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) ) 143 zfracfe = zfrac * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn) 144 145 zgrazffep = zproport * zgrazffep 146 zgrazffeg = zproport * zgrazffeg 147 zgrazfffp = zproport * zgrazfffp 148 zgrazfffg = zproport * zgrazfffg 149 zgraztotc = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg 150 zgraztotn = zgrazd * quotad(ji,jj,jk) + zgrazz + zgrazn * quotan(ji,jj,jk) & 151 & + zgrazpoc + zgrazffep + zgrazffeg 152 zgraztotf = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfffp + zgrazfffg 153 154 ! Total grazing ( grazing by microzoo is already computed in p4zmicro ) 155 zgrazing2(ji,jj,jk) = zgraztotc 156 157 ! Mesozooplankton efficiency 158 ! -------------------------- 159 zgrasrat = ( zgraztotf + rtrn )/ ( zgraztotc + rtrn ) 160 zgrasratn = ( zgraztotn + rtrn )/ ( zgraztotc + rtrn ) 161 zepshert = MIN( 1., zgrasratn, zgrasrat / ferat3) 162 zbeta = MAX(0., (epsher2 - epsher2min) ) 163 zepsherf = epsher2min + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 164 zepsherv = zepsherf * zepshert 165 166 zgrarem2 = zgraztotc * ( 1. - zepsherv - unass2 ) & 167 & + ( 1. - epsher2 - unass2 ) / ( 1. - epsher2 ) * ztortz 168 zgrafer2 = zgraztotc * MAX( 0. , ( 1. - unass2 ) * zgrasrat - ferat3 * zepsherv ) & 169 & + ferat3 * ( ( 1. - epsher2 - unass2 ) /( 1. - epsher2 ) * ztortz ) 170 zgrapoc2 = zgraztotc * unass2 171 172 ! Update the arrays TRA which contain the biological sources and sinks 173 zgrarsig = zgrarem2 * sigma2 174 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig 175 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 176 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 - zgrarsig 177 ! 178 IF( ln_ligand ) THEN 179 tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + (zgrarem2 - zgrarsig) * ldocz 180 zz2ligprod(ji,jj,jk) = (zgrarem2 - zgrarsig) * ldocz 181 ENDIF 182 ! 183 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 184 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2 185 zfezoo2(ji,jj,jk) = zgrafer2 186 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig 187 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig 188 189 zmortz = ztortz + zrespz 190 zmortzgoc = unass2 / ( 1. - epsher2 ) * ztortz + zrespz 191 tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz + zepsherv * zgraztotc 192 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazd 193 tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz 194 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazn 195 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn * trb(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpphy) + rtrn ) 196 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd * trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn ) 197 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 198 tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 199 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf 200 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf 201 202 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc - zgrazffep + zfrac 203 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfrac 204 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep 205 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortzgoc - zgrazffeg + zgrapoc2 - zfrac 206 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zmortzgoc + zgrapoc2 207 consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfrac 208 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof - zgrazfffp + zfracfe 209 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortzgoc - zgrazfffg & 210 & + zgraztotf * unass2 - zfracfe 211 zfracal = trb(ji,jj,jk,jpcal) / (trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + rtrn ) 212 zgrazcal = (zgrazffeg + zgrazpoc) * (1. - part2) * zfracal 213 ! calcite production 214 zprcaca = xfracal(ji,jj,jk) * zgrazn 215 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 216 ! 217 zprcaca = part2 * zprcaca 218 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrazcal - zprcaca 219 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * ( zgrazcal + zprcaca ) 220 tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) - zgrazcal + zprcaca 221 END DO 222 END DO 223 END DO 82 DO_3D_11_11( 1, jpkm1 ) 83 zcompam = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - 1.e-9 ), 0.e0 ) 84 zfact = xstep * tgfunc2(ji,jj,jk) * zcompam 85 86 ! Respiration rates of both zooplankton 87 ! ------------------------------------- 88 zrespz = resrat2 * zfact * ( tr(ji,jj,jk,jpmes,Kbb) / ( xkmort + tr(ji,jj,jk,jpmes,Kbb) ) & 89 & + 3. * nitrfac(ji,jj,jk) ) 90 91 ! Zooplankton mortality. A square function has been selected with 92 ! no real reason except that it seems to be more stable and may mimic predation 93 ! --------------------------------------------------------------- 94 ztortz = mzrat2 * 1.e6 * zfact * tr(ji,jj,jk,jpmes,Kbb) * (1. - nitrfac(ji,jj,jk) ) 95 ! 96 zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthresh2dia ), 0.e0 ) 97 zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - xthresh2zoo ), 0.e0 ) 98 zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthresh2poc ), 0.e0 ) 99 ! Size effect of nanophytoplankton on grazing : the smaller it is, the less prone 100 ! it is to predation by mesozooplankton 101 ! ------------------------------------------------------------------------------- 102 zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthresh2phy ), 0.e0 ) & 103 & * MIN(1., MAX( 0., ( quotan(ji,jj,jk) - 0.2) / 0.3 ) ) 104 105 ! Mesozooplankton grazing 106 ! ------------------------ 107 zfood = xpref2d * zcompadi + xpref2z * zcompaz + xpref2n * zcompaph + xpref2c * zcompapoc 108 zfoodlim = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) ) 109 zdenom = zfoodlim / ( xkgraz2 + zfoodlim ) 110 zdenom2 = zdenom / ( zfood + rtrn ) 111 zgraze2 = grazrat2 * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpmes,Kbb) * (1. - nitrfac(ji,jj,jk)) 112 113 zgrazd = zgraze2 * xpref2d * zcompadi * zdenom2 114 zgrazz = zgraze2 * xpref2z * zcompaz * zdenom2 115 zgrazn = zgraze2 * xpref2n * zcompaph * zdenom2 116 zgrazpoc = zgraze2 * xpref2c * zcompapoc * zdenom2 117 118 zgraznf = zgrazn * tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn) 119 zgrazf = zgrazd * tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn) 120 zgrazpof = zgrazpoc * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 121 122 ! Mesozooplankton flux feeding on GOC 123 ! ---------------------------------- 124 zgrazffeg = grazflux * xstep * wsbio4(ji,jj,jk) & 125 & * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 126 & * (1. - nitrfac(ji,jj,jk)) 127 zgrazfffg = zgrazffeg * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 128 zgrazffep = grazflux * xstep * wsbio3(ji,jj,jk) & 129 & * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 130 & * (1. - nitrfac(ji,jj,jk)) 131 zgrazfffp = zgrazffep * tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 132 ! 133 zgraztotc = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg 134 ! Compute the proportion of filter feeders 135 zproport = (zgrazffep + zgrazffeg)/(rtrn + zgraztotc) 136 ! Compute fractionation of aggregates. It is assumed that 137 ! diatoms based aggregates are more prone to fractionation 138 ! since they are more porous (marine snow instead of fecal pellets) 139 zratio = tr(ji,jj,jk,jpgsi,Kbb) / ( tr(ji,jj,jk,jpgoc,Kbb) + rtrn ) 140 zratio2 = zratio * zratio 141 zfrac = zproport * grazflux * xstep * wsbio4(ji,jj,jk) & 142 & * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 143 & * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) ) 144 zfracfe = zfrac * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 145 146 zgrazffep = zproport * zgrazffep 147 zgrazffeg = zproport * zgrazffeg 148 zgrazfffp = zproport * zgrazfffp 149 zgrazfffg = zproport * zgrazfffg 150 zgraztotc = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg 151 zgraztotn = zgrazd * quotad(ji,jj,jk) + zgrazz + zgrazn * quotan(ji,jj,jk) & 152 & + zgrazpoc + zgrazffep + zgrazffeg 153 zgraztotf = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfffp + zgrazfffg 154 155 ! Total grazing ( grazing by microzoo is already computed in p4zmicro ) 156 zgrazing2(ji,jj,jk) = zgraztotc 157 158 ! Mesozooplankton efficiency 159 ! -------------------------- 160 zgrasrat = ( zgraztotf + rtrn )/ ( zgraztotc + rtrn ) 161 zgrasratn = ( zgraztotn + rtrn )/ ( zgraztotc + rtrn ) 162 zepshert = MIN( 1., zgrasratn, zgrasrat / ferat3) 163 zbeta = MAX(0., (epsher2 - epsher2min) ) 164 zepsherf = epsher2min + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 165 zepsherv = zepsherf * zepshert 166 167 zgrarem2 = zgraztotc * ( 1. - zepsherv - unass2 ) & 168 & + ( 1. - epsher2 - unass2 ) / ( 1. - epsher2 ) * ztortz 169 zgrafer2 = zgraztotc * MAX( 0. , ( 1. - unass2 ) * zgrasrat - ferat3 * zepsherv ) & 170 & + ferat3 * ( ( 1. - epsher2 - unass2 ) /( 1. - epsher2 ) * ztortz ) 171 zgrapoc2 = zgraztotc * unass2 172 173 ! Update the arrays TRA which contain the biological sources and sinks 174 zgrarsig = zgrarem2 * sigma2 175 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarsig 176 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgrarsig 177 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgrarem2 - zgrarsig 178 ! 179 IF( ln_ligand ) THEN 180 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + (zgrarem2 - zgrarsig) * ldocz 181 zz2ligprod(ji,jj,jk) = (zgrarem2 - zgrarsig) * ldocz 182 ENDIF 183 ! 184 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarsig 185 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgrafer2 186 zfezoo2(ji,jj,jk) = zgrafer2 187 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarsig 188 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zgrarsig 189 190 zmortz = ztortz + zrespz 191 zmortzgoc = unass2 / ( 1. - epsher2 ) * ztortz + zrespz 192 tr(ji,jj,jk,jpmes,Krhs) = tr(ji,jj,jk,jpmes,Krhs) - zmortz + zepsherv * zgraztotc 193 tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazd 194 tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) - zgrazz 195 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgrazn 196 tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgrazn * tr(ji,jj,jk,jpnch,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 197 tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazd * tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 198 tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazd * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 199 tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazd * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 200 tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgraznf 201 tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazf 202 203 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zgrazpoc - zgrazffep + zfrac 204 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfrac 205 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep 206 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zmortzgoc - zgrazffeg + zgrapoc2 - zfrac 207 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zmortzgoc + zgrapoc2 208 consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfrac 209 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zgrazpof - zgrazfffp + zfracfe 210 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + ferat3 * zmortzgoc - zgrazfffg & 211 & + zgraztotf * unass2 - zfracfe 212 zfracal = tr(ji,jj,jk,jpcal,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + tr(ji,jj,jk,jpgoc,Kbb) + rtrn ) 213 zgrazcal = (zgrazffeg + zgrazpoc) * (1. - part2) * zfracal 214 ! calcite production 215 zprcaca = xfracal(ji,jj,jk) * zgrazn 216 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 217 ! 218 zprcaca = part2 * zprcaca 219 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrazcal - zprcaca 220 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * ( zgrazcal + zprcaca ) 221 tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) - zgrazcal + zprcaca 222 END_3D 224 223 ! 225 224 IF( lk_iomput .AND. knt == nrdttrc ) THEN 226 227 225 CALL iom_put( "PCAL" , prodcal(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) ! Calcite production 226 IF( iom_use("GRAZ2") ) THEN ! Total grazing of phyto by zooplankton 228 227 zgrazing2(:,:,jpk) = 0._wp ; CALL iom_put( "GRAZ2" , zgrazing2(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) 229 228 ENDIF … … 236 235 ENDIF 237 236 ! 238 IF( ln_ctl) THEN ! print mean trends (used for debugging)237 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 239 238 WRITE(charout, FMT="('meso')") 240 239 CALL prt_ctl_trc_info(charout) 241 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)240 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 242 241 ENDIF 243 242 ! … … 271 270 ENDIF 272 271 ! 273 REWIND( numnatp_ref )274 272 READ ( numnatp_ref, namp4zmes, IOSTAT = ios, ERR = 901) 275 273 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmes in reference namelist' ) 276 277 REWIND( numnatp_cfg )278 274 READ ( numnatp_cfg, namp4zmes, IOSTAT = ios, ERR = 902 ) 279 275 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namp4zmes in configuration namelist' ) -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zmicro.F90
r12276 r12377 42 42 REAL(wp), PUBLIC :: epshermin !: minimum growth efficiency for grazing 1 43 43 44 !! * Substitutions 45 # include "do_loop_substitute.h90" 44 46 !!---------------------------------------------------------------------- 45 47 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 49 51 CONTAINS 50 52 51 SUBROUTINE p4z_micro( kt, knt )53 SUBROUTINE p4z_micro( kt, knt, Kbb, Krhs ) 52 54 !!--------------------------------------------------------------------- 53 55 !! *** ROUTINE p4z_micro *** … … 59 61 INTEGER, INTENT(in) :: kt ! ocean time step 60 62 INTEGER, INTENT(in) :: knt ! ??? 63 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 61 64 ! 62 65 INTEGER :: ji, jj, jk … … 75 78 IF( ln_timing ) CALL timing_start('p4z_micro') 76 79 ! 77 DO jk = 1, jpkm1 78 DO jj = 1, jpj 79 DO ji = 1, jpi 80 zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 ) 81 zfact = xstep * tgfunc2(ji,jj,jk) * zcompaz 82 83 ! Respiration rates of both zooplankton 84 ! ------------------------------------- 85 zrespz = resrat * zfact * trb(ji,jj,jk,jpzoo) / ( xkmort + trb(ji,jj,jk,jpzoo) ) & 86 & + resrat * zfact * 3. * nitrfac(ji,jj,jk) 87 88 ! Zooplankton mortality. A square function has been selected with 89 ! no real reason except that it seems to be more stable and may mimic predation. 90 ! --------------------------------------------------------------- 91 ztortz = mzrat * 1.e6 * zfact * trb(ji,jj,jk,jpzoo) * (1. - nitrfac(ji,jj,jk)) 92 93 zcompadi = MIN( MAX( ( trb(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia ) 94 zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 ) 95 zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 ) 96 97 ! Microzooplankton grazing 98 ! ------------------------ 99 zfood = xprefn * zcompaph + xprefc * zcompapoc + xprefd * zcompadi 100 zfoodlim = MAX( 0. , zfood - min(xthresh,0.5*zfood) ) 101 zdenom = zfoodlim / ( xkgraz + zfoodlim ) 102 zdenom2 = zdenom / ( zfood + rtrn ) 103 zgraze = grazrat * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpzoo) * (1. - nitrfac(ji,jj,jk)) 104 105 zgrazp = zgraze * xprefn * zcompaph * zdenom2 106 zgrazm = zgraze * xprefc * zcompapoc * zdenom2 107 zgrazsd = zgraze * xprefd * zcompadi * zdenom2 108 109 zgrazpf = zgrazp * trb(ji,jj,jk,jpnfe) / (trb(ji,jj,jk,jpphy) + rtrn) 110 zgrazmf = zgrazm * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn) 111 zgrazsf = zgrazsd * trb(ji,jj,jk,jpdfe) / (trb(ji,jj,jk,jpdia) + rtrn) 112 ! 113 zgraztotc = zgrazp + zgrazm + zgrazsd 114 zgraztotf = zgrazpf + zgrazsf + zgrazmf 115 zgraztotn = zgrazp * quotan(ji,jj,jk) + zgrazm + zgrazsd * quotad(ji,jj,jk) 116 117 ! Grazing by microzooplankton 118 zgrazing(ji,jj,jk) = zgraztotc 119 120 ! Various remineralization and excretion terms 121 ! -------------------------------------------- 122 zgrasrat = ( zgraztotf + rtrn ) / ( zgraztotc + rtrn ) 123 zgrasratn = ( zgraztotn + rtrn ) / ( zgraztotc + rtrn ) 124 zepshert = MIN( 1., zgrasratn, zgrasrat / ferat3) 125 zbeta = MAX(0., (epsher - epshermin) ) 126 zepsherf = epshermin + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 127 zepsherv = zepsherf * zepshert 128 129 zgrafer = zgraztotc * MAX( 0. , ( 1. - unass ) * zgrasrat - ferat3 * zepsherv ) 130 zgrarem = zgraztotc * ( 1. - zepsherv - unass ) 131 zgrapoc = zgraztotc * unass 132 133 ! Update of the TRA arrays 134 ! ------------------------ 135 zgrarsig = zgrarem * sigma1 136 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig 137 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 138 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem - zgrarsig 139 ! 140 IF( ln_ligand ) THEN 141 tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + (zgrarem - zgrarsig) * ldocz 142 zzligprod(ji,jj,jk) = (zgrarem - zgrarsig) * ldocz 143 ENDIF 144 ! 145 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 146 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer 147 zfezoo(ji,jj,jk) = zgrafer 148 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc 149 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zgrapoc 150 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zgraztotf * unass 151 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig 152 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig 153 ! Update the arrays TRA which contain the biological sources and sinks 154 ! -------------------------------------------------------------------- 155 zmortz = ztortz + zrespz 156 tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz + zepsherv * zgraztotc 157 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp 158 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd 159 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp * trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn) 160 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd * trb(ji,jj,jk,jpdch)/(trb(ji,jj,jk,jpdia)+rtrn) 161 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazsd * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn) 162 tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazsd * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn) 163 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgrazpf 164 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf 165 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm 166 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortz 167 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazm 168 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz - zgrazmf 169 ! 170 ! calcite production 171 zprcaca = xfracal(ji,jj,jk) * zgrazp 172 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 173 ! 174 zprcaca = part * zprcaca 175 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 176 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 177 tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 178 END DO 179 END DO 180 END DO 80 DO_3D_11_11( 1, jpkm1 ) 81 zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - 1.e-9 ), 0.e0 ) 82 zfact = xstep * tgfunc2(ji,jj,jk) * zcompaz 83 84 ! Respiration rates of both zooplankton 85 ! ------------------------------------- 86 zrespz = resrat * zfact * tr(ji,jj,jk,jpzoo,Kbb) / ( xkmort + tr(ji,jj,jk,jpzoo,Kbb) ) & 87 & + resrat * zfact * 3. * nitrfac(ji,jj,jk) 88 89 ! Zooplankton mortality. A square function has been selected with 90 ! no real reason except that it seems to be more stable and may mimic predation. 91 ! --------------------------------------------------------------- 92 ztortz = mzrat * 1.e6 * zfact * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk)) 93 94 zcompadi = MIN( MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthreshdia ), 0.e0 ), xsizedia ) 95 zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthreshphy ), 0.e0 ) 96 zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthreshpoc ), 0.e0 ) 97 98 ! Microzooplankton grazing 99 ! ------------------------ 100 zfood = xprefn * zcompaph + xprefc * zcompapoc + xprefd * zcompadi 101 zfoodlim = MAX( 0. , zfood - min(xthresh,0.5*zfood) ) 102 zdenom = zfoodlim / ( xkgraz + zfoodlim ) 103 zdenom2 = zdenom / ( zfood + rtrn ) 104 zgraze = grazrat * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk)) 105 106 zgrazp = zgraze * xprefn * zcompaph * zdenom2 107 zgrazm = zgraze * xprefc * zcompapoc * zdenom2 108 zgrazsd = zgraze * xprefd * zcompadi * zdenom2 109 110 zgrazpf = zgrazp * tr(ji,jj,jk,jpnfe,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 111 zgrazmf = zgrazm * tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 112 zgrazsf = zgrazsd * tr(ji,jj,jk,jpdfe,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 113 ! 114 zgraztotc = zgrazp + zgrazm + zgrazsd 115 zgraztotf = zgrazpf + zgrazsf + zgrazmf 116 zgraztotn = zgrazp * quotan(ji,jj,jk) + zgrazm + zgrazsd * quotad(ji,jj,jk) 117 118 ! Grazing by microzooplankton 119 zgrazing(ji,jj,jk) = zgraztotc 120 121 ! Various remineralization and excretion terms 122 ! -------------------------------------------- 123 zgrasrat = ( zgraztotf + rtrn ) / ( zgraztotc + rtrn ) 124 zgrasratn = ( zgraztotn + rtrn ) / ( zgraztotc + rtrn ) 125 zepshert = MIN( 1., zgrasratn, zgrasrat / ferat3) 126 zbeta = MAX(0., (epsher - epshermin) ) 127 zepsherf = epshermin + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 128 zepsherv = zepsherf * zepshert 129 130 zgrafer = zgraztotc * MAX( 0. , ( 1. - unass ) * zgrasrat - ferat3 * zepsherv ) 131 zgrarem = zgraztotc * ( 1. - zepsherv - unass ) 132 zgrapoc = zgraztotc * unass 133 134 ! Update of the TRA arrays 135 ! ------------------------ 136 zgrarsig = zgrarem * sigma1 137 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarsig 138 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgrarsig 139 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgrarem - zgrarsig 140 ! 141 IF( ln_ligand ) THEN 142 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + (zgrarem - zgrarsig) * ldocz 143 zzligprod(ji,jj,jk) = (zgrarem - zgrarsig) * ldocz 144 ENDIF 145 ! 146 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarsig 147 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgrafer 148 zfezoo(ji,jj,jk) = zgrafer 149 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zgrapoc 150 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zgrapoc 151 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zgraztotf * unass 152 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarsig 153 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zgrarsig 154 ! Update the arrays TRA which contain the biological sources and sinks 155 ! -------------------------------------------------------------------- 156 zmortz = ztortz + zrespz 157 tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) - zmortz + zepsherv * zgraztotc 158 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgrazp 159 tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazsd 160 tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgrazp * tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 161 tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazsd * tr(ji,jj,jk,jpdch,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 162 tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazsd * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 163 tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazsd * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 164 tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgrazpf 165 tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazsf 166 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortz - zgrazm 167 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortz 168 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazm 169 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ferat3 * zmortz - zgrazmf 170 ! 171 ! calcite production 172 zprcaca = xfracal(ji,jj,jk) * zgrazp 173 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 174 ! 175 zprcaca = part * zprcaca 176 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprcaca 177 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca 178 tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca 179 END_3D 181 180 ! 182 181 IF( lk_iomput .AND. knt == nrdttrc ) THEN 183 IF( iom_use("GRAZ1") ) THEN ! Total grazing of phyto by zooplankton182 IF( iom_use("GRAZ1") ) THEN ! Total grazing of phyto by zooplankton 184 183 zgrazing(:,:,jpk) = 0._wp ; CALL iom_put( "GRAZ1" , zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) 185 184 ENDIF 186 185 IF( iom_use("FEZOO") ) THEN 187 zfezoo (:,:,jpk) = 0._wp ; CALL iom_put( "FEZOO" 186 zfezoo (:,:,jpk) = 0._wp ; CALL iom_put( "FEZOO", zfezoo(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) ) 188 187 ENDIF 189 188 IF( ln_ligand ) THEN … … 192 191 ENDIF 193 192 ! 194 IF( ln_ctl) THEN ! print mean trends (used for debugging)193 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 195 194 WRITE(charout, FMT="('micro')") 196 195 CALL prt_ctl_trc_info(charout) 197 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)196 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 198 197 ENDIF 199 198 ! … … 228 227 ENDIF 229 228 ! 230 REWIND( numnatp_ref )231 229 READ ( numnatp_ref, namp4zzoo, IOSTAT = ios, ERR = 901) 232 230 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zzoo in reference namelist' ) 233 234 REWIND( numnatp_cfg )235 231 READ ( numnatp_cfg, namp4zzoo, IOSTAT = ios, ERR = 902 ) 236 232 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namp4zzoo in configuration namelist' ) -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zmort.F90
r11536 r12377 29 29 REAL(wp), PUBLIC :: mprat2 !: 30 30 31 !! * Substitutions 32 # include "do_loop_substitute.h90" 31 33 !!---------------------------------------------------------------------- 32 34 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 36 38 CONTAINS 37 39 38 SUBROUTINE p4z_mort( kt )40 SUBROUTINE p4z_mort( kt, Kbb, Krhs ) 39 41 !!--------------------------------------------------------------------- 40 42 !! *** ROUTINE p4z_mort *** … … 46 48 !!--------------------------------------------------------------------- 47 49 INTEGER, INTENT(in) :: kt ! ocean time step 48 !!--------------------------------------------------------------------- 49 ! 50 CALL p4z_nano ! nanophytoplankton 51 ! 52 CALL p4z_diat ! diatoms 50 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 51 !!--------------------------------------------------------------------- 52 ! 53 CALL p4z_nano( Kbb, Krhs ) ! nanophytoplankton 54 ! 55 CALL p4z_diat( Kbb, Krhs ) ! diatoms 53 56 ! 54 57 END SUBROUTINE p4z_mort 55 58 56 59 57 SUBROUTINE p4z_nano 60 SUBROUTINE p4z_nano( Kbb, Krhs ) 58 61 !!--------------------------------------------------------------------- 59 62 !! *** ROUTINE p4z_nano *** … … 63 66 !! ** Method : - ??? 64 67 !!--------------------------------------------------------------------- 68 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 65 69 INTEGER :: ji, jj, jk 66 70 REAL(wp) :: zsizerat, zcompaph … … 73 77 ! 74 78 prodcal(:,:,:) = 0._wp ! calcite production variable set to zero 75 DO jk = 1, jpkm1 76 DO jj = 1, jpj 77 DO ji = 1, jpi 78 zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 ) 79 ! When highly limited by macronutrients, very small cells 80 ! dominate the community. As a consequence, aggregation 81 ! due to turbulence is negligible. Mortality is also set 82 ! to 0 83 zsizerat = MIN(1., MAX( 0., (quotan(ji,jj,jk) - 0.2) / 0.3) ) * trb(ji,jj,jk,jpphy) 84 ! Squared mortality of Phyto similar to a sedimentation term during 85 ! blooms (Doney et al. 1996) 86 zrespp = wchl * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * zsizerat 87 88 ! Phytoplankton mortality. This mortality loss is slightly 89 ! increased when nutrients are limiting phytoplankton growth 90 ! as observed for instance in case of iron limitation. 91 ztortp = mprat * xstep * zcompaph / ( xkmort + trb(ji,jj,jk,jpphy) ) * zsizerat 92 93 zmortp = zrespp + ztortp 94 95 ! Update the arrays TRA which contains the biological sources and sinks 96 97 zfactfe = trb(ji,jj,jk,jpnfe)/(trb(ji,jj,jk,jpphy)+rtrn) 98 zfactch = trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn) 99 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zmortp 100 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zmortp * zfactch 101 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zmortp * zfactfe 102 zprcaca = xfracal(ji,jj,jk) * zmortp 103 ! 104 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 105 ! 106 zfracal = 0.5 * xfracal(ji,jj,jk) 107 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 108 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 109 tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 110 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfracal * zmortp 111 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ( 1. - zfracal ) * zmortp 112 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ( 1. - zfracal ) * zmortp 113 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zfracal * zmortp 114 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ( 1. - zfracal ) * zmortp * zfactfe 115 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zfracal * zmortp * zfactfe 116 END DO 117 END DO 118 END DO 119 ! 120 IF(ln_ctl) THEN ! print mean trends (used for debugging) 79 DO_3D_11_11( 1, jpkm1 ) 80 zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-8 ), 0.e0 ) 81 ! When highly limited by macronutrients, very small cells 82 ! dominate the community. As a consequence, aggregation 83 ! due to turbulence is negligible. Mortality is also set 84 ! to 0 85 zsizerat = MIN(1., MAX( 0., (quotan(ji,jj,jk) - 0.2) / 0.3) ) * tr(ji,jj,jk,jpphy,Kbb) 86 ! Squared mortality of Phyto similar to a sedimentation term during 87 ! blooms (Doney et al. 1996) 88 zrespp = wchl * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * zsizerat 89 90 ! Phytoplankton mortality. This mortality loss is slightly 91 ! increased when nutrients are limiting phytoplankton growth 92 ! as observed for instance in case of iron limitation. 93 ztortp = mprat * xstep * zcompaph / ( xkmort + tr(ji,jj,jk,jpphy,Kbb) ) * zsizerat 94 95 zmortp = zrespp + ztortp 96 97 ! Update the arrays TRA which contains the biological sources and sinks 98 99 zfactfe = tr(ji,jj,jk,jpnfe,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 100 zfactch = tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 101 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zmortp 102 tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zmortp * zfactch 103 tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zmortp * zfactfe 104 zprcaca = xfracal(ji,jj,jk) * zmortp 105 ! 106 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 107 ! 108 zfracal = 0.5 * xfracal(ji,jj,jk) 109 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprcaca 110 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca 111 tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca 112 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfracal * zmortp 113 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + ( 1. - zfracal ) * zmortp 114 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ( 1. - zfracal ) * zmortp 115 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zfracal * zmortp 116 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ( 1. - zfracal ) * zmortp * zfactfe 117 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zfracal * zmortp * zfactfe 118 END_3D 119 ! 120 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 121 121 WRITE(charout, FMT="('nano')") 122 122 CALL prt_ctl_trc_info(charout) 123 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)123 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 124 124 ENDIF 125 125 ! … … 129 129 130 130 131 SUBROUTINE p4z_diat 131 SUBROUTINE p4z_diat( Kbb, Krhs ) 132 132 !!--------------------------------------------------------------------- 133 133 !! *** ROUTINE p4z_diat *** … … 137 137 !! ** Method : - ??? 138 138 !!--------------------------------------------------------------------- 139 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 139 140 INTEGER :: ji, jj, jk 140 141 REAL(wp) :: zfactfe,zfactsi,zfactch, zcompadi … … 151 152 ! ------------------------------------------------------------ 152 153 153 DO jk = 1, jpkm1 154 DO jj = 1, jpj 155 DO ji = 1, jpi 156 157 zcompadi = MAX( ( trb(ji,jj,jk,jpdia) - 1e-9), 0. ) 158 159 ! Aggregation term for diatoms is increased in case of nutrient 160 ! stress as observed in reality. The stressed cells become more 161 ! sticky and coagulate to sink quickly out of the euphotic zone 162 ! ------------------------------------------------------------ 163 ! Phytoplankton respiration 164 ! ------------------------ 165 zlim2 = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk) 166 zlim1 = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 167 zrespp2 = 1.e6 * xstep * ( wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trb(ji,jj,jk,jpdia) 168 169 ! Phytoplankton mortality. 170 ! ------------------------ 171 ztortp2 = mprat2 * xstep * trb(ji,jj,jk,jpdia) / ( xkmort + trb(ji,jj,jk,jpdia) ) * zcompadi 172 173 zmortp2 = zrespp2 + ztortp2 174 175 ! Update the arrays tra which contains the biological sources and sinks 176 ! --------------------------------------------------------------------- 177 zfactch = trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn ) 178 zfactfe = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn ) 179 zfactsi = trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 180 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zmortp2 181 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zmortp2 * zfactch 182 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zmortp2 * zfactfe 183 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zmortp2 * zfactsi 184 tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zmortp2 * zfactsi 185 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zrespp2 + 0.5 * ztortp2 186 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + 0.5 * ztortp2 187 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + 0.5 * ztortp2 188 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zrespp2 + 0.5 * ztortp2 189 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 0.5 * ztortp2 * zfactfe 190 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ( zrespp2 + 0.5 * ztortp2 ) * zfactfe 191 END DO 192 END DO 193 END DO 194 ! 195 IF(ln_ctl) THEN ! print mean trends (used for debugging) 154 DO_3D_11_11( 1, jpkm1 ) 155 156 zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1e-9), 0. ) 157 158 ! Aggregation term for diatoms is increased in case of nutrient 159 ! stress as observed in reality. The stressed cells become more 160 ! sticky and coagulate to sink quickly out of the euphotic zone 161 ! ------------------------------------------------------------ 162 ! Phytoplankton respiration 163 ! ------------------------ 164 zlim2 = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk) 165 zlim1 = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 166 zrespp2 = 1.e6 * xstep * ( wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * tr(ji,jj,jk,jpdia,Kbb) 167 168 ! Phytoplankton mortality. 169 ! ------------------------ 170 ztortp2 = mprat2 * xstep * tr(ji,jj,jk,jpdia,Kbb) / ( xkmort + tr(ji,jj,jk,jpdia,Kbb) ) * zcompadi 171 172 zmortp2 = zrespp2 + ztortp2 173 174 ! Update the arrays tr(:,:,:,:,Krhs) which contains the biological sources and sinks 175 ! --------------------------------------------------------------------- 176 zfactch = tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 177 zfactfe = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 178 zfactsi = tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 179 tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zmortp2 180 tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zmortp2 * zfactch 181 tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zmortp2 * zfactfe 182 tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zmortp2 * zfactsi 183 tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zmortp2 * zfactsi 184 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zrespp2 + 0.5 * ztortp2 185 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + 0.5 * ztortp2 186 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + 0.5 * ztortp2 187 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zrespp2 + 0.5 * ztortp2 188 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 0.5 * ztortp2 * zfactfe 189 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + ( zrespp2 + 0.5 * ztortp2 ) * zfactfe 190 END_3D 191 ! 192 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 196 193 WRITE(charout, FMT="('diat')") 197 194 CALL prt_ctl_trc_info(charout) 198 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)195 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 199 196 ENDIF 200 197 ! … … 227 224 ENDIF 228 225 ! 229 REWIND( numnatp_ref ) ! Namelist nampismort in reference namelist : Pisces phytoplankton230 226 READ ( numnatp_ref, namp4zmort, IOSTAT = ios, ERR = 901) 231 227 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmort in reference namelist' ) 232 REWIND( numnatp_cfg ) ! Namelist nampismort in configuration namelist : Pisces phytoplankton233 228 READ ( numnatp_cfg, namp4zmort, IOSTAT = ios, ERR = 902 ) 234 229 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namp4zmort in configuration namelist' ) -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zopt.F90
r12276 r12377 42 42 REAL(wp), DIMENSION(3,61) :: xkrgb ! tabulated attenuation coefficients for RGB absorption 43 43 44 !! * Substitutions 45 # include "do_loop_substitute.h90" 44 46 !!---------------------------------------------------------------------- 45 47 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 49 51 CONTAINS 50 52 51 SUBROUTINE p4z_opt( kt, knt )53 SUBROUTINE p4z_opt( kt, knt, Kbb, Kmm ) 52 54 !!--------------------------------------------------------------------- 53 55 !! *** ROUTINE p4z_opt *** … … 59 61 !!--------------------------------------------------------------------- 60 62 INTEGER, INTENT(in) :: kt, knt ! ocean time step 63 INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices 61 64 ! 62 65 INTEGER :: ji, jj, jk … … 82 85 ! !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 83 86 ! ! -------------------------------------------------------- 84 zchl3d(:,:,:) = trb(:,:,:,jpnch) + trb(:,:,:,jpdch) 85 IF( ln_p5z ) zchl3d(:,:,:) = zchl3d(:,:,:) + trb(:,:,:,jppch) 86 ! 87 DO jk = 1, jpkm1 88 DO jj = 1, jpj 89 DO ji = 1, jpi 90 zchl = ( zchl3d(ji,jj,jk) + rtrn ) * 1.e6 91 zchl = MIN( 10. , MAX( 0.05, zchl ) ) 92 irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 93 ! 94 ekb(ji,jj,jk) = xkrgb(1,irgb) * e3t_n(ji,jj,jk) 95 ekg(ji,jj,jk) = xkrgb(2,irgb) * e3t_n(ji,jj,jk) 96 ekr(ji,jj,jk) = xkrgb(3,irgb) * e3t_n(ji,jj,jk) 97 END DO 98 END DO 99 END DO 87 zchl3d(:,:,:) = tr(:,:,:,jpnch,Kbb) + tr(:,:,:,jpdch,Kbb) 88 IF( ln_p5z ) zchl3d(:,:,:) = zchl3d(:,:,:) + tr(:,:,:,jppch,Kbb) 89 ! 90 DO_3D_11_11( 1, jpkm1 ) 91 zchl = ( zchl3d(ji,jj,jk) + rtrn ) * 1.e6 92 zchl = MIN( 10. , MAX( 0.05, zchl ) ) 93 irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 94 ! 95 ekb(ji,jj,jk) = xkrgb(1,irgb) * e3t(ji,jj,jk,Kmm) 96 ekg(ji,jj,jk) = xkrgb(2,irgb) * e3t(ji,jj,jk,Kmm) 97 ekr(ji,jj,jk) = xkrgb(3,irgb) * e3t(ji,jj,jk,Kmm) 98 END_3D 100 99 ! !* Photosynthetically Available Radiation (PAR) 101 100 ! ! -------------------------------------- … … 104 103 zqsr_corr(:,:) = qsr_mean(:,:) / ( 1.-fr_i(:,:) + rtrn ) 105 104 ! 106 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 )105 CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) 107 106 ! 108 107 DO jk = 1, nksrp … … 119 118 zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn ) 120 119 ! 121 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 )120 CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3 ) 122 121 ! 123 122 DO jk = 1, nksrp … … 129 128 zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn ) 130 129 ! 131 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 )130 CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) 132 131 ! 133 132 DO jk = 1, nksrp 134 etot (:,:,jk) = 133 etot (:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 135 134 enano(:,:,jk) = 1.85 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.46 * ze3(:,:,jk) 136 135 ediat(:,:,jk) = 1.62 * ze1(:,:,jk) + 0.74 * ze2(:,:,jk) + 0.63 * ze3(:,:,jk) … … 147 146 IF( ln_qsr_bio ) THEN !* heat flux accros w-level (used in the dynamics) 148 147 ! ! ------------------------ 149 CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3, pe0=ze0 )148 CALL p4z_opt_par( kt, Kmm, qsr, ze1, ze2, ze3, pe0=ze0 ) 150 149 ! 151 150 etot3(:,:,1) = qsr(:,:) * tmask(:,:,1) … … 157 156 ! !* Euphotic depth and level 158 157 neln (:,:) = 1 ! ------------------------ 159 heup (:,:) = gdepw_n(:,:,2) 160 heup_01(:,:) = gdepw_n(:,:,2) 161 162 DO jk = 2, nksrp 163 DO jj = 1, jpj 164 DO ji = 1, jpi 165 IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= zqsr100(ji,jj) ) THEN 166 neln(ji,jj) = jk+1 ! Euphotic level : 1rst T-level strictly below Euphotic layer 167 ! ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint 168 heup(ji,jj) = gdepw_n(ji,jj,jk+1) ! Euphotic layer depth 169 ENDIF 170 IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.50 ) THEN 171 heup_01(ji,jj) = gdepw_n(ji,jj,jk+1) ! Euphotic layer depth (light level definition) 172 ENDIF 173 END DO 174 END DO 175 END DO 158 heup (:,:) = gdepw(:,:,2,Kmm) 159 heup_01(:,:) = gdepw(:,:,2,Kmm) 160 161 DO_3D_11_11( 2, nksrp ) 162 IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= zqsr100(ji,jj) ) THEN 163 neln(ji,jj) = jk+1 ! Euphotic level : 1rst T-level strictly below Euphotic layer 164 ! ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint 165 heup(ji,jj) = gdepw(ji,jj,jk+1,Kmm) ! Euphotic layer depth 166 ENDIF 167 IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.50 ) THEN 168 heup_01(ji,jj) = gdepw(ji,jj,jk+1,Kmm) ! Euphotic layer depth (light level definition) 169 ENDIF 170 END_3D 176 171 ! 177 172 heup (:,:) = MIN( 300., heup (:,:) ) … … 182 177 zetmp2 (:,:) = 0.e0 183 178 184 DO jk = 1, nksrp 185 DO jj = 1, jpj 186 DO ji = 1, jpi 187 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 188 zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot (ji,jj,jk) * e3t_n(ji,jj,jk) ! remineralisation 189 zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t_n(ji,jj,jk) ! production 190 zdepmoy(ji,jj) = zdepmoy(ji,jj) + e3t_n(ji,jj,jk) 191 ENDIF 192 END DO 193 END DO 194 END DO 179 DO_3D_11_11( 1, nksrp ) 180 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 181 zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! remineralisation 182 zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 183 zdepmoy(ji,jj) = zdepmoy(ji,jj) + e3t(ji,jj,jk,Kmm) 184 ENDIF 185 END_3D 195 186 ! 196 187 emoy(:,:,:) = etot(:,:,:) ! remineralisation 197 188 zpar(:,:,:) = etot_ndcy(:,:,:) ! diagnostic : PAR with no diurnal cycle 198 189 ! 199 DO jk = 1, nksrp 200 DO jj = 1, jpj 201 DO ji = 1, jpi 202 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 203 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 204 emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep 205 zpar (ji,jj,jk) = zetmp2(ji,jj) * z1_dep 206 ENDIF 207 END DO 208 END DO 209 END DO 190 DO_3D_11_11( 1, nksrp ) 191 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 192 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 193 emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep 194 zpar (ji,jj,jk) = zetmp2(ji,jj) * z1_dep 195 ENDIF 196 END_3D 210 197 ! 211 198 zdepmoy(:,:) = 0.e0 … … 213 200 zetmp4 (:,:) = 0.e0 214 201 ! 215 DO jk = 1, nksrp 216 DO jj = 1, jpj 217 DO ji = 1, jpi 218 IF( gdepw_n(ji,jj,jk+1) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 219 zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano (ji,jj,jk) * e3t_n(ji,jj,jk) ! production 220 zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat (ji,jj,jk) * e3t_n(ji,jj,jk) ! production 221 zdepmoy(ji,jj) = zdepmoy(ji,jj) + e3t_n(ji,jj,jk) 222 ENDIF 223 END DO 224 END DO 225 END DO 202 DO_3D_11_11( 1, nksrp ) 203 IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 204 zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 205 zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 206 zdepmoy(ji,jj) = zdepmoy(ji,jj) + e3t(ji,jj,jk,Kmm) 207 ENDIF 208 END_3D 226 209 enanom(:,:,:) = enano(:,:,:) 227 210 ediatm(:,:,:) = ediat(:,:,:) 228 211 ! 229 DO jk = 1, nksrp 230 DO jj = 1, jpj 231 DO ji = 1, jpi 232 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 233 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 234 enanom(ji,jj,jk) = zetmp3(ji,jj) * z1_dep 235 ediatm(ji,jj,jk) = zetmp4(ji,jj) * z1_dep 236 ENDIF 237 END DO 238 END DO 239 END DO 212 DO_3D_11_11( 1, nksrp ) 213 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 214 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 215 enanom(ji,jj,jk) = zetmp3(ji,jj) * z1_dep 216 ediatm(ji,jj,jk) = zetmp4(ji,jj) * z1_dep 217 ENDIF 218 END_3D 240 219 ! 241 220 IF( ln_p5z ) THEN 242 221 ALLOCATE( zetmp5(jpi,jpj) ) ; zetmp5 (:,:) = 0.e0 243 DO jk = 1, nksrp 244 DO jj = 1, jpj 245 DO ji = 1, jpi 246 IF( gdepw_n(ji,jj,jk+1) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 247 zetmp5(ji,jj) = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t_n(ji,jj,jk) ! production 248 ENDIF 249 END DO 250 END DO 251 END DO 222 DO_3D_11_11( 1, nksrp ) 223 IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 224 zetmp5(ji,jj) = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 225 ENDIF 226 END_3D 252 227 ! 253 228 epicom(:,:,:) = epico(:,:,:) 254 229 ! 255 DO jk = 1, nksrp 256 DO jj = 1, jpj 257 DO ji = 1, jpi 258 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 259 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 260 epicom(ji,jj,jk) = zetmp5(ji,jj) * z1_dep 261 ENDIF 262 END DO 263 END DO 264 END DO 230 DO_3D_11_11( 1, nksrp ) 231 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 232 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 233 epicom(ji,jj,jk) = zetmp5(ji,jj) * z1_dep 234 ENDIF 235 END_3D 265 236 DEALLOCATE( zetmp5 ) 266 237 ENDIF … … 277 248 278 249 279 SUBROUTINE p4z_opt_par( kt, pqsr, pe1, pe2, pe3, pe0, pqsr100 )250 SUBROUTINE p4z_opt_par( kt, Kmm, pqsr, pe1, pe2, pe3, pe0, pqsr100 ) 280 251 !!---------------------------------------------------------------------- 281 252 !! *** routine p4z_opt_par *** … … 286 257 !!---------------------------------------------------------------------- 287 258 INTEGER , INTENT(in) :: kt ! ocean time-step 259 INTEGER , INTENT(in) :: Kmm ! ocean time-index 288 260 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pqsr ! shortwave 289 261 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe1 , pe2 , pe3 ! PAR ( R-G-B) … … 313 285 DO jj = 1, jpj 314 286 DO ji = 1, jpi 315 pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t _n(ji,jj,jk-1) * xsi0r )287 pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t(ji,jj,jk-1,Kmm) * xsi0r ) 316 288 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb (ji,jj,jk-1 ) ) 317 289 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg (ji,jj,jk-1 ) ) … … 329 301 pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) ) 330 302 ! 331 DO jk = 2, nksrp 332 DO jj = 1, jpj 333 DO ji = 1, jpi 334 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) 335 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) ) 336 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) ) 337 END DO 338 END DO 339 END DO 303 DO_3D_11_11( 2, nksrp ) 304 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) 305 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) ) 306 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) ) 307 END_3D 340 308 ! 341 309 ENDIF … … 398 366 WRITE(numout,*) '~~~~~~~~~~~~ ' 399 367 ENDIF 400 401 REWIND( numnatp_ref )402 368 READ ( numnatp_ref, nampisopt, IOSTAT = ios, ERR = 901) 403 369 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisopt in reference namelist' ) 404 405 REWIND( numnatp_cfg )406 370 READ ( numnatp_cfg, nampisopt, IOSTAT = ios, ERR = 902 ) 407 371 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisopt in configuration namelist' ) -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zpoc.F90
r11536 r12377 37 37 38 38 39 !! * Substitutions 40 # include "do_loop_substitute.h90" 39 41 !!---------------------------------------------------------------------- 40 42 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 44 46 CONTAINS 45 47 46 SUBROUTINE p4z_poc( kt, knt )48 SUBROUTINE p4z_poc( kt, knt, Kbb, Kmm, Krhs ) 47 49 !!--------------------------------------------------------------------- 48 50 !! *** ROUTINE p4z_poc *** … … 52 54 !! ** Method : - ??? 53 55 !!--------------------------------------------------------------------- 54 INTEGER, INTENT(in) :: kt, knt ! ocean time step and ??? 56 INTEGER, INTENT(in) :: kt, knt ! ocean time step and ??? 57 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 55 58 ! 56 59 INTEGER :: ji, jj, jk, jn … … 103 106 ! ----------------------------------------------------------------------- 104 107 ztremint(:,:,:) = zremigoc(:,:,:) 105 DO jk = 2, jpkm1 106 DO jj = 1, jpj 107 DO ji = 1, jpi 108 IF (tmask(ji,jj,jk) == 1.) THEN 109 zdep = hmld(ji,jj) 110 ! 111 ! In the case of GOC, lability is constant in the mixed layer 112 ! It is computed only below the mixed layer depth 113 ! ------------------------------------------------------------ 114 ! 115 IF( gdept_n(ji,jj,jk) > zdep ) THEN 116 alphat = 0. 117 remint = 0. 118 ! 119 zsizek1 = e3t_n(ji,jj,jk-1) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 120 zsizek = e3t_n(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 121 ! 122 IF ( gdept_n(ji,jj,jk-1) <= zdep ) THEN 123 ! 124 ! The first level just below the mixed layer needs a 125 ! specific treatment because lability is supposed constant 126 ! everywhere within the mixed layer. This means that 127 ! change in lability in the bottom part of the previous cell 128 ! should not be computed 129 ! ---------------------------------------------------------- 130 ! 131 ! POC concentration is computed using the lagrangian 132 ! framework. It is only used for the lability param 133 zpoc = trb(ji,jj,jk-1,jpgoc) + consgoc(ji,jj,jk) * rday / rfact2 & 134 & * e3t_n(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn) 135 zpoc = MAX(0., zpoc) 136 ! 137 DO jn = 1, jcpoc 138 ! 139 ! Lagrangian based algorithm. The fraction of each 140 ! lability class is computed starting from the previous 141 ! level 142 ! ----------------------------------------------------- 143 ! 144 ! the concentration of each lability class is calculated 145 ! as the sum of the different sources and sinks 146 ! Please note that production of new GOC experiences 147 ! degradation 148 alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc & 149 & + prodgoc(ji,jj,jk) * alphan(jn) / tgfunc(ji,jj,jk) / reminp(jn) & 150 & * ( 1. - exp( -reminp(jn) * zsizek ) ) * rday / rfact2 151 alphat = alphat + alphag(ji,jj,jk,jn) 152 remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) 153 END DO 154 ELSE 155 ! 156 ! standard algorithm in the rest of the water column 157 ! See the comments in the previous block. 158 ! --------------------------------------------------- 159 ! 160 zpoc = trb(ji,jj,jk-1,jpgoc) + consgoc(ji,jj,jk-1) * rday / rfact2 & 161 & * e3t_n(ji,jj,jk-1) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) + consgoc(ji,jj,jk) & 162 & * rday / rfact2 * e3t_n(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn) 163 zpoc = max(0., zpoc) 164 ! 165 DO jn = 1, jcpoc 166 alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * ( zsizek & 167 & + zsizek1 ) ) * zpoc + ( prodgoc(ji,jj,jk-1) / tgfunc(ji,jj,jk-1) * ( 1. & 168 & - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn) * zsizek ) + prodgoc(ji,jj,jk) & 169 & / tgfunc(ji,jj,jk) * ( 1. - exp( -reminp(jn) * zsizek ) ) ) * rday / rfact2 / reminp(jn) * alphan(jn) 170 alphat = alphat + alphag(ji,jj,jk,jn) 171 remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) 172 END DO 173 ENDIF 174 ! 175 DO jn = 1, jcpoc 176 ! The contribution of each lability class at the current 177 ! level is computed 178 alphag(ji,jj,jk,jn) = alphag(ji,jj,jk,jn) / ( alphat + rtrn) 179 END DO 180 ! Computation of the mean remineralisation rate 181 ztremint(ji,jj,jk) = MAX(0., remint / ( alphat + rtrn) ) 182 ! 183 ENDIF 184 ENDIF 108 DO_3D_11_11( 2, jpkm1 ) 109 IF (tmask(ji,jj,jk) == 1.) THEN 110 zdep = hmld(ji,jj) 111 ! 112 ! In the case of GOC, lability is constant in the mixed layer 113 ! It is computed only below the mixed layer depth 114 ! ------------------------------------------------------------ 115 ! 116 IF( gdept(ji,jj,jk,Kmm) > zdep ) THEN 117 alphat = 0. 118 remint = 0. 119 ! 120 zsizek1 = e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 121 zsizek = e3t(ji,jj,jk,Kmm) / 2. / (wsbio4(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 122 ! 123 IF ( gdept(ji,jj,jk-1,Kmm) <= zdep ) THEN 124 ! 125 ! The first level just below the mixed layer needs a 126 ! specific treatment because lability is supposed constant 127 ! everywhere within the mixed layer. This means that 128 ! change in lability in the bottom part of the previous cell 129 ! should not be computed 130 ! ---------------------------------------------------------- 131 ! 132 ! POC concentration is computed using the lagrangian 133 ! framework. It is only used for the lability param 134 zpoc = tr(ji,jj,jk-1,jpgoc,Kbb) + consgoc(ji,jj,jk) * rday / rfact2 & 135 & * e3t(ji,jj,jk,Kmm) / 2. / (wsbio4(ji,jj,jk) + rtrn) 136 zpoc = MAX(0., zpoc) 137 ! 138 DO jn = 1, jcpoc 139 ! 140 ! Lagrangian based algorithm. The fraction of each 141 ! lability class is computed starting from the previous 142 ! level 143 ! ----------------------------------------------------- 144 ! 145 ! the concentration of each lability class is calculated 146 ! as the sum of the different sources and sinks 147 ! Please note that production of new GOC experiences 148 ! degradation 149 alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc & 150 & + prodgoc(ji,jj,jk) * alphan(jn) / tgfunc(ji,jj,jk) / reminp(jn) & 151 & * ( 1. - exp( -reminp(jn) * zsizek ) ) * rday / rfact2 152 alphat = alphat + alphag(ji,jj,jk,jn) 153 remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) 154 END DO 155 ELSE 156 ! 157 ! standard algorithm in the rest of the water column 158 ! See the comments in the previous block. 159 ! --------------------------------------------------- 160 ! 161 zpoc = tr(ji,jj,jk-1,jpgoc,Kbb) + consgoc(ji,jj,jk-1) * rday / rfact2 & 162 & * e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) + consgoc(ji,jj,jk) & 163 & * rday / rfact2 * e3t(ji,jj,jk,Kmm) / 2. / (wsbio4(ji,jj,jk) + rtrn) 164 zpoc = max(0., zpoc) 165 ! 166 DO jn = 1, jcpoc 167 alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * ( zsizek & 168 & + zsizek1 ) ) * zpoc + ( prodgoc(ji,jj,jk-1) / tgfunc(ji,jj,jk-1) * ( 1. & 169 & - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn) * zsizek ) + prodgoc(ji,jj,jk) & 170 & / tgfunc(ji,jj,jk) * ( 1. - exp( -reminp(jn) * zsizek ) ) ) * rday / rfact2 / reminp(jn) * alphan(jn) 171 alphat = alphat + alphag(ji,jj,jk,jn) 172 remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) 173 END DO 174 ENDIF 175 ! 176 DO jn = 1, jcpoc 177 ! The contribution of each lability class at the current 178 ! level is computed 179 alphag(ji,jj,jk,jn) = alphag(ji,jj,jk,jn) / ( alphat + rtrn) 185 180 END DO 186 END DO 187 END DO 181 ! Computation of the mean remineralisation rate 182 ztremint(ji,jj,jk) = MAX(0., remint / ( alphat + rtrn) ) 183 ! 184 ENDIF 185 ENDIF 186 END_3D 188 187 189 188 IF( ln_p4z ) THEN ; zremigoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) … … 192 191 193 192 IF( ln_p4z ) THEN 194 DO jk = 1, jpkm1 195 DO jj = 1, jpj 196 DO ji = 1, jpi 197 ! POC disaggregation by turbulence and bacterial activity. 198 ! -------------------------------------------------------- 199 zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 200 zorem2 = zremig * trb(ji,jj,jk,jpgoc) 201 orem(ji,jj,jk) = zorem2 202 zorem3(ji,jj,jk) = zremig * solgoc * trb(ji,jj,jk,jpgoc) 203 zofer2 = zremig * trb(ji,jj,jk,jpbfe) 204 zofer3 = zremig * solgoc * trb(ji,jj,jk,jpbfe) 205 206 ! ------------------------------------- 207 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zorem3(ji,jj,jk) 208 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zorem2 - zorem3(ji,jj,jk) 209 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zofer3 210 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zofer2 - zofer3 211 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem2 212 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer2 213 zfolimi(ji,jj,jk) = zofer2 214 END DO 215 END DO 216 END DO 193 DO_3D_11_11( 1, jpkm1 ) 194 ! POC disaggregation by turbulence and bacterial activity. 195 ! -------------------------------------------------------- 196 zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 197 zorem2 = zremig * tr(ji,jj,jk,jpgoc,Kbb) 198 orem(ji,jj,jk) = zorem2 199 zorem3(ji,jj,jk) = zremig * solgoc * tr(ji,jj,jk,jpgoc,Kbb) 200 zofer2 = zremig * tr(ji,jj,jk,jpbfe,Kbb) 201 zofer3 = zremig * solgoc * tr(ji,jj,jk,jpbfe,Kbb) 202 203 ! ------------------------------------- 204 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zorem3(ji,jj,jk) 205 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) - zorem2 - zorem3(ji,jj,jk) 206 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zofer3 207 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zofer2 - zofer3 208 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zorem2 209 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer2 210 zfolimi(ji,jj,jk) = zofer2 211 END_3D 217 212 ELSE 218 DO jk = 1, jpkm1 219 DO jj = 1, jpj 220 DO ji = 1, jpi 221 ! POC disaggregation by turbulence and bacterial activity. 222 ! -------------------------------------------------------- 223 zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 224 zopoc2 = zremig * trb(ji,jj,jk,jpgoc) 225 orem(ji,jj,jk) = zopoc2 226 zorem3(ji,jj,jk) = zremig * solgoc * trb(ji,jj,jk,jpgoc) 227 zopon2 = xremipn / xremipc * zremig * trb(ji,jj,jk,jpgon) 228 zopop2 = xremipp / xremipc * zremig * trb(ji,jj,jk,jpgop) 229 zofer2 = xremipn / xremipc * zremig * trb(ji,jj,jk,jpbfe) 230 231 ! ------------------------------------- 232 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zorem3(ji,jj,jk) 233 tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + solgoc * zopon2 234 tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + solgoc * zopop2 235 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + solgoc * zofer2 236 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zopoc2 237 tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zopon2 238 tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zopop2 239 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer2 240 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zopoc2 - zorem3(ji,jj,jk) 241 tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) - zopon2 * (1. + solgoc) 242 tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) - zopop2 * (1. + solgoc) 243 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zofer2 * (1. + solgoc) 244 zfolimi(ji,jj,jk) = zofer2 245 END DO 246 END DO 247 END DO 213 DO_3D_11_11( 1, jpkm1 ) 214 ! POC disaggregation by turbulence and bacterial activity. 215 ! -------------------------------------------------------- 216 zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 217 zopoc2 = zremig * tr(ji,jj,jk,jpgoc,Kbb) 218 orem(ji,jj,jk) = zopoc2 219 zorem3(ji,jj,jk) = zremig * solgoc * tr(ji,jj,jk,jpgoc,Kbb) 220 zopon2 = xremipn / xremipc * zremig * tr(ji,jj,jk,jpgon,Kbb) 221 zopop2 = xremipp / xremipc * zremig * tr(ji,jj,jk,jpgop,Kbb) 222 zofer2 = xremipn / xremipc * zremig * tr(ji,jj,jk,jpbfe,Kbb) 223 224 ! ------------------------------------- 225 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zorem3(ji,jj,jk) 226 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + solgoc * zopon2 227 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + solgoc * zopop2 228 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + solgoc * zofer2 229 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zopoc2 230 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zopon2 231 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zopop2 232 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer2 233 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) - zopoc2 - zorem3(ji,jj,jk) 234 tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) - zopon2 * (1. + solgoc) 235 tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) - zopop2 * (1. + solgoc) 236 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zofer2 * (1. + solgoc) 237 zfolimi(ji,jj,jk) = zofer2 238 END_3D 248 239 ENDIF 249 240 250 IF( ln_ctl) THEN ! print mean trends (used for debugging)241 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 251 242 WRITE(charout, FMT="('poc1')") 252 243 CALL prt_ctl_trc_info(charout) 253 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)244 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 254 245 ENDIF 255 246 … … 268 259 ! ---------------------------------------------------------------- 269 260 ! 270 DO jk = 1, jpkm1 271 DO jj = 1, jpj 272 DO ji = 1, jpi 273 zdep = hmld(ji,jj) 274 IF (tmask(ji,jj,jk) == 1. .AND. gdept_n(ji,jj,jk) <= zdep ) THEN 275 totprod(ji,jj) = totprod(ji,jj) + prodpoc(ji,jj,jk) * e3t_n(ji,jj,jk) * rday/ rfact2 276 ! The temperature effect is included here 277 totthick(ji,jj) = totthick(ji,jj) + e3t_n(ji,jj,jk)* tgfunc(ji,jj,jk) 278 totcons(ji,jj) = totcons(ji,jj) - conspoc(ji,jj,jk) * e3t_n(ji,jj,jk) * rday/ rfact2 & 279 & / ( trb(ji,jj,jk,jppoc) + rtrn ) 280 ENDIF 281 END DO 282 END DO 283 END DO 261 DO_3D_11_11( 1, jpkm1 ) 262 zdep = hmld(ji,jj) 263 IF (tmask(ji,jj,jk) == 1. .AND. gdept(ji,jj,jk,Kmm) <= zdep ) THEN 264 totprod(ji,jj) = totprod(ji,jj) + prodpoc(ji,jj,jk) * e3t(ji,jj,jk,Kmm) * rday/ rfact2 265 ! The temperature effect is included here 266 totthick(ji,jj) = totthick(ji,jj) + e3t(ji,jj,jk,Kmm)* tgfunc(ji,jj,jk) 267 totcons(ji,jj) = totcons(ji,jj) - conspoc(ji,jj,jk) * e3t(ji,jj,jk,Kmm) * rday/ rfact2 & 268 & / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 269 ENDIF 270 END_3D 284 271 285 272 ! Computation of the lability spectrum in the mixed layer. In the mixed … … 287 274 ! --------------------------------------------------------------------- 288 275 ztremint(:,:,:) = zremipoc(:,:,:) 289 DO jk = 1, jpkm1 290 DO jj = 1, jpj 291 DO ji = 1, jpi 292 IF (tmask(ji,jj,jk) == 1.) THEN 293 zdep = hmld(ji,jj) 294 alphat = 0.0 295 remint = 0.0 296 IF( gdept_n(ji,jj,jk) <= zdep ) THEN 297 DO jn = 1, jcpoc 298 ! For each lability class, the system is supposed to be 299 ! at equilibrium: Prod - Sink - w alphap = 0. 300 alphap(ji,jj,jk,jn) = totprod(ji,jj) * alphan(jn) / ( reminp(jn) & 301 & * totthick(ji,jj) + totcons(ji,jj) + wsbio + rtrn ) 302 alphat = alphat + alphap(ji,jj,jk,jn) 303 END DO 304 DO jn = 1, jcpoc 305 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 306 remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 307 END DO 308 ! Mean remineralization rate in the mixed layer 309 ztremint(ji,jj,jk) = MAX( 0., remint ) 310 ENDIF 311 ENDIF 312 END DO 313 END DO 314 END DO 276 DO_3D_11_11( 1, jpkm1 ) 277 IF (tmask(ji,jj,jk) == 1.) THEN 278 zdep = hmld(ji,jj) 279 alphat = 0.0 280 remint = 0.0 281 IF( gdept(ji,jj,jk,Kmm) <= zdep ) THEN 282 DO jn = 1, jcpoc 283 ! For each lability class, the system is supposed to be 284 ! at equilibrium: Prod - Sink - w alphap = 0. 285 alphap(ji,jj,jk,jn) = totprod(ji,jj) * alphan(jn) / ( reminp(jn) & 286 & * totthick(ji,jj) + totcons(ji,jj) + wsbio + rtrn ) 287 alphat = alphat + alphap(ji,jj,jk,jn) 288 END DO 289 DO jn = 1, jcpoc 290 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 291 remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 292 END DO 293 ! Mean remineralization rate in the mixed layer 294 ztremint(ji,jj,jk) = MAX( 0., remint ) 295 ENDIF 296 ENDIF 297 END_3D 315 298 ! 316 299 IF( ln_p4z ) THEN ; zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) … … 326 309 ! ----------------------------------------------------------------------- 327 310 ! 328 DO jk = 2, jpkm1 329 DO jj = 1, jpj 330 DO ji = 1, jpi 331 IF (tmask(ji,jj,jk) == 1.) THEN 332 zdep = hmld(ji,jj) 333 IF( gdept_n(ji,jj,jk) > zdep ) THEN 334 alphat = 0. 335 remint = 0. 336 ! 337 ! the scale factors are corrected with temperature 338 zsizek1 = e3t_n(ji,jj,jk-1) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 339 zsizek = e3t_n(ji,jj,jk) / 2. / (wsbio3(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 340 ! 341 ! Special treatment of the level just below the MXL 342 ! See the comments in the GOC section 343 ! --------------------------------------------------- 344 ! 345 IF ( gdept_n(ji,jj,jk-1) <= zdep ) THEN 346 ! 347 ! Computation of the POC concentration using the 348 ! lagrangian algorithm 349 zpoc = trb(ji,jj,jk-1,jppoc) + conspoc(ji,jj,jk) * rday / rfact2 & 350 & * e3t_n(ji,jj,jk) / 2. / (wsbio3(ji,jj,jk) + rtrn) 351 zpoc = max(0., zpoc) 352 ! 353 DO jn = 1, jcpoc 354 ! computation of the lability spectrum applying the 355 ! different sources and sinks 356 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc & 357 & + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk) * alphag(ji,jj,jk,jn) ) & 358 & / tgfunc(ji,jj,jk) / reminp(jn) * rday / rfact2 * ( 1. - exp( -reminp(jn) & 359 & * zsizek ) ) 360 alphap(ji,jj,jk,jn) = MAX( 0., alphap(ji,jj,jk,jn) ) 361 alphat = alphat + alphap(ji,jj,jk,jn) 362 END DO 363 ELSE 364 ! 365 ! Lability parameterization for the interior of the ocean 366 ! This is very similar to what is done in the previous 367 ! block 368 ! -------------------------------------------------------- 369 ! 370 zpoc = trb(ji,jj,jk-1,jppoc) + conspoc(ji,jj,jk-1) * rday / rfact2 & 371 & * e3t_n(ji,jj,jk-1) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) + conspoc(ji,jj,jk) & 372 & * rday / rfact2 * e3t_n(ji,jj,jk) / 2. / (wsbio3(ji,jj,jk) + rtrn) 373 zpoc = max(0., zpoc) 374 ! 375 DO jn = 1, jcpoc 376 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn) & 377 & * ( zsizek + zsizek1 ) ) * zpoc + ( prodpoc(ji,jj,jk-1) * alphan(jn) & 378 & + zorem3(ji,jj,jk-1) * alphag(ji,jj,jk-1,jn) ) * rday / rfact2 / reminp(jn) & 379 & / tgfunc(ji,jj,jk-1) * ( 1. - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn) & 380 & * zsizek ) + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk) & 381 & * alphag(ji,jj,jk,jn) ) * rday / rfact2 / reminp(jn) / tgfunc(ji,jj,jk) * ( 1. & 382 & - exp( -reminp(jn) * zsizek ) ) 383 alphap(ji,jj,jk,jn) = max(0., alphap(ji,jj,jk,jn) ) 384 alphat = alphat + alphap(ji,jj,jk,jn) 385 END DO 386 ENDIF 387 ! Normalization of the lability spectrum so that the 388 ! integral is equal to 1 389 DO jn = 1, jcpoc 390 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 391 remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 392 END DO 393 ! Mean remineralization rate in the water column 394 ztremint(ji,jj,jk) = MAX( 0., remint ) 395 ENDIF 396 ENDIF 311 DO_3D_11_11( 2, jpkm1 ) 312 IF (tmask(ji,jj,jk) == 1.) THEN 313 zdep = hmld(ji,jj) 314 IF( gdept(ji,jj,jk,Kmm) > zdep ) THEN 315 alphat = 0. 316 remint = 0. 317 ! 318 ! the scale factors are corrected with temperature 319 zsizek1 = e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 320 zsizek = e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 321 ! 322 ! Special treatment of the level just below the MXL 323 ! See the comments in the GOC section 324 ! --------------------------------------------------- 325 ! 326 IF ( gdept(ji,jj,jk-1,Kmm) <= zdep ) THEN 327 ! 328 ! Computation of the POC concentration using the 329 ! lagrangian algorithm 330 zpoc = tr(ji,jj,jk-1,jppoc,Kbb) + conspoc(ji,jj,jk) * rday / rfact2 & 331 & * e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn) 332 zpoc = max(0., zpoc) 333 ! 334 DO jn = 1, jcpoc 335 ! computation of the lability spectrum applying the 336 ! different sources and sinks 337 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc & 338 & + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk) * alphag(ji,jj,jk,jn) ) & 339 & / tgfunc(ji,jj,jk) / reminp(jn) * rday / rfact2 * ( 1. - exp( -reminp(jn) & 340 & * zsizek ) ) 341 alphap(ji,jj,jk,jn) = MAX( 0., alphap(ji,jj,jk,jn) ) 342 alphat = alphat + alphap(ji,jj,jk,jn) 343 END DO 344 ELSE 345 ! 346 ! Lability parameterization for the interior of the ocean 347 ! This is very similar to what is done in the previous 348 ! block 349 ! -------------------------------------------------------- 350 ! 351 zpoc = tr(ji,jj,jk-1,jppoc,Kbb) + conspoc(ji,jj,jk-1) * rday / rfact2 & 352 & * e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) + conspoc(ji,jj,jk) & 353 & * rday / rfact2 * e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn) 354 zpoc = max(0., zpoc) 355 ! 356 DO jn = 1, jcpoc 357 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn) & 358 & * ( zsizek + zsizek1 ) ) * zpoc + ( prodpoc(ji,jj,jk-1) * alphan(jn) & 359 & + zorem3(ji,jj,jk-1) * alphag(ji,jj,jk-1,jn) ) * rday / rfact2 / reminp(jn) & 360 & / tgfunc(ji,jj,jk-1) * ( 1. - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn) & 361 & * zsizek ) + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk) & 362 & * alphag(ji,jj,jk,jn) ) * rday / rfact2 / reminp(jn) / tgfunc(ji,jj,jk) * ( 1. & 363 & - exp( -reminp(jn) * zsizek ) ) 364 alphap(ji,jj,jk,jn) = max(0., alphap(ji,jj,jk,jn) ) 365 alphat = alphat + alphap(ji,jj,jk,jn) 366 END DO 367 ENDIF 368 ! Normalization of the lability spectrum so that the 369 ! integral is equal to 1 370 DO jn = 1, jcpoc 371 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 372 remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 397 373 END DO 398 END DO 399 END DO 374 ! Mean remineralization rate in the water column 375 ztremint(ji,jj,jk) = MAX( 0., remint ) 376 ENDIF 377 ENDIF 378 END_3D 400 379 401 380 IF( ln_p4z ) THEN ; zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) … … 404 383 405 384 IF( ln_p4z ) THEN 406 DO jk = 1, jpkm1 407 DO jj = 1, jpj 408 DO ji = 1, jpi 409 IF (tmask(ji,jj,jk) == 1.) THEN 410 ! POC disaggregation by turbulence and bacterial activity. 411 ! -------------------------------------------------------- 412 zremip = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 413 zorem = zremip * trb(ji,jj,jk,jppoc) 414 zofer = zremip * trb(ji,jj,jk,jpsfe) 415 416 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem 417 orem(ji,jj,jk) = orem(ji,jj,jk) + zorem 418 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer 419 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zorem 420 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zofer 421 zfolimi(ji,jj,jk) = zfolimi(ji,jj,jk) + zofer 422 ENDIF 423 END DO 424 END DO 425 END DO 385 DO_3D_11_11( 1, jpkm1 ) 386 IF (tmask(ji,jj,jk) == 1.) THEN 387 ! POC disaggregation by turbulence and bacterial activity. 388 ! -------------------------------------------------------- 389 zremip = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 390 zorem = zremip * tr(ji,jj,jk,jppoc,Kbb) 391 zofer = zremip * tr(ji,jj,jk,jpsfe,Kbb) 392 393 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zorem 394 orem(ji,jj,jk) = orem(ji,jj,jk) + zorem 395 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer 396 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zorem 397 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zofer 398 zfolimi(ji,jj,jk) = zfolimi(ji,jj,jk) + zofer 399 ENDIF 400 END_3D 426 401 ELSE 427 DO jk = 1, jpkm1 428 DO jj = 1, jpj 429 DO ji = 1, jpi 430 ! POC disaggregation by turbulence and bacterial activity. 431 ! -------------------------------------------------------- 432 zremip = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 433 zopoc = zremip * trb(ji,jj,jk,jppoc) 434 orem(ji,jj,jk) = orem(ji,jj,jk) + zopoc 435 zopon = xremipn / xremipc * zremip * trb(ji,jj,jk,jppon) 436 zopop = xremipp / xremipc * zremip * trb(ji,jj,jk,jppop) 437 zofer = xremipn / xremipc * zremip * trb(ji,jj,jk,jpsfe) 438 439 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zopoc 440 tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) - zopon 441 tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) - zopop 442 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zofer 443 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zopoc 444 tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zopon 445 tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zopop 446 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer 447 zfolimi(ji,jj,jk) = zfolimi(ji,jj,jk) + zofer 448 END DO 449 END DO 450 END DO 402 DO_3D_11_11( 1, jpkm1 ) 403 ! POC disaggregation by turbulence and bacterial activity. 404 ! -------------------------------------------------------- 405 zremip = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 406 zopoc = zremip * tr(ji,jj,jk,jppoc,Kbb) 407 orem(ji,jj,jk) = orem(ji,jj,jk) + zopoc 408 zopon = xremipn / xremipc * zremip * tr(ji,jj,jk,jppon,Kbb) 409 zopop = xremipp / xremipc * zremip * tr(ji,jj,jk,jppop,Kbb) 410 zofer = xremipn / xremipc * zremip * tr(ji,jj,jk,jpsfe,Kbb) 411 412 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zopoc 413 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) - zopon 414 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) - zopop 415 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zofer 416 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zopoc 417 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zopon 418 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zopop 419 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer 420 zfolimi(ji,jj,jk) = zfolimi(ji,jj,jk) + zofer 421 END_3D 451 422 ENDIF 452 423 … … 460 431 ENDIF 461 432 462 IF( ln_ctl) THEN ! print mean trends (used for debugging)433 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 463 434 WRITE(charout, FMT="('poc2')") 464 435 CALL prt_ctl_trc_info(charout) 465 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)436 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 466 437 ENDIF 467 438 ! … … 497 468 ENDIF 498 469 ! 499 REWIND( numnatp_ref ) ! Namelist nampisrem in reference namelist : Pisces remineralization500 470 READ ( numnatp_ref, nampispoc, IOSTAT = ios, ERR = 901) 501 471 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampispoc in reference namelist' ) 502 REWIND( numnatp_cfg ) ! Namelist nampisrem in configuration namelist : Pisces remineralization503 472 READ ( numnatp_cfg, nampispoc, IOSTAT = ios, ERR = 902 ) 504 473 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampispoc in configuration namelist' ) -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zprod.F90
r12280 r12377 46 46 REAL(wp) :: texcretd ! 1 - excretd 47 47 48 !! * Substitutions 49 # include "do_loop_substitute.h90" 48 50 !!---------------------------------------------------------------------- 49 51 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 53 55 CONTAINS 54 56 55 SUBROUTINE p4z_prod( kt , knt )57 SUBROUTINE p4z_prod( kt , knt, Kbb, Kmm, Krhs ) 56 58 !!--------------------------------------------------------------------- 57 59 !! *** ROUTINE p4z_prod *** … … 63 65 !!--------------------------------------------------------------------- 64 66 INTEGER, INTENT(in) :: kt, knt ! 67 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 65 68 ! 66 69 INTEGER :: ji, jj, jk … … 89 92 ! Allocate temporary workspace 90 93 ! 91 zprorcan(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp ; zprofed (:,:,:) = 0._wp 92 zprofen (:,:,:) = 0._wp ; zysopt (:,:,:) = 0._wp 93 zpronewn(:,:,:) = 0._wp ; zpronewd(:,:,:) = 0._wp ; zprdia (:,:,:) = 0._wp 94 zprbio (:,:,:) = 0._wp ; zprdch (:,:,:) = 0._wp ; zprnch (:,:,:) = 0._wp 95 zmxl_fac(:,:,:) = 0._wp ; zmxl_chl(:,:,:) = 0._wp 94 zprorcan (:,:,:) = 0._wp ; zprorcad (:,:,:) = 0._wp ; zprofed (:,:,:) = 0._wp 95 zprofen (:,:,:) = 0._wp ; zysopt (:,:,:) = 0._wp 96 zpronewn (:,:,:) = 0._wp ; zpronewd (:,:,:) = 0._wp ; zprdia (:,:,:) = 0._wp 97 zprbio (:,:,:) = 0._wp ; zprdch (:,:,:) = 0._wp ; zprnch (:,:,:) = 0._wp 98 zmxl_fac (:,:,:) = 0._wp ; zmxl_chl (:,:,:) = 0._wp 99 zpligprod1(:,:,:) = 0._wp ; zpligprod2(:,:,:) = 0._wp 96 100 97 101 ! Computation of the optimal production … … 105 109 ! day length in hours 106 110 zstrn(:,:) = 0. 107 DO jj = 1, jpj 108 DO ji = 1, jpi 109 zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 110 zargu = MAX( -1., MIN( 1., zargu ) ) 111 zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 112 END DO 113 END DO 111 DO_2D_11_11 112 zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 113 zargu = MAX( -1., MIN( 1., zargu ) ) 114 zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 115 END_2D 114 116 115 117 ! Impact of the day duration and light intermittency on phytoplankton growth 116 DO jk = 1, jpkm1 117 DO jj = 1 ,jpj 118 DO ji = 1, jpi 119 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 120 zval = MAX( 1., zstrn(ji,jj) ) 121 IF( gdept_n(ji,jj,jk) <= hmld(ji,jj) ) THEN 122 zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 123 ENDIF 124 zmxl_chl(ji,jj,jk) = zval / 24. 125 zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval ) 126 ENDIF 127 END DO 128 END DO 129 END DO 118 DO_3D_11_11( 1, jpkm1 ) 119 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 120 zval = MAX( 1., zstrn(ji,jj) ) 121 IF( gdept(ji,jj,jk,Kmm) <= hmld(ji,jj) ) THEN 122 zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 123 ENDIF 124 zmxl_chl(ji,jj,jk) = zval / 24. 125 zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval ) 126 ENDIF 127 END_3D 130 128 131 129 zprbio(:,:,:) = zprmaxn(:,:,:) * zmxl_fac(:,:,:) … … 136 134 137 135 ! Computation of the P-I slope for nanos and diatoms 138 DO jk = 1, jpkm1 139 DO jj = 1, jpj 140 DO ji = 1, jpi 141 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 142 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 143 zadap = xadap * ztn / ( 2.+ ztn ) 144 zconctemp = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia ) 145 zconctemp2 = trb(ji,jj,jk,jpdia) - zconctemp 146 ! 147 zpislopeadn(ji,jj,jk) = pislopen * ( 1.+ zadap * EXP( -0.25 * enano(ji,jj,jk) ) ) & 148 & * trb(ji,jj,jk,jpnch) /( trb(ji,jj,jk,jpphy) * 12. + rtrn) 149 ! 150 zpislopeadd(ji,jj,jk) = (pislopen * zconctemp2 + pisloped * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn ) & 151 & * trb(ji,jj,jk,jpdch) /( trb(ji,jj,jk,jpdia) * 12. + rtrn) 152 ENDIF 153 END DO 154 END DO 155 END DO 156 157 DO jk = 1, jpkm1 158 DO jj = 1, jpj 159 DO ji = 1, jpi 160 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 161 ! Computation of production function for Carbon 162 ! --------------------------------------------- 163 zpislopen = zpislopeadn(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 164 & * zmxl_fac(ji,jj,jk) * rday + rtrn) 165 zpisloped = zpislopeadd(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 166 & * zmxl_fac(ji,jj,jk) * rday + rtrn) 167 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 168 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 169 ! Computation of production function for Chlorophyll 170 !-------------------------------------------------- 171 zpislopen = zpislopeadn(ji,jj,jk) / ( zprmaxn(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 172 zpisloped = zpislopeadd(ji,jj,jk) / ( zprmaxd(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 173 zprnch(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) ) ) 174 zprdch(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) ) ) 175 ENDIF 176 END DO 177 END DO 178 END DO 136 DO_3D_11_11( 1, jpkm1 ) 137 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 138 ztn = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. ) 139 zadap = xadap * ztn / ( 2.+ ztn ) 140 zconctemp = MAX( 0.e0 , tr(ji,jj,jk,jpdia,Kbb) - xsizedia ) 141 zconctemp2 = tr(ji,jj,jk,jpdia,Kbb) - zconctemp 142 ! 143 zpislopeadn(ji,jj,jk) = pislopen * ( 1.+ zadap * EXP( -0.25 * enano(ji,jj,jk) ) ) & 144 & * tr(ji,jj,jk,jpnch,Kbb) /( tr(ji,jj,jk,jpphy,Kbb) * 12. + rtrn) 145 ! 146 zpislopeadd(ji,jj,jk) = (pislopen * zconctemp2 + pisloped * zconctemp) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) & 147 & * tr(ji,jj,jk,jpdch,Kbb) /( tr(ji,jj,jk,jpdia,Kbb) * 12. + rtrn) 148 ENDIF 149 END_3D 150 151 DO_3D_11_11( 1, jpkm1 ) 152 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 153 ! Computation of production function for Carbon 154 ! --------------------------------------------- 155 zpislopen = zpislopeadn(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 156 & * zmxl_fac(ji,jj,jk) * rday + rtrn) 157 zpisloped = zpislopeadd(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 158 & * zmxl_fac(ji,jj,jk) * rday + rtrn) 159 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 160 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 161 ! Computation of production function for Chlorophyll 162 !-------------------------------------------------- 163 zpislopen = zpislopeadn(ji,jj,jk) / ( zprmaxn(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 164 zpisloped = zpislopeadd(ji,jj,jk) / ( zprmaxd(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 165 zprnch(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) ) ) 166 zprdch(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) ) ) 167 ENDIF 168 END_3D 179 169 180 170 ! Computation of a proxy of the N/C ratio 181 171 ! --------------------------------------- 182 DO jk = 1, jpkm1 183 DO jj = 1, jpj 184 DO ji = 1, jpi 185 zval = MIN( xnanopo4(ji,jj,jk), ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) ) & 186 & * zprmaxn(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn ) 187 quotan(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval ) 188 zval = MIN( xdiatpo4(ji,jj,jk), ( xdiatnh4(ji,jj,jk) + xdiatno3(ji,jj,jk) ) ) & 189 & * zprmaxd(ji,jj,jk) / ( zprdia(ji,jj,jk) + rtrn ) 190 quotad(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval ) 191 END DO 192 END DO 193 END DO 194 195 196 DO jk = 1, jpkm1 197 DO jj = 1, jpj 198 DO ji = 1, jpi 199 200 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 201 ! Si/C of diatoms 202 ! ------------------------ 203 ! Si/C increases with iron stress and silicate availability 204 ! Si/C is arbitrariliy increased for very high Si concentrations 205 ! to mimic the very high ratios observed in the Southern Ocean (silpot2) 206 zlim = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi1 ) 207 zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 208 zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) ) ) + 1.e0 209 zsiborn = trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) 210 IF (gphit(ji,jj) < -30 ) THEN 211 zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 ) 212 ELSE 213 zsilfac2 = 1. + zsiborn / ( zsiborn + xksi2**3 ) 214 ENDIF 215 zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2 216 ENDIF 217 END DO 218 END DO 219 END DO 172 DO_3D_11_11( 1, jpkm1 ) 173 zval = MIN( xnanopo4(ji,jj,jk), ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) ) & 174 & * zprmaxn(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn ) 175 quotan(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval ) 176 zval = MIN( xdiatpo4(ji,jj,jk), ( xdiatnh4(ji,jj,jk) + xdiatno3(ji,jj,jk) ) ) & 177 & * zprmaxd(ji,jj,jk) / ( zprdia(ji,jj,jk) + rtrn ) 178 quotad(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval ) 179 END_3D 180 181 182 DO_3D_11_11( 1, jpkm1 ) 183 184 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 185 ! Si/C of diatoms 186 ! ------------------------ 187 ! Si/C increases with iron stress and silicate availability 188 ! Si/C is arbitrariliy increased for very high Si concentrations 189 ! to mimic the very high ratios observed in the Southern Ocean (silpot2) 190 zlim = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi1 ) 191 zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 192 zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) ) ) + 1.e0 193 zsiborn = tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) 194 IF (gphit(ji,jj) < -30 ) THEN 195 zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 ) 196 ELSE 197 zsilfac2 = 1. + zsiborn / ( zsiborn + xksi2**3 ) 198 ENDIF 199 zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2 200 ENDIF 201 END_3D 220 202 221 203 ! Mixed-layer effect on production 222 204 ! Sea-ice effect on production 223 205 224 DO jk = 1, jpkm1 225 DO jj = 1, jpj 226 DO ji = 1, jpi 227 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 228 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 229 END DO 230 END DO 231 END DO 206 DO_3D_11_11( 1, jpkm1 ) 207 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 208 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 209 END_3D 232 210 233 211 ! Computation of the various production terms 234 DO jk = 1, jpkm1 235 DO jj = 1, jpj 236 DO ji = 1, jpi 237 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 238 ! production terms for nanophyto. (C) 239 zprorcan(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2 240 zpronewn(ji,jj,jk) = zprorcan(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 241 ! 242 zratio = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) * fecnm + rtrn ) 243 zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 244 zprofen(ji,jj,jk) = fecnm * zprmaxn(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) ) & 245 & * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) ) & 246 & * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) ) & 247 & * zmax * trb(ji,jj,jk,jpphy) * rfact2 248 ! production terms for diatoms (C) 249 zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trb(ji,jj,jk,jpdia) * rfact2 250 zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 251 ! 252 zratio = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) * fecdm + rtrn ) 253 zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 254 zprofed(ji,jj,jk) = fecdm * zprmaxd(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) ) & 255 & * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) ) & 256 & * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) ) & 257 & * zmax * trb(ji,jj,jk,jpdia) * rfact2 258 ENDIF 259 END DO 260 END DO 261 END DO 212 DO_3D_11_11( 1, jpkm1 ) 213 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 214 ! production terms for nanophyto. (C) 215 zprorcan(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * tr(ji,jj,jk,jpphy,Kbb) * rfact2 216 zpronewn(ji,jj,jk) = zprorcan(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 217 ! 218 zratio = tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) * fecnm + rtrn ) 219 zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 220 zprofen(ji,jj,jk) = fecnm * zprmaxn(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) ) & 221 & * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) ) & 222 & * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) ) & 223 & * zmax * tr(ji,jj,jk,jpphy,Kbb) * rfact2 224 ! production terms for diatoms (C) 225 zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr(ji,jj,jk,jpdia,Kbb) * rfact2 226 zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 227 ! 228 zratio = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) * fecdm + rtrn ) 229 zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 230 zprofed(ji,jj,jk) = fecdm * zprmaxd(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) ) & 231 & * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) ) & 232 & * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) ) & 233 & * zmax * tr(ji,jj,jk,jpdia,Kbb) * rfact2 234 ENDIF 235 END_3D 262 236 263 237 ! Computation of the chlorophyll production terms 264 DO jk = 1, jpkm1 265 DO jj = 1, jpj 266 DO ji = 1, jpi 267 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 268 ! production terms for nanophyto. ( chlorophyll ) 269 znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 270 zprod = rday * zprorcan(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 271 zprochln = chlcmin * 12. * zprorcan (ji,jj,jk) 272 chlcnm_n = MIN ( chlcnm, ( chlcnm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem))) * (1. - 1.14 / 43.4 * 20.)) 273 zprochln = zprochln + (chlcnm_n-chlcmin) * 12. * zprod / & 274 & ( zpislopeadn(ji,jj,jk) * znanotot +rtrn) 275 ! production terms for diatoms ( chlorophyll ) 276 zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 277 zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 278 zprochld = chlcmin * 12. * zprorcad(ji,jj,jk) 279 chlcdm_n = MIN ( chlcdm, ( chlcdm / (1. - 1.14 / 43.4 * tsn(ji,jj,jk,jp_tem))) * (1. - 1.14 / 43.4 * 20.)) 280 zprochld = zprochld + (chlcdm_n-chlcmin) * 12. * zprod / & 281 & ( zpislopeadd(ji,jj,jk) * zdiattot +rtrn ) 282 ! Update the arrays TRA which contain the Chla sources and sinks 283 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln * texcretn 284 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld * texcretd 285 ENDIF 286 END DO 287 END DO 288 END DO 238 DO_3D_11_11( 1, jpkm1 ) 239 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 240 ! production terms for nanophyto. ( chlorophyll ) 241 znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 242 zprod = rday * zprorcan(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 243 zprochln = chlcmin * 12. * zprorcan (ji,jj,jk) 244 chlcnm_n = MIN ( chlcnm, ( chlcnm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm))) * (1. - 1.14 / 43.4 * 20.)) 245 zprochln = zprochln + (chlcnm_n-chlcmin) * 12. * zprod / & 246 & ( zpislopeadn(ji,jj,jk) * znanotot +rtrn) 247 ! production terms for diatoms ( chlorophyll ) 248 zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 249 zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 250 zprochld = chlcmin * 12. * zprorcad(ji,jj,jk) 251 chlcdm_n = MIN ( chlcdm, ( chlcdm / (1. - 1.14 / 43.4 * ts(ji,jj,jk,jp_tem,Kmm))) * (1. - 1.14 / 43.4 * 20.)) 252 zprochld = zprochld + (chlcdm_n-chlcmin) * 12. * zprod / & 253 & ( zpislopeadd(ji,jj,jk) * zdiattot +rtrn ) 254 ! Update the arrays TRA which contain the Chla sources and sinks 255 tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) + zprochln * texcretn 256 tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) + zprochld * texcretd 257 ENDIF 258 END_3D 289 259 290 260 ! Update the arrays TRA which contain the biological sources and sinks 291 DO jk = 1, jpkm1 292 DO jj = 1, jpj 293 DO ji =1 ,jpi 294 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 295 zproreg = zprorcan(ji,jj,jk) - zpronewn(ji,jj,jk) 296 zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk) 297 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 298 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 299 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk) 300 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproreg - zproreg2 301 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorcan(ji,jj,jk) * texcretn 302 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcretn 303 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcretd 304 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcretd 305 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 306 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zdocprod 307 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) & 308 & + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) 309 ! 310 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 311 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zfeup 312 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 313 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 314 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 315 & - rno3 * ( zproreg + zproreg2 ) 316 ENDIF 317 END DO 318 END DO 319 END DO 261 DO_3D_11_11( 1, jpkm1 ) 262 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 263 zproreg = zprorcan(ji,jj,jk) - zpronewn(ji,jj,jk) 264 zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk) 265 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 266 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 267 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk) 268 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zproreg - zproreg2 269 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zprorcan(ji,jj,jk) * texcretn 270 tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) + zprofen(ji,jj,jk) * texcretn 271 tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) + zprorcad(ji,jj,jk) * texcretd 272 tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) + zprofed(ji,jj,jk) * texcretd 273 tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 274 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zdocprod 275 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + o2ut * ( zproreg + zproreg2) & 276 & + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) 277 ! 278 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 279 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zfeup 280 tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 281 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 282 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 283 & - rno3 * ( zproreg + zproreg2 ) 284 ENDIF 285 END_3D 320 286 ! 321 287 IF( ln_ligand ) THEN 322 288 zpligprod1(:,:,:) = 0._wp ; zpligprod2(:,:,:) = 0._wp 323 DO jk = 1, jpkm1 324 DO jj = 1, jpj 325 DO ji =1 ,jpi 326 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 327 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 328 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 329 tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 330 zpligprod1(ji,jj,jk) = zdocprod * ldocp 331 zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet 332 ENDIF 333 END DO 334 END DO 335 END DO 289 DO_3D_11_11( 1, jpkm1 ) 290 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 291 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 292 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 293 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 294 zpligprod1(ji,jj,jk) = zdocprod * ldocp 295 zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet 296 ENDIF 297 END_3D 336 298 ENDIF 337 299 … … 366 328 ENDIF 367 329 368 IF( ln_ctl) THEN ! print mean trends (used for debugging)330 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 369 331 WRITE(charout, FMT="('prod')") 370 332 CALL prt_ctl_trc_info(charout) 371 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)333 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 372 334 ENDIF 373 335 ! … … 400 362 ENDIF 401 363 ! 402 REWIND( numnatp_ref )403 364 READ ( numnatp_ref, namp4zprod, IOSTAT = ios, ERR = 901) 404 365 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zprod in reference namelist' ) 405 406 REWIND( numnatp_cfg )407 366 READ ( numnatp_cfg, namp4zprod, IOSTAT = ios, ERR = 902 ) 408 367 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namp4zprod in configuration namelist' ) -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zrem.F90
r12276 r12377 42 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: denitr !: denitrification array 43 43 44 !! * Substitutions 45 # include "do_loop_substitute.h90" 44 46 !!---------------------------------------------------------------------- 45 47 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 49 51 CONTAINS 50 52 51 SUBROUTINE p4z_rem( kt, knt )53 SUBROUTINE p4z_rem( kt, knt, Kbb, Kmm, Krhs ) 52 54 !!--------------------------------------------------------------------- 53 55 !! *** ROUTINE p4z_rem *** … … 57 59 !! ** Method : - ??? 58 60 !!--------------------------------------------------------------------- 59 INTEGER, INTENT(in) :: kt, knt ! ocean time step 61 INTEGER, INTENT(in) :: kt, knt ! ocean time step 62 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 60 63 ! 61 64 INTEGER :: ji, jj, jk … … 85 88 ! that was modeling explicitely bacteria 86 89 ! ------------------------------------------------------- 87 DO jk = 1, jpkm1 88 DO jj = 1, jpj 89 DO ji = 1, jpi 90 zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 91 IF( gdept_n(ji,jj,jk) < zdep ) THEN 92 zdepbac(ji,jj,jk) = MIN( 0.7 * ( trb(ji,jj,jk,jpzoo) + 2.* trb(ji,jj,jk,jpmes) ), 4.e-6 ) 93 ztempbac(ji,jj) = zdepbac(ji,jj,jk) 94 ELSE 95 zdepmin = MIN( 1., zdep / gdept_n(ji,jj,jk) ) 96 zdepbac (ji,jj,jk) = zdepmin**0.683 * ztempbac(ji,jj) 97 zdepprod(ji,jj,jk) = zdepmin**0.273 98 zdepeff (ji,jj,jk) = zdepeff(ji,jj,jk) * zdepmin**0.3 99 ENDIF 100 END DO 101 END DO 102 END DO 90 DO_3D_11_11( 1, jpkm1 ) 91 zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 92 IF( gdept(ji,jj,jk,Kmm) < zdep ) THEN 93 zdepbac(ji,jj,jk) = MIN( 0.7 * ( tr(ji,jj,jk,jpzoo,Kbb) + 2.* tr(ji,jj,jk,jpmes,Kbb) ), 4.e-6 ) 94 ztempbac(ji,jj) = zdepbac(ji,jj,jk) 95 ELSE 96 zdepmin = MIN( 1., zdep / gdept(ji,jj,jk,Kmm) ) 97 zdepbac (ji,jj,jk) = zdepmin**0.683 * ztempbac(ji,jj) 98 zdepprod(ji,jj,jk) = zdepmin**0.273 99 zdepeff (ji,jj,jk) = zdepeff(ji,jj,jk) * zdepmin**0.3 100 ENDIF 101 END_3D 103 102 104 103 IF( ln_p4z ) THEN 105 DO jk = 1, jpkm1 106 DO jj = 1, jpj 107 DO ji = 1, jpi 108 ! DOC ammonification. Depends on depth, phytoplankton biomass 109 ! and a limitation term which is supposed to be a parameterization of the bacterial activity. 110 zremik = xremik * xstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk) 111 zremik = MAX( zremik, 2.74e-4 * xstep ) 112 ! Ammonification in oxic waters with oxygen consumption 113 ! ----------------------------------------------------- 114 zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc) 115 zolimi(ji,jj,jk) = MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit ) 116 ! Ammonification in suboxic waters with denitrification 117 ! ------------------------------------------------------- 118 zammonic = zremik * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc) 119 denitr(ji,jj,jk) = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 120 denitr(ji,jj,jk) = MIN( ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit, denitr(ji,jj,jk) ) 121 zoxyremc = zammonic - denitr(ji,jj,jk) 122 ! 123 zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) ) 124 denitr (ji,jj,jk) = MAX( 0.e0, denitr (ji,jj,jk) ) 125 zoxyremc = MAX( 0.e0, zoxyremc ) 126 127 ! 128 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 129 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 130 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - denitr (ji,jj,jk) * rdenit 131 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zolimi (ji,jj,jk) - denitr(ji,jj,jk) - zoxyremc 132 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - zolimi (ji,jj,jk) * o2ut 133 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 134 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zolimi(ji,jj,jk) + zoxyremc & 135 & + ( rdenit + 1.) * denitr(ji,jj,jk) ) 136 END DO 137 END DO 138 END DO 104 DO_3D_11_11( 1, jpkm1 ) 105 ! DOC ammonification. Depends on depth, phytoplankton biomass 106 ! and a limitation term which is supposed to be a parameterization of the bacterial activity. 107 zremik = xremik * xstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk) 108 zremik = MAX( zremik, 2.74e-4 * xstep ) 109 ! Ammonification in oxic waters with oxygen consumption 110 ! ----------------------------------------------------- 111 zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * tr(ji,jj,jk,jpdoc,Kbb) 112 zolimi(ji,jj,jk) = MIN( ( tr(ji,jj,jk,jpoxy,Kbb) - rtrn ) / o2ut, zolimit ) 113 ! Ammonification in suboxic waters with denitrification 114 ! ------------------------------------------------------- 115 zammonic = zremik * nitrfac(ji,jj,jk) * tr(ji,jj,jk,jpdoc,Kbb) 116 denitr(ji,jj,jk) = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 117 denitr(ji,jj,jk) = MIN( ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenit, denitr(ji,jj,jk) ) 118 zoxyremc = zammonic - denitr(ji,jj,jk) 119 ! 120 zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) ) 121 denitr (ji,jj,jk) = MAX( 0.e0, denitr (ji,jj,jk) ) 122 zoxyremc = MAX( 0.e0, zoxyremc ) 123 124 ! 125 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 126 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 127 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - denitr (ji,jj,jk) * rdenit 128 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zolimi (ji,jj,jk) - denitr(ji,jj,jk) - zoxyremc 129 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - zolimi (ji,jj,jk) * o2ut 130 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 131 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zolimi(ji,jj,jk) + zoxyremc & 132 & + ( rdenit + 1.) * denitr(ji,jj,jk) ) 133 END_3D 139 134 ELSE 140 DO jk = 1, jpkm1 141 DO jj = 1, jpj 142 DO ji = 1, jpi 143 ! DOC ammonification. Depends on depth, phytoplankton biomass 144 ! and a limitation term which is supposed to be a parameterization of the bacterial activity. 145 ! ----------------------------------------------------------------- 146 zremik = xstep / 1.e-6 * MAX(0.01, xlimbac(ji,jj,jk)) * zdepbac(ji,jj,jk) 147 zremik = MAX( zremik, 2.74e-4 * xstep / xremikc ) 148 149 zremikc = xremikc * zremik 150 zremikn = xremikn / xremikc 151 zremikp = xremikp / xremikc 152 153 ! Ammonification in oxic waters with oxygen consumption 154 ! ----------------------------------------------------- 155 zolimit = zremikc * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc) 156 zolimic = MAX( 0.e0, MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit ) ) 157 zolimi(ji,jj,jk) = zolimic 158 zolimin = zremikn * zolimic * trb(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 159 zolimip = zremikp * zolimic * trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 160 161 ! Ammonification in suboxic waters with denitrification 162 ! ------------------------------------------------------- 163 zammonic = zremikc * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc) 164 denitr(ji,jj,jk) = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 165 denitr(ji,jj,jk) = MAX(0., MIN( ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit, denitr(ji,jj,jk) ) ) 166 zoxyremc = MAX(0., zammonic - denitr(ji,jj,jk)) 167 zdenitrn = zremikn * denitr(ji,jj,jk) * trb(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 168 zdenitrp = zremikp * denitr(ji,jj,jk) * trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 169 zoxyremn = zremikn * zoxyremc * trb(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 170 zoxyremp = zremikp * zoxyremc * trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 171 172 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zolimip + zdenitrp + zoxyremp 173 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zolimin + zdenitrn + zoxyremn 174 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - denitr(ji,jj,jk) * rdenit 175 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zolimic - denitr(ji,jj,jk) - zoxyremc 176 tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) - zolimin - zdenitrn - zoxyremn 177 tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) - zolimip - zdenitrp - zoxyremp 178 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - zolimic * o2ut 179 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zolimic + denitr(ji,jj,jk) + zoxyremc 180 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zolimin + zoxyremn + ( rdenit + 1.) * zdenitrn ) 181 END DO 182 END DO 183 END DO 135 DO_3D_11_11( 1, jpkm1 ) 136 ! DOC ammonification. Depends on depth, phytoplankton biomass 137 ! and a limitation term which is supposed to be a parameterization of the bacterial activity. 138 ! ----------------------------------------------------------------- 139 zremik = xstep / 1.e-6 * MAX(0.01, xlimbac(ji,jj,jk)) * zdepbac(ji,jj,jk) 140 zremik = MAX( zremik, 2.74e-4 * xstep / xremikc ) 141 142 zremikc = xremikc * zremik 143 zremikn = xremikn / xremikc 144 zremikp = xremikp / xremikc 145 146 ! Ammonification in oxic waters with oxygen consumption 147 ! ----------------------------------------------------- 148 zolimit = zremikc * ( 1.- nitrfac(ji,jj,jk) ) * tr(ji,jj,jk,jpdoc,Kbb) 149 zolimic = MAX( 0.e0, MIN( ( tr(ji,jj,jk,jpoxy,Kbb) - rtrn ) / o2ut, zolimit ) ) 150 zolimi(ji,jj,jk) = zolimic 151 zolimin = zremikn * zolimic * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 152 zolimip = zremikp * zolimic * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 153 154 ! Ammonification in suboxic waters with denitrification 155 ! ------------------------------------------------------- 156 zammonic = zremikc * nitrfac(ji,jj,jk) * tr(ji,jj,jk,jpdoc,Kbb) 157 denitr(ji,jj,jk) = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 158 denitr(ji,jj,jk) = MAX(0., MIN( ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenit, denitr(ji,jj,jk) ) ) 159 zoxyremc = MAX(0., zammonic - denitr(ji,jj,jk)) 160 zdenitrn = zremikn * denitr(ji,jj,jk) * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 161 zdenitrp = zremikp * denitr(ji,jj,jk) * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 162 zoxyremn = zremikn * zoxyremc * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 163 zoxyremp = zremikp * zoxyremc * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 164 165 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zolimip + zdenitrp + zoxyremp 166 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zolimin + zdenitrn + zoxyremn 167 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - denitr(ji,jj,jk) * rdenit 168 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zolimic - denitr(ji,jj,jk) - zoxyremc 169 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) - zolimin - zdenitrn - zoxyremn 170 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) - zolimip - zdenitrp - zoxyremp 171 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - zolimic * o2ut 172 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zolimic + denitr(ji,jj,jk) + zoxyremc 173 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zolimin + zoxyremn + ( rdenit + 1.) * zdenitrn ) 174 END_3D 184 175 ! 185 176 ENDIF 186 177 187 178 188 DO jk = 1, jpkm1 189 DO jj = 1, jpj 190 DO ji = 1, jpi 191 ! NH4 nitrification to NO3. Ceased for oxygen concentrations 192 ! below 2 umol/L. Inhibited at strong light 193 ! ---------------------------------------------------------- 194 zonitr = nitrif * xstep * trb(ji,jj,jk,jpnh4) * ( 1.- nitrfac(ji,jj,jk) ) & 195 & / ( 1.+ emoy(ji,jj,jk) ) * ( 1. + fr_i(ji,jj) * emoy(ji,jj,jk) ) 196 zdenitnh4 = nitrif * xstep * trb(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk) 197 zdenitnh4 = MIN( ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenita, zdenitnh4 ) 198 ! Update of the tracers trends 199 ! ---------------------------- 200 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr - zdenitnh4 201 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr - rdenita * zdenitnh4 202 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr 203 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * zdenitnh4 204 END DO 205 END DO 206 END DO 207 208 IF(ln_ctl) THEN ! print mean trends (used for debugging) 179 DO_3D_11_11( 1, jpkm1 ) 180 ! NH4 nitrification to NO3. Ceased for oxygen concentrations 181 ! below 2 umol/L. Inhibited at strong light 182 ! ---------------------------------------------------------- 183 zonitr = nitrif * xstep * tr(ji,jj,jk,jpnh4,Kbb) * ( 1.- nitrfac(ji,jj,jk) ) & 184 & / ( 1.+ emoy(ji,jj,jk) ) * ( 1. + fr_i(ji,jj) * emoy(ji,jj,jk) ) 185 zdenitnh4 = nitrif * xstep * tr(ji,jj,jk,jpnh4,Kbb) * nitrfac(ji,jj,jk) 186 zdenitnh4 = MIN( ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenita, zdenitnh4 ) 187 ! Update of the tracers trends 188 ! ---------------------------- 189 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zonitr - zdenitnh4 190 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + zonitr - rdenita * zdenitnh4 191 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2nit * zonitr 192 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * zdenitnh4 193 END_3D 194 195 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 209 196 WRITE(charout, FMT="('rem1')") 210 197 CALL prt_ctl_trc_info(charout) 211 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)198 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 212 199 ENDIF 213 200 214 DO jk = 1, jpkm1 215 DO jj = 1, jpj 216 DO ji = 1, jpi 217 218 ! Bacterial uptake of iron. No iron is available in DOC. So 219 ! Bacteries are obliged to take up iron from the water. Some 220 ! studies (especially at Papa) have shown this uptake to be significant 221 ! ---------------------------------------------------------- 222 zbactfer = feratb * rfact2 * 0.6_wp / rday * tgfunc(ji,jj,jk) * xlimbacl(ji,jj,jk) & 223 & * trb(ji,jj,jk,jpfer) / ( xkferb + trb(ji,jj,jk,jpfer) ) & 224 & * zdepprod(ji,jj,jk) * zdepeff(ji,jj,jk) * zdepbac(ji,jj,jk) 225 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zbactfer*0.33 226 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zbactfer*0.25 227 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zbactfer*0.08 228 zfebact(ji,jj,jk) = zbactfer * 0.33 229 blim(ji,jj,jk) = xlimbacl(ji,jj,jk) * zdepbac(ji,jj,jk) / 1.e-6 * zdepprod(ji,jj,jk) 230 END DO 231 END DO 232 END DO 233 234 IF(ln_ctl) THEN ! print mean trends (used for debugging) 201 DO_3D_11_11( 1, jpkm1 ) 202 203 ! Bacterial uptake of iron. No iron is available in DOC. So 204 ! Bacteries are obliged to take up iron from the water. Some 205 ! studies (especially at Papa) have shown this uptake to be significant 206 ! ---------------------------------------------------------- 207 zbactfer = feratb * rfact2 * 0.6_wp / rday * tgfunc(ji,jj,jk) * xlimbacl(ji,jj,jk) & 208 & * tr(ji,jj,jk,jpfer,Kbb) / ( xkferb + tr(ji,jj,jk,jpfer,Kbb) ) & 209 & * zdepprod(ji,jj,jk) * zdepeff(ji,jj,jk) * zdepbac(ji,jj,jk) 210 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zbactfer*0.33 211 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zbactfer*0.25 212 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zbactfer*0.08 213 zfebact(ji,jj,jk) = zbactfer * 0.33 214 blim(ji,jj,jk) = xlimbacl(ji,jj,jk) * zdepbac(ji,jj,jk) / 1.e-6 * zdepprod(ji,jj,jk) 215 END_3D 216 217 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 235 218 WRITE(charout, FMT="('rem2')") 236 219 CALL prt_ctl_trc_info(charout) 237 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)220 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 238 221 ENDIF 239 222 … … 242 225 ! --------------------------------------------------------------- 243 226 244 DO jk = 1, jpkm1 245 DO jj = 1, jpj 246 DO ji = 1, jpi 247 zdep = MAX( hmld(ji,jj), heup_01(ji,jj) ) 248 zsatur = MAX( rtrn, ( sio3eq(ji,jj,jk) - trb(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) ) 249 zsatur2 = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**37 250 znusil = 0.225 * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25 251 ! Remineralization rate of BSi depedant on T and saturation 252 ! --------------------------------------------------------- 253 IF ( gdept_n(ji,jj,jk) > zdep ) THEN 254 zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk-1) * EXP( -0.5 * ( xsiremlab - xsirem ) & 255 & * znusil * e3t_n(ji,jj,jk) / wsbio4(ji,jj,jk) ) 256 zfacsi(ji,jj,jk) = zfacsib(ji,jj,jk) / ( 1.0 + zfacsib(ji,jj,jk) ) 257 zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk) * EXP( -0.5 * ( xsiremlab - xsirem ) & 258 & * znusil * e3t_n(ji,jj,jk) / wsbio4(ji,jj,jk) ) 259 ENDIF 260 zsiremin = ( xsiremlab * zfacsi(ji,jj,jk) + xsirem * ( 1. - zfacsi(ji,jj,jk) ) ) * xstep * znusil 261 zosil = zsiremin * trb(ji,jj,jk,jpgsi) 262 ! 263 tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) - zosil 264 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + zosil 265 END DO 266 END DO 267 END DO 268 269 IF(ln_ctl) THEN ! print mean trends (used for debugging) 227 DO_3D_11_11( 1, jpkm1 ) 228 zdep = MAX( hmld(ji,jj), heup_01(ji,jj) ) 229 zsatur = MAX( rtrn, ( sio3eq(ji,jj,jk) - tr(ji,jj,jk,jpsil,Kbb) ) / ( sio3eq(ji,jj,jk) + rtrn ) ) 230 zsatur2 = ( 1. + ts(ji,jj,jk,jp_tem,Kmm) / 400.)**37 231 znusil = 0.225 * ( 1. + ts(ji,jj,jk,jp_tem,Kmm) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25 232 ! Remineralization rate of BSi depedant on T and saturation 233 ! --------------------------------------------------------- 234 IF ( gdept(ji,jj,jk,Kmm) > zdep ) THEN 235 zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk-1) * EXP( -0.5 * ( xsiremlab - xsirem ) & 236 & * znusil * e3t(ji,jj,jk,Kmm) / wsbio4(ji,jj,jk) ) 237 zfacsi(ji,jj,jk) = zfacsib(ji,jj,jk) / ( 1.0 + zfacsib(ji,jj,jk) ) 238 zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk) * EXP( -0.5 * ( xsiremlab - xsirem ) & 239 & * znusil * e3t(ji,jj,jk,Kmm) / wsbio4(ji,jj,jk) ) 240 ENDIF 241 zsiremin = ( xsiremlab * zfacsi(ji,jj,jk) + xsirem * ( 1. - zfacsi(ji,jj,jk) ) ) * xstep * znusil 242 zosil = zsiremin * tr(ji,jj,jk,jpgsi,Kbb) 243 ! 244 tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) - zosil 245 tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) + zosil 246 END_3D 247 248 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 270 249 WRITE(charout, FMT="('rem3')") 271 250 CALL prt_ctl_trc_info(charout) 272 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)251 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 273 252 ENDIF 274 253 275 IF( lk_iomput .AND.knt == nrdttrc ) THEN254 IF( knt == nrdttrc ) THEN 276 255 zrfact2 = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s 277 256 ! … … 314 293 ENDIF 315 294 ! 316 REWIND( numnatp_ref )317 295 READ ( numnatp_ref, nampisrem, IOSTAT = ios, ERR = 901) 318 296 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisrem in reference namelist' ) 319 320 REWIND( numnatp_cfg )321 297 READ ( numnatp_cfg, nampisrem, IOSTAT = ios, ERR = 902 ) 322 298 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisrem in configuration namelist' ) -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zsed.F90
r12276 r12377 15 15 USE sms_pisces ! PISCES Source Minus Sink variables 16 16 USE p4zlim ! Co-limitations of differents nutrients 17 USE p4zsbc ! External source of nutrients18 17 USE p4zint ! interpolation and computation of various fields 19 18 USE sed ! Sediment module … … 25 24 26 25 PUBLIC p4z_sed 26 PUBLIC p4z_sed_init 27 27 PUBLIC p4z_sed_alloc 28 28 29 REAL(wp), PUBLIC :: nitrfix !: Nitrogen fixation rate 30 REAL(wp), PUBLIC :: diazolight !: Nitrogen fixation sensitivty to light 31 REAL(wp), PUBLIC :: concfediaz !: Fe half-saturation Cste for diazotrophs 32 29 33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nitrpot !: Nitrogen fixation 30 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,: ) :: sdenit !: Nitrate reduction in the sediments 31 REAL(wp) :: r1_rday !: inverse of rday 32 LOGICAL, SAVE :: lk_sed 33 35 ! 36 REAL(wp), SAVE :: r1_rday 37 REAL(wp), SAVE :: sedsilfrac, sedcalfrac 38 39 !! * Substitutions 40 # include "do_loop_substitute.h90" 34 41 !!---------------------------------------------------------------------- 35 42 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 39 46 CONTAINS 40 47 41 SUBROUTINE p4z_sed( kt, knt )48 SUBROUTINE p4z_sed( kt, knt, Kbb, Kmm, Krhs ) 42 49 !!--------------------------------------------------------------------- 43 50 !! *** ROUTINE p4z_sed *** … … 51 58 ! 52 59 INTEGER, INTENT(in) :: kt, knt ! ocean time step 60 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 53 61 INTEGER :: ji, jj, jk, ikt 54 62 REAL(wp) :: zrivalk, zrivsil, zrivno3 55 REAL(wp) :: z wflux, zlim, zfact, zfactcal63 REAL(wp) :: zlim, zfact, zfactcal 56 64 REAL(wp) :: zo2, zno3, zflx, zpdenit, z1pdenit, zolimit 57 65 REAL(wp) :: zsiloss, zcaloss, zws3, zws4, zwsc, zdep … … 66 74 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zsoufer, zlight 67 75 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrpo4, ztrdop, zirondep, zpdep 68 REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zsidep, zironice69 76 !!--------------------------------------------------------------------- 70 77 ! 71 78 IF( ln_timing ) CALL timing_start('p4z_sed') 72 79 ! 73 IF( kt == nittrc000 .AND. knt == 1 ) THEN 74 r1_rday = 1. / rday 75 IF (ln_sediment .AND. ln_sed_2way) THEN 76 lk_sed = .TRUE. 77 ELSE 78 lk_sed = .FALSE. 79 ENDIF 80 ENDIF 81 ! 82 IF( kt == nittrc000 .AND. knt == 1 ) r1_rday = 1. / rday 83 ! 80 84 81 ! Allocate temporary workspace 85 82 ALLOCATE( ztrpo4(jpi,jpj,jpk) ) … … 93 90 zsedc (:,:) = 0.e0 94 91 95 ! Iron input/uptake due to sea ice : Crude parameterization based on Lancelot et al. 96 ! ---------------------------------------------------- 97 IF( ln_ironice ) THEN 98 ! 99 ALLOCATE( zironice(jpi,jpj) ) 100 ! 101 DO jj = 1, jpj 102 DO ji = 1, jpi 103 zdep = rfact2 / e3t_n(ji,jj,1) 104 zwflux = fmmflx(ji,jj) / 1000._wp 105 zironice(ji,jj) = MAX( -0.99 * trb(ji,jj,1,jpfer), -zwflux * icefeinput * zdep ) 106 END DO 107 END DO 108 ! 109 tra(:,:,1,jpfer) = tra(:,:,1,jpfer) + zironice(:,:) 110 ! 111 IF( lk_iomput .AND. knt == nrdttrc ) & 112 & CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! iron flux from ice 113 ! 114 DEALLOCATE( zironice ) 115 ! 116 ENDIF 117 118 ! Add the external input of nutrients from dust deposition 119 ! ---------------------------------------------------------- 120 IF( ln_dust ) THEN 121 ! 122 ALLOCATE( zsidep(jpi,jpj), zpdep(jpi,jpj,jpk), zirondep(jpi,jpj,jpk) ) 123 ! ! Iron and Si deposition at the surface 124 IF( ln_solub ) THEN 125 zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 126 ELSE 127 zirondep(:,:,1) = dustsolub * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 128 ENDIF 129 zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 28.1 130 zpdep (:,:,1) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 31. / po4r 131 ! ! Iron solubilization of particles in the water column 132 ! ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ; wdust in m/j 133 zwdust = 0.03 * rday / ( wdust * 55.85 ) / ( 270. * rday ) 134 DO jk = 2, jpkm1 135 zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -gdept_n(:,:,jk) / 540. ) 136 zpdep (:,:,jk) = zirondep(:,:,jk) * 0.023 137 END DO 138 ! ! Iron solubilization of particles in the water column 139 tra(:,:,1,jpsil) = tra(:,:,1,jpsil) + zsidep (:,:) 140 DO jk = 1, jpkm1 141 tra(:,:,jk,jppo4) = tra(:,:,jk,jppo4) + zpdep (:,:,jk) 142 tra(:,:,jk,jpfer) = tra(:,:,jk,jpfer) + zirondep(:,:,jk) 143 ENDDO 144 ! 145 IF( lk_iomput .AND. knt == nrdttrc ) THEN 146 CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron 147 CALL iom_put( "pdust" , dust(:,:) / ( wdust * rday ) * tmask(:,:,1) ) ! dust concentration at surface 148 ENDIF 149 DEALLOCATE( zsidep, zpdep, zirondep ) 150 ! 151 ENDIF 152 153 ! Add the external input of nutrients from river 154 ! ---------------------------------------------------------- 155 IF( ln_river ) THEN 156 DO jj = 1, jpj 157 DO ji = 1, jpi 158 DO jk = 1, nk_rnf(ji,jj) 159 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + rivdip(ji,jj) * rfact2 160 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + rivdin(ji,jj) * rfact2 161 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + rivdic(ji,jj) * 5.e-5 * rfact2 162 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + rivdsi(ji,jj) * rfact2 163 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + rivdic(ji,jj) * rfact2 164 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + ( rivalk(ji,jj) - rno3 * rivdin(ji,jj) ) * rfact2 165 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + rivdoc(ji,jj) * rfact2 166 ENDDO 167 ENDDO 168 ENDDO 169 IF (ln_ligand) THEN 170 DO jj = 1, jpj 171 DO ji = 1, jpi 172 DO jk = 1, nk_rnf(ji,jj) 173 tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + rivdic(ji,jj) * 5.e-5 * rfact2 174 ENDDO 175 ENDDO 176 ENDDO 177 ENDIF 178 IF( ln_p5z ) THEN 179 DO jj = 1, jpj 180 DO ji = 1, jpi 181 DO jk = 1, nk_rnf(ji,jj) 182 tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + rivdop(ji,jj) * rfact2 183 tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + rivdon(ji,jj) * rfact2 184 ENDDO 185 ENDDO 186 ENDDO 187 ENDIF 188 ENDIF 189 190 ! Add the external input of nutrients from nitrogen deposition 191 ! ---------------------------------------------------------- 192 IF( ln_ndepo ) THEN 193 tra(:,:,1,jpno3) = tra(:,:,1,jpno3) + nitdep(:,:) * rfact2 194 tra(:,:,1,jptal) = tra(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2 195 ENDIF 196 197 ! Add the external input of iron from hydrothermal vents 198 ! ------------------------------------------------------ 199 IF( ln_hydrofe ) THEN 200 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2 201 IF( ln_ligand ) THEN 202 tra(:,:,:,jplgw) = tra(:,:,:,jplgw) + ( hydrofe(:,:,:) * lgw_rath ) * rfact2 203 ENDIF 204 ! 205 IF( lk_iomput .AND. knt == nrdttrc ) & 206 & CALL iom_put( "HYDR", hydrofe(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! hydrothermal iron input 207 ENDIF 208 209 ! OA: Warning, the following part is necessary to avoid CFL problems above the sediments 210 ! -------------------------------------------------------------------- 211 DO jj = 1, jpj 212 DO ji = 1, jpi 92 IF( .NOT.lk_sed ) THEN 93 ! OA: Warning, the following part is necessary to avoid CFL problems above the sediments 94 ! -------------------------------------------------------------------- 95 DO_2D_11_11 213 96 ikt = mbkt(ji,jj) 214 zdep = e3t _n(ji,jj,ikt) / xstep97 zdep = e3t(ji,jj,ikt,Kmm) / xstep 215 98 zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) ) 216 99 zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) ) 217 END DO 218 END DO 219 ! 220 IF( .NOT.lk_sed ) THEN 221 ! 222 ! Add the external input of iron from sediment mobilization 223 ! ------------------------------------------------------ 224 IF( ln_ironsed ) THEN 225 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2 226 ! 227 IF( lk_iomput .AND. knt == nrdttrc ) & 228 & CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! iron inputs from sediments 229 ENDIF 100 END_2D 230 101 231 102 ! Computation of the sediment denitrification proportion: The metamodel from midlleburg (2006) is being used 232 103 ! Computation of the fraction of organic matter that is permanently buried from Dunne's model 233 104 ! ------------------------------------------------------- 234 DO jj = 1, jpj 235 DO ji = 1, jpi 236 IF( tmask(ji,jj,1) == 1 ) THEN 237 ikt = mbkt(ji,jj) 238 zflx = ( trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) & 239 & + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E3 * 1E6 / 1E4 240 zflx = LOG10( MAX( 1E-3, zflx ) ) 241 zo2 = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) ) 242 zno3 = LOG10( MAX( 1. , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) ) 243 zdep = LOG10( gdepw_n(ji,jj,ikt+1) ) 244 zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3 & 245 & + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2 246 zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) ) 247 ! 248 zflx = ( trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) & 249 & + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6 250 zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2 251 ENDIF 252 END DO 253 END DO 105 DO_2D_11_11 106 IF( tmask(ji,jj,1) == 1 ) THEN 107 ikt = mbkt(ji,jj) 108 zflx = ( tr(ji,jj,ikt,jpgoc,Kbb) * zwsbio4(ji,jj) & 109 & + tr(ji,jj,ikt,jppoc,Kbb) * zwsbio3(ji,jj) ) * 1E3 * 1E6 / 1E4 110 zflx = LOG10( MAX( 1E-3, zflx ) ) 111 zo2 = LOG10( MAX( 10. , tr(ji,jj,ikt,jpoxy,Kbb) * 1E6 ) ) 112 zno3 = LOG10( MAX( 1. , tr(ji,jj,ikt,jpno3,Kbb) * 1E6 * rno3 ) ) 113 zdep = LOG10( gdepw(ji,jj,ikt+1,Kmm) ) 114 zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3 & 115 & + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2 116 zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) ) 117 ! 118 zflx = ( tr(ji,jj,ikt,jpgoc,Kbb) * zwsbio4(ji,jj) & 119 & + tr(ji,jj,ikt,jppoc,Kbb) * zwsbio3(ji,jj) ) * 1E6 120 zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2 121 ENDIF 122 END_2D 254 123 ! 255 124 ENDIF … … 260 129 IF( .NOT.lk_sed ) zrivsil = 1._wp - sedsilfrac 261 130 262 DO jj = 1, jpj 263 DO ji = 1, jpi 131 DO_2D_11_11 132 ikt = mbkt(ji,jj) 133 zdep = xstep / e3t(ji,jj,ikt,Kmm) 134 zwsc = zwsbio4(ji,jj) * zdep 135 zsiloss = tr(ji,jj,ikt,jpgsi,Kbb) * zwsc 136 zcaloss = tr(ji,jj,ikt,jpcal,Kbb) * zwsc 137 ! 138 tr(ji,jj,ikt,jpgsi,Krhs) = tr(ji,jj,ikt,jpgsi,Krhs) - zsiloss 139 tr(ji,jj,ikt,jpcal,Krhs) = tr(ji,jj,ikt,jpcal,Krhs) - zcaloss 140 END_2D 141 ! 142 IF( .NOT.lk_sed ) THEN 143 DO_2D_11_11 264 144 ikt = mbkt(ji,jj) 265 zdep = xstep / e3t _n(ji,jj,ikt)145 zdep = xstep / e3t(ji,jj,ikt,Kmm) 266 146 zwsc = zwsbio4(ji,jj) * zdep 267 zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc 268 zcaloss = trb(ji,jj,ikt,jpcal) * zwsc 147 zsiloss = tr(ji,jj,ikt,jpgsi,Kbb) * zwsc 148 zcaloss = tr(ji,jj,ikt,jpcal,Kbb) * zwsc 149 tr(ji,jj,ikt,jpsil,Krhs) = tr(ji,jj,ikt,jpsil,Krhs) + zsiloss * zrivsil 269 150 ! 270 tra(ji,jj,ikt,jpgsi) = tra(ji,jj,ikt,jpgsi) - zsiloss 271 tra(ji,jj,ikt,jpcal) = tra(ji,jj,ikt,jpcal) - zcaloss 272 END DO 273 END DO 274 ! 275 IF( .NOT.lk_sed ) THEN 276 DO jj = 1, jpj 277 DO ji = 1, jpi 278 ikt = mbkt(ji,jj) 279 zdep = xstep / e3t_n(ji,jj,ikt) 280 zwsc = zwsbio4(ji,jj) * zdep 281 zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc 282 zcaloss = trb(ji,jj,ikt,jpcal) * zwsc 283 tra(ji,jj,ikt,jpsil) = tra(ji,jj,ikt,jpsil) + zsiloss * zrivsil 284 ! 285 zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 286 zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 287 zrivalk = sedcalfrac * zfactcal 288 tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0 289 tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk 290 zsedcal(ji,jj) = (1.0 - zrivalk) * zcaloss * e3t_n(ji,jj,ikt) 291 zsedsi (ji,jj) = (1.0 - zrivsil) * zsiloss * e3t_n(ji,jj,ikt) 292 END DO 293 END DO 294 ENDIF 295 ! 296 DO jj = 1, jpj 297 DO ji = 1, jpi 151 zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 152 zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 153 zrivalk = sedcalfrac * zfactcal 154 tr(ji,jj,ikt,jptal,Krhs) = tr(ji,jj,ikt,jptal,Krhs) + zcaloss * zrivalk * 2.0 155 tr(ji,jj,ikt,jpdic,Krhs) = tr(ji,jj,ikt,jpdic,Krhs) + zcaloss * zrivalk 156 zsedcal(ji,jj) = (1.0 - zrivalk) * zcaloss * e3t(ji,jj,ikt,Kmm) 157 zsedsi (ji,jj) = (1.0 - zrivsil) * zsiloss * e3t(ji,jj,ikt,Kmm) 158 END_2D 159 ENDIF 160 ! 161 DO_2D_11_11 162 ikt = mbkt(ji,jj) 163 zdep = xstep / e3t(ji,jj,ikt,Kmm) 164 zws4 = zwsbio4(ji,jj) * zdep 165 zws3 = zwsbio3(ji,jj) * zdep 166 tr(ji,jj,ikt,jpgoc,Krhs) = tr(ji,jj,ikt,jpgoc,Krhs) - tr(ji,jj,ikt,jpgoc,Kbb) * zws4 167 tr(ji,jj,ikt,jppoc,Krhs) = tr(ji,jj,ikt,jppoc,Krhs) - tr(ji,jj,ikt,jppoc,Kbb) * zws3 168 tr(ji,jj,ikt,jpbfe,Krhs) = tr(ji,jj,ikt,jpbfe,Krhs) - tr(ji,jj,ikt,jpbfe,Kbb) * zws4 169 tr(ji,jj,ikt,jpsfe,Krhs) = tr(ji,jj,ikt,jpsfe,Krhs) - tr(ji,jj,ikt,jpsfe,Kbb) * zws3 170 END_2D 171 ! 172 IF( ln_p5z ) THEN 173 DO_2D_11_11 298 174 ikt = mbkt(ji,jj) 299 zdep = xstep / e3t _n(ji,jj,ikt)175 zdep = xstep / e3t(ji,jj,ikt,Kmm) 300 176 zws4 = zwsbio4(ji,jj) * zdep 301 177 zws3 = zwsbio3(ji,jj) * zdep 302 tra(ji,jj,ikt,jpgoc) = tra(ji,jj,ikt,jpgoc) - trb(ji,jj,ikt,jpgoc) * zws4 303 tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3 304 tra(ji,jj,ikt,jpbfe) = tra(ji,jj,ikt,jpbfe) - trb(ji,jj,ikt,jpbfe) * zws4 305 tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3 306 END DO 307 END DO 308 ! 309 IF( ln_p5z ) THEN 310 DO jj = 1, jpj 311 DO ji = 1, jpi 312 ikt = mbkt(ji,jj) 313 zdep = xstep / e3t_n(ji,jj,ikt) 314 zws4 = zwsbio4(ji,jj) * zdep 315 zws3 = zwsbio3(ji,jj) * zdep 316 tra(ji,jj,ikt,jpgon) = tra(ji,jj,ikt,jpgon) - trb(ji,jj,ikt,jpgon) * zws4 317 tra(ji,jj,ikt,jppon) = tra(ji,jj,ikt,jppon) - trb(ji,jj,ikt,jppon) * zws3 318 tra(ji,jj,ikt,jpgop) = tra(ji,jj,ikt,jpgop) - trb(ji,jj,ikt,jpgop) * zws4 319 tra(ji,jj,ikt,jppop) = tra(ji,jj,ikt,jppop) - trb(ji,jj,ikt,jppop) * zws3 320 END DO 321 END DO 178 tr(ji,jj,ikt,jpgon,Krhs) = tr(ji,jj,ikt,jpgon,Krhs) - tr(ji,jj,ikt,jpgon,Kbb) * zws4 179 tr(ji,jj,ikt,jppon,Krhs) = tr(ji,jj,ikt,jppon,Krhs) - tr(ji,jj,ikt,jppon,Kbb) * zws3 180 tr(ji,jj,ikt,jpgop,Krhs) = tr(ji,jj,ikt,jpgop,Krhs) - tr(ji,jj,ikt,jpgop,Kbb) * zws4 181 tr(ji,jj,ikt,jppop,Krhs) = tr(ji,jj,ikt,jppop,Krhs) - tr(ji,jj,ikt,jppop,Kbb) * zws3 182 END_2D 322 183 ENDIF 323 184 … … 325 186 ! The 0.5 factor in zpdenit is to avoid negative NO3 concentration after 326 187 ! denitrification in the sediments. Not very clever, but simpliest option. 327 DO jj = 1, jpj 328 DO ji = 1, jpi 329 ikt = mbkt(ji,jj) 330 zdep = xstep / e3t_n(ji,jj,ikt) 331 zws4 = zwsbio4(ji,jj) * zdep 332 zws3 = zwsbio3(ji,jj) * zdep 333 zrivno3 = 1. - zbureff(ji,jj) 334 zwstpoc = trb(ji,jj,ikt,jpgoc) * zws4 + trb(ji,jj,ikt,jppoc) * zws3 335 zpdenit = MIN( 0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 ) 336 z1pdenit = zwstpoc * zrivno3 - zpdenit 337 zolimit = MIN( ( trb(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) ) 338 tra(ji,jj,ikt,jpdoc) = tra(ji,jj,ikt,jpdoc) + z1pdenit - zolimit 339 tra(ji,jj,ikt,jppo4) = tra(ji,jj,ikt,jppo4) + zpdenit + zolimit 340 tra(ji,jj,ikt,jpnh4) = tra(ji,jj,ikt,jpnh4) + zpdenit + zolimit 341 tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) - rdenit * zpdenit 342 tra(ji,jj,ikt,jpoxy) = tra(ji,jj,ikt,jpoxy) - zolimit * o2ut 343 tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * zpdenit ) 344 tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit 345 sdenit(ji,jj) = rdenit * zpdenit * e3t_n(ji,jj,ikt) 346 zsedc(ji,jj) = (1. - zrivno3) * zwstpoc * e3t_n(ji,jj,ikt) 347 IF( ln_p5z ) THEN 348 zwstpop = trb(ji,jj,ikt,jpgop) * zws4 + trb(ji,jj,ikt,jppop) * zws3 349 zwstpon = trb(ji,jj,ikt,jpgon) * zws4 + trb(ji,jj,ikt,jppon) * zws3 350 tra(ji,jj,ikt,jpdon) = tra(ji,jj,ikt,jpdon) + ( z1pdenit - zolimit ) * zwstpon / (zwstpoc + rtrn) 351 tra(ji,jj,ikt,jpdop) = tra(ji,jj,ikt,jpdop) + ( z1pdenit - zolimit ) * zwstpop / (zwstpoc + rtrn) 352 ENDIF 353 END DO 354 END DO 188 DO_2D_11_11 189 ikt = mbkt(ji,jj) 190 zdep = xstep / e3t(ji,jj,ikt,Kmm) 191 zws4 = zwsbio4(ji,jj) * zdep 192 zws3 = zwsbio3(ji,jj) * zdep 193 zrivno3 = 1. - zbureff(ji,jj) 194 zwstpoc = tr(ji,jj,ikt,jpgoc,Kbb) * zws4 + tr(ji,jj,ikt,jppoc,Kbb) * zws3 195 zpdenit = MIN( 0.5 * ( tr(ji,jj,ikt,jpno3,Kbb) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 ) 196 z1pdenit = zwstpoc * zrivno3 - zpdenit 197 zolimit = MIN( ( tr(ji,jj,ikt,jpoxy,Kbb) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) ) 198 tr(ji,jj,ikt,jpdoc,Krhs) = tr(ji,jj,ikt,jpdoc,Krhs) + z1pdenit - zolimit 199 tr(ji,jj,ikt,jppo4,Krhs) = tr(ji,jj,ikt,jppo4,Krhs) + zpdenit + zolimit 200 tr(ji,jj,ikt,jpnh4,Krhs) = tr(ji,jj,ikt,jpnh4,Krhs) + zpdenit + zolimit 201 tr(ji,jj,ikt,jpno3,Krhs) = tr(ji,jj,ikt,jpno3,Krhs) - rdenit * zpdenit 202 tr(ji,jj,ikt,jpoxy,Krhs) = tr(ji,jj,ikt,jpoxy,Krhs) - zolimit * o2ut 203 tr(ji,jj,ikt,jptal,Krhs) = tr(ji,jj,ikt,jptal,Krhs) + rno3 * (zolimit + (1.+rdenit) * zpdenit ) 204 tr(ji,jj,ikt,jpdic,Krhs) = tr(ji,jj,ikt,jpdic,Krhs) + zpdenit + zolimit 205 sdenit(ji,jj) = rdenit * zpdenit * e3t(ji,jj,ikt,Kmm) 206 zsedc(ji,jj) = (1. - zrivno3) * zwstpoc * e3t(ji,jj,ikt,Kmm) 207 IF( ln_p5z ) THEN 208 zwstpop = tr(ji,jj,ikt,jpgop,Kbb) * zws4 + tr(ji,jj,ikt,jppop,Kbb) * zws3 209 zwstpon = tr(ji,jj,ikt,jpgon,Kbb) * zws4 + tr(ji,jj,ikt,jppon,Kbb) * zws3 210 tr(ji,jj,ikt,jpdon,Krhs) = tr(ji,jj,ikt,jpdon,Krhs) + ( z1pdenit - zolimit ) * zwstpon / (zwstpoc + rtrn) 211 tr(ji,jj,ikt,jpdop,Krhs) = tr(ji,jj,ikt,jpdop,Krhs) + ( z1pdenit - zolimit ) * zwstpop / (zwstpoc + rtrn) 212 ENDIF 213 END_2D 355 214 ENDIF 356 215 … … 364 223 ENDDO 365 224 IF( ln_p4z ) THEN 366 DO jk = 1, jpkm1 367 DO jj = 1, jpj 368 DO ji = 1, jpi 369 ! ! Potential nitrogen fixation dependant on temperature and iron 370 ztemp = tsn(ji,jj,jk,jp_tem) 371 zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 372 ! Potential nitrogen fixation dependant on temperature and iron 373 xdianh4 = trb(ji,jj,jk,jpnh4) / ( concnnh4 + trb(ji,jj,jk,jpnh4) ) 374 xdiano3 = trb(ji,jj,jk,jpno3) / ( concnno3 + trb(ji,jj,jk,jpno3) ) * (1. - xdianh4) 375 zlim = ( 1.- xdiano3 - xdianh4 ) 376 IF( zlim <= 0.1 ) zlim = 0.01 377 zfact = zlim * rfact2 378 ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 379 ztrpo4(ji,jj,jk) = trb(ji,jj,jk,jppo4) / ( 1E-6 + trb(ji,jj,jk,jppo4) ) 380 ztrdp = ztrpo4(ji,jj,jk) 381 nitrpot(ji,jj,jk) = zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 382 END DO 383 END DO 384 END DO 225 DO_3D_11_11( 1, jpkm1 ) 226 ! ! Potential nitrogen fixation dependant on temperature and iron 227 ztemp = ts(ji,jj,jk,jp_tem,Kmm) 228 zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 229 ! Potential nitrogen fixation dependant on temperature and iron 230 xdianh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 231 xdiano3 = tr(ji,jj,jk,jpno3,Kbb) / ( concnno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - xdianh4) 232 zlim = ( 1.- xdiano3 - xdianh4 ) 233 IF( zlim <= 0.1 ) zlim = 0.01 234 zfact = zlim * rfact2 235 ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 236 ztrpo4(ji,jj,jk) = tr(ji,jj,jk,jppo4,Kbb) / ( 1E-6 + tr(ji,jj,jk,jppo4,Kbb) ) 237 ztrdp = ztrpo4(ji,jj,jk) 238 nitrpot(ji,jj,jk) = zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 239 END_3D 385 240 ELSE ! p5z 386 DO jk = 1, jpkm1 387 DO jj = 1, jpj 388 DO ji = 1, jpi 389 ! ! Potential nitrogen fixation dependant on temperature and iron 390 ztemp = tsn(ji,jj,jk,jp_tem) 391 zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 392 ! Potential nitrogen fixation dependant on temperature and iron 393 xdianh4 = trb(ji,jj,jk,jpnh4) / ( concnnh4 + trb(ji,jj,jk,jpnh4) ) 394 xdiano3 = trb(ji,jj,jk,jpno3) / ( concnno3 + trb(ji,jj,jk,jpno3) ) * (1. - xdianh4) 395 zlim = ( 1.- xdiano3 - xdianh4 ) 396 IF( zlim <= 0.1 ) zlim = 0.01 397 zfact = zlim * rfact2 398 ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 399 ztrpo4(ji,jj,jk) = trb(ji,jj,jk,jppo4) / ( 1E-6 + trb(ji,jj,jk,jppo4) ) 400 ztrdop(ji,jj,jk) = trb(ji,jj,jk,jpdop) / ( 1E-6 + trb(ji,jj,jk,jpdop) ) * (1. - ztrpo4(ji,jj,jk)) 401 ztrdp = ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) 402 nitrpot(ji,jj,jk) = zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 403 END DO 404 END DO 405 END DO 241 DO_3D_11_11( 1, jpkm1 ) 242 ! ! Potential nitrogen fixation dependant on temperature and iron 243 ztemp = ts(ji,jj,jk,jp_tem,Kmm) 244 zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 245 ! Potential nitrogen fixation dependant on temperature and iron 246 xdianh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 247 xdiano3 = tr(ji,jj,jk,jpno3,Kbb) / ( concnno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - xdianh4) 248 zlim = ( 1.- xdiano3 - xdianh4 ) 249 IF( zlim <= 0.1 ) zlim = 0.01 250 zfact = zlim * rfact2 251 ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 252 ztrpo4(ji,jj,jk) = tr(ji,jj,jk,jppo4,Kbb) / ( 1E-6 + tr(ji,jj,jk,jppo4,Kbb) ) 253 ztrdop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( 1E-6 + tr(ji,jj,jk,jpdop,Kbb) ) * (1. - ztrpo4(ji,jj,jk)) 254 ztrdp = ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) 255 nitrpot(ji,jj,jk) = zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 256 END_3D 406 257 ENDIF 407 258 … … 409 260 ! ---------------------------------------- 410 261 IF( ln_p4z ) THEN 411 DO jk = 1, jpkm1 412 DO jj = 1, jpj 413 DO ji = 1, jpi 414 zfact = nitrpot(ji,jj,jk) * nitrfix 415 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zfact / 3.0 416 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zfact / 3.0 417 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zfact * 2.0 / 3.0 418 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zfact * 1.0 / 3.0 419 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zfact * 1.0 / 3.0 * 2.0 / 3.0 420 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfact * 1.0 / 3.0 * 1.0 / 3.0 421 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 422 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - 30E-6 * zfact * 1.0 / 3.0 423 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 424 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 425 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 426 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trb(ji,jj,jk,jppo4) ) & 427 & * 0.001 * trb(ji,jj,jk,jpdoc) * xstep 428 END DO 429 END DO 430 END DO 262 DO_3D_11_11( 1, jpkm1 ) 263 zfact = nitrpot(ji,jj,jk) * nitrfix 264 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0 265 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zfact / 3.0 266 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zfact * 2.0 / 3.0 267 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zfact * 1.0 / 3.0 268 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zfact * 1.0 / 3.0 * 2.0 / 3.0 269 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfact * 1.0 / 3.0 * 1.0 / 3.0 270 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 271 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - 30E-6 * zfact * 1.0 / 3.0 272 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 273 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 274 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 275 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + concdnh4 / ( concdnh4 + tr(ji,jj,jk,jppo4,Kbb) ) & 276 & * 0.001 * tr(ji,jj,jk,jpdoc,Kbb) * xstep 277 END_3D 431 278 ELSE ! p5z 432 DO jk = 1, jpkm1 433 DO jj = 1, jpj 434 DO ji = 1, jpi 435 zfact = nitrpot(ji,jj,jk) * nitrfix 436 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zfact / 3.0 437 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zfact / 3.0 438 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - 16.0 / 46.0 * zfact * ( 1.0 - 1.0 / 3.0 ) & 439 & * ztrpo4(ji,jj,jk) / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 440 tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zfact * 1.0 / 3.0 441 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zfact * 1.0 / 3.0 442 tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + 16.0 / 46.0 * zfact / 3.0 & 443 & - 16.0 / 46.0 * zfact * ztrdop(ji,jj,jk) & 444 & / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 445 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zfact * 1.0 / 3.0 * 2.0 / 3.0 446 tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zfact * 1.0 / 3.0 * 2.0 /3.0 447 tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 2.0 /3.0 448 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfact * 1.0 / 3.0 * 1.0 / 3.0 449 tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zfact * 1.0 / 3.0 * 1.0 /3.0 450 tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 1.0 /3.0 451 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 452 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - 30E-6 * zfact * 1.0 / 3.0 453 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 454 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 455 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 456 END DO 457 END DO 458 END DO 279 DO_3D_11_11( 1, jpkm1 ) 280 zfact = nitrpot(ji,jj,jk) * nitrfix 281 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0 282 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zfact / 3.0 283 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - 16.0 / 46.0 * zfact * ( 1.0 - 1.0 / 3.0 ) & 284 & * ztrpo4(ji,jj,jk) / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 285 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zfact * 1.0 / 3.0 286 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zfact * 1.0 / 3.0 287 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + 16.0 / 46.0 * zfact / 3.0 & 288 & - 16.0 / 46.0 * zfact * ztrdop(ji,jj,jk) & 289 & / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 290 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zfact * 1.0 / 3.0 * 2.0 / 3.0 291 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zfact * 1.0 / 3.0 * 2.0 /3.0 292 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 2.0 /3.0 293 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfact * 1.0 / 3.0 * 1.0 / 3.0 294 tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zfact * 1.0 / 3.0 * 1.0 /3.0 295 tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 1.0 /3.0 296 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 297 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - 30E-6 * zfact * 1.0 / 3.0 298 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 299 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 300 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 301 END_3D 459 302 ! 460 303 ENDIF 461 304 462 IF( lk_iomput ) THEN 463 IF( knt == nrdttrc ) THEN 464 zfact = 1.e+3 * rfact2r ! conversion from molC/l/kt to molN/m3/s 465 CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * rno3 * zfact * tmask(:,:,:) ) ! nitrogen fixation 466 CALL iom_put( "SedCal", zsedcal(:,:) * zfact ) 467 CALL iom_put( "SedSi", zsedsi (:,:) * zfact ) 468 CALL iom_put( "SedC", zsedc (:,:) * zfact ) 469 CALL iom_put( "Sdenit", sdenit (:,:) * zfact * rno3 ) 470 ENDIF 471 ENDIF 472 ! 473 IF(ln_ctl) THEN ! print mean trends (USEd for debugging) 305 IF( lk_iomput .AND. knt == nrdttrc ) THEN 306 zfact = 1.e+3 * rfact2r ! conversion from molC/l/kt to molN/m3/s 307 CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * rno3 * zfact * tmask(:,:,:) ) ! nitrogen fixation 308 CALL iom_put( "SedCal", zsedcal(:,:) * zfact ) 309 CALL iom_put( "SedSi" , zsedsi (:,:) * zfact ) 310 CALL iom_put( "SedC" , zsedc (:,:) * zfact ) 311 CALL iom_put( "Sdenit", sdenit (:,:) * zfact * rno3 ) 312 ENDIF 313 ! 314 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (USEd for debugging) 474 315 WRITE(charout, fmt="('sed ')") 475 316 CALL prt_ctl_trc_info(charout) 476 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)317 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 477 318 ENDIF 478 319 ! … … 483 324 END SUBROUTINE p4z_sed 484 325 326 SUBROUTINE p4z_sed_init 327 !!---------------------------------------------------------------------- 328 !! *** routine p4z_sed_init *** 329 !! 330 !! ** purpose : initialization of some parameters 331 !! 332 !!---------------------------------------------------------------------- 333 !!---------------------------------------------------------------------- 334 INTEGER :: ji, jj, jk, jm 335 INTEGER :: ios ! Local integer output status for namelist read 336 ! 337 !! 338 NAMELIST/nampissed/ nitrfix, diazolight, concfediaz 339 !!---------------------------------------------------------------------- 340 ! 341 IF(lwp) THEN 342 WRITE(numout,*) 343 WRITE(numout,*) 'p4z_sed_init : initialization of sediment mobilisation ' 344 WRITE(numout,*) '~~~~~~~~~~~~ ' 345 ENDIF 346 ! !* set file information 347 READ ( numnatp_ref, nampissed, IOSTAT = ios, ERR = 901) 348 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampissed in reference namelist' ) 349 READ ( numnatp_cfg, nampissed, IOSTAT = ios, ERR = 902 ) 350 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampissed in configuration namelist' ) 351 IF(lwm) WRITE ( numonp, nampissed ) 352 353 IF(lwp) THEN 354 WRITE(numout,*) ' Namelist : nampissed ' 355 WRITE(numout,*) ' nitrogen fixation rate nitrfix = ', nitrfix 356 WRITE(numout,*) ' nitrogen fixation sensitivty to light diazolight = ', diazolight 357 WRITE(numout,*) ' Fe half-saturation cste for diazotrophs concfediaz = ', concfediaz 358 ENDIF 359 ! 360 r1_rday = 1. / rday 361 ! 362 sedsilfrac = 0.03 ! percentage of silica loss in the sediments 363 sedcalfrac = 0.6 ! percentage of calcite loss in the sediments 364 ! 365 lk_sed = ln_sediment .AND. ln_sed_2way 366 ! 367 END SUBROUTINE p4z_sed_init 485 368 486 369 INTEGER FUNCTION p4z_sed_alloc() -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zsink.F90
r12276 r12377 38 38 INTEGER :: ik100 39 39 40 !! * Substitutions 41 # include "do_loop_substitute.h90" 40 42 !!---------------------------------------------------------------------- 41 43 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 49 51 !!---------------------------------------------------------------------- 50 52 51 SUBROUTINE p4z_sink ( kt, knt )53 SUBROUTINE p4z_sink ( kt, knt, Kbb, Kmm, Krhs ) 52 54 !!--------------------------------------------------------------------- 53 55 !! *** ROUTINE p4z_sink *** … … 59 61 !!--------------------------------------------------------------------- 60 62 INTEGER, INTENT(in) :: kt, knt 63 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 61 64 INTEGER :: ji, jj, jk 62 65 CHARACTER (len=25) :: charout … … 77 80 ! by data and from the coagulation theory 78 81 ! ----------------------------------------------------------- 79 DO jk = 1, jpkm1 80 DO jj = 1, jpj 81 DO ji = 1,jpi 82 zmax = MAX( heup_01(ji,jj), hmld(ji,jj) ) 83 zfact = MAX( 0., gdepw_n(ji,jj,jk+1) - zmax ) / wsbio2scale 84 wsbio4(ji,jj,jk) = wsbio2 + MAX(0., ( wsbio2max - wsbio2 )) * zfact 85 END DO 86 END DO 87 END DO 82 DO_3D_11_11( 1, jpkm1 ) 83 zmax = MAX( heup_01(ji,jj), hmld(ji,jj) ) 84 zfact = MAX( 0., gdepw(ji,jj,jk+1,Kmm) - zmax ) / wsbio2scale 85 wsbio4(ji,jj,jk) = wsbio2 + MAX(0., ( wsbio2max - wsbio2 )) * zfact 86 END_3D 88 87 89 88 ! limit the values of the sinking speeds to avoid numerical instabilities … … 102 101 ! Compute the sedimentation term using p4zsink2 for all the sinking particles 103 102 ! ----------------------------------------------------- 104 CALL trc_sink( kt, wsbio3, sinking , jppoc, rfact2 )105 CALL trc_sink( kt, wsbio3, sinkfer , jpsfe, rfact2 )106 CALL trc_sink( kt, wsbio4, sinking2, jpgoc, rfact2 )107 CALL trc_sink( kt, wsbio4, sinkfer2, jpbfe, rfact2 )108 CALL trc_sink( kt, wsbio4, sinksil , jpgsi, rfact2 )109 CALL trc_sink( kt, wsbio4, sinkcal , jpcal, rfact2 )103 CALL trc_sink( kt, Kbb, Kmm, wsbio3, sinking , jppoc, rfact2 ) 104 CALL trc_sink( kt, Kbb, Kmm, wsbio3, sinkfer , jpsfe, rfact2 ) 105 CALL trc_sink( kt, Kbb, Kmm, wsbio4, sinking2, jpgoc, rfact2 ) 106 CALL trc_sink( kt, Kbb, Kmm, wsbio4, sinkfer2, jpbfe, rfact2 ) 107 CALL trc_sink( kt, Kbb, Kmm, wsbio4, sinksil , jpgsi, rfact2 ) 108 CALL trc_sink( kt, Kbb, Kmm, wsbio4, sinkcal , jpcal, rfact2 ) 110 109 111 110 IF( ln_p5z ) THEN … … 117 116 ! Compute the sedimentation term using p4zsink2 for all the sinking particles 118 117 ! ----------------------------------------------------- 119 CALL trc_sink( kt, wsbio3, sinkingn , jppon, rfact2 )120 CALL trc_sink( kt, wsbio3, sinkingp , jppop, rfact2 )121 CALL trc_sink( kt, wsbio4, sinking2n, jpgon, rfact2 )122 CALL trc_sink( kt, wsbio4, sinking2p, jpgop, rfact2 )118 CALL trc_sink( kt, Kbb, Kmm, wsbio3, sinkingn , jppon, rfact2 ) 119 CALL trc_sink( kt, Kbb, Kmm, wsbio3, sinkingp , jppop, rfact2 ) 120 CALL trc_sink( kt, Kbb, Kmm, wsbio4, sinking2n, jpgon, rfact2 ) 121 CALL trc_sink( kt, Kbb, Kmm, wsbio4, sinking2p, jpgop, rfact2 ) 123 122 ENDIF 124 123 … … 142 141 ENDIF 143 142 ! 144 IF( ln_ctl) THEN ! print mean trends (used for debugging)143 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 145 144 WRITE(charout, FMT="('sink')") 146 145 CALL prt_ctl_trc_info(charout) 147 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)146 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 148 147 ENDIF 149 148 ! -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zsms.F90
r12276 r12377 17 17 USE p4zlys ! Calcite saturation 18 18 USE p4zflx ! Gas exchange 19 USE p4z sbc! External source of nutrients19 USE p4zbc ! External source of nutrients 20 20 USE p4zsed ! Sedimentation 21 21 USE p4zint ! time interpolation … … 39 39 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnegtr ! Array used to indicate negative tracer values 40 40 41 !! * Substitutions 42 # include "do_loop_substitute.h90" 41 43 !!---------------------------------------------------------------------- 42 44 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 46 48 CONTAINS 47 49 48 SUBROUTINE p4z_sms( kt )50 SUBROUTINE p4z_sms( kt, Kbb, Kmm, Krhs ) 49 51 !!--------------------------------------------------------------------- 50 52 !! *** ROUTINE p4z_sms *** … … 58 60 !!--------------------------------------------------------------------- 59 61 ! 60 INTEGER, INTENT( in ) :: kt ! ocean time-step index 62 INTEGER, INTENT( in ) :: kt ! ocean time-step index 63 INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs ! time level index 61 64 !! 62 65 INTEGER :: ji, jj, jk, jnt, jn, jl … … 76 79 ! 77 80 IF( .NOT. ln_rsttr ) THEN 78 CALL p4z_che 79 CALL ahini_for_at( hi)! set PH at kt=nit00081 CALL p4z_che( Kbb, Kmm ) ! initialize the chemical constants 82 CALL ahini_for_at( hi, Kbb ) ! set PH at kt=nit000 80 83 t_oce_co2_flx_cum = 0._wp 81 84 ELSE 82 CALL p4z_rst( nittrc000, 'READ' ) !* read or initialize all required fields85 CALL p4z_rst( nittrc000, Kbb, Kmm, 'READ' ) !* read or initialize all required fields 83 86 ENDIF 84 87 ! 85 88 ENDIF 86 89 ! 87 IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 ) CALL p4z_dmp( kt) ! Relaxation of some tracers90 IF( ln_pisdmp .AND. MOD( kt - 1, nn_pisdmp ) == 0 ) CALL p4z_dmp( kt, Kbb, Kmm ) ! Relaxation of some tracers 88 91 ! 89 92 rfact = r2dttrc … … 92 95 IF( l_trdtrc ) THEN 93 96 ALLOCATE( ztrdt(jpi,jpj,jpk,jp_pisces) ) !* store now fields before applying the Asselin filter 94 ztrdt(:,:,:,:) = tr n(:,:,:,:)95 ENDIF 96 ! 97 98 IF( ( ln_top_euler .AND. kt == nittrc000 ) .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + nn_dttrc) ) THEN97 ztrdt(:,:,:,:) = tr(:,:,:,:,Kmm) 98 ENDIF 99 ! 100 101 IF( ( ln_top_euler .AND. kt == nittrc000 ) .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + 1 ) ) THEN 99 102 rfactr = 1. / rfact 100 103 rfact2 = rfact / REAL( nrdttrc, wp ) … … 110 113 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN 111 114 DO jn = jp_pcs0, jp_pcs1 ! SMS on tracer without Asselin time-filter 112 tr b(:,:,:,jn) = trn(:,:,:,jn)115 tr(:,:,:,jn,Kbb) = tr(:,:,:,jn,Kmm) 113 116 END DO 114 117 ENDIF 115 118 ! 116 IF( ll_ sbc ) CALL p4z_sbc( kt) ! external sources of nutrients119 IF( ll_bc ) CALL p4z_bc( kt, Kbb, Kmm, Krhs ) ! external sources of nutrients 117 120 ! 118 121 #if ! defined key_sed_off 119 CALL p4z_che 120 CALL p4z_int( kt )! computation of various rates for biogeochemistry122 CALL p4z_che( Kbb, Kmm ) ! computation of chemical constants 123 CALL p4z_int( kt, Kbb, Kmm ) ! computation of various rates for biogeochemistry 121 124 ! 122 125 DO jnt = 1, nrdttrc ! Potential time splitting if requested 123 126 ! 124 CALL p4z_bio( kt, jnt ) ! Biology125 CALL p4z_lys( kt, jnt ) ! Compute CaCO3 saturation126 CALL p4z_sed( kt, jnt ) ! Surface and Bottom boundary conditions127 CALL p4z_flx( kt, jnt ) ! Compute surface fluxes127 CALL p4z_bio( kt, jnt, Kbb, Kmm, Krhs ) ! Biology 128 CALL p4z_lys( kt, jnt, Kbb, Krhs ) ! Compute CaCO3 saturation 129 CALL p4z_sed( kt, jnt, Kbb, Kmm, Krhs ) ! Surface and Bottom boundary conditions 130 CALL p4z_flx( kt, jnt, Kbb, Kmm, Krhs ) ! Compute surface fluxes 128 131 ! 129 132 xnegtr(:,:,:) = 1.e0 130 133 DO jn = jp_pcs0, jp_pcs1 131 DO jk = 1, jpk 132 DO jj = 1, jpj 133 DO ji = 1, jpi 134 IF( ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN 135 ztra = ABS( trb(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn ) 136 xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk), ztra ) 137 ENDIF 138 END DO 139 END DO 140 END DO 134 DO_3D_11_11( 1, jpk ) 135 IF( ( tr(ji,jj,jk,jn,Kbb) + tr(ji,jj,jk,jn,Krhs) ) < 0.e0 ) THEN 136 ztra = ABS( tr(ji,jj,jk,jn,Kbb) ) / ( ABS( tr(ji,jj,jk,jn,Krhs) ) + rtrn ) 137 xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk), ztra ) 138 ENDIF 139 END_3D 141 140 END DO 142 141 ! ! where at least 1 tracer concentration becomes negative 143 142 ! ! 144 143 DO jn = jp_pcs0, jp_pcs1 145 tr b(:,:,:,jn) = trb(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn)144 tr(:,:,:,jn,Kbb) = tr(:,:,:,jn,Kbb) + xnegtr(:,:,:) * tr(:,:,:,jn,Krhs) 146 145 END DO 147 146 ! … … 152 151 zw3d(:,:,jpk) = 0. 153 152 DO jk = 1, jpkm1 154 zw3d(:,:,jk) = xnegtr(:,:,jk) * xfact * e3t _n(:,:,jk) * tmask(:,:,jk)153 zw3d(:,:,jk) = xnegtr(:,:,jk) * xfact * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 155 154 ENDDO 156 155 ! 157 156 zw2d(:,:) = 0. 158 157 DO jk = 1, jpkm1 159 zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr a(:,:,jk,jptal)158 zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jptal,Krhs) 160 159 ENDDO 161 160 CALL iom_put( 'INTdtAlk', zw2d ) … … 163 162 zw2d(:,:) = 0. 164 163 DO jk = 1, jpkm1 165 zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr a(:,:,jk,jpdic)164 zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpdic,Krhs) 166 165 ENDDO 167 166 CALL iom_put( 'INTdtDIC', zw2d ) … … 169 168 zw2d(:,:) = 0. 170 169 DO jk = 1, jpkm1 171 zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * rno3 * ( tr a(:,:,jk,jpno3) + tra(:,:,jk,jpnh4) )170 zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * rno3 * ( tr(:,:,jk,jpno3,Krhs) + tr(:,:,jk,jpnh4,Krhs) ) 172 171 ENDDO 173 172 CALL iom_put( 'INTdtDIN', zw2d ) … … 175 174 zw2d(:,:) = 0. 176 175 DO jk = 1, jpkm1 177 zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * po4r * tr a(:,:,jk,jppo4)176 zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * po4r * tr(:,:,jk,jppo4,Krhs) 178 177 ENDDO 179 178 CALL iom_put( 'INTdtDIP', zw2d ) … … 181 180 zw2d(:,:) = 0. 182 181 DO jk = 1, jpkm1 183 zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr a(:,:,jk,jpfer)182 zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpfer,Krhs) 184 183 ENDDO 185 184 CALL iom_put( 'INTdtFer', zw2d ) … … 187 186 zw2d(:,:) = 0. 188 187 DO jk = 1, jpkm1 189 zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr a(:,:,jk,jpsil)188 zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpsil,Krhs) 190 189 ENDDO 191 190 CALL iom_put( 'INTdtSil', zw2d ) … … 195 194 ! 196 195 DO jn = jp_pcs0, jp_pcs1 197 tr a(:,:,:,jn) = 0._wp196 tr(:,:,:,jn,Krhs) = 0._wp 198 197 END DO 199 198 ! 200 199 IF( ln_top_euler ) THEN 201 200 DO jn = jp_pcs0, jp_pcs1 202 tr n(:,:,:,jn) = trb(:,:,:,jn)201 tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 203 202 END DO 204 203 ENDIF … … 207 206 IF( l_trdtrc ) THEN 208 207 DO jn = jp_pcs0, jp_pcs1 209 ztrdt(:,:,:,jn) = ( tr b(:,:,:,jn) - ztrdt(:,:,:,jn) ) * rfact2r210 CALL trd_trc( ztrdt(:,:,:,jn), jn, jptra_sms, kt) ! save trends208 ztrdt(:,:,:,jn) = ( tr(:,:,:,jn,Kbb) - ztrdt(:,:,:,jn) ) * rfact2r 209 CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm ) ! save trends 211 210 END DO 212 211 DEALLOCATE( ztrdt ) … … 216 215 IF( ln_sediment ) THEN 217 216 ! 218 CALL sed_model( kt ) ! Main program of Sediment model217 CALL sed_model( kt, Kbb, Kmm, Krhs ) ! Main program of Sediment model 219 218 ! 220 219 IF( ln_top_euler ) THEN 221 220 DO jn = jp_pcs0, jp_pcs1 222 tr n(:,:,:,jn) = trb(:,:,:,jn)221 tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 223 222 END DO 224 223 ENDIF … … 226 225 ENDIF 227 226 ! 228 IF( lrst_trc ) CALL p4z_rst( kt, 'WRITE' )!* Write PISCES informations in restart file229 ! 230 231 IF( lk_iomput .OR. ln_check_mass ) CALL p4z_chk_mass( kt )! Mass conservation checking232 233 IF( lwm .AND. kt == nittrc000 ) CALL FLUSH( numonp ) ! flush output namelist PISCES227 IF( lrst_trc ) CALL p4z_rst( kt, Kbb, Kmm, 'WRITE' ) !* Write PISCES informations in restart file 228 ! 229 230 IF( lk_iomput .OR. ln_check_mass ) CALL p4z_chk_mass( kt, Kmm ) ! Mass conservation checking 231 232 IF( lwm .AND. kt == nittrc000 ) CALL FLUSH( numonp ) ! flush output namelist PISCES 234 233 ! 235 234 IF( ln_timing ) CALL timing_stop('p4z_sms') … … 262 261 ENDIF 263 262 264 REWIND( numnatp_ref ) ! Namelist nampisbio in reference namelist : Pisces variables265 263 READ ( numnatp_ref, nampisbio, IOSTAT = ios, ERR = 901) 266 264 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisbio in reference namelist' ) 267 REWIND( numnatp_cfg ) ! Namelist nampisbio in configuration namelist : Pisces variables268 265 READ ( numnatp_cfg, nampisbio, IOSTAT = ios, ERR = 902 ) 269 266 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisbio in configuration namelist' ) … … 293 290 294 291 295 REWIND( numnatp_ref ) ! Namelist nampisdmp in reference namelist : Pisces damping296 292 READ ( numnatp_ref, nampisdmp, IOSTAT = ios, ERR = 905) 297 293 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdmp in reference namelist' ) 298 REWIND( numnatp_cfg ) ! Namelist nampisdmp in configuration namelist : Pisces damping299 294 READ ( numnatp_cfg, nampisdmp, IOSTAT = ios, ERR = 906 ) 300 295 906 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisdmp in configuration namelist' ) … … 308 303 ENDIF 309 304 310 REWIND( numnatp_ref ) ! Namelist nampismass in reference namelist : Pisces mass conservation check311 305 READ ( numnatp_ref, nampismass, IOSTAT = ios, ERR = 907) 312 306 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismass in reference namelist' ) 313 REWIND( numnatp_cfg ) ! Namelist nampismass in configuration namelist : Pisces mass conservation check314 307 READ ( numnatp_cfg, nampismass, IOSTAT = ios, ERR = 908 ) 315 308 908 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampismass in configuration namelist' ) … … 325 318 326 319 327 SUBROUTINE p4z_rst( kt, cdrw )320 SUBROUTINE p4z_rst( kt, Kbb, Kmm, cdrw ) 328 321 !!--------------------------------------------------------------------- 329 322 !! *** ROUTINE p4z_rst *** … … 336 329 !!--------------------------------------------------------------------- 337 330 INTEGER , INTENT(in) :: kt ! ocean time-step 331 INTEGER , INTENT(in) :: Kbb, Kmm ! time level indices 338 332 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 339 333 !!--------------------------------------------------------------------- … … 348 342 CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:) ) 349 343 ELSE 350 CALL p4z_che 351 CALL ahini_for_at( hi)344 CALL p4z_che( Kbb, Kmm ) ! initialize the chemical constants 345 CALL ahini_for_at( hi, Kbb ) 352 346 ENDIF 353 347 CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) ) … … 396 390 397 391 398 SUBROUTINE p4z_dmp( kt )392 SUBROUTINE p4z_dmp( kt, Kbb, Kmm ) 399 393 !!---------------------------------------------------------------------- 400 394 !! *** p4z_dmp *** … … 403 397 !!---------------------------------------------------------------------- 404 398 ! 405 INTEGER, INTENT( in ) :: kt ! time step 399 INTEGER, INTENT( in ) :: kt ! time step 400 INTEGER, INTENT( in ) :: Kbb, Kmm ! time level indices 406 401 ! 407 402 REAL(wp) :: alkmean = 2426. ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) … … 424 419 zarea = 1._wp / glob_sum( 'p4zsms', cvol(:,:,:) ) * 1e6 425 420 426 zalksumn = glob_sum( 'p4zsms', tr n(:,:,:,jptal) * cvol(:,:,:) ) * zarea427 zpo4sumn = glob_sum( 'p4zsms', tr n(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r428 zno3sumn = glob_sum( 'p4zsms', tr n(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3429 zsilsumn = glob_sum( 'p4zsms', tr n(:,:,:,jpsil) * cvol(:,:,:) ) * zarea421 zalksumn = glob_sum( 'p4zsms', tr(:,:,:,jptal,Kmm) * cvol(:,:,:) ) * zarea 422 zpo4sumn = glob_sum( 'p4zsms', tr(:,:,:,jppo4,Kmm) * cvol(:,:,:) ) * zarea * po4r 423 zno3sumn = glob_sum( 'p4zsms', tr(:,:,:,jpno3,Kmm) * cvol(:,:,:) ) * zarea * rno3 424 zsilsumn = glob_sum( 'p4zsms', tr(:,:,:,jpsil,Kmm) * cvol(:,:,:) ) * zarea 430 425 431 426 IF(lwp) WRITE(numout,*) ' TALKN mean : ', zalksumn 432 tr n(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn427 tr(:,:,:,jptal,Kmm) = tr(:,:,:,jptal,Kmm) * alkmean / zalksumn 433 428 434 429 IF(lwp) WRITE(numout,*) ' PO4N mean : ', zpo4sumn 435 tr n(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn430 tr(:,:,:,jppo4,Kmm) = tr(:,:,:,jppo4,Kmm) * po4mean / zpo4sumn 436 431 437 432 IF(lwp) WRITE(numout,*) ' NO3N mean : ', zno3sumn 438 tr n(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn433 tr(:,:,:,jpno3,Kmm) = tr(:,:,:,jpno3,Kmm) * no3mean / zno3sumn 439 434 440 435 IF(lwp) WRITE(numout,*) ' SiO3N mean : ', zsilsumn 441 tr n(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn )436 tr(:,:,:,jpsil,Kmm) = MIN( 400.e-6,tr(:,:,:,jpsil,Kmm) * silmean / zsilsumn ) 442 437 ! 443 438 ! 444 439 IF( .NOT. ln_top_euler ) THEN 445 zalksumb = glob_sum( 'p4zsms', tr b(:,:,:,jptal) * cvol(:,:,:) ) * zarea446 zpo4sumb = glob_sum( 'p4zsms', tr b(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r447 zno3sumb = glob_sum( 'p4zsms', tr b(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3448 zsilsumb = glob_sum( 'p4zsms', tr b(:,:,:,jpsil) * cvol(:,:,:) ) * zarea440 zalksumb = glob_sum( 'p4zsms', tr(:,:,:,jptal,Kbb) * cvol(:,:,:) ) * zarea 441 zpo4sumb = glob_sum( 'p4zsms', tr(:,:,:,jppo4,Kbb) * cvol(:,:,:) ) * zarea * po4r 442 zno3sumb = glob_sum( 'p4zsms', tr(:,:,:,jpno3,Kbb) * cvol(:,:,:) ) * zarea * rno3 443 zsilsumb = glob_sum( 'p4zsms', tr(:,:,:,jpsil,Kbb) * cvol(:,:,:) ) * zarea 449 444 450 445 IF(lwp) WRITE(numout,*) ' ' 451 446 IF(lwp) WRITE(numout,*) ' TALKB mean : ', zalksumb 452 tr b(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb447 tr(:,:,:,jptal,Kbb) = tr(:,:,:,jptal,Kbb) * alkmean / zalksumb 453 448 454 449 IF(lwp) WRITE(numout,*) ' PO4B mean : ', zpo4sumb 455 tr b(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb450 tr(:,:,:,jppo4,Kbb) = tr(:,:,:,jppo4,Kbb) * po4mean / zpo4sumb 456 451 457 452 IF(lwp) WRITE(numout,*) ' NO3B mean : ', zno3sumb 458 tr b(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb453 tr(:,:,:,jpno3,Kbb) = tr(:,:,:,jpno3,Kbb) * no3mean / zno3sumb 459 454 460 455 IF(lwp) WRITE(numout,*) ' SiO3B mean : ', zsilsumb 461 tr b(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb )456 tr(:,:,:,jpsil,Kbb) = MIN( 400.e-6,tr(:,:,:,jpsil,Kbb) * silmean / zsilsumb ) 462 457 ENDIF 463 458 ENDIF … … 468 463 469 464 470 SUBROUTINE p4z_chk_mass( kt )465 SUBROUTINE p4z_chk_mass( kt, Kmm ) 471 466 !!---------------------------------------------------------------------- 472 467 !! *** ROUTINE p4z_chk_mass *** … … 476 471 !!--------------------------------------------------------------------- 477 472 INTEGER, INTENT( in ) :: kt ! ocean time-step index 473 INTEGER, INTENT( in ) :: Kmm ! time level indices 478 474 REAL(wp) :: zrdenittot, zsdenittot, znitrpottot 479 475 CHARACTER(LEN=100) :: cltxt … … 499 495 ! Compute the budget of NO3, ALK, Si, Fer 500 496 IF( ln_p4z ) THEN 501 zwork(:,:,:) = tr n(:,:,:,jpno3) + trn(:,:,:,jpnh4) &502 & + tr n(:,:,:,jpphy) + trn(:,:,:,jpdia) &503 & + tr n(:,:,:,jppoc) + trn(:,:,:,jpgoc) + trn(:,:,:,jpdoc) &504 & + tr n(:,:,:,jpzoo) + trn(:,:,:,jpmes)497 zwork(:,:,:) = tr(:,:,:,jpno3,Kmm) + tr(:,:,:,jpnh4,Kmm) & 498 & + tr(:,:,:,jpphy,Kmm) + tr(:,:,:,jpdia,Kmm) & 499 & + tr(:,:,:,jppoc,Kmm) + tr(:,:,:,jpgoc,Kmm) + tr(:,:,:,jpdoc,Kmm) & 500 & + tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) 505 501 ELSE 506 zwork(:,:,:) = tr n(:,:,:,jpno3) + trn(:,:,:,jpnh4) + trn(:,:,:,jpnph) &507 & + tr n(:,:,:,jpndi) + trn(:,:,:,jpnpi) &508 & + tr n(:,:,:,jppon) + trn(:,:,:,jpgon) + trn(:,:,:,jpdon) &509 & + ( tr n(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * no3rat3502 zwork(:,:,:) = tr(:,:,:,jpno3,Kmm) + tr(:,:,:,jpnh4,Kmm) + tr(:,:,:,jpnph,Kmm) & 503 & + tr(:,:,:,jpndi,Kmm) + tr(:,:,:,jpnpi,Kmm) & 504 & + tr(:,:,:,jppon,Kmm) + tr(:,:,:,jpgon,Kmm) + tr(:,:,:,jpdon,Kmm) & 505 & + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * no3rat3 510 506 ENDIF 511 507 ! … … 517 513 IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 518 514 IF( ln_p4z ) THEN 519 zwork(:,:,:) = tr n(:,:,:,jppo4) &520 & + tr n(:,:,:,jpphy) + trn(:,:,:,jpdia) &521 & + tr n(:,:,:,jppoc) + trn(:,:,:,jpgoc) + trn(:,:,:,jpdoc) &522 & + tr n(:,:,:,jpzoo) + trn(:,:,:,jpmes)515 zwork(:,:,:) = tr(:,:,:,jppo4,Kmm) & 516 & + tr(:,:,:,jpphy,Kmm) + tr(:,:,:,jpdia,Kmm) & 517 & + tr(:,:,:,jppoc,Kmm) + tr(:,:,:,jpgoc,Kmm) + tr(:,:,:,jpdoc,Kmm) & 518 & + tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) 523 519 ELSE 524 zwork(:,:,:) = tr n(:,:,:,jppo4) + trn(:,:,:,jppph) &525 & + tr n(:,:,:,jppdi) + trn(:,:,:,jpppi) &526 & + tr n(:,:,:,jppop) + trn(:,:,:,jpgop) + trn(:,:,:,jpdop) &527 & + ( tr n(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * po4rat3520 zwork(:,:,:) = tr(:,:,:,jppo4,Kmm) + tr(:,:,:,jppph,Kmm) & 521 & + tr(:,:,:,jppdi,Kmm) + tr(:,:,:,jpppi,Kmm) & 522 & + tr(:,:,:,jppop,Kmm) + tr(:,:,:,jpgop,Kmm) + tr(:,:,:,jpdop,Kmm) & 523 & + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * po4rat3 528 524 ENDIF 529 525 ! … … 534 530 ! 535 531 IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 536 zwork(:,:,:) = tr n(:,:,:,jpsil) + trn(:,:,:,jpgsi) + trn(:,:,:,jpdsi)532 zwork(:,:,:) = tr(:,:,:,jpsil,Kmm) + tr(:,:,:,jpgsi,Kmm) + tr(:,:,:,jpdsi,Kmm) 537 533 ! 538 534 silbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) ) … … 542 538 ! 543 539 IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 544 zwork(:,:,:) = tr n(:,:,:,jpno3) * rno3 + trn(:,:,:,jptal) + trn(:,:,:,jpcal) * 2.540 zwork(:,:,:) = tr(:,:,:,jpno3,Kmm) * rno3 + tr(:,:,:,jptal,Kmm) + tr(:,:,:,jpcal,Kmm) * 2. 545 541 ! 546 542 alkbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) ) ! … … 550 546 ! 551 547 IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 552 zwork(:,:,:) = tr n(:,:,:,jpfer) + trn(:,:,:,jpnfe) + trn(:,:,:,jpdfe) &553 & + tr n(:,:,:,jpbfe) + trn(:,:,:,jpsfe) &554 & + ( tr n(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * ferat3548 zwork(:,:,:) = tr(:,:,:,jpfer,Kmm) + tr(:,:,:,jpnfe,Kmm) + tr(:,:,:,jpdfe,Kmm) & 549 & + tr(:,:,:,jpbfe,Kmm) + tr(:,:,:,jpsfe,Kmm) & 550 & + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * ferat3 555 551 ! 556 552 ferbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) ) -
NEMO/trunk/src/TOP/PISCES/P4Z/p5zlim.F90
r12277 r12377 91 91 REAL(wp) :: xcoef2 = 1.21E-5 * 14. / 55.85 / 7.625 * 0.5 * 1.5 92 92 REAL(wp) :: xcoef3 = 1.15E-4 * 14. / 55.85 / 7.625 * 0.5 93 !! * Substitutions 94 # include "do_loop_substitute.h90" 93 95 !!---------------------------------------------------------------------- 94 96 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 99 101 CONTAINS 100 102 101 SUBROUTINE p5z_lim( kt, knt )103 SUBROUTINE p5z_lim( kt, knt, Kbb, Kmm ) 102 104 !!--------------------------------------------------------------------- 103 105 !! *** ROUTINE p5z_lim *** … … 110 112 ! 111 113 INTEGER, INTENT(in) :: kt, knt 114 INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices 112 115 ! 113 116 INTEGER :: ji, jj, jk … … 128 131 zratchl = 6.0 129 132 ! 130 DO jk = 1, jpkm1 131 DO jj = 1, jpj 132 DO ji = 1, jpi 133 ! 134 ! Tuning of the iron concentration to a minimum level that is set to the detection limit 135 !------------------------------------- 136 zno3 = trb(ji,jj,jk,jpno3) / 40.e-6 137 zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 ) 138 zferlim = MIN( zferlim, 7e-11 ) 139 trb(ji,jj,jk,jpfer) = MAX( trb(ji,jj,jk,jpfer), zferlim ) 140 141 ! Computation of the mean relative size of each community 142 ! ------------------------------------------------------- 143 z1_trnphy = 1. / ( trb(ji,jj,jk,jpphy) + rtrn ) 144 z1_trnpic = 1. / ( trb(ji,jj,jk,jppic) + rtrn ) 145 z1_trndia = 1. / ( trb(ji,jj,jk,jpdia) + rtrn ) 146 znanochl = trb(ji,jj,jk,jpnch) * z1_trnphy 147 zpicochl = trb(ji,jj,jk,jppch) * z1_trnpic 148 zdiatchl = trb(ji,jj,jk,jpdch) * z1_trndia 149 150 ! Computation of a variable Ks for iron on diatoms taking into account 151 ! that increasing biomass is made of generally bigger cells 152 !------------------------------------------------ 153 zsized = sized(ji,jj,jk)**0.81 154 zconcdfe = concdfer * zsized 155 zconc1d = concdno3 * zsized 156 zconc1dnh4 = concdnh4 * zsized 157 zconc0dpo4 = concdpo4 * zsized 158 159 zsizep = 1. 160 zconcpfe = concpfer * zsizep 161 zconc0p = concpno3 * zsizep 162 zconc0pnh4 = concpnh4 * zsizep 163 zconc0ppo4 = concppo4 * zsizep 164 165 zsizen = 1. 166 zconcnfe = concnfer * zsizen 167 zconc0n = concnno3 * zsizen 168 zconc0nnh4 = concnnh4 * zsizen 169 zconc0npo4 = concnpo4 * zsizen 170 171 ! Allometric variations of the minimum and maximum quotas 172 ! From Talmy et al. (2014) and Maranon et al. (2013) 173 ! ------------------------------------------------------- 174 xqnnmin(ji,jj,jk) = qnnmin 175 xqnnmax(ji,jj,jk) = qnnmax 176 xqndmin(ji,jj,jk) = qndmin * sized(ji,jj,jk)**(-0.27) 177 xqndmax(ji,jj,jk) = qndmax 178 xqnpmin(ji,jj,jk) = qnpmin 179 xqnpmax(ji,jj,jk) = qnpmax 180 181 ! Computation of the optimal allocation parameters 182 ! Based on the different papers by Pahlow et al., and Smith et al. 183 ! ----------------------------------------------------------------- 184 znutlim = MAX( trb(ji,jj,jk,jpnh4) / zconc0nnh4, & 185 & trb(ji,jj,jk,jpno3) / zconc0n) 186 fanano = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 187 znutlim = trb(ji,jj,jk,jppo4) / zconc0npo4 188 fananop = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 189 znutlim = biron(ji,jj,jk) / zconcnfe 190 fananof = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 191 znutlim = MAX( trb(ji,jj,jk,jpnh4) / zconc0pnh4, & 192 & trb(ji,jj,jk,jpno3) / zconc0p) 193 fapico = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 194 znutlim = trb(ji,jj,jk,jppo4) / zconc0ppo4 195 fapicop = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 196 znutlim = biron(ji,jj,jk) / zconcpfe 197 fapicof = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 198 znutlim = MAX( trb(ji,jj,jk,jpnh4) / zconc1dnh4, & 199 & trb(ji,jj,jk,jpno3) / zconc1d ) 200 fadiat = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 201 znutlim = trb(ji,jj,jk,jppo4) / zconc0dpo4 202 fadiatp = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 203 znutlim = biron(ji,jj,jk) / zconcdfe 204 fadiatf = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 205 ! 206 ! Michaelis-Menten Limitation term for nutrients Small bacteria 207 ! ------------------------------------------------------------- 208 zbactnh4 = trb(ji,jj,jk,jpnh4) / ( concbnh4 + trb(ji,jj,jk,jpnh4) ) 209 zbactno3 = trb(ji,jj,jk,jpno3) / ( concbno3 + trb(ji,jj,jk,jpno3) ) * (1. - zbactnh4) 210 ! 211 zlim1 = zbactno3 + zbactnh4 212 zlim2 = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concbpo4) 213 zlim3 = biron(ji,jj,jk) / ( concbfe + biron(ji,jj,jk) ) 214 zlim4 = trb(ji,jj,jk,jpdoc) / ( xkdoc + trb(ji,jj,jk,jpdoc) ) 215 xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 216 xlimbac (ji,jj,jk) = xlimbacl(ji,jj,jk) * zlim4 217 ! 218 ! Michaelis-Menten Limitation term for nutrients Small flagellates 219 ! ----------------------------------------------- 220 zfalim = (1.-fanano) / fanano 221 xnanonh4(ji,jj,jk) = (1. - fanano) * trb(ji,jj,jk,jpnh4) / ( zfalim * zconc0nnh4 + trb(ji,jj,jk,jpnh4) ) 222 xnanono3(ji,jj,jk) = (1. - fanano) * trb(ji,jj,jk,jpno3) / ( zfalim * zconc0n + trb(ji,jj,jk,jpno3) ) & 223 & * (1. - xnanonh4(ji,jj,jk)) 224 ! 225 zfalim = (1.-fananop) / fananop 226 xnanopo4(ji,jj,jk) = (1. - fananop) * trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zfalim * zconc0npo4 ) 227 xnanodop(ji,jj,jk) = trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdop) + xkdoc ) & 228 & * ( 1.0 - xnanopo4(ji,jj,jk) ) 229 xnanodop(ji,jj,jk) = 0. 230 ! 231 zfalim = (1.-fananof) / fananof 232 xnanofer(ji,jj,jk) = (1. - fananof) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcnfe ) 233 ! 234 zratiof = trb(ji,jj,jk,jpnfe) * z1_trnphy 235 zqfemn = xcoef1 * znanochl + xcoef2 + xcoef3 * xnanono3(ji,jj,jk) 236 ! 237 zration = trb(ji,jj,jk,jpnph) * z1_trnphy 238 zration = MIN(xqnnmax(ji,jj,jk), MAX( 2. * xqnnmin(ji,jj,jk), zration )) 239 fvnuptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqnnmin(ji,jj,jk) / (zration + rtrn) & 240 & * MAX(0., (1. - zratchl * znanochl / 12. ) ) 241 ! 242 zlim1 = max(0., (zration - 2. * xqnnmin(ji,jj,jk) ) & 243 & / (xqnnmax(ji,jj,jk) - 2. * xqnnmin(ji,jj,jk) ) ) * xqnnmax(ji,jj,jk) & 244 & / (zration + rtrn) 245 zlim3 = MAX( 0.,( zratiof - zqfemn ) / qfnopt ) 246 xlimnfe(ji,jj,jk) = MIN( 1., zlim3 ) 247 xlimphy(ji,jj,jk) = MIN( 1., zlim1, zlim3 ) 248 ! 249 ! Michaelis-Menten Limitation term for nutrients picophytoplankton 250 ! ---------------------------------------------------------------- 251 zfalim = (1.-fapico) / fapico 252 xpiconh4(ji,jj,jk) = (1. - fapico) * trb(ji,jj,jk,jpnh4) / ( zfalim * zconc0pnh4 + trb(ji,jj,jk,jpnh4) ) 253 xpicono3(ji,jj,jk) = (1. - fapico) * trb(ji,jj,jk,jpno3) / ( zfalim * zconc0p + trb(ji,jj,jk,jpno3) ) & 254 & * (1. - xpiconh4(ji,jj,jk)) 255 ! 256 zfalim = (1.-fapicop) / fapicop 257 xpicopo4(ji,jj,jk) = (1. - fapicop) * trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zfalim * zconc0ppo4 ) 258 xpicodop(ji,jj,jk) = trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdop) + xkdoc ) & 259 & * ( 1.0 - xpicopo4(ji,jj,jk) ) 260 xpicodop(ji,jj,jk) = 0. 261 ! 262 zfalim = (1.-fapicof) / fapicof 263 xpicofer(ji,jj,jk) = (1. - fapicof) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcpfe ) 264 ! 265 zratiof = trb(ji,jj,jk,jppfe) * z1_trnpic 266 zqfemp = xcoef1 * zpicochl + xcoef2 + xcoef3 * xpicono3(ji,jj,jk) 267 ! 268 zration = trb(ji,jj,jk,jpnpi) * z1_trnpic 269 zration = MIN(xqnpmax(ji,jj,jk), MAX( 2. * xqnpmin(ji,jj,jk), zration )) 270 fvpuptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqnpmin(ji,jj,jk) / (zration + rtrn) & 271 & * MAX(0., (1. - zratchl * zpicochl / 12. ) ) 272 ! 273 zlim1 = max(0., (zration - 2. * xqnpmin(ji,jj,jk) ) & 274 & / (xqnpmax(ji,jj,jk) - 2. * xqnpmin(ji,jj,jk) ) ) * xqnpmax(ji,jj,jk) & 275 & / (zration + rtrn) 276 zlim3 = MAX( 0.,( zratiof - zqfemp ) / qfpopt ) 277 xlimpfe(ji,jj,jk) = MIN( 1., zlim3 ) 278 xlimpic(ji,jj,jk) = MIN( 1., zlim1, zlim3 ) 279 ! 280 ! Michaelis-Menten Limitation term for nutrients Diatoms 281 ! ------------------------------------------------------ 282 zfalim = (1.-fadiat) / fadiat 283 xdiatnh4(ji,jj,jk) = (1. - fadiat) * trb(ji,jj,jk,jpnh4) / ( zfalim * zconc1dnh4 + trb(ji,jj,jk,jpnh4) ) 284 xdiatno3(ji,jj,jk) = (1. - fadiat) * trb(ji,jj,jk,jpno3) / ( zfalim * zconc1d + trb(ji,jj,jk,jpno3) ) & 285 & * (1. - xdiatnh4(ji,jj,jk)) 286 ! 287 zfalim = (1.-fadiatp) / fadiatp 288 xdiatpo4(ji,jj,jk) = (1. - fadiatp) * trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zfalim * zconc0dpo4 ) 289 xdiatdop(ji,jj,jk) = trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdop) + xkdoc ) & 290 & * ( 1.0 - xdiatpo4(ji,jj,jk) ) 291 xdiatdop(ji,jj,jk) = 0. 292 ! 293 zfalim = (1.-fadiatf) / fadiatf 294 xdiatfer(ji,jj,jk) = (1. - fadiatf) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcdfe ) 295 ! 296 zratiof = trb(ji,jj,jk,jpdfe) * z1_trndia 297 zqfemd = xcoef1 * zdiatchl + xcoef2 + xcoef3 * xdiatno3(ji,jj,jk) 298 ! 299 zration = trb(ji,jj,jk,jpndi) * z1_trndia 300 zration = MIN(xqndmax(ji,jj,jk), MAX( 2. * xqndmin(ji,jj,jk), zration )) 301 fvduptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqndmin(ji,jj,jk) / (zration + rtrn) & 302 & * MAX(0., (1. - zratchl * zdiatchl / 12. ) ) 303 ! 304 zlim1 = max(0., (zration - 2. * xqndmin(ji,jj,jk) ) & 305 & / (xqndmax(ji,jj,jk) - 2. * xqndmin(ji,jj,jk) ) ) & 306 & * xqndmax(ji,jj,jk) / (zration + rtrn) 307 zlim3 = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi(ji,jj) ) 308 zlim4 = MAX( 0., ( zratiof - zqfemd ) / qfdopt ) 309 xlimdfe(ji,jj,jk) = MIN( 1., zlim4 ) 310 xlimdia(ji,jj,jk) = MIN( 1., zlim1, zlim3, zlim4 ) 311 xlimsi(ji,jj,jk) = MIN( zlim1, zlim4 ) 312 END DO 313 END DO 314 END DO 133 DO_3D_11_11( 1, jpkm1 ) 134 ! 135 ! Tuning of the iron concentration to a minimum level that is set to the detection limit 136 !------------------------------------- 137 zno3 = tr(ji,jj,jk,jpno3,Kbb) / 40.e-6 138 zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 ) 139 zferlim = MIN( zferlim, 7e-11 ) 140 tr(ji,jj,jk,jpfer,Kbb) = MAX( tr(ji,jj,jk,jpfer,Kbb), zferlim ) 141 142 ! Computation of the mean relative size of each community 143 ! ------------------------------------------------------- 144 z1_trnphy = 1. / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 145 z1_trnpic = 1. / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 146 z1_trndia = 1. / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 147 znanochl = tr(ji,jj,jk,jpnch,Kbb) * z1_trnphy 148 zpicochl = tr(ji,jj,jk,jppch,Kbb) * z1_trnpic 149 zdiatchl = tr(ji,jj,jk,jpdch,Kbb) * z1_trndia 150 151 ! Computation of a variable Ks for iron on diatoms taking into account 152 ! that increasing biomass is made of generally bigger cells 153 !------------------------------------------------ 154 zsized = sized(ji,jj,jk)**0.81 155 zconcdfe = concdfer * zsized 156 zconc1d = concdno3 * zsized 157 zconc1dnh4 = concdnh4 * zsized 158 zconc0dpo4 = concdpo4 * zsized 159 160 zsizep = 1. 161 zconcpfe = concpfer * zsizep 162 zconc0p = concpno3 * zsizep 163 zconc0pnh4 = concpnh4 * zsizep 164 zconc0ppo4 = concppo4 * zsizep 165 166 zsizen = 1. 167 zconcnfe = concnfer * zsizen 168 zconc0n = concnno3 * zsizen 169 zconc0nnh4 = concnnh4 * zsizen 170 zconc0npo4 = concnpo4 * zsizen 171 172 ! Allometric variations of the minimum and maximum quotas 173 ! From Talmy et al. (2014) and Maranon et al. (2013) 174 ! ------------------------------------------------------- 175 xqnnmin(ji,jj,jk) = qnnmin 176 xqnnmax(ji,jj,jk) = qnnmax 177 xqndmin(ji,jj,jk) = qndmin * sized(ji,jj,jk)**(-0.27) 178 xqndmax(ji,jj,jk) = qndmax 179 xqnpmin(ji,jj,jk) = qnpmin 180 xqnpmax(ji,jj,jk) = qnpmax 181 182 ! Computation of the optimal allocation parameters 183 ! Based on the different papers by Pahlow et al., and Smith et al. 184 ! ----------------------------------------------------------------- 185 znutlim = MAX( tr(ji,jj,jk,jpnh4,Kbb) / zconc0nnh4, & 186 & tr(ji,jj,jk,jpno3,Kbb) / zconc0n) 187 fanano = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 188 znutlim = tr(ji,jj,jk,jppo4,Kbb) / zconc0npo4 189 fananop = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 190 znutlim = biron(ji,jj,jk) / zconcnfe 191 fananof = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 192 znutlim = MAX( tr(ji,jj,jk,jpnh4,Kbb) / zconc0pnh4, & 193 & tr(ji,jj,jk,jpno3,Kbb) / zconc0p) 194 fapico = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 195 znutlim = tr(ji,jj,jk,jppo4,Kbb) / zconc0ppo4 196 fapicop = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 197 znutlim = biron(ji,jj,jk) / zconcpfe 198 fapicof = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 199 znutlim = MAX( tr(ji,jj,jk,jpnh4,Kbb) / zconc1dnh4, & 200 & tr(ji,jj,jk,jpno3,Kbb) / zconc1d ) 201 fadiat = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 202 znutlim = tr(ji,jj,jk,jppo4,Kbb) / zconc0dpo4 203 fadiatp = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 204 znutlim = biron(ji,jj,jk) / zconcdfe 205 fadiatf = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 206 ! 207 ! Michaelis-Menten Limitation term for nutrients Small bacteria 208 ! ------------------------------------------------------------- 209 zbactnh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concbnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 210 zbactno3 = tr(ji,jj,jk,jpno3,Kbb) / ( concbno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - zbactnh4) 211 ! 212 zlim1 = zbactno3 + zbactnh4 213 zlim2 = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concbpo4) 214 zlim3 = biron(ji,jj,jk) / ( concbfe + biron(ji,jj,jk) ) 215 zlim4 = tr(ji,jj,jk,jpdoc,Kbb) / ( xkdoc + tr(ji,jj,jk,jpdoc,Kbb) ) 216 xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 217 xlimbac (ji,jj,jk) = xlimbacl(ji,jj,jk) * zlim4 218 ! 219 ! Michaelis-Menten Limitation term for nutrients Small flagellates 220 ! ----------------------------------------------- 221 zfalim = (1.-fanano) / fanano 222 xnanonh4(ji,jj,jk) = (1. - fanano) * tr(ji,jj,jk,jpnh4,Kbb) / ( zfalim * zconc0nnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 223 xnanono3(ji,jj,jk) = (1. - fanano) * tr(ji,jj,jk,jpno3,Kbb) / ( zfalim * zconc0n + tr(ji,jj,jk,jpno3,Kbb) ) & 224 & * (1. - xnanonh4(ji,jj,jk)) 225 ! 226 zfalim = (1.-fananop) / fananop 227 xnanopo4(ji,jj,jk) = (1. - fananop) * tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zfalim * zconc0npo4 ) 228 xnanodop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdop,Kbb) + xkdoc ) & 229 & * ( 1.0 - xnanopo4(ji,jj,jk) ) 230 xnanodop(ji,jj,jk) = 0. 231 ! 232 zfalim = (1.-fananof) / fananof 233 xnanofer(ji,jj,jk) = (1. - fananof) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcnfe ) 234 ! 235 zratiof = tr(ji,jj,jk,jpnfe,Kbb) * z1_trnphy 236 zqfemn = xcoef1 * znanochl + xcoef2 + xcoef3 * xnanono3(ji,jj,jk) 237 ! 238 zration = tr(ji,jj,jk,jpnph,Kbb) * z1_trnphy 239 zration = MIN(xqnnmax(ji,jj,jk), MAX( 2. * xqnnmin(ji,jj,jk), zration )) 240 fvnuptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqnnmin(ji,jj,jk) / (zration + rtrn) & 241 & * MAX(0., (1. - zratchl * znanochl / 12. ) ) 242 ! 243 zlim1 = max(0., (zration - 2. * xqnnmin(ji,jj,jk) ) & 244 & / (xqnnmax(ji,jj,jk) - 2. * xqnnmin(ji,jj,jk) ) ) * xqnnmax(ji,jj,jk) & 245 & / (zration + rtrn) 246 zlim3 = MAX( 0.,( zratiof - zqfemn ) / qfnopt ) 247 xlimnfe(ji,jj,jk) = MIN( 1., zlim3 ) 248 xlimphy(ji,jj,jk) = MIN( 1., zlim1, zlim3 ) 249 ! 250 ! Michaelis-Menten Limitation term for nutrients picophytoplankton 251 ! ---------------------------------------------------------------- 252 zfalim = (1.-fapico) / fapico 253 xpiconh4(ji,jj,jk) = (1. - fapico) * tr(ji,jj,jk,jpnh4,Kbb) / ( zfalim * zconc0pnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 254 xpicono3(ji,jj,jk) = (1. - fapico) * tr(ji,jj,jk,jpno3,Kbb) / ( zfalim * zconc0p + tr(ji,jj,jk,jpno3,Kbb) ) & 255 & * (1. - xpiconh4(ji,jj,jk)) 256 ! 257 zfalim = (1.-fapicop) / fapicop 258 xpicopo4(ji,jj,jk) = (1. - fapicop) * tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zfalim * zconc0ppo4 ) 259 xpicodop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdop,Kbb) + xkdoc ) & 260 & * ( 1.0 - xpicopo4(ji,jj,jk) ) 261 xpicodop(ji,jj,jk) = 0. 262 ! 263 zfalim = (1.-fapicof) / fapicof 264 xpicofer(ji,jj,jk) = (1. - fapicof) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcpfe ) 265 ! 266 zratiof = tr(ji,jj,jk,jppfe,Kbb) * z1_trnpic 267 zqfemp = xcoef1 * zpicochl + xcoef2 + xcoef3 * xpicono3(ji,jj,jk) 268 ! 269 zration = tr(ji,jj,jk,jpnpi,Kbb) * z1_trnpic 270 zration = MIN(xqnpmax(ji,jj,jk), MAX( 2. * xqnpmin(ji,jj,jk), zration )) 271 fvpuptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqnpmin(ji,jj,jk) / (zration + rtrn) & 272 & * MAX(0., (1. - zratchl * zpicochl / 12. ) ) 273 ! 274 zlim1 = max(0., (zration - 2. * xqnpmin(ji,jj,jk) ) & 275 & / (xqnpmax(ji,jj,jk) - 2. * xqnpmin(ji,jj,jk) ) ) * xqnpmax(ji,jj,jk) & 276 & / (zration + rtrn) 277 zlim3 = MAX( 0.,( zratiof - zqfemp ) / qfpopt ) 278 xlimpfe(ji,jj,jk) = MIN( 1., zlim3 ) 279 xlimpic(ji,jj,jk) = MIN( 1., zlim1, zlim3 ) 280 ! 281 ! Michaelis-Menten Limitation term for nutrients Diatoms 282 ! ------------------------------------------------------ 283 zfalim = (1.-fadiat) / fadiat 284 xdiatnh4(ji,jj,jk) = (1. - fadiat) * tr(ji,jj,jk,jpnh4,Kbb) / ( zfalim * zconc1dnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 285 xdiatno3(ji,jj,jk) = (1. - fadiat) * tr(ji,jj,jk,jpno3,Kbb) / ( zfalim * zconc1d + tr(ji,jj,jk,jpno3,Kbb) ) & 286 & * (1. - xdiatnh4(ji,jj,jk)) 287 ! 288 zfalim = (1.-fadiatp) / fadiatp 289 xdiatpo4(ji,jj,jk) = (1. - fadiatp) * tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zfalim * zconc0dpo4 ) 290 xdiatdop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdop,Kbb) + xkdoc ) & 291 & * ( 1.0 - xdiatpo4(ji,jj,jk) ) 292 xdiatdop(ji,jj,jk) = 0. 293 ! 294 zfalim = (1.-fadiatf) / fadiatf 295 xdiatfer(ji,jj,jk) = (1. - fadiatf) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcdfe ) 296 ! 297 zratiof = tr(ji,jj,jk,jpdfe,Kbb) * z1_trndia 298 zqfemd = xcoef1 * zdiatchl + xcoef2 + xcoef3 * xdiatno3(ji,jj,jk) 299 ! 300 zration = tr(ji,jj,jk,jpndi,Kbb) * z1_trndia 301 zration = MIN(xqndmax(ji,jj,jk), MAX( 2. * xqndmin(ji,jj,jk), zration )) 302 fvduptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqndmin(ji,jj,jk) / (zration + rtrn) & 303 & * MAX(0., (1. - zratchl * zdiatchl / 12. ) ) 304 ! 305 zlim1 = max(0., (zration - 2. * xqndmin(ji,jj,jk) ) & 306 & / (xqndmax(ji,jj,jk) - 2. * xqndmin(ji,jj,jk) ) ) & 307 & * xqndmax(ji,jj,jk) / (zration + rtrn) 308 zlim3 = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi(ji,jj) ) 309 zlim4 = MAX( 0., ( zratiof - zqfemd ) / qfdopt ) 310 xlimdfe(ji,jj,jk) = MIN( 1., zlim4 ) 311 xlimdia(ji,jj,jk) = MIN( 1., zlim1, zlim3, zlim4 ) 312 xlimsi(ji,jj,jk) = MIN( zlim1, zlim4 ) 313 END_3D 315 314 ! 316 315 ! Compute the phosphorus quota values. It is based on Litchmann et al., 2004 and Daines et al, 2013. … … 319 318 ! phytoplankton (see Daines et al., 2013). 320 319 ! -------------------------------------------------------------------------------------------------- 321 DO jk = 1, jpkm1 322 DO jj = 1, jpj 323 DO ji = 1, jpi 324 ! Size estimation of nanophytoplankton 325 ! ------------------------------------ 326 zfvn = 2. * fvnuptk(ji,jj,jk) 327 sizen(ji,jj,jk) = MAX(1., MIN(xsizern, 1.0 / ( MAX(rtrn, zfvn) ) ) ) 328 329 ! N/P ratio of nanophytoplankton 330 ! ------------------------------ 331 zfuptk = 0.23 * zfvn 332 zrpho = 2.24 * trb(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpnph) * rno3 * 15. + rtrn ) 333 zrass = 1. - 0.2 - zrpho - zfuptk 334 xqpnmax(ji,jj,jk) = ( zfuptk + zrpho ) * 0.0128 * 16. + zrass * 1./ 7.2 * 16. 335 xqpnmax(ji,jj,jk) = xqpnmax(ji,jj,jk) * trb(ji,jj,jk,jpnph) / ( trb(ji,jj,jk,jpphy) + rtrn ) + 0.13 336 xqpnmin(ji,jj,jk) = 0.13 + 0.23 * 0.0128 * 16. 337 338 ! Size estimation of picophytoplankton 339 ! ------------------------------------ 340 zfvn = 2. * fvpuptk(ji,jj,jk) 341 sizep(ji,jj,jk) = MAX(1., MIN(xsizerp, 1.0 / ( MAX(rtrn, zfvn) ) ) ) 342 343 ! N/P ratio of picophytoplankton 344 ! ------------------------------ 345 zfuptk = 0.35 * zfvn 346 zrpho = 2.24 * trb(ji,jj,jk,jppch) / ( trb(ji,jj,jk,jpnpi) * rno3 * 15. + rtrn ) 347 zrass = 1. - 0.4 - zrpho - zfuptk 348 xqppmax(ji,jj,jk) = (zrpho + zfuptk) * 0.0128 * 16. + zrass * 1./ 9. * 16. 349 xqppmax(ji,jj,jk) = xqppmax(ji,jj,jk) * trb(ji,jj,jk,jpnpi) / ( trb(ji,jj,jk,jppic) + rtrn ) + 0.13 350 xqppmin(ji,jj,jk) = 0.13 351 352 ! Size estimation of diatoms 353 ! -------------------------- 354 zfvn = 2. * fvduptk(ji,jj,jk) 355 sized(ji,jj,jk) = MAX(1., MIN(xsizerd, 1.0 / ( MAX(rtrn, zfvn) ) ) ) 356 zcoef = trb(ji,jj,jk,jpdia) - MIN(xsizedia, trb(ji,jj,jk,jpdia) ) 357 sized(ji,jj,jk) = 1. + xsizerd * zcoef *1E6 / ( 1. + zcoef * 1E6 ) 358 359 ! N/P ratio of diatoms 360 ! -------------------- 361 zfuptk = 0.2 * zfvn 362 zrpho = 2.24 * trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpndi) * rno3 * 15. + rtrn ) 363 zrass = 1. - 0.2 - zrpho - zfuptk 364 xqpdmax(ji,jj,jk) = ( zfuptk + zrpho ) * 0.0128 * 16. + zrass * 1./ 7.2 * 16. 365 xqpdmax(ji,jj,jk) = xqpdmax(ji,jj,jk) * trb(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn ) + 0.13 366 xqpdmin(ji,jj,jk) = 0.13 + 0.2 * 0.0128 * 16. 367 368 END DO 369 END DO 370 END DO 320 DO_3D_11_11( 1, jpkm1 ) 321 ! Size estimation of nanophytoplankton 322 ! ------------------------------------ 323 zfvn = 2. * fvnuptk(ji,jj,jk) 324 sizen(ji,jj,jk) = MAX(1., MIN(xsizern, 1.0 / ( MAX(rtrn, zfvn) ) ) ) 325 326 ! N/P ratio of nanophytoplankton 327 ! ------------------------------ 328 zfuptk = 0.23 * zfvn 329 zrpho = 2.24 * tr(ji,jj,jk,jpnch,Kbb) / ( tr(ji,jj,jk,jpnph,Kbb) * rno3 * 15. + rtrn ) 330 zrass = 1. - 0.2 - zrpho - zfuptk 331 xqpnmax(ji,jj,jk) = ( zfuptk + zrpho ) * 0.0128 * 16. + zrass * 1./ 7.2 * 16. 332 xqpnmax(ji,jj,jk) = xqpnmax(ji,jj,jk) * tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) + 0.13 333 xqpnmin(ji,jj,jk) = 0.13 + 0.23 * 0.0128 * 16. 334 335 ! Size estimation of picophytoplankton 336 ! ------------------------------------ 337 zfvn = 2. * fvpuptk(ji,jj,jk) 338 sizep(ji,jj,jk) = MAX(1., MIN(xsizerp, 1.0 / ( MAX(rtrn, zfvn) ) ) ) 339 340 ! N/P ratio of picophytoplankton 341 ! ------------------------------ 342 zfuptk = 0.35 * zfvn 343 zrpho = 2.24 * tr(ji,jj,jk,jppch,Kbb) / ( tr(ji,jj,jk,jpnpi,Kbb) * rno3 * 15. + rtrn ) 344 zrass = 1. - 0.4 - zrpho - zfuptk 345 xqppmax(ji,jj,jk) = (zrpho + zfuptk) * 0.0128 * 16. + zrass * 1./ 9. * 16. 346 xqppmax(ji,jj,jk) = xqppmax(ji,jj,jk) * tr(ji,jj,jk,jpnpi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) + 0.13 347 xqppmin(ji,jj,jk) = 0.13 348 349 ! Size estimation of diatoms 350 ! -------------------------- 351 zfvn = 2. * fvduptk(ji,jj,jk) 352 sized(ji,jj,jk) = MAX(1., MIN(xsizerd, 1.0 / ( MAX(rtrn, zfvn) ) ) ) 353 zcoef = tr(ji,jj,jk,jpdia,Kbb) - MIN(xsizedia, tr(ji,jj,jk,jpdia,Kbb) ) 354 sized(ji,jj,jk) = 1. + xsizerd * zcoef *1E6 / ( 1. + zcoef * 1E6 ) 355 356 ! N/P ratio of diatoms 357 ! -------------------- 358 zfuptk = 0.2 * zfvn 359 zrpho = 2.24 * tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpndi,Kbb) * rno3 * 15. + rtrn ) 360 zrass = 1. - 0.2 - zrpho - zfuptk 361 xqpdmax(ji,jj,jk) = ( zfuptk + zrpho ) * 0.0128 * 16. + zrass * 1./ 7.2 * 16. 362 xqpdmax(ji,jj,jk) = xqpdmax(ji,jj,jk) * tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) + 0.13 363 xqpdmin(ji,jj,jk) = 0.13 + 0.2 * 0.0128 * 16. 364 365 END_3D 371 366 372 367 ! Compute the fraction of nanophytoplankton that is made of calcifiers 373 368 ! -------------------------------------------------------------------- 374 DO jk = 1, jpkm1 375 DO jj = 1, jpj 376 DO ji = 1, jpi 377 zlim1 = trb(ji,jj,jk,jpnh4) / ( trb(ji,jj,jk,jpnh4) + concnnh4 ) + trb(ji,jj,jk,jpno3) & 378 & / ( trb(ji,jj,jk,jpno3) + concnno3 ) * ( 1.0 - trb(ji,jj,jk,jpnh4) & 379 & / ( trb(ji,jj,jk,jpnh4) + concnnh4 ) ) 380 zlim2 = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concnpo4 ) 381 zlim3 = trb(ji,jj,jk,jpfer) / ( trb(ji,jj,jk,jpfer) + 5.E-11 ) 382 ztem1 = MAX( 0., tsn(ji,jj,jk,jp_tem) ) 383 ztem2 = tsn(ji,jj,jk,jp_tem) - 10. 384 zetot1 = MAX( 0., etot(ji,jj,jk) - 1.) / ( 4. + etot(ji,jj,jk) ) * 20. / ( 20. + etot(ji,jj,jk) ) 369 DO_3D_11_11( 1, jpkm1 ) 370 zlim1 = tr(ji,jj,jk,jpnh4,Kbb) / ( tr(ji,jj,jk,jpnh4,Kbb) + concnnh4 ) + tr(ji,jj,jk,jpno3,Kbb) & 371 & / ( tr(ji,jj,jk,jpno3,Kbb) + concnno3 ) * ( 1.0 - tr(ji,jj,jk,jpnh4,Kbb) & 372 & / ( tr(ji,jj,jk,jpnh4,Kbb) + concnnh4 ) ) 373 zlim2 = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concnpo4 ) 374 zlim3 = tr(ji,jj,jk,jpfer,Kbb) / ( tr(ji,jj,jk,jpfer,Kbb) + 5.E-11 ) 375 ztem1 = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) ) 376 ztem2 = ts(ji,jj,jk,jp_tem,Kmm) - 10. 377 zetot1 = MAX( 0., etot(ji,jj,jk) - 1.) / ( 4. + etot(ji,jj,jk) ) * 20. / ( 20. + etot(ji,jj,jk) ) 385 378 386 379 ! xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 ) & 387 xfracal(ji,jj,jk) = caco3r & 388 & * ztem1 / ( 1. + ztem1 ) * MAX( 1., trb(ji,jj,jk,jpphy)*1E6 ) & 389 & * ( 1. + EXP(-ztem2 * ztem2 / 25. ) ) & 390 & * zetot1 * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) ) 391 xfracal(ji,jj,jk) = MAX( 0.02, MIN( 0.8 , xfracal(ji,jj,jk) ) ) 392 END DO 393 END DO 394 END DO 395 ! 396 DO jk = 1, jpkm1 397 DO jj = 1, jpj 398 DO ji = 1, jpi 399 ! denitrification factor computed from O2 levels 400 nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - trb(ji,jj,jk,jpoxy) ) & 401 & / ( oxymin + trb(ji,jj,jk,jpoxy) ) ) 402 nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 403 END DO 404 END DO 405 END DO 380 xfracal(ji,jj,jk) = caco3r & 381 & * ztem1 / ( 1. + ztem1 ) * MAX( 1., tr(ji,jj,jk,jpphy,Kbb)*1E6 ) & 382 & * ( 1. + EXP(-ztem2 * ztem2 / 25. ) ) & 383 & * zetot1 * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) ) 384 xfracal(ji,jj,jk) = MAX( 0.02, MIN( 0.8 , xfracal(ji,jj,jk) ) ) 385 END_3D 386 ! 387 DO_3D_11_11( 1, jpkm1 ) 388 ! denitrification factor computed from O2 levels 389 nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - tr(ji,jj,jk,jpoxy,Kbb) ) & 390 & / ( oxymin + tr(ji,jj,jk,jpoxy,Kbb) ) ) 391 nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 392 END_3D 406 393 ! 407 394 IF( lk_iomput .AND. knt == nrdttrc ) THEN ! save output diagnostics … … 448 435 !!---------------------------------------------------------------------- 449 436 ! 450 REWIND( numnatp_ref )451 437 READ ( numnatp_ref, namp5zlim, IOSTAT = ios, ERR = 901) 452 438 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampislim in reference namelist' ) 453 439 ! 454 REWIND( numnatp_cfg )455 440 READ ( numnatp_cfg, namp5zlim, IOSTAT = ios, ERR = 902 ) 456 441 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampislim in configuration namelist' ) … … 489 474 ENDIF 490 475 491 REWIND( numnatp_ref )492 476 READ ( numnatp_ref, namp5zquota, IOSTAT = ios, ERR = 903) 493 477 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisquota in reference namelist' ) 494 478 ! 495 REWIND( numnatp_cfg )496 479 READ ( numnatp_cfg, namp5zquota, IOSTAT = ios, ERR = 904 ) 497 480 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisquota in configuration namelist' ) -
NEMO/trunk/src/TOP/PISCES/P4Z/p5zmeso.F90
r12276 r12377 51 51 LOGICAL, PUBLIC :: bmetexc2 !: Use of excess carbon for respiration 52 52 53 !! * Substitutions 54 # include "do_loop_substitute.h90" 53 55 !!---------------------------------------------------------------------- 54 56 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 59 61 CONTAINS 60 62 61 SUBROUTINE p5z_meso( kt, knt )63 SUBROUTINE p5z_meso( kt, knt, Kbb, Krhs ) 62 64 !!--------------------------------------------------------------------- 63 65 !! *** ROUTINE p5z_meso *** … … 67 69 !! ** Method : - ??? 68 70 !!--------------------------------------------------------------------- 69 INTEGER, INTENT(in) :: kt, knt ! ocean time step 71 INTEGER, INTENT(in) :: kt, knt ! ocean time step 72 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 70 73 INTEGER :: ji, jj, jk 71 74 REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam, zcompames … … 86 89 CHARACTER (len=25) :: charout 87 90 REAL(wp) :: zrfact2, zmetexcess 88 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing 2, zfezoo2,zz2ligprod91 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo2, zz2ligprod 89 92 90 93 !!--------------------------------------------------------------------- … … 92 95 IF( ln_timing ) CALL timing_start('p5z_meso') 93 96 ! 94 95 97 zmetexcess = 0.0 96 98 IF ( bmetexc2 ) zmetexcess = 1.0 97 99 98 DO jk = 1, jpkm1 99 DO jj = 1, jpj 100 DO ji = 1, jpi 101 zcompam = MAX( ( trb(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 ) 102 zfact = xstep * tgfunc2(ji,jj,jk) * zcompam 103 104 ! Michaelis-Menten mortality rates of mesozooplankton 105 ! --------------------------------------------------- 106 zrespz = resrat2 * zfact * ( trb(ji,jj,jk,jpmes) / ( xkmort + trb(ji,jj,jk,jpmes) ) & 107 & + 3. * nitrfac(ji,jj,jk) ) 108 109 ! Zooplankton mortality. A square function has been selected with 110 ! no real reason except that it seems to be more stable and may mimic predation 111 ! --------------------------------------------------------------- 112 ztortz = mzrat2 * 1.e6 * zfact * trb(ji,jj,jk,jpmes) * (1. - nitrfac(ji,jj,jk)) 113 114 ! Computation of the abundance of the preys 115 ! A threshold can be specified in the namelist 116 ! -------------------------------------------- 117 zcompadi = MAX( ( trb(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 ) 118 zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 ) 119 zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) 120 zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 ) 121 zcompames = MAX( ( trb(ji,jj,jk,jpmes) - xthresh2mes ), 0.e0 ) 122 123 ! Mesozooplankton grazing 124 ! ------------------------ 125 zfood = xpref2d * zcompadi + xpref2z * zcompaz + xpref2n * zcompaph + xpref2c * zcompapoc & 126 & + xpref2m * zcompames 127 zfoodlim = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) ) 128 zdenom = zfoodlim / ( xkgraz2 + zfoodlim ) 129 zgraze2 = grazrat2 * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes) * (1. - nitrfac(ji,jj,jk)) 130 131 ! An active switching parameterization is used here. 132 ! We don't use the KTW parameterization proposed by 133 ! Vallina et al. because it tends to produce to steady biomass 134 ! composition and the variance of Chl is too low as it grazes 135 ! too strongly on winning organisms. Thus, instead of a square 136 ! a 1.5 power value is used which decreases the pressure on the 137 ! most abundant species 138 ! ------------------------------------------------------------ 139 ztmp1 = xpref2n * zcompaph**1.5 140 ztmp2 = xpref2m * zcompames**1.5 141 ztmp3 = xpref2c * zcompapoc**1.5 142 ztmp4 = xpref2d * zcompadi**1.5 143 ztmp5 = xpref2z * zcompaz**1.5 144 ztmptot = ztmp1 + ztmp2 + ztmp3 + ztmp4 + ztmp5 + rtrn 145 ztmp1 = ztmp1 / ztmptot 146 ztmp2 = ztmp2 / ztmptot 147 ztmp3 = ztmp3 / ztmptot 148 ztmp4 = ztmp4 / ztmptot 149 ztmp5 = ztmp5 / ztmptot 150 151 ! Mesozooplankton regular grazing on the different preys 152 ! ------------------------------------------------------ 153 zgrazdc = zgraze2 * ztmp4 * zdenom 154 zgrazdn = zgrazdc * trb(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn) 155 zgrazdp = zgrazdc * trb(ji,jj,jk,jppdi) / ( trb(ji,jj,jk,jpdia) + rtrn) 156 zgrazdf = zgrazdc * trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn) 157 zgrazz = zgraze2 * ztmp5 * zdenom 158 zgrazm = zgraze2 * ztmp2 * zdenom 159 zgraznc = zgraze2 * ztmp1 * zdenom 160 zgraznn = zgraznc * trb(ji,jj,jk,jpnph) / ( trb(ji,jj,jk,jpphy) + rtrn) 161 zgraznp = zgraznc * trb(ji,jj,jk,jppph) / ( trb(ji,jj,jk,jpphy) + rtrn) 162 zgraznf = zgraznc * trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn) 163 zgrazpoc = zgraze2 * ztmp3 * zdenom 164 zgrazpon = zgrazpoc * trb(ji,jj,jk,jppon) / ( trb(ji,jj,jk,jppoc) + rtrn) 165 zgrazpop = zgrazpoc * trb(ji,jj,jk,jppop) / ( trb(ji,jj,jk,jppoc) + rtrn) 166 zgrazpof = zgrazpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn) 167 168 ! Mesozooplankton flux feeding on GOC 169 ! ---------------------------------- 170 zgrazffeg = grazflux * xstep * wsbio4(ji,jj,jk) & 171 & * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes) & 172 & * (1. - nitrfac(ji,jj,jk)) 173 zgrazfffg = zgrazffeg * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn) 174 zgrazffng = zgrazffeg * trb(ji,jj,jk,jpgon) / (trb(ji,jj,jk,jpgoc) + rtrn) 175 zgrazffpg = zgrazffeg * trb(ji,jj,jk,jpgop) / (trb(ji,jj,jk,jpgoc) + rtrn) 176 zgrazffep = grazflux * xstep * wsbio3(ji,jj,jk) & 177 & * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpmes) & 178 & * (1. - nitrfac(ji,jj,jk)) 179 zgrazfffp = zgrazffep * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn) 180 zgrazffnp = zgrazffep * trb(ji,jj,jk,jppon) / (trb(ji,jj,jk,jppoc) + rtrn) 181 zgrazffpp = zgrazffep * trb(ji,jj,jk,jppop) / (trb(ji,jj,jk,jppoc) + rtrn) 182 ! 183 zgraztotc = zgrazdc + zgrazz + zgraznc + zgrazm + zgrazpoc + zgrazffep + zgrazffeg 184 185 ! Compute the proportion of filter feeders 186 ! ---------------------------------------- 187 zproport = (zgrazffep + zgrazffeg)/(rtrn + zgraztotc) 188 189 ! Compute fractionation of aggregates. It is assumed that 190 ! diatoms based aggregates are more prone to fractionation 191 ! since they are more porous (marine snow instead of fecal pellets) 192 ! ---------------------------------------------------------------- 193 zratio = trb(ji,jj,jk,jpgsi) / ( trb(ji,jj,jk,jpgoc) + rtrn ) 194 zratio2 = zratio * zratio 195 zfracc = zproport * grazflux * xstep * wsbio4(ji,jj,jk) & 196 & * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes) & 197 & * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) ) 198 zfracfe = zfracc * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn) 199 zfracn = zfracc * trb(ji,jj,jk,jpgon) / (trb(ji,jj,jk,jpgoc) + rtrn) 200 zfracp = zfracc * trb(ji,jj,jk,jpgop) / (trb(ji,jj,jk,jpgoc) + rtrn) 201 202 zgrazffep = zproport * zgrazffep ; zgrazffeg = zproport * zgrazffeg 203 zgrazfffp = zproport * zgrazfffp ; zgrazfffg = zproport * zgrazfffg 204 zgrazffnp = zproport * zgrazffnp ; zgrazffng = zproport * zgrazffng 205 zgrazffpp = zproport * zgrazffpp ; zgrazffpg = zproport * zgrazffpg 206 207 zgraztotc = zgrazdc + zgrazz + zgraznc + zgrazm + zgrazpoc + zgrazffep + zgrazffeg 208 zgraztotf = zgrazdf + zgraznf + ( zgrazz + zgrazm ) * ferat3 + zgrazpof & 209 & + zgrazfffp + zgrazfffg 210 zgraztotn = zgrazdn + (zgrazm + zgrazz) * no3rat3 + zgraznn + zgrazpon & 211 & + zgrazffnp + zgrazffng 212 zgraztotp = zgrazdp + (zgrazz + zgrazm) * po4rat3 + zgraznp + zgrazpop & 213 & + zgrazffpp + zgrazffpg 214 215 216 ! Total grazing ( grazing by microzoo is already computed in p5zmicro ) 217 zgrazing2(ji,jj,jk) = zgraztotc 218 219 ! Stoichiometruc ratios of the food ingested by zooplanton 220 ! -------------------------------------------------------- 221 zgrasratf = (zgraztotf + rtrn) / ( zgraztotc + rtrn ) 222 zgrasratn = (zgraztotn + rtrn) / ( zgraztotc + rtrn ) 223 zgrasratp = (zgraztotp + rtrn) / ( zgraztotc + rtrn ) 224 225 ! Growth efficiency is made a function of the quality 226 ! and the quantity of the preys 227 ! --------------------------------------------------- 228 zepshert = MIN( 1., zgrasratn/ no3rat3, zgrasratp/ po4rat3, zgrasratf / ferat3) 229 zbeta = MAX(0., (epsher2 - epsher2min) ) 230 zepsherf = epsher2min + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 231 zepsherv = zepsherf * zepshert 232 233 ! Respiration of mesozooplankton 234 ! Excess carbon in the food is used preferentially 235 ! ---------------- ------------------------------ 236 zexcess = zgraztotc * zepsherf * (1.0 - zepshert) * zmetexcess 237 zbasresb = MAX(0., zrespz - zexcess) 238 zbasresi = zexcess + MIN(0., zrespz - zexcess) 239 zrespirc = srespir2 * zepsherv * zgraztotc + zbasresb 240 241 ! When excess carbon is used, the other elements in excess 242 ! are also used proportionally to their abundance 243 ! -------------------------------------------------------- 244 zexcess = ( zgrasratn/ no3rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 245 zbasresn = zbasresi * zexcess * zgrasratn 246 zexcess = ( zgrasratp/ po4rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 247 zbasresp = zbasresi * zexcess * zgrasratp 248 zexcess = ( zgrasratf/ ferat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 249 zbasresf = zbasresi * zexcess * zgrasratf 250 251 ! Voiding of the excessive elements as organic matter 252 ! -------------------------------------------------------- 253 zgradoct = (1. - unass2c - zepsherv) * zgraztotc - zbasresi 254 zgradont = (1. - unass2n) * zgraztotn - zepsherv * no3rat3 * zgraztotc - zbasresn 255 zgradopt = (1. - unass2p) * zgraztotp - zepsherv * po4rat3 * zgraztotc - zbasresp 256 zgrareft = (1. - unass2c) * zgraztotf - zepsherv * ferat3 * zgraztotc - zbasresf 257 ztmp1 = ( 1. - epsher2 - unass2c ) /( 1. - 0.8 * epsher2 ) * ztortz 258 zgradoc = (zgradoct + ztmp1) * ssigma2 259 zgradon = (zgradont + no3rat3 * ztmp1) * ssigma2 260 zgradop = (zgradopt + po4rat3 * ztmp1) * ssigma2 261 zgratmp = 0.2 * epsher2 /( 1. - 0.8 * epsher2 ) * ztortz 262 263 ! Since only semilabile DOM is represented in PISCES 264 ! part of DOM is in fact labile and is then released 265 ! as dissolved inorganic compounds (ssigma2) 266 ! -------------------------------------------------- 267 zgrarem = zgratmp + ( zgradoct + ztmp1 ) * (1.0 - ssigma2) 268 zgraren = no3rat3 * zgratmp + ( zgradont + no3rat3 * ztmp1 ) * (1.0 - ssigma2) 269 zgrarep = po4rat3 * zgratmp + ( zgradopt + po4rat3 * ztmp1 ) * (1.0 - ssigma2) 270 zgraref = zgrareft + ferat3 * ( ztmp1 + zgratmp ) 271 272 ! Defecation as a result of non assimilated products 273 ! -------------------------------------------------- 274 zgrapoc = zgraztotc * unass2c + unass2c / ( 1. - 0.8 * epsher2 ) * ztortz 275 zgrapon = zgraztotn * unass2n + no3rat3 * unass2n / ( 1. - 0.8 * epsher2 ) * ztortz 276 zgrapop = zgraztotp * unass2p + po4rat3 * unass2p / ( 1. - 0.8 * epsher2 ) * ztortz 277 zgrapof = zgraztotf * unass2c + ferat3 * unass2c / ( 1. - 0.8 * epsher2 ) * ztortz 278 279 ! Addition of respiration to the release of inorganic nutrients 280 ! ------------------------------------------------------------- 281 zgrarem = zgrarem + zbasresi + zrespirc 282 zgraren = zgraren + zbasresn + zrespirc * no3rat3 283 zgrarep = zgrarep + zbasresp + zrespirc * po4rat3 284 zgraref = zgraref + zbasresf + zrespirc * ferat3 285 286 ! Update the arrays TRA which contain the biological sources and 287 ! sinks 288 ! -------------------------------------------------------------- 289 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarep 290 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgraren 291 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgradoc 292 ! 293 IF( ln_ligand ) THEN 294 tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zgradoc * ldocz 295 zz2ligprod(ji,jj,jk) = zgradoc * ldocz 296 ENDIF 297 ! 298 tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zgradon 299 tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zgradop 300 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem 301 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgraref 302 zfezoo2(ji,jj,jk) = zgraref 303 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem 304 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgraren 305 tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) + zepsherv * zgraztotc - zrespirc & 306 & - ztortz - zgrazm 307 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazdc 308 tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) - zgrazdn 309 tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) - zgrazdp 310 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazdf 311 tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz 312 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgraznc 313 tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) - zgraznn 314 tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) - zgraznp 315 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf 316 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgraznc * trb(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpphy) + rtrn ) 317 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazdc * trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn ) 318 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazdc * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 319 tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazdc * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 320 321 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc - zgrazffep + zfracc 322 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfracc 323 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep 324 tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) - zgrazpon - zgrazffnp + zfracn 325 tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) - zgrazpop - zgrazffpp + zfracp 326 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zgrazffeg + zgrapoc - zfracc 327 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zgrapoc 328 consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfracc 329 tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) - zgrazffng + zgrapon - zfracn 330 tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) - zgrazffpg + zgrapop - zfracp 331 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof - zgrazfffp + zfracfe 332 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zgrazfffg + zgrapof - zfracfe 333 zfracal = trb(ji,jj,jk,jpcal) / ( trb(ji,jj,jk,jpgoc) + rtrn ) 334 zgrazcal = zgrazffeg * (1. - part2) * zfracal 335 336 ! calcite production 337 ! ------------------ 338 zprcaca = xfracal(ji,jj,jk) * zgraznc 339 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 340 zprcaca = part2 * zprcaca 341 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrazcal - zprcaca 342 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * ( zgrazcal - zprcaca ) 343 tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) - zgrazcal + zprcaca 344 END DO 345 END DO 346 END DO 347 ! 348 IF( lk_iomput .AND. knt == nrdttrc ) THEN 349 CALL iom_put( "PCAL" , prodcal(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) ! Calcite production 350 IF( iom_use("GRAZ2") ) THEN ! Total grazing of phyto by zooplankton 351 zgrazing2(:,:,jpk) = 0._wp ; CALL iom_put( "GRAZ2" , zgrazing2(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) 100 DO_3D_11_11( 1, jpkm1 ) 101 zcompam = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - 1.e-9 ), 0.e0 ) 102 zfact = xstep * tgfunc2(ji,jj,jk) * zcompam 103 104 ! Michaelis-Menten mortality rates of mesozooplankton 105 ! --------------------------------------------------- 106 zrespz = resrat2 * zfact * ( tr(ji,jj,jk,jpmes,Kbb) / ( xkmort + tr(ji,jj,jk,jpmes,Kbb) ) & 107 & + 3. * nitrfac(ji,jj,jk) ) 108 109 ! Zooplankton mortality. A square function has been selected with 110 ! no real reason except that it seems to be more stable and may mimic predation 111 ! --------------------------------------------------------------- 112 ztortz = mzrat2 * 1.e6 * zfact * tr(ji,jj,jk,jpmes,Kbb) * (1. - nitrfac(ji,jj,jk)) 113 114 ! Computation of the abundance of the preys 115 ! A threshold can be specified in the namelist 116 ! -------------------------------------------- 117 zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthresh2dia ), 0.e0 ) 118 zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - xthresh2zoo ), 0.e0 ) 119 zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthresh2phy ), 0.e0 ) 120 zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthresh2poc ), 0.e0 ) 121 zcompames = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - xthresh2mes ), 0.e0 ) 122 123 ! Mesozooplankton grazing 124 ! ------------------------ 125 zfood = xpref2d * zcompadi + xpref2z * zcompaz + xpref2n * zcompaph + xpref2c * zcompapoc & 126 & + xpref2m * zcompames 127 zfoodlim = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) ) 128 zdenom = zfoodlim / ( xkgraz2 + zfoodlim ) 129 zgraze2 = grazrat2 * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpmes,Kbb) * (1. - nitrfac(ji,jj,jk)) 130 131 ! An active switching parameterization is used here. 132 ! We don't use the KTW parameterization proposed by 133 ! Vallina et al. because it tends to produce to steady biomass 134 ! composition and the variance of Chl is too low as it grazes 135 ! too strongly on winning organisms. Thus, instead of a square 136 ! a 1.5 power value is used which decreases the pressure on the 137 ! most abundant species 138 ! ------------------------------------------------------------ 139 ztmp1 = xpref2n * zcompaph**1.5 140 ztmp2 = xpref2m * zcompames**1.5 141 ztmp3 = xpref2c * zcompapoc**1.5 142 ztmp4 = xpref2d * zcompadi**1.5 143 ztmp5 = xpref2z * zcompaz**1.5 144 ztmptot = ztmp1 + ztmp2 + ztmp3 + ztmp4 + ztmp5 + rtrn 145 ztmp1 = ztmp1 / ztmptot 146 ztmp2 = ztmp2 / ztmptot 147 ztmp3 = ztmp3 / ztmptot 148 ztmp4 = ztmp4 / ztmptot 149 ztmp5 = ztmp5 / ztmptot 150 151 ! Mesozooplankton regular grazing on the different preys 152 ! ------------------------------------------------------ 153 zgrazdc = zgraze2 * ztmp4 * zdenom 154 zgrazdn = zgrazdc * tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn) 155 zgrazdp = zgrazdc * tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn) 156 zgrazdf = zgrazdc * tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn) 157 zgrazz = zgraze2 * ztmp5 * zdenom 158 zgrazm = zgraze2 * ztmp2 * zdenom 159 zgraznc = zgraze2 * ztmp1 * zdenom 160 zgraznn = zgraznc * tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn) 161 zgraznp = zgraznc * tr(ji,jj,jk,jppph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn) 162 zgraznf = zgraznc * tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn) 163 zgrazpoc = zgraze2 * ztmp3 * zdenom 164 zgrazpon = zgrazpoc * tr(ji,jj,jk,jppon,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 165 zgrazpop = zgrazpoc * tr(ji,jj,jk,jppop,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 166 zgrazpof = zgrazpoc * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 167 168 ! Mesozooplankton flux feeding on GOC 169 ! ---------------------------------- 170 zgrazffeg = grazflux * xstep * wsbio4(ji,jj,jk) & 171 & * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 172 & * (1. - nitrfac(ji,jj,jk)) 173 zgrazfffg = zgrazffeg * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 174 zgrazffng = zgrazffeg * tr(ji,jj,jk,jpgon,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 175 zgrazffpg = zgrazffeg * tr(ji,jj,jk,jpgop,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 176 zgrazffep = grazflux * xstep * wsbio3(ji,jj,jk) & 177 & * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 178 & * (1. - nitrfac(ji,jj,jk)) 179 zgrazfffp = zgrazffep * tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 180 zgrazffnp = zgrazffep * tr(ji,jj,jk,jppon,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 181 zgrazffpp = zgrazffep * tr(ji,jj,jk,jppop,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 182 ! 183 zgraztotc = zgrazdc + zgrazz + zgraznc + zgrazm + zgrazpoc + zgrazffep + zgrazffeg 184 185 ! Compute the proportion of filter feeders 186 ! ---------------------------------------- 187 zproport = (zgrazffep + zgrazffeg)/(rtrn + zgraztotc) 188 189 ! Compute fractionation of aggregates. It is assumed that 190 ! diatoms based aggregates are more prone to fractionation 191 ! since they are more porous (marine snow instead of fecal pellets) 192 ! ---------------------------------------------------------------- 193 zratio = tr(ji,jj,jk,jpgsi,Kbb) / ( tr(ji,jj,jk,jpgoc,Kbb) + rtrn ) 194 zratio2 = zratio * zratio 195 zfracc = zproport * grazflux * xstep * wsbio4(ji,jj,jk) & 196 & * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 197 & * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) ) 198 zfracfe = zfracc * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 199 zfracn = zfracc * tr(ji,jj,jk,jpgon,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 200 zfracp = zfracc * tr(ji,jj,jk,jpgop,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 201 202 zgrazffep = zproport * zgrazffep ; zgrazffeg = zproport * zgrazffeg 203 zgrazfffp = zproport * zgrazfffp ; zgrazfffg = zproport * zgrazfffg 204 zgrazffnp = zproport * zgrazffnp ; zgrazffng = zproport * zgrazffng 205 zgrazffpp = zproport * zgrazffpp ; zgrazffpg = zproport * zgrazffpg 206 207 zgraztotc = zgrazdc + zgrazz + zgraznc + zgrazm + zgrazpoc + zgrazffep + zgrazffeg 208 zgraztotf = zgrazdf + zgraznf + ( zgrazz + zgrazm ) * ferat3 + zgrazpof & 209 & + zgrazfffp + zgrazfffg 210 zgraztotn = zgrazdn + (zgrazm + zgrazz) * no3rat3 + zgraznn + zgrazpon & 211 & + zgrazffnp + zgrazffng 212 zgraztotp = zgrazdp + (zgrazz + zgrazm) * po4rat3 + zgraznp + zgrazpop & 213 & + zgrazffpp + zgrazffpg 214 215 216 ! Total grazing ( grazing by microzoo is already computed in p5zmicro ) 217 zgrazing(ji,jj,jk) = zgraztotc 218 219 ! Stoichiometruc ratios of the food ingested by zooplanton 220 ! -------------------------------------------------------- 221 zgrasratf = (zgraztotf + rtrn) / ( zgraztotc + rtrn ) 222 zgrasratn = (zgraztotn + rtrn) / ( zgraztotc + rtrn ) 223 zgrasratp = (zgraztotp + rtrn) / ( zgraztotc + rtrn ) 224 225 ! Growth efficiency is made a function of the quality 226 ! and the quantity of the preys 227 ! --------------------------------------------------- 228 zepshert = MIN( 1., zgrasratn/ no3rat3, zgrasratp/ po4rat3, zgrasratf / ferat3) 229 zbeta = MAX(0., (epsher2 - epsher2min) ) 230 zepsherf = epsher2min + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 231 zepsherv = zepsherf * zepshert 232 233 ! Respiration of mesozooplankton 234 ! Excess carbon in the food is used preferentially 235 ! ---------------- ------------------------------ 236 zexcess = zgraztotc * zepsherf * (1.0 - zepshert) * zmetexcess 237 zbasresb = MAX(0., zrespz - zexcess) 238 zbasresi = zexcess + MIN(0., zrespz - zexcess) 239 zrespirc = srespir2 * zepsherv * zgraztotc + zbasresb 240 241 ! When excess carbon is used, the other elements in excess 242 ! are also used proportionally to their abundance 243 ! -------------------------------------------------------- 244 zexcess = ( zgrasratn/ no3rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 245 zbasresn = zbasresi * zexcess * zgrasratn 246 zexcess = ( zgrasratp/ po4rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 247 zbasresp = zbasresi * zexcess * zgrasratp 248 zexcess = ( zgrasratf/ ferat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 249 zbasresf = zbasresi * zexcess * zgrasratf 250 251 ! Voiding of the excessive elements as organic matter 252 ! -------------------------------------------------------- 253 zgradoct = (1. - unass2c - zepsherv) * zgraztotc - zbasresi 254 zgradont = (1. - unass2n) * zgraztotn - zepsherv * no3rat3 * zgraztotc - zbasresn 255 zgradopt = (1. - unass2p) * zgraztotp - zepsherv * po4rat3 * zgraztotc - zbasresp 256 zgrareft = (1. - unass2c) * zgraztotf - zepsherv * ferat3 * zgraztotc - zbasresf 257 ztmp1 = ( 1. - epsher2 - unass2c ) /( 1. - 0.8 * epsher2 ) * ztortz 258 zgradoc = (zgradoct + ztmp1) * ssigma2 259 zgradon = (zgradont + no3rat3 * ztmp1) * ssigma2 260 zgradop = (zgradopt + po4rat3 * ztmp1) * ssigma2 261 zgratmp = 0.2 * epsher2 /( 1. - 0.8 * epsher2 ) * ztortz 262 263 ! Since only semilabile DOM is represented in PISCES 264 ! part of DOM is in fact labile and is then released 265 ! as dissolved inorganic compounds (ssigma2) 266 ! -------------------------------------------------- 267 zgrarem = zgratmp + ( zgradoct + ztmp1 ) * (1.0 - ssigma2) 268 zgraren = no3rat3 * zgratmp + ( zgradont + no3rat3 * ztmp1 ) * (1.0 - ssigma2) 269 zgrarep = po4rat3 * zgratmp + ( zgradopt + po4rat3 * ztmp1 ) * (1.0 - ssigma2) 270 zgraref = zgrareft + ferat3 * ( ztmp1 + zgratmp ) 271 272 ! Defecation as a result of non assimilated products 273 ! -------------------------------------------------- 274 zgrapoc = zgraztotc * unass2c + unass2c / ( 1. - 0.8 * epsher2 ) * ztortz 275 zgrapon = zgraztotn * unass2n + no3rat3 * unass2n / ( 1. - 0.8 * epsher2 ) * ztortz 276 zgrapop = zgraztotp * unass2p + po4rat3 * unass2p / ( 1. - 0.8 * epsher2 ) * ztortz 277 zgrapof = zgraztotf * unass2c + ferat3 * unass2c / ( 1. - 0.8 * epsher2 ) * ztortz 278 279 ! Addition of respiration to the release of inorganic nutrients 280 ! ------------------------------------------------------------- 281 zgrarem = zgrarem + zbasresi + zrespirc 282 zgraren = zgraren + zbasresn + zrespirc * no3rat3 283 zgrarep = zgrarep + zbasresp + zrespirc * po4rat3 284 zgraref = zgraref + zbasresf + zrespirc * ferat3 285 286 ! Update the arrays TRA which contain the biological sources and 287 ! sinks 288 ! -------------------------------------------------------------- 289 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarep 290 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgraren 291 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgradoc 292 ! 293 IF( ln_ligand ) THEN 294 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zgradoc * ldocz 295 zz2ligprod(ji,jj,jk) = zgradoc * ldocz 296 ENDIF 297 ! 298 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zgradon 299 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zgradop 300 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarem 301 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgraref 302 zfezoo2(ji,jj,jk) = zgraref 303 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarem 304 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zgraren 305 tr(ji,jj,jk,jpmes,Krhs) = tr(ji,jj,jk,jpmes,Krhs) + zepsherv * zgraztotc - zrespirc & 306 & - ztortz - zgrazm 307 tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazdc 308 tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zgrazdn 309 tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zgrazdp 310 tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazdf 311 tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) - zgrazz 312 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgraznc 313 tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) - zgraznn 314 tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) - zgraznp 315 tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgraznf 316 tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgraznc * tr(ji,jj,jk,jpnch,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 317 tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazdc * tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 318 tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazdc * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 319 tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazdc * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 320 321 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zgrazpoc - zgrazffep + zfracc 322 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfracc 323 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep 324 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) - zgrazpon - zgrazffnp + zfracn 325 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) - zgrazpop - zgrazffpp + zfracp 326 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) - zgrazffeg + zgrapoc - zfracc 327 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zgrapoc 328 consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfracc 329 tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) - zgrazffng + zgrapon - zfracn 330 tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) - zgrazffpg + zgrapop - zfracp 331 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zgrazpof - zgrazfffp + zfracfe 332 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zgrazfffg + zgrapof - zfracfe 333 zfracal = tr(ji,jj,jk,jpcal,Kbb) / ( tr(ji,jj,jk,jpgoc,Kbb) + rtrn ) 334 zgrazcal = zgrazffeg * (1. - part2) * zfracal 335 336 ! calcite production 337 ! ------------------ 338 zprcaca = xfracal(ji,jj,jk) * zgraznc 339 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 340 zprcaca = part2 * zprcaca 341 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrazcal - zprcaca 342 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + 2. * ( zgrazcal - zprcaca ) 343 tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) - zgrazcal + zprcaca 344 END_3D 345 ! 346 IF( lk_iomput .AND. knt == nrdttrc ) THEN 347 CALL iom_put( "PCAL" , prodcal(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) ! Calcite production 348 IF( iom_use("GRAZ2") ) THEN ! Total grazing of phyto by zooplankton 349 zgrazing(:,:,jpk) = 0._wp ; CALL iom_put( "GRAZ2" , zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) 352 350 ENDIF 353 351 IF( iom_use("FEZOO2") ) THEN … … 359 357 ENDIF 360 358 ! 361 IF( ln_ctl) THEN ! print mean trends (used for debugging)359 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 362 360 WRITE(charout, FMT="('meso')") 363 361 CALL prt_ctl_trc_info(charout) 364 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)362 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 365 363 ENDIF 366 364 ! … … 390 388 !!---------------------------------------------------------------------- 391 389 ! 392 REWIND( numnatp_ref )393 390 READ ( numnatp_ref, namp5zmes, IOSTAT = ios, ERR = 901) 394 391 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismes in reference namelist' ) 395 392 ! 396 REWIND( numnatp_cfg )397 393 READ ( numnatp_cfg, namp5zmes, IOSTAT = ios, ERR = 902 ) 398 394 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampismes in configuration namelist' ) -
NEMO/trunk/src/TOP/PISCES/P4Z/p5zmicro.F90
r12276 r12377 52 52 LOGICAL, PUBLIC :: bmetexc !: Use of excess carbon for respiration 53 53 54 !! * Substitutions 55 # include "do_loop_substitute.h90" 54 56 !!---------------------------------------------------------------------- 55 57 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 60 62 CONTAINS 61 63 62 SUBROUTINE p5z_micro( kt, knt )64 SUBROUTINE p5z_micro( kt, knt, Kbb, Krhs ) 63 65 !!--------------------------------------------------------------------- 64 66 !! *** ROUTINE p5z_micro *** … … 70 72 INTEGER, INTENT(in) :: kt ! ocean time step 71 73 INTEGER, INTENT(in) :: knt 74 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 72 75 ! 73 76 INTEGER :: ji, jj, jk … … 93 96 IF ( bmetexc ) zmetexcess = 1.0 94 97 ! 95 DO jk = 1, jpkm1 96 DO jj = 1, jpj 97 DO ji = 1, jpi 98 zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 ) 99 zfact = xstep * tgfunc2(ji,jj,jk) * zcompaz 100 101 ! Michaelis-Menten mortality rates of microzooplankton 102 ! ----------------------------------------------------- 103 zrespz = resrat * zfact * ( trb(ji,jj,jk,jpzoo) / ( xkmort + trb(ji,jj,jk,jpzoo) ) & 104 & + 3. * nitrfac(ji,jj,jk) ) 105 106 ! Zooplankton mortality. A square function has been selected with 107 ! no real reason except that it seems to be more stable and may mimic predation. 108 ! ------------------------------------------------------------------------------ 109 ztortz = mzrat * 1.e6 * zfact * trb(ji,jj,jk,jpzoo) * (1. - nitrfac(ji,jj,jk)) 110 111 ! Computation of the abundance of the preys 112 ! A threshold can be specified in the namelist 113 ! -------------------------------------------- 114 zcompadi = MIN( MAX( ( trb(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia ) 115 zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 ) 116 zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - xthreshzoo ), 0.e0 ) 117 zcompapi = MAX( ( trb(ji,jj,jk,jppic) - xthreshpic ), 0.e0 ) 118 zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 ) 119 120 ! Microzooplankton grazing 121 ! ------------------------ 122 zfood = xprefn * zcompaph + xprefc * zcompapoc + xprefd * zcompadi & 123 & + xprefz * zcompaz + xprefp * zcompapi 124 zfoodlim = MAX( 0. , zfood - min(xthresh,0.5*zfood) ) 125 zdenom = zfoodlim / ( xkgraz + zfoodlim ) 126 zgraze = grazrat * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpzoo) * (1. - nitrfac(ji,jj,jk)) 127 128 ! An active switching parameterization is used here. 129 ! We don't use the KTW parameterization proposed by 130 ! Vallina et al. because it tends to produce to steady biomass 131 ! composition and the variance of Chl is too low as it grazes 132 ! too strongly on winning organisms. Thus, instead of a square 133 ! a 1.5 power value is used which decreases the pressure on the 134 ! most abundant species 135 ! ------------------------------------------------------------ 136 ztmp1 = xprefn * zcompaph**1.5 137 ztmp2 = xprefp * zcompapi**1.5 138 ztmp3 = xprefc * zcompapoc**1.5 139 ztmp4 = xprefd * zcompadi**1.5 140 ztmp5 = xprefz * zcompaz**1.5 141 ztmptot = ztmp1 + ztmp2 + ztmp3 + ztmp4 + ztmp5 + rtrn 142 ztmp1 = ztmp1 / ztmptot 143 ztmp2 = ztmp2 / ztmptot 144 ztmp3 = ztmp3 / ztmptot 145 ztmp4 = ztmp4 / ztmptot 146 ztmp5 = ztmp5 / ztmptot 147 148 ! Microzooplankton regular grazing on the different preys 149 ! ------------------------------------------------------- 150 zgraznc = zgraze * ztmp1 * zdenom 151 zgraznn = zgraznc * trb(ji,jj,jk,jpnph) / (trb(ji,jj,jk,jpphy) + rtrn) 152 zgraznp = zgraznc * trb(ji,jj,jk,jppph) / (trb(ji,jj,jk,jpphy) + rtrn) 153 zgraznf = zgraznc * trb(ji,jj,jk,jpnfe) / (trb(ji,jj,jk,jpphy) + rtrn) 154 zgrazpc = zgraze * ztmp2 * zdenom 155 zgrazpn = zgrazpc * trb(ji,jj,jk,jpnpi) / (trb(ji,jj,jk,jppic) + rtrn) 156 zgrazpp = zgrazpc * trb(ji,jj,jk,jpppi) / (trb(ji,jj,jk,jppic) + rtrn) 157 zgrazpf = zgrazpc * trb(ji,jj,jk,jppfe) / (trb(ji,jj,jk,jppic) + rtrn) 158 zgrazz = zgraze * ztmp5 * zdenom 159 zgrazpoc = zgraze * ztmp3 * zdenom 160 zgrazpon = zgrazpoc * trb(ji,jj,jk,jppon) / ( trb(ji,jj,jk,jppoc) + rtrn ) 161 zgrazpop = zgrazpoc * trb(ji,jj,jk,jppop) / ( trb(ji,jj,jk,jppoc) + rtrn ) 162 zgrazpof = zgrazpoc* trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn) 163 zgrazdc = zgraze * ztmp4 * zdenom 164 zgrazdn = zgrazdc * trb(ji,jj,jk,jpndi) / (trb(ji,jj,jk,jpdia) + rtrn) 165 zgrazdp = zgrazdc * trb(ji,jj,jk,jppdi) / (trb(ji,jj,jk,jpdia) + rtrn) 166 zgrazdf = zgrazdc * trb(ji,jj,jk,jpdfe) / (trb(ji,jj,jk,jpdia) + rtrn) 167 ! 168 zgraztotc = zgraznc + zgrazpoc + zgrazdc + zgrazz + zgrazpc 169 zgraztotn = zgraznn + zgrazpn + zgrazpon + zgrazdn + zgrazz * no3rat3 170 zgraztotp = zgraznp + zgrazpp + zgrazpop + zgrazdp + zgrazz * po4rat3 171 zgraztotf = zgraznf + zgrazpf + zgrazpof + zgrazdf + zgrazz * ferat3 172 ! 173 ! Grazing by microzooplankton 174 zgrazing(ji,jj,jk) = zgraztotc 175 176 ! Stoichiometruc ratios of the food ingested by zooplanton 177 ! -------------------------------------------------------- 178 zgrasratf = (zgraztotf + rtrn) / ( zgraztotc + rtrn ) 179 zgrasratn = (zgraztotn + rtrn) / ( zgraztotc + rtrn ) 180 zgrasratp = (zgraztotp + rtrn) / ( zgraztotc + rtrn ) 181 182 ! Growth efficiency is made a function of the quality 183 ! and the quantity of the preys 184 ! --------------------------------------------------- 185 zepshert = MIN( 1., zgrasratn/ no3rat3, zgrasratp/ po4rat3, zgrasratf / ferat3) 186 zbeta = MAX( 0., (epsher - epshermin) ) 187 zepsherf = epshermin + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 188 zepsherv = zepsherf * zepshert 189 190 ! Respiration of microzooplankton 191 ! Excess carbon in the food is used preferentially 192 ! ------------------------------------------------ 193 zexcess = zgraztotc * zepsherf * (1.0 - zepshert) * zmetexcess 194 zbasresb = MAX(0., zrespz - zexcess) 195 zbasresi = zexcess + MIN(0., zrespz - zexcess) 196 zrespirc = srespir * zepsherv * zgraztotc + zbasresb 197 198 ! When excess carbon is used, the other elements in excess 199 ! are also used proportionally to their abundance 200 ! -------------------------------------------------------- 201 zexcess = ( zgrasratn/ no3rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 202 zbasresn = zbasresi * zexcess * zgrasratn 203 zexcess = ( zgrasratp/ po4rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 204 zbasresp = zbasresi * zexcess * zgrasratp 205 zexcess = ( zgrasratf/ ferat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 206 zbasresf = zbasresi * zexcess * zgrasratf 207 208 ! Voiding of the excessive elements as DOM 209 ! ---------------------------------------- 210 zgradoct = (1. - unassc - zepsherv) * zgraztotc - zbasresi 211 zgradont = (1. - unassn) * zgraztotn - zepsherv * no3rat3 * zgraztotc - zbasresn 212 zgradopt = (1. - unassp) * zgraztotp - zepsherv * po4rat3 * zgraztotc - zbasresp 213 zgrareft = (1. - unassc) * zgraztotf - zepsherv * ferat3 * zgraztotc - zbasresf 214 215 ! Since only semilabile DOM is represented in PISCES 216 ! part of DOM is in fact labile and is then released 217 ! as dissolved inorganic compounds (ssigma) 218 ! -------------------------------------------------- 219 zgradoc = zgradoct * ssigma 220 zgradon = zgradont * ssigma 221 zgradop = zgradopt * ssigma 222 zgrarem = (1.0 - ssigma) * zgradoct 223 zgraren = (1.0 - ssigma) * zgradont 224 zgrarep = (1.0 - ssigma) * zgradopt 225 zgraref = zgrareft 226 227 ! Defecation as a result of non assimilated products 228 ! -------------------------------------------------- 229 zgrapoc = zgraztotc * unassc 230 zgrapon = zgraztotn * unassn 231 zgrapop = zgraztotp * unassp 232 zgrapof = zgraztotf * unassc 233 234 ! Addition of respiration to the release of inorganic nutrients 235 ! ------------------------------------------------------------- 236 zgrarem = zgrarem + zbasresi + zrespirc 237 zgraren = zgraren + zbasresn + zrespirc * no3rat3 238 zgrarep = zgrarep + zbasresp + zrespirc * po4rat3 239 zgraref = zgraref + zbasresf + zrespirc * ferat3 240 241 ! Update of the TRA arrays 242 ! ------------------------ 243 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarep 244 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgraren 245 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgradoc 246 ! 247 IF( ln_ligand ) THEN 248 tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zgradoc * ldocz 249 zzligprod(ji,jj,jk) = zgradoc * ldocz 250 ENDIF 251 ! 252 tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zgradon 253 tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zgradop 254 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem 255 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgraref 256 zfezoo(ji,jj,jk) = zgraref 257 tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zepsherv * zgraztotc - zrespirc - ztortz - zgrazz 258 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgraznc 259 tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) - zgraznn 260 tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) - zgraznp 261 tra(ji,jj,jk,jppic) = tra(ji,jj,jk,jppic) - zgrazpc 262 tra(ji,jj,jk,jpnpi) = tra(ji,jj,jk,jpnpi) - zgrazpn 263 tra(ji,jj,jk,jpppi) = tra(ji,jj,jk,jpppi) - zgrazpp 264 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazdc 265 tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) - zgrazdn 266 tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) - zgrazdp 267 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgraznc * trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn) 268 tra(ji,jj,jk,jppch) = tra(ji,jj,jk,jppch) - zgrazpc * trb(ji,jj,jk,jppch)/(trb(ji,jj,jk,jppic)+rtrn) 269 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazdc * trb(ji,jj,jk,jpdch)/(trb(ji,jj,jk,jpdia)+rtrn) 270 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazdc * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn) 271 tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazdc * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn) 272 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf 273 tra(ji,jj,jk,jppfe) = tra(ji,jj,jk,jppfe) - zgrazpf 274 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazdf 275 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ztortz + zgrapoc - zgrazpoc 276 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ztortz + zgrapoc 277 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc 278 tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + no3rat3 * ztortz + zgrapon - zgrazpon 279 tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + po4rat3 * ztortz + zgrapop - zgrazpop 280 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * ztortz + zgrapof - zgrazpof 281 ! 282 ! calcite production 283 zprcaca = xfracal(ji,jj,jk) * zgraznc 284 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 285 ! 286 zprcaca = part * zprcaca 287 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem - zprcaca 288 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca & 289 & + rno3 * zgraren 290 tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 291 END DO 292 END DO 293 END DO 98 DO_3D_11_11( 1, jpkm1 ) 99 zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - 1.e-9 ), 0.e0 ) 100 zfact = xstep * tgfunc2(ji,jj,jk) * zcompaz 101 102 ! Michaelis-Menten mortality rates of microzooplankton 103 ! ----------------------------------------------------- 104 zrespz = resrat * zfact * ( tr(ji,jj,jk,jpzoo,Kbb) / ( xkmort + tr(ji,jj,jk,jpzoo,Kbb) ) & 105 & + 3. * nitrfac(ji,jj,jk) ) 106 107 ! Zooplankton mortality. A square function has been selected with 108 ! no real reason except that it seems to be more stable and may mimic predation. 109 ! ------------------------------------------------------------------------------ 110 ztortz = mzrat * 1.e6 * zfact * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk)) 111 112 ! Computation of the abundance of the preys 113 ! A threshold can be specified in the namelist 114 ! -------------------------------------------- 115 zcompadi = MIN( MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthreshdia ), 0.e0 ), xsizedia ) 116 zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthreshphy ), 0.e0 ) 117 zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - xthreshzoo ), 0.e0 ) 118 zcompapi = MAX( ( tr(ji,jj,jk,jppic,Kbb) - xthreshpic ), 0.e0 ) 119 zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthreshpoc ), 0.e0 ) 120 121 ! Microzooplankton grazing 122 ! ------------------------ 123 zfood = xprefn * zcompaph + xprefc * zcompapoc + xprefd * zcompadi & 124 & + xprefz * zcompaz + xprefp * zcompapi 125 zfoodlim = MAX( 0. , zfood - min(xthresh,0.5*zfood) ) 126 zdenom = zfoodlim / ( xkgraz + zfoodlim ) 127 zgraze = grazrat * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk)) 128 129 ! An active switching parameterization is used here. 130 ! We don't use the KTW parameterization proposed by 131 ! Vallina et al. because it tends to produce to steady biomass 132 ! composition and the variance of Chl is too low as it grazes 133 ! too strongly on winning organisms. Thus, instead of a square 134 ! a 1.5 power value is used which decreases the pressure on the 135 ! most abundant species 136 ! ------------------------------------------------------------ 137 ztmp1 = xprefn * zcompaph**1.5 138 ztmp2 = xprefp * zcompapi**1.5 139 ztmp3 = xprefc * zcompapoc**1.5 140 ztmp4 = xprefd * zcompadi**1.5 141 ztmp5 = xprefz * zcompaz**1.5 142 ztmptot = ztmp1 + ztmp2 + ztmp3 + ztmp4 + ztmp5 + rtrn 143 ztmp1 = ztmp1 / ztmptot 144 ztmp2 = ztmp2 / ztmptot 145 ztmp3 = ztmp3 / ztmptot 146 ztmp4 = ztmp4 / ztmptot 147 ztmp5 = ztmp5 / ztmptot 148 149 ! Microzooplankton regular grazing on the different preys 150 ! ------------------------------------------------------- 151 zgraznc = zgraze * ztmp1 * zdenom 152 zgraznn = zgraznc * tr(ji,jj,jk,jpnph,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 153 zgraznp = zgraznc * tr(ji,jj,jk,jppph,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 154 zgraznf = zgraznc * tr(ji,jj,jk,jpnfe,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 155 zgrazpc = zgraze * ztmp2 * zdenom 156 zgrazpn = zgrazpc * tr(ji,jj,jk,jpnpi,Kbb) / (tr(ji,jj,jk,jppic,Kbb) + rtrn) 157 zgrazpp = zgrazpc * tr(ji,jj,jk,jpppi,Kbb) / (tr(ji,jj,jk,jppic,Kbb) + rtrn) 158 zgrazpf = zgrazpc * tr(ji,jj,jk,jppfe,Kbb) / (tr(ji,jj,jk,jppic,Kbb) + rtrn) 159 zgrazz = zgraze * ztmp5 * zdenom 160 zgrazpoc = zgraze * ztmp3 * zdenom 161 zgrazpon = zgrazpoc * tr(ji,jj,jk,jppon,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 162 zgrazpop = zgrazpoc * tr(ji,jj,jk,jppop,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 163 zgrazpof = zgrazpoc* tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 164 zgrazdc = zgraze * ztmp4 * zdenom 165 zgrazdn = zgrazdc * tr(ji,jj,jk,jpndi,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 166 zgrazdp = zgrazdc * tr(ji,jj,jk,jppdi,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 167 zgrazdf = zgrazdc * tr(ji,jj,jk,jpdfe,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 168 ! 169 zgraztotc = zgraznc + zgrazpoc + zgrazdc + zgrazz + zgrazpc 170 zgraztotn = zgraznn + zgrazpn + zgrazpon + zgrazdn + zgrazz * no3rat3 171 zgraztotp = zgraznp + zgrazpp + zgrazpop + zgrazdp + zgrazz * po4rat3 172 zgraztotf = zgraznf + zgrazpf + zgrazpof + zgrazdf + zgrazz * ferat3 173 ! 174 ! Grazing by microzooplankton 175 zgrazing(ji,jj,jk) = zgraztotc 176 177 ! Stoichiometruc ratios of the food ingested by zooplanton 178 ! -------------------------------------------------------- 179 zgrasratf = (zgraztotf + rtrn) / ( zgraztotc + rtrn ) 180 zgrasratn = (zgraztotn + rtrn) / ( zgraztotc + rtrn ) 181 zgrasratp = (zgraztotp + rtrn) / ( zgraztotc + rtrn ) 182 183 ! Growth efficiency is made a function of the quality 184 ! and the quantity of the preys 185 ! --------------------------------------------------- 186 zepshert = MIN( 1., zgrasratn/ no3rat3, zgrasratp/ po4rat3, zgrasratf / ferat3) 187 zbeta = MAX( 0., (epsher - epshermin) ) 188 zepsherf = epshermin + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 189 zepsherv = zepsherf * zepshert 190 191 ! Respiration of microzooplankton 192 ! Excess carbon in the food is used preferentially 193 ! ------------------------------------------------ 194 zexcess = zgraztotc * zepsherf * (1.0 - zepshert) * zmetexcess 195 zbasresb = MAX(0., zrespz - zexcess) 196 zbasresi = zexcess + MIN(0., zrespz - zexcess) 197 zrespirc = srespir * zepsherv * zgraztotc + zbasresb 198 199 ! When excess carbon is used, the other elements in excess 200 ! are also used proportionally to their abundance 201 ! -------------------------------------------------------- 202 zexcess = ( zgrasratn/ no3rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 203 zbasresn = zbasresi * zexcess * zgrasratn 204 zexcess = ( zgrasratp/ po4rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 205 zbasresp = zbasresi * zexcess * zgrasratp 206 zexcess = ( zgrasratf/ ferat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 207 zbasresf = zbasresi * zexcess * zgrasratf 208 209 ! Voiding of the excessive elements as DOM 210 ! ---------------------------------------- 211 zgradoct = (1. - unassc - zepsherv) * zgraztotc - zbasresi 212 zgradont = (1. - unassn) * zgraztotn - zepsherv * no3rat3 * zgraztotc - zbasresn 213 zgradopt = (1. - unassp) * zgraztotp - zepsherv * po4rat3 * zgraztotc - zbasresp 214 zgrareft = (1. - unassc) * zgraztotf - zepsherv * ferat3 * zgraztotc - zbasresf 215 216 ! Since only semilabile DOM is represented in PISCES 217 ! part of DOM is in fact labile and is then released 218 ! as dissolved inorganic compounds (ssigma) 219 ! -------------------------------------------------- 220 zgradoc = zgradoct * ssigma 221 zgradon = zgradont * ssigma 222 zgradop = zgradopt * ssigma 223 zgrarem = (1.0 - ssigma) * zgradoct 224 zgraren = (1.0 - ssigma) * zgradont 225 zgrarep = (1.0 - ssigma) * zgradopt 226 zgraref = zgrareft 227 228 ! Defecation as a result of non assimilated products 229 ! -------------------------------------------------- 230 zgrapoc = zgraztotc * unassc 231 zgrapon = zgraztotn * unassn 232 zgrapop = zgraztotp * unassp 233 zgrapof = zgraztotf * unassc 234 235 ! Addition of respiration to the release of inorganic nutrients 236 ! ------------------------------------------------------------- 237 zgrarem = zgrarem + zbasresi + zrespirc 238 zgraren = zgraren + zbasresn + zrespirc * no3rat3 239 zgrarep = zgrarep + zbasresp + zrespirc * po4rat3 240 zgraref = zgraref + zbasresf + zrespirc * ferat3 241 242 ! Update of the TRA arrays 243 ! ------------------------ 244 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarep 245 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgraren 246 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgradoc 247 ! 248 IF( ln_ligand ) THEN 249 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zgradoc * ldocz 250 zzligprod(ji,jj,jk) = zgradoc * ldocz 251 ENDIF 252 ! 253 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zgradon 254 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zgradop 255 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarem 256 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgraref 257 zfezoo(ji,jj,jk) = zgraref 258 tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) + zepsherv * zgraztotc - zrespirc - ztortz - zgrazz 259 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgraznc 260 tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) - zgraznn 261 tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) - zgraznp 262 tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) - zgrazpc 263 tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) - zgrazpn 264 tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) - zgrazpp 265 tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazdc 266 tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zgrazdn 267 tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zgrazdp 268 tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgraznc * tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 269 tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) - zgrazpc * tr(ji,jj,jk,jppch,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 270 tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazdc * tr(ji,jj,jk,jpdch,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 271 tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazdc * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 272 tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazdc * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 273 tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgraznf 274 tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) - zgrazpf 275 tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazdf 276 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + ztortz + zgrapoc - zgrazpoc 277 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ztortz + zgrapoc 278 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc 279 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + no3rat3 * ztortz + zgrapon - zgrazpon 280 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + po4rat3 * ztortz + zgrapop - zgrazpop 281 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ferat3 * ztortz + zgrapof - zgrazpof 282 ! 283 ! calcite production 284 zprcaca = xfracal(ji,jj,jk) * zgraznc 285 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 286 ! 287 zprcaca = part * zprcaca 288 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarem - zprcaca 289 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca & 290 & + rno3 * zgraren 291 tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca 292 END_3D 294 293 ! 295 294 IF( lk_iomput .AND. knt == nrdttrc ) THEN 296 295 IF( iom_use("GRAZ1") ) THEN ! Total grazing of phyto by zooplankton 297 296 zgrazing(:,:,jpk) = 0._wp ; CALL iom_put( "GRAZ1" , zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) 298 297 ENDIF … … 305 304 ENDIF 306 305 ! 307 IF( ln_ctl) THEN ! print mean trends (used for debugging)306 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 308 307 WRITE(charout, FMT="('micro')") 309 308 CALL prt_ctl_trc_info(charout) 310 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)309 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 311 310 ENDIF 312 311 ! … … 336 335 !!---------------------------------------------------------------------- 337 336 ! 338 REWIND( numnatp_ref )339 337 READ ( numnatp_ref, namp5zzoo, IOSTAT = ios, ERR = 901) 340 338 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp5zzoo in reference namelist' ) 341 339 ! 342 REWIND( numnatp_cfg )343 340 READ ( numnatp_cfg, namp5zzoo, IOSTAT = ios, ERR = 902 ) 344 341 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namp5zzoo in configuration namelist' ) -
NEMO/trunk/src/TOP/PISCES/P4Z/p5zmort.F90
r11536 r12377 33 33 REAL(wp), PUBLIC :: mpratd !: 34 34 35 !! * Substitutions 36 # include "do_loop_substitute.h90" 35 37 !!---------------------------------------------------------------------- 36 38 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 41 43 CONTAINS 42 44 43 SUBROUTINE p5z_mort( kt )45 SUBROUTINE p5z_mort( kt, Kbb, Krhs ) 44 46 !!--------------------------------------------------------------------- 45 47 !! *** ROUTINE p5z_mort *** … … 51 53 !!--------------------------------------------------------------------- 52 54 INTEGER, INTENT(in) :: kt ! ocean time step 53 !!--------------------------------------------------------------------- 54 55 CALL p5z_nano ! nanophytoplankton 56 CALL p5z_pico ! picophytoplankton 57 CALL p5z_diat ! diatoms 55 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 56 !!--------------------------------------------------------------------- 57 58 CALL p5z_nano( Kbb, Krhs ) ! nanophytoplankton 59 CALL p5z_pico( Kbb, Krhs ) ! picophytoplankton 60 CALL p5z_diat( Kbb, Krhs ) ! diatoms 58 61 59 62 END SUBROUTINE p5z_mort 60 63 61 64 62 SUBROUTINE p5z_nano 65 SUBROUTINE p5z_nano( Kbb, Krhs ) 63 66 !!--------------------------------------------------------------------- 64 67 !! *** ROUTINE p5z_nano *** … … 68 71 !! ** Method : - ??? 69 72 !!--------------------------------------------------------------------- 73 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 70 74 INTEGER :: ji, jj, jk 71 75 REAL(wp) :: zcompaph … … 78 82 ! 79 83 prodcal(:,:,:) = 0. !: calcite production variable set to zero 80 DO jk = 1, jpkm1 81 DO jj = 1, jpj 82 DO ji = 1, jpi 83 zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - 1e-9 ), 0.e0 ) 84 ! Squared mortality of Phyto similar to a sedimentation term during 85 ! blooms (Doney et al. 1996) 86 ! ----------------------------------------------------------------- 87 zrespp = wchln * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * trb(ji,jj,jk,jpphy) 88 89 ! Phytoplankton linear mortality 90 ! ------------------------------ 91 ztortp = mpratn * xstep * zcompaph 92 zmortp = zrespp + ztortp 93 94 ! Update the arrays TRA which contains the biological sources and sinks 95 96 zfactn = trb(ji,jj,jk,jpnph)/(trb(ji,jj,jk,jpphy)+rtrn) 97 zfactp = trb(ji,jj,jk,jppph)/(trb(ji,jj,jk,jpphy)+rtrn) 98 zfactfe = trb(ji,jj,jk,jpnfe)/(trb(ji,jj,jk,jpphy)+rtrn) 99 zfactch = trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn) 100 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zmortp 101 tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) - zmortp * zfactn 102 tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) - zmortp * zfactp 103 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zmortp * zfactch 104 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zmortp * zfactfe 105 zprcaca = xfracal(ji,jj,jk) * zmortp 106 ! 107 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 108 ! 109 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 110 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 111 tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 112 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp 113 tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zmortp * zfactn 114 tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + zmortp * zfactp 115 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp 116 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp * zfactfe 117 END DO 118 END DO 119 END DO 120 ! 121 IF(ln_ctl) THEN ! print mean trends (used for debugging) 84 DO_3D_11_11( 1, jpkm1 ) 85 zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-9 ), 0.e0 ) 86 ! Squared mortality of Phyto similar to a sedimentation term during 87 ! blooms (Doney et al. 1996) 88 ! ----------------------------------------------------------------- 89 zrespp = wchln * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * tr(ji,jj,jk,jpphy,Kbb) 90 91 ! Phytoplankton linear mortality 92 ! ------------------------------ 93 ztortp = mpratn * xstep * zcompaph 94 zmortp = zrespp + ztortp 95 96 ! Update the arrays TRA which contains the biological sources and sinks 97 98 zfactn = tr(ji,jj,jk,jpnph,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 99 zfactp = tr(ji,jj,jk,jppph,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 100 zfactfe = tr(ji,jj,jk,jpnfe,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 101 zfactch = tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 102 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zmortp 103 tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) - zmortp * zfactn 104 tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) - zmortp * zfactp 105 tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zmortp * zfactch 106 tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zmortp * zfactfe 107 zprcaca = xfracal(ji,jj,jk) * zmortp 108 ! 109 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 110 ! 111 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprcaca 112 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca 113 tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca 114 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortp 115 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zmortp * zfactn 116 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + zmortp * zfactp 117 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp 118 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zmortp * zfactfe 119 END_3D 120 ! 121 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 122 122 WRITE(charout, FMT="('nano')") 123 123 CALL prt_ctl_trc_info(charout) 124 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)124 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 125 125 ENDIF 126 126 ! … … 130 130 131 131 132 SUBROUTINE p5z_pico 132 SUBROUTINE p5z_pico( Kbb, Krhs ) 133 133 !!--------------------------------------------------------------------- 134 134 !! *** ROUTINE p5z_pico *** … … 138 138 !! ** Method : - ??? 139 139 !!--------------------------------------------------------------------- 140 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 140 141 INTEGER :: ji, jj, jk 141 142 REAL(wp) :: zcompaph … … 147 148 IF( ln_timing ) CALL timing_start('p5z_pico') 148 149 ! 149 DO jk = 1, jpkm1 150 DO jj = 1, jpj 151 DO ji = 1, jpi 152 zcompaph = MAX( ( trb(ji,jj,jk,jppic) - 1e-9 ), 0.e0 ) 153 ! Squared mortality of Phyto similar to a sedimentation term during 154 ! blooms (Doney et al. 1996) 155 ! ----------------------------------------------------------------- 156 zrespp = wchlp * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * trb(ji,jj,jk,jppic) 157 158 ! Phytoplankton mortality 159 ztortp = mpratp * xstep * zcompaph 160 zmortp = zrespp + ztortp 161 162 ! Update the arrays TRA which contains the biological sources and sinks 163 164 zfactn = trb(ji,jj,jk,jpnpi)/(trb(ji,jj,jk,jppic)+rtrn) 165 zfactp = trb(ji,jj,jk,jpppi)/(trb(ji,jj,jk,jppic)+rtrn) 166 zfactfe = trb(ji,jj,jk,jppfe)/(trb(ji,jj,jk,jppic)+rtrn) 167 zfactch = trb(ji,jj,jk,jppch)/(trb(ji,jj,jk,jppic)+rtrn) 168 tra(ji,jj,jk,jppic) = tra(ji,jj,jk,jppic) - zmortp 169 tra(ji,jj,jk,jpnpi) = tra(ji,jj,jk,jpnpi) - zmortp * zfactn 170 tra(ji,jj,jk,jpppi) = tra(ji,jj,jk,jpppi) - zmortp * zfactp 171 tra(ji,jj,jk,jppch) = tra(ji,jj,jk,jppch) - zmortp * zfactch 172 tra(ji,jj,jk,jppfe) = tra(ji,jj,jk,jppfe) - zmortp * zfactfe 173 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp 174 tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zmortp * zfactn 175 tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + zmortp * zfactp 176 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp * zfactfe 177 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp 178 END DO 179 END DO 180 END DO 181 ! 182 IF(ln_ctl) THEN ! print mean trends (used for debugging) 150 DO_3D_11_11( 1, jpkm1 ) 151 zcompaph = MAX( ( tr(ji,jj,jk,jppic,Kbb) - 1e-9 ), 0.e0 ) 152 ! Squared mortality of Phyto similar to a sedimentation term during 153 ! blooms (Doney et al. 1996) 154 ! ----------------------------------------------------------------- 155 zrespp = wchlp * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * tr(ji,jj,jk,jppic,Kbb) 156 157 ! Phytoplankton mortality 158 ztortp = mpratp * xstep * zcompaph 159 zmortp = zrespp + ztortp 160 161 ! Update the arrays TRA which contains the biological sources and sinks 162 163 zfactn = tr(ji,jj,jk,jpnpi,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 164 zfactp = tr(ji,jj,jk,jpppi,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 165 zfactfe = tr(ji,jj,jk,jppfe,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 166 zfactch = tr(ji,jj,jk,jppch,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 167 tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) - zmortp 168 tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) - zmortp * zfactn 169 tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) - zmortp * zfactp 170 tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) - zmortp * zfactch 171 tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) - zmortp * zfactfe 172 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortp 173 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zmortp * zfactn 174 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + zmortp * zfactp 175 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zmortp * zfactfe 176 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp 177 END_3D 178 ! 179 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 183 180 WRITE(charout, FMT="('pico')") 184 181 CALL prt_ctl_trc_info(charout) 185 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)182 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 186 183 ENDIF 187 184 ! … … 191 188 192 189 193 SUBROUTINE p5z_diat 190 SUBROUTINE p5z_diat( Kbb, Krhs ) 194 191 !!--------------------------------------------------------------------- 195 192 !! *** ROUTINE p5z_diat *** … … 199 196 !! ** Method : - ??? 200 197 !!--------------------------------------------------------------------- 198 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 201 199 INTEGER :: ji, jj, jk 202 200 REAL(wp) :: zfactfe,zfactsi,zfactch, zfactn, zfactp, zcompadi … … 209 207 ! 210 208 211 DO jk = 1, jpkm1 212 DO jj = 1, jpj 213 DO ji = 1, jpi 214 215 zcompadi = MAX( ( trb(ji,jj,jk,jpdia) - 1E-9), 0. ) 216 217 ! Aggregation term for diatoms is increased in case of nutrient 218 ! stress as observed in reality. The stressed cells become more 219 ! sticky and coagulate to sink quickly out of the euphotic zone 220 ! ------------------------------------------------------------- 221 ! Phytoplankton squared mortality 222 ! ------------------------------- 223 zlim2 = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk) 224 zlim1 = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 225 zrespp2 = 1.e6 * xstep * ( wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trb(ji,jj,jk,jpdia) 226 227 ! Phytoplankton linear mortality 228 ! ------------------------------ 229 ztortp2 = mpratd * xstep * zcompadi 230 zmortp2 = zrespp2 + ztortp2 231 232 ! Update the arrays tra which contains the biological sources and sinks 233 ! --------------------------------------------------------------------- 234 zfactn = trb(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 235 zfactp = trb(ji,jj,jk,jppdi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 236 zfactch = trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn ) 237 zfactfe = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn ) 238 zfactsi = trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 239 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zmortp2 240 tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) - zmortp2 * zfactn 241 tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) - zmortp2 * zfactp 242 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zmortp2 * zfactch 243 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zmortp2 * zfactfe 244 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zmortp2 * zfactsi 245 tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zmortp2 * zfactsi 246 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zrespp2 247 tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zrespp2 * zfactn 248 tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + zrespp2 * zfactp 249 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zrespp2 * zfactfe 250 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ztortp2 251 tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + ztortp2 * zfactn 252 tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + ztortp2 * zfactp 253 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ztortp2 * zfactfe 254 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ztortp2 255 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zrespp2 256 END DO 257 END DO 258 END DO 259 ! 260 IF(ln_ctl) THEN ! print mean trends (used for debugging) 209 DO_3D_11_11( 1, jpkm1 ) 210 211 zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1E-9), 0. ) 212 213 ! Aggregation term for diatoms is increased in case of nutrient 214 ! stress as observed in reality. The stressed cells become more 215 ! sticky and coagulate to sink quickly out of the euphotic zone 216 ! ------------------------------------------------------------- 217 ! Phytoplankton squared mortality 218 ! ------------------------------- 219 zlim2 = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk) 220 zlim1 = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 221 zrespp2 = 1.e6 * xstep * ( wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * tr(ji,jj,jk,jpdia,Kbb) 222 223 ! Phytoplankton linear mortality 224 ! ------------------------------ 225 ztortp2 = mpratd * xstep * zcompadi 226 zmortp2 = zrespp2 + ztortp2 227 228 ! Update the arrays tr(:,:,:,:,Krhs) which contains the biological sources and sinks 229 ! --------------------------------------------------------------------- 230 zfactn = tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 231 zfactp = tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 232 zfactch = tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 233 zfactfe = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 234 zfactsi = tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 235 tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zmortp2 236 tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zmortp2 * zfactn 237 tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zmortp2 * zfactp 238 tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zmortp2 * zfactch 239 tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zmortp2 * zfactfe 240 tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zmortp2 * zfactsi 241 tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zmortp2 * zfactsi 242 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zrespp2 243 tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zrespp2 * zfactn 244 tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + zrespp2 * zfactp 245 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zrespp2 * zfactfe 246 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + ztortp2 247 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + ztortp2 * zfactn 248 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + ztortp2 * zfactp 249 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ztortp2 * zfactfe 250 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ztortp2 251 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zrespp2 252 END_3D 253 ! 254 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 261 255 WRITE(charout, FMT="('diat')") 262 256 CALL prt_ctl_trc_info(charout) 263 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)257 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 264 258 ENDIF 265 259 ! … … 286 280 !!---------------------------------------------------------------------- 287 281 288 REWIND( numnatp_ref ) ! Namelist nampismort in reference namelist : Pisces phytoplankton289 282 READ ( numnatp_ref, namp5zmort, IOSTAT = ios, ERR = 901) 290 283 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp5zmort in reference namelist' ) 291 284 292 REWIND( numnatp_cfg ) ! Namelist nampismort in configuration namelist : Pisces phytoplankton293 285 READ ( numnatp_cfg, namp5zmort, IOSTAT = ios, ERR = 902 ) 294 286 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namp5zmort in configuration namelist' ) -
NEMO/trunk/src/TOP/PISCES/P4Z/p5zprod.F90
r12280 r12377 50 50 REAL(wp) :: texcretd !: 1 - excret2 51 51 52 !! * Substitutions 53 # include "do_loop_substitute.h90" 52 54 !!---------------------------------------------------------------------- 53 55 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 57 59 CONTAINS 58 60 59 SUBROUTINE p5z_prod( kt , knt )61 SUBROUTINE p5z_prod( kt , knt, Kbb, Kmm, Krhs ) 60 62 !!--------------------------------------------------------------------- 61 63 !! *** ROUTINE p5z_prod *** … … 68 70 ! 69 71 INTEGER, INTENT(in) :: kt, knt 72 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 70 73 ! 71 74 INTEGER :: ji, jj, jk … … 121 124 ! day length in hours 122 125 zstrn(:,:) = 0. 123 DO jj = 1, jpj 124 DO ji = 1, jpi 125 zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 126 zargu = MAX( -1., MIN( 1., zargu ) ) 127 zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 128 END DO 129 END DO 126 DO_2D_11_11 127 zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 128 zargu = MAX( -1., MIN( 1., zargu ) ) 129 zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 130 END_2D 130 131 131 132 ! Impact of the day duration on phytoplankton growth 132 DO jk = 1, jpkm1 133 DO jj = 1 ,jpj 134 DO ji = 1, jpi 135 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 136 zval = MAX( 1., zstrn(ji,jj) ) 137 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 138 zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 139 ENDIF 140 zmxl_chl(ji,jj,jk) = zval / 24. 141 zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval ) 142 ENDIF 143 END DO 144 END DO 145 END DO 133 DO_3D_11_11( 1, jpkm1 ) 134 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 135 zval = MAX( 1., zstrn(ji,jj) ) 136 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 137 zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 138 ENDIF 139 zmxl_chl(ji,jj,jk) = zval / 24. 140 zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval ) 141 ENDIF 142 END_3D 146 143 147 144 zprbio(:,:,:) = zprmaxn(:,:,:) * zmxl_fac(:,:,:) … … 154 151 WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 155 152 156 DO jk = 1, jpkm1 157 DO jj = 1, jpj 158 DO ji = 1, jpi 159 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 160 ! Computation of the P-I slope for nanos and diatoms 161 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 162 zadap = xadap * ztn / ( 2.+ ztn ) 163 ! 164 zpislopeadn(ji,jj,jk) = pislopen * trb(ji,jj,jk,jpnch) & 165 & /( trb(ji,jj,jk,jpphy) * 12. + rtrn) 166 zpislopeadp(ji,jj,jk) = pislopep * ( 1. + zadap * EXP( -0.25 * epico(ji,jj,jk) ) ) & 167 & * trb(ji,jj,jk,jppch) /( trb(ji,jj,jk,jppic) * 12. + rtrn) 168 zpislopeadd(ji,jj,jk) = pisloped * trb(ji,jj,jk,jpdch) & 169 & /( trb(ji,jj,jk,jpdia) * 12. + rtrn) 170 ! 171 zpislopen = zpislopeadn(ji,jj,jk) / ( zprbio(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 172 zpislopep = zpislopeadp(ji,jj,jk) / ( zprpic(ji,jj,jk) * rday * xlimpic(ji,jj,jk) + rtrn ) 173 zpisloped = zpislopeadd(ji,jj,jk) / ( zprdia(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 174 175 ! Computation of production function for Carbon 176 ! --------------------------------------------- 177 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 178 zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1.- EXP( -zpislopep * epico(ji,jj,jk) ) ) 179 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 180 181 ! Computation of production function for Chlorophyll 182 ! ------------------------------------------------- 183 zpislopen = zpislopen * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 184 zpisloped = zpisloped * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 185 zpislopep = zpislopep * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 186 zprchln(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) ) ) 187 zprchlp(ji,jj,jk) = zprmaxp(ji,jj,jk) * ( 1.- EXP( -zpislopep * epicom(ji,jj,jk) ) ) 188 zprchld(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) ) ) 189 ENDIF 190 END DO 191 END DO 192 END DO 193 194 DO jk = 1, jpkm1 195 DO jj = 1, jpj 196 DO ji = 1, jpi 197 198 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 199 ! Si/C of diatoms 200 ! ------------------------ 201 ! Si/C increases with iron stress and silicate availability 202 ! Si/C is arbitrariliy increased for very high Si concentrations 203 ! to mimic the very high ratios observed in the Southern Ocean (silpot2) 204 zlim = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi1 ) 205 zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 206 zsilfac = 3.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) ) ) + 1.e0 207 zsiborn = trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) 208 IF (gphit(ji,jj) < -30 ) THEN 209 zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 ) 210 ELSE 211 zsilfac2 = 1. + zsiborn / ( zsiborn + xksi2**3 ) 212 ENDIF 213 zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2 214 ENDIF 215 END DO 216 END DO 217 END DO 153 DO_3D_11_11( 1, jpkm1 ) 154 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 155 ! Computation of the P-I slope for nanos and diatoms 156 ztn = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. ) 157 zadap = xadap * ztn / ( 2.+ ztn ) 158 ! 159 zpislopeadn(ji,jj,jk) = pislopen * tr(ji,jj,jk,jpnch,Kbb) & 160 & /( tr(ji,jj,jk,jpphy,Kbb) * 12. + rtrn) 161 zpislopeadp(ji,jj,jk) = pislopep * ( 1. + zadap * EXP( -0.25 * epico(ji,jj,jk) ) ) & 162 & * tr(ji,jj,jk,jppch,Kbb) /( tr(ji,jj,jk,jppic,Kbb) * 12. + rtrn) 163 zpislopeadd(ji,jj,jk) = pisloped * tr(ji,jj,jk,jpdch,Kbb) & 164 & /( tr(ji,jj,jk,jpdia,Kbb) * 12. + rtrn) 165 ! 166 zpislopen = zpislopeadn(ji,jj,jk) / ( zprbio(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 167 zpislopep = zpislopeadp(ji,jj,jk) / ( zprpic(ji,jj,jk) * rday * xlimpic(ji,jj,jk) + rtrn ) 168 zpisloped = zpislopeadd(ji,jj,jk) / ( zprdia(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 169 170 ! Computation of production function for Carbon 171 ! --------------------------------------------- 172 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 173 zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1.- EXP( -zpislopep * epico(ji,jj,jk) ) ) 174 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 175 176 ! Computation of production function for Chlorophyll 177 ! ------------------------------------------------- 178 zpislopen = zpislopen * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 179 zpisloped = zpisloped * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 180 zpislopep = zpislopep * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 181 zprchln(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) ) ) 182 zprchlp(ji,jj,jk) = zprmaxp(ji,jj,jk) * ( 1.- EXP( -zpislopep * epicom(ji,jj,jk) ) ) 183 zprchld(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) ) ) 184 ENDIF 185 END_3D 186 187 DO_3D_11_11( 1, jpkm1 ) 188 189 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 190 ! Si/C of diatoms 191 ! ------------------------ 192 ! Si/C increases with iron stress and silicate availability 193 ! Si/C is arbitrariliy increased for very high Si concentrations 194 ! to mimic the very high ratios observed in the Southern Ocean (silpot2) 195 zlim = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi1 ) 196 zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 197 zsilfac = 3.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) ) ) + 1.e0 198 zsiborn = tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) 199 IF (gphit(ji,jj) < -30 ) THEN 200 zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 ) 201 ELSE 202 zsilfac2 = 1. + zsiborn / ( zsiborn + xksi2**3 ) 203 ENDIF 204 zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2 205 ENDIF 206 END_3D 218 207 219 208 ! Sea-ice effect on production 220 DO jk = 1, jpkm1 221 DO jj = 1, jpj 222 DO ji = 1, jpi 223 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 224 zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 225 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 226 zprnut(ji,jj,jk) = zprnut(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 227 END DO 228 END DO 229 END DO 209 DO_3D_11_11( 1, jpkm1 ) 210 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 211 zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 212 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 213 zprnut(ji,jj,jk) = zprnut(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 214 END_3D 230 215 231 216 ! Computation of the various production terms of nanophytoplankton 232 DO jk = 1, jpkm1 233 DO jj = 1, jpj 234 DO ji = 1, jpi 235 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 236 ! production terms for nanophyto. 237 zprorcan(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2 238 ! 239 zration = trb(ji,jj,jk,jpnph) / ( trb(ji,jj,jk,jpphy) + rtrn ) 240 zratiop = trb(ji,jj,jk,jppph) / ( trb(ji,jj,jk,jpphy) + rtrn ) 241 zratiof = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn ) 242 zprnutmax = zprnut(ji,jj,jk) * fvnuptk(ji,jj,jk) / rno3 * trb(ji,jj,jk,jpphy) * rfact2 243 ! Uptake of nitrogen 244 zrat = MIN( 1., zration / (xqnnmax(ji,jj,jk) + rtrn) ) 245 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 246 zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpnmin(ji,jj,jk) ) & 247 & / ( xqpnmax(ji,jj,jk) - xqpnmin(ji,jj,jk) + rtrn ), xlimnfe(ji,jj,jk) ) ) 248 zpronewn(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xnanono3(ji,jj,jk) 249 zproregn(ji,jj,jk) = zpronmax * xnanonh4(ji,jj,jk) 250 ! Uptake of phosphorus 251 zrat = MIN( 1., zratiop / (xqpnmax(ji,jj,jk) + rtrn) ) 252 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 253 zpropmax = zprnutmax * zmax * xlimnfe(ji,jj,jk) 254 zpropo4n(ji,jj,jk) = zpropmax * xnanopo4(ji,jj,jk) 255 zprodopn(ji,jj,jk) = zpropmax * xnanodop(ji,jj,jk) 256 ! Uptake of iron 257 zrat = MIN( 1., zratiof / qfnmax ) 258 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 259 zprofmax = zprnutmax * qfnmax * zmax 260 zprofen(ji,jj,jk) = zprofmax * xnanofer(ji,jj,jk) * ( 3. - 2.4 * xlimnfe(ji,jj,jk) & 261 & / ( xlimnfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xnanono3(ji,jj,jk) / ( rtrn & 262 & + xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) ) * (1. - xnanofer(ji,jj,jk) ) ) 263 ENDIF 264 END DO 265 END DO 266 END DO 217 DO_3D_11_11( 1, jpkm1 ) 218 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 219 ! production terms for nanophyto. 220 zprorcan(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * tr(ji,jj,jk,jpphy,Kbb) * rfact2 221 ! 222 zration = tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 223 zratiop = tr(ji,jj,jk,jppph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 224 zratiof = tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 225 zprnutmax = zprnut(ji,jj,jk) * fvnuptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jpphy,Kbb) * rfact2 226 ! Uptake of nitrogen 227 zrat = MIN( 1., zration / (xqnnmax(ji,jj,jk) + rtrn) ) 228 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 229 zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpnmin(ji,jj,jk) ) & 230 & / ( xqpnmax(ji,jj,jk) - xqpnmin(ji,jj,jk) + rtrn ), xlimnfe(ji,jj,jk) ) ) 231 zpronewn(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xnanono3(ji,jj,jk) 232 zproregn(ji,jj,jk) = zpronmax * xnanonh4(ji,jj,jk) 233 ! Uptake of phosphorus 234 zrat = MIN( 1., zratiop / (xqpnmax(ji,jj,jk) + rtrn) ) 235 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 236 zpropmax = zprnutmax * zmax * xlimnfe(ji,jj,jk) 237 zpropo4n(ji,jj,jk) = zpropmax * xnanopo4(ji,jj,jk) 238 zprodopn(ji,jj,jk) = zpropmax * xnanodop(ji,jj,jk) 239 ! Uptake of iron 240 zrat = MIN( 1., zratiof / qfnmax ) 241 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 242 zprofmax = zprnutmax * qfnmax * zmax 243 zprofen(ji,jj,jk) = zprofmax * xnanofer(ji,jj,jk) * ( 3. - 2.4 * xlimnfe(ji,jj,jk) & 244 & / ( xlimnfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xnanono3(ji,jj,jk) / ( rtrn & 245 & + xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) ) * (1. - xnanofer(ji,jj,jk) ) ) 246 ENDIF 247 END_3D 267 248 268 249 ! Computation of the various production terms of picophytoplankton 269 DO jk = 1, jpkm1 270 DO jj = 1, jpj 271 DO ji = 1, jpi 272 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 273 ! production terms for picophyto. 274 zprorcap(ji,jj,jk) = zprpic(ji,jj,jk) * xlimpic(ji,jj,jk) * trb(ji,jj,jk,jppic) * rfact2 275 ! 276 zration = trb(ji,jj,jk,jpnpi) / ( trb(ji,jj,jk,jppic) + rtrn ) 277 zratiop = trb(ji,jj,jk,jpppi) / ( trb(ji,jj,jk,jppic) + rtrn ) 278 zratiof = trb(ji,jj,jk,jppfe) / ( trb(ji,jj,jk,jppic) + rtrn ) 279 zprnutmax = zprnut(ji,jj,jk) * fvpuptk(ji,jj,jk) / rno3 * trb(ji,jj,jk,jppic) * rfact2 280 ! Uptake of nitrogen 281 zrat = MIN( 1., zration / (xqnpmax(ji,jj,jk) + rtrn) ) 282 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 283 zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqppmin(ji,jj,jk) ) & 284 & / ( xqppmax(ji,jj,jk) - xqppmin(ji,jj,jk) + rtrn ), xlimpfe(ji,jj,jk) ) ) 285 zpronewp(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xpicono3(ji,jj,jk) 286 zproregp(ji,jj,jk) = zpronmax * xpiconh4(ji,jj,jk) 287 ! Uptake of phosphorus 288 zrat = MIN( 1., zratiop / (xqppmax(ji,jj,jk) + rtrn) ) 289 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 290 zpropmax = zprnutmax * zmax * xlimpfe(ji,jj,jk) 291 zpropo4p(ji,jj,jk) = zpropmax * xpicopo4(ji,jj,jk) 292 zprodopp(ji,jj,jk) = zpropmax * xpicodop(ji,jj,jk) 293 ! Uptake of iron 294 zrat = MIN( 1., zratiof / qfpmax ) 295 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 296 zprofmax = zprnutmax * qfpmax * zmax 297 zprofep(ji,jj,jk) = zprofmax * xpicofer(ji,jj,jk) * ( 3. - 2.4 * xlimpfe(ji,jj,jk) & 298 & / ( xlimpfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xpicono3(ji,jj,jk) / ( rtrn & 299 & + xpicono3(ji,jj,jk) + xpiconh4(ji,jj,jk) ) * (1. - xpicofer(ji,jj,jk) ) ) 300 ENDIF 301 END DO 302 END DO 303 END DO 250 DO_3D_11_11( 1, jpkm1 ) 251 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 252 ! production terms for picophyto. 253 zprorcap(ji,jj,jk) = zprpic(ji,jj,jk) * xlimpic(ji,jj,jk) * tr(ji,jj,jk,jppic,Kbb) * rfact2 254 ! 255 zration = tr(ji,jj,jk,jpnpi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 256 zratiop = tr(ji,jj,jk,jpppi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 257 zratiof = tr(ji,jj,jk,jppfe,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 258 zprnutmax = zprnut(ji,jj,jk) * fvpuptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jppic,Kbb) * rfact2 259 ! Uptake of nitrogen 260 zrat = MIN( 1., zration / (xqnpmax(ji,jj,jk) + rtrn) ) 261 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 262 zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqppmin(ji,jj,jk) ) & 263 & / ( xqppmax(ji,jj,jk) - xqppmin(ji,jj,jk) + rtrn ), xlimpfe(ji,jj,jk) ) ) 264 zpronewp(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xpicono3(ji,jj,jk) 265 zproregp(ji,jj,jk) = zpronmax * xpiconh4(ji,jj,jk) 266 ! Uptake of phosphorus 267 zrat = MIN( 1., zratiop / (xqppmax(ji,jj,jk) + rtrn) ) 268 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 269 zpropmax = zprnutmax * zmax * xlimpfe(ji,jj,jk) 270 zpropo4p(ji,jj,jk) = zpropmax * xpicopo4(ji,jj,jk) 271 zprodopp(ji,jj,jk) = zpropmax * xpicodop(ji,jj,jk) 272 ! Uptake of iron 273 zrat = MIN( 1., zratiof / qfpmax ) 274 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 275 zprofmax = zprnutmax * qfpmax * zmax 276 zprofep(ji,jj,jk) = zprofmax * xpicofer(ji,jj,jk) * ( 3. - 2.4 * xlimpfe(ji,jj,jk) & 277 & / ( xlimpfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xpicono3(ji,jj,jk) / ( rtrn & 278 & + xpicono3(ji,jj,jk) + xpiconh4(ji,jj,jk) ) * (1. - xpicofer(ji,jj,jk) ) ) 279 ENDIF 280 END_3D 304 281 305 282 ! Computation of the various production terms of diatoms 306 DO jk = 1, jpkm1 307 DO jj = 1, jpj 308 DO ji = 1, jpi 309 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 310 ! production terms for diatomees 311 zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trb(ji,jj,jk,jpdia) * rfact2 312 ! Computation of the respiration term according to pahlow 313 ! & oschlies (2013) 314 ! 315 zration = trb(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 316 zratiop = trb(ji,jj,jk,jppdi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 317 zratiof = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn ) 318 zprnutmax = zprnut(ji,jj,jk) * fvduptk(ji,jj,jk) / rno3 * trb(ji,jj,jk,jpdia) * rfact2 319 ! Uptake of nitrogen 320 zrat = MIN( 1., zration / (xqndmax(ji,jj,jk) + rtrn) ) 321 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 322 zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpdmin(ji,jj,jk) ) & 323 & / ( xqpdmax(ji,jj,jk) - xqpdmin(ji,jj,jk) + rtrn ), xlimdfe(ji,jj,jk) ) ) 324 zpronewd(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xdiatno3(ji,jj,jk) 325 zproregd(ji,jj,jk) = zpronmax * xdiatnh4(ji,jj,jk) 326 ! Uptake of phosphorus 327 zrat = MIN( 1., zratiop / (xqpdmax(ji,jj,jk) + rtrn) ) 328 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 329 zpropmax = zprnutmax * zmax * xlimdfe(ji,jj,jk) 330 zpropo4d(ji,jj,jk) = zpropmax * xdiatpo4(ji,jj,jk) 331 zprodopd(ji,jj,jk) = zpropmax * xdiatdop(ji,jj,jk) 332 ! Uptake of iron 333 zrat = MIN( 1., zratiof / qfdmax ) 334 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 335 zprofmax = zprnutmax * qfdmax * zmax 336 zprofed(ji,jj,jk) = zprofmax * xdiatfer(ji,jj,jk) * ( 3. - 2.4 * xlimdfe(ji,jj,jk) & 337 & / ( xlimdfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xdiatno3(ji,jj,jk) / ( rtrn & 338 & + xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) ) * (1. - xdiatfer(ji,jj,jk) ) ) 339 ENDIF 340 END DO 341 END DO 342 END DO 343 344 DO jk = 1, jpkm1 345 DO jj = 1, jpj 346 DO ji = 1, jpi 347 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 348 ! production terms for nanophyto. ( chlorophyll ) 349 znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 350 zprod = rday * (zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)) * zprchln(ji,jj,jk) * xlimphy(ji,jj,jk) 351 thetannm_n = MIN ( thetannm, ( thetannm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem))) & 352 & * (1. - 1.14 / 43.4 * 20.)) 353 zprochln = thetannm_n * zprod / ( zpislopeadn(ji,jj,jk) * znanotot + rtrn ) 354 zprochln = MAX(zprochln, chlcmin * 12. * zprorcan (ji,jj,jk) ) 355 ! production terms for picophyto. ( chlorophyll ) 356 zpicotot = epicom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 357 zprod = rday * (zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)) * zprchlp(ji,jj,jk) * xlimpic(ji,jj,jk) 358 thetanpm_n = MIN ( thetanpm, ( thetanpm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem))) & 359 & * (1. - 1.14 / 43.4 * 20.)) 360 zprochlp = thetanpm_n * zprod / ( zpislopeadp(ji,jj,jk) * zpicotot + rtrn ) 361 zprochlp = MAX(zprochlp, chlcmin * 12. * zprorcap(ji,jj,jk) ) 362 ! production terms for diatomees ( chlorophyll ) 363 zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 364 zprod = rday * (zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)) * zprchld(ji,jj,jk) * xlimdia(ji,jj,jk) 365 thetandm_n = MIN ( thetandm, ( thetandm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem))) & 366 & * (1. - 1.14 / 43.4 * 20.)) 367 zprochld = thetandm_n * zprod / ( zpislopeadd(ji,jj,jk) * zdiattot + rtrn ) 368 zprochld = MAX(zprochld, chlcmin * 12. * zprorcad(ji,jj,jk) ) 369 ! Update the arrays TRA which contain the Chla sources and sinks 370 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln * texcretn 371 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld * texcretd 372 tra(ji,jj,jk,jppch) = tra(ji,jj,jk,jppch) + zprochlp * texcretp 373 ENDIF 374 END DO 375 END DO 376 END DO 283 DO_3D_11_11( 1, jpkm1 ) 284 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 285 ! production terms for diatomees 286 zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr(ji,jj,jk,jpdia,Kbb) * rfact2 287 ! Computation of the respiration term according to pahlow 288 ! & oschlies (2013) 289 ! 290 zration = tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 291 zratiop = tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 292 zratiof = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 293 zprnutmax = zprnut(ji,jj,jk) * fvduptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jpdia,Kbb) * rfact2 294 ! Uptake of nitrogen 295 zrat = MIN( 1., zration / (xqndmax(ji,jj,jk) + rtrn) ) 296 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 297 zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpdmin(ji,jj,jk) ) & 298 & / ( xqpdmax(ji,jj,jk) - xqpdmin(ji,jj,jk) + rtrn ), xlimdfe(ji,jj,jk) ) ) 299 zpronewd(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xdiatno3(ji,jj,jk) 300 zproregd(ji,jj,jk) = zpronmax * xdiatnh4(ji,jj,jk) 301 ! Uptake of phosphorus 302 zrat = MIN( 1., zratiop / (xqpdmax(ji,jj,jk) + rtrn) ) 303 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 304 zpropmax = zprnutmax * zmax * xlimdfe(ji,jj,jk) 305 zpropo4d(ji,jj,jk) = zpropmax * xdiatpo4(ji,jj,jk) 306 zprodopd(ji,jj,jk) = zpropmax * xdiatdop(ji,jj,jk) 307 ! Uptake of iron 308 zrat = MIN( 1., zratiof / qfdmax ) 309 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 310 zprofmax = zprnutmax * qfdmax * zmax 311 zprofed(ji,jj,jk) = zprofmax * xdiatfer(ji,jj,jk) * ( 3. - 2.4 * xlimdfe(ji,jj,jk) & 312 & / ( xlimdfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xdiatno3(ji,jj,jk) / ( rtrn & 313 & + xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) ) * (1. - xdiatfer(ji,jj,jk) ) ) 314 ENDIF 315 END_3D 316 317 DO_3D_11_11( 1, jpkm1 ) 318 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 319 ! production terms for nanophyto. ( chlorophyll ) 320 znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 321 zprod = rday * (zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)) * zprchln(ji,jj,jk) * xlimphy(ji,jj,jk) 322 thetannm_n = MIN ( thetannm, ( thetannm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm))) & 323 & * (1. - 1.14 / 43.4 * 20.)) 324 zprochln = thetannm_n * zprod / ( zpislopeadn(ji,jj,jk) * znanotot + rtrn ) 325 zprochln = MAX(zprochln, chlcmin * 12. * zprorcan (ji,jj,jk) ) 326 ! production terms for picophyto. ( chlorophyll ) 327 zpicotot = epicom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 328 zprod = rday * (zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)) * zprchlp(ji,jj,jk) * xlimpic(ji,jj,jk) 329 thetanpm_n = MIN ( thetanpm, ( thetanpm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm))) & 330 & * (1. - 1.14 / 43.4 * 20.)) 331 zprochlp = thetanpm_n * zprod / ( zpislopeadp(ji,jj,jk) * zpicotot + rtrn ) 332 zprochlp = MAX(zprochlp, chlcmin * 12. * zprorcap(ji,jj,jk) ) 333 ! production terms for diatomees ( chlorophyll ) 334 zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 335 zprod = rday * (zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)) * zprchld(ji,jj,jk) * xlimdia(ji,jj,jk) 336 thetandm_n = MIN ( thetandm, ( thetandm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm))) & 337 & * (1. - 1.14 / 43.4 * 20.)) 338 zprochld = thetandm_n * zprod / ( zpislopeadd(ji,jj,jk) * zdiattot + rtrn ) 339 zprochld = MAX(zprochld, chlcmin * 12. * zprorcad(ji,jj,jk) ) 340 ! Update the arrays TRA which contain the Chla sources and sinks 341 tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) + zprochln * texcretn 342 tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) + zprochld * texcretd 343 tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) + zprochlp * texcretp 344 ENDIF 345 END_3D 377 346 378 347 ! Update the arrays TRA which contain the biological sources and sinks 379 DO jk = 1, jpkm1 380 DO jj = 1, jpj 381 DO ji =1 ,jpi 382 zprontot = zpronewn(ji,jj,jk) + zproregn(ji,jj,jk) 383 zproptot = zpronewp(ji,jj,jk) + zproregp(ji,jj,jk) 384 zprodtot = zpronewd(ji,jj,jk) + zproregd(ji,jj,jk) 385 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) & 386 & + excretp * zprorcap(ji,jj,jk) 387 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zpropo4n(ji,jj,jk) - zpropo4d(ji,jj,jk) & 388 & - zpropo4p(ji,jj,jk) 389 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk) & 390 & - zpronewp(ji,jj,jk) 391 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproregn(ji,jj,jk) - zproregd(ji,jj,jk) & 392 & - zproregp(ji,jj,jk) 393 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorcan(ji,jj,jk) * texcretn & 394 & - zpsino3 * zpronewn(ji,jj,jk) - zpsinh4 * zproregn(ji,jj,jk) & 395 & - zrespn(ji,jj,jk) 396 zcroissn(ji,jj,jk) = tra(ji,jj,jk,jpphy) / rfact2/ (trb(ji,jj,jk,jpphy) + rtrn) 397 tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) + zprontot * texcretn 398 tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) + zpropo4n(ji,jj,jk) * texcretn & 399 & + zprodopn(ji,jj,jk) * texcretn 400 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcretn 401 tra(ji,jj,jk,jppic) = tra(ji,jj,jk,jppic) + zprorcap(ji,jj,jk) * texcretp & 402 & - zpsino3 * zpronewp(ji,jj,jk) - zpsinh4 * zproregp(ji,jj,jk) & 403 & - zrespp(ji,jj,jk) 404 zcroissp(ji,jj,jk) = tra(ji,jj,jk,jppic) / rfact2/ (trb(ji,jj,jk,jppic) + rtrn) 405 tra(ji,jj,jk,jpnpi) = tra(ji,jj,jk,jpnpi) + zproptot * texcretp 406 tra(ji,jj,jk,jpppi) = tra(ji,jj,jk,jpppi) + zpropo4p(ji,jj,jk) * texcretp & 407 & + zprodopp(ji,jj,jk) * texcretp 408 tra(ji,jj,jk,jppfe) = tra(ji,jj,jk,jppfe) + zprofep(ji,jj,jk) * texcretp 409 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcretd & 410 & - zpsino3 * zpronewd(ji,jj,jk) - zpsinh4 * zproregd(ji,jj,jk) & 411 & - zrespd(ji,jj,jk) 412 zcroissd(ji,jj,jk) = tra(ji,jj,jk,jpdia) / rfact2 / (trb(ji,jj,jk,jpdia) + rtrn) 413 tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) + zprodtot * texcretd 414 tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) + zpropo4d(ji,jj,jk) * texcretd & 415 & + zprodopd(ji,jj,jk) * texcretd 416 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcretd 417 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 418 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) & 419 & + excretp * zprorcap(ji,jj,jk) 420 tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + excretd * zprodtot + excretn * zprontot & 421 & + excretp * zproptot 422 tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + excretd * zpropo4d(ji,jj,jk) + excretn * zpropo4n(ji,jj,jk) & 423 & - texcretn * zprodopn(ji,jj,jk) - texcretd * zprodopd(ji,jj,jk) + excretp * zpropo4p(ji,jj,jk) & 424 & - texcretp * zprodopp(ji,jj,jk) 425 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk) & 426 & + zproregp(ji,jj,jk) ) + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) & 427 & + zpronewd(ji,jj,jk) + zpronewp(ji,jj,jk) ) & 428 & - o2ut * ( zrespn(ji,jj,jk) + zrespp(ji,jj,jk) + zrespd(ji,jj,jk) ) 429 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) 430 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zfeup 431 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 432 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) - zprorcap(ji,jj,jk) & 433 & + zpsino3 * zpronewn(ji,jj,jk) + zpsinh4 * zproregn(ji,jj,jk) & 434 & + zpsino3 * zpronewp(ji,jj,jk) + zpsinh4 * zproregp(ji,jj,jk) & 435 & + zpsino3 * zpronewd(ji,jj,jk) + zpsinh4 * zproregd(ji,jj,jk) & 436 & + zrespn(ji,jj,jk) + zrespd(ji,jj,jk) + zrespp(ji,jj,jk) 437 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) & 438 & + zpronewp(ji,jj,jk) ) - rno3 * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk) & 439 & + zproregp(ji,jj,jk) ) 440 END DO 441 END DO 442 END DO 348 DO_3D_11_11( 1, jpkm1 ) 349 zprontot = zpronewn(ji,jj,jk) + zproregn(ji,jj,jk) 350 zproptot = zpronewp(ji,jj,jk) + zproregp(ji,jj,jk) 351 zprodtot = zpronewd(ji,jj,jk) + zproregd(ji,jj,jk) 352 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) & 353 & + excretp * zprorcap(ji,jj,jk) 354 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zpropo4n(ji,jj,jk) - zpropo4d(ji,jj,jk) & 355 & - zpropo4p(ji,jj,jk) 356 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk) & 357 & - zpronewp(ji,jj,jk) 358 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zproregn(ji,jj,jk) - zproregd(ji,jj,jk) & 359 & - zproregp(ji,jj,jk) 360 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zprorcan(ji,jj,jk) * texcretn & 361 & - zpsino3 * zpronewn(ji,jj,jk) - zpsinh4 * zproregn(ji,jj,jk) & 362 & - zrespn(ji,jj,jk) 363 zcroissn(ji,jj,jk) = tr(ji,jj,jk,jpphy,Krhs) / rfact2/ (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 364 tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) + zprontot * texcretn 365 tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) + zpropo4n(ji,jj,jk) * texcretn & 366 & + zprodopn(ji,jj,jk) * texcretn 367 tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) + zprofen(ji,jj,jk) * texcretn 368 tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) + zprorcap(ji,jj,jk) * texcretp & 369 & - zpsino3 * zpronewp(ji,jj,jk) - zpsinh4 * zproregp(ji,jj,jk) & 370 & - zrespp(ji,jj,jk) 371 zcroissp(ji,jj,jk) = tr(ji,jj,jk,jppic,Krhs) / rfact2/ (tr(ji,jj,jk,jppic,Kbb) + rtrn) 372 tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) + zproptot * texcretp 373 tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) + zpropo4p(ji,jj,jk) * texcretp & 374 & + zprodopp(ji,jj,jk) * texcretp 375 tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) + zprofep(ji,jj,jk) * texcretp 376 tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) + zprorcad(ji,jj,jk) * texcretd & 377 & - zpsino3 * zpronewd(ji,jj,jk) - zpsinh4 * zproregd(ji,jj,jk) & 378 & - zrespd(ji,jj,jk) 379 zcroissd(ji,jj,jk) = tr(ji,jj,jk,jpdia,Krhs) / rfact2 / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 380 tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) + zprodtot * texcretd 381 tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) + zpropo4d(ji,jj,jk) * texcretd & 382 & + zprodopd(ji,jj,jk) * texcretd 383 tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) + zprofed(ji,jj,jk) * texcretd 384 tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 385 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) & 386 & + excretp * zprorcap(ji,jj,jk) 387 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + excretd * zprodtot + excretn * zprontot & 388 & + excretp * zproptot 389 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + excretd * zpropo4d(ji,jj,jk) + excretn * zpropo4n(ji,jj,jk) & 390 & - texcretn * zprodopn(ji,jj,jk) - texcretd * zprodopd(ji,jj,jk) + excretp * zpropo4p(ji,jj,jk) & 391 & - texcretp * zprodopp(ji,jj,jk) 392 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + o2ut * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk) & 393 & + zproregp(ji,jj,jk) ) + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) & 394 & + zpronewd(ji,jj,jk) + zpronewp(ji,jj,jk) ) & 395 & - o2ut * ( zrespn(ji,jj,jk) + zrespp(ji,jj,jk) + zrespd(ji,jj,jk) ) 396 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) 397 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zfeup 398 tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 399 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) - zprorcap(ji,jj,jk) & 400 & + zpsino3 * zpronewn(ji,jj,jk) + zpsinh4 * zproregn(ji,jj,jk) & 401 & + zpsino3 * zpronewp(ji,jj,jk) + zpsinh4 * zproregp(ji,jj,jk) & 402 & + zpsino3 * zpronewd(ji,jj,jk) + zpsinh4 * zproregd(ji,jj,jk) & 403 & + zrespn(ji,jj,jk) + zrespd(ji,jj,jk) + zrespp(ji,jj,jk) 404 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) & 405 & + zpronewp(ji,jj,jk) ) - rno3 * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk) & 406 & + zproregp(ji,jj,jk) ) 407 END_3D 443 408 ! 444 409 IF( ln_ligand ) THEN 445 zpligprod1(:,:,:) = 0._wp ; zpligprod2(:,:,:) = 0._wp 446 DO jk = 1, jpkm1 447 DO jj = 1, jpj 448 DO ji =1 ,jpi 449 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) + excretp * zprorcap(ji,jj,jk) 450 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) 451 tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 452 zpligprod1(ji,jj,jk) = zdocprod * ldocp 453 zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet 454 END DO 455 END DO 456 END DO 410 zpligprod1(:,:,:) = 0._wp ; zpligprod2(:,:,:) = 0._wp 411 DO_3D_11_11( 1, jpkm1 ) 412 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) + excretp * zprorcap(ji,jj,jk) 413 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) 414 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 415 zpligprod1(ji,jj,jk) = zdocprod * ldocp 416 zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet 417 END_3D 457 418 ENDIF 458 419 … … 497 458 ENDIF 498 459 499 IF( ln_ctl) THEN ! print mean trends (used for debugging)460 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 500 461 WRITE(charout, FMT="('prod')") 501 462 CALL prt_ctl_trc_info(charout) 502 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)463 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 503 464 ENDIF 504 465 ! … … 525 486 !!---------------------------------------------------------------------- 526 487 527 REWIND( numnatp_ref )528 488 READ ( numnatp_ref, namp5zprod, IOSTAT = ios, ERR = 901) 529 489 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp5zprod in reference namelist' ) 530 490 531 REWIND( numnatp_cfg )532 491 READ ( numnatp_cfg, namp5zprod, IOSTAT = ios, ERR = 902 ) 533 492 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namp5zprod in configuration namelist' ) -
NEMO/trunk/src/TOP/PISCES/SED/oce_sed.F90
r10362 r12377 13 13 USE dom_oce , ONLY : glamt => glamt !: longitude of t-point (degre) 14 14 USE dom_oce , ONLY : gphit => gphit !: latitude of t-point (degre) 15 USE dom_oce , ONLY : e3t _n => e3t_n!: latitude of t-point (degre)15 USE dom_oce , ONLY : e3t => e3t !: latitude of t-point (degre) 16 16 USE dom_oce , ONLY : e3t_1d => e3t_1d !: reference depth of t-points (m) 17 17 USE dom_oce , ONLY : gdepw_0 => gdepw_0 !: reference depth of t-points (m) … … 26 26 ! !: that may have been run with different time steps. 27 27 28 USE oce , ONLY : tsn => tsn!: pot. temperature (celsius) and salinity (psu)29 USE trc , ONLY : trb => trb!: pot. temperature (celsius) and salinity (psu)28 USE oce , ONLY : ts => ts !: pot. temperature (celsius) and salinity (psu) 29 USE trc , ONLY : tr => tr !: pot. temperature (celsius) and salinity (psu) 30 30 31 31 USE sms_pisces, ONLY : wsbio4 => wsbio4 !: sinking flux for POC 32 32 USE sms_pisces, ONLY : wsbio3 => wsbio3 !: sinking flux for GOC 33 USE sms_pisces, ONLY : wsbio2 => wsbio2 33 USE sms_pisces, ONLY : wsbio2 => wsbio2 !: sinking flux for calcite 34 34 USE sms_pisces, ONLY : wsbio => wsbio !: sinking flux for calcite 35 35 USE sms_pisces, ONLY : ln_p5z => ln_p5z !: PISCES-QUOTA flag … … 49 49 USE p4zche, ONLY : sulfat => sulfat !: Chemical constants 50 50 USE p4zche, ONLY : sio3eq => sio3eq !: Chemical constants 51 USE p4z sbc, ONLY : dust => dust52 USE trc 51 USE p4zbc, ONLY : dust => dust 52 USE trc , ONLY : r2dttrc => r2dttrc 53 53 54 54 END MODULE oce_sed -
NEMO/trunk/src/TOP/PISCES/SED/sedchem.F90
r10356 r12377 23 23 REAL(wp), PARAMETER :: pp_rdel_ah_target = 1.E-4_wp 24 24 25 !! * Substitutions 26 # include "do_loop_substitute.h90" 25 27 !! * Module variables 26 28 REAL(wp) :: & … … 136 138 CALL sed_chem_cst 137 139 ELSE 138 DO jj = 1,jpj 139 DO ji = 1, jpi 140 ikt = mbkt(ji,jj) 141 IF ( tmask(ji,jj,ikt) == 1 ) THEN 142 zchem_data(ji,jj,1) = ak13 (ji,jj,ikt) 143 zchem_data(ji,jj,2) = ak23 (ji,jj,ikt) 144 zchem_data(ji,jj,3) = akb3 (ji,jj,ikt) 145 zchem_data(ji,jj,4) = akw3 (ji,jj,ikt) 146 zchem_data(ji,jj,5) = aksp (ji,jj,ikt) 147 zchem_data(ji,jj,6) = borat (ji,jj,ikt) 148 zchem_data(ji,jj,7) = ak1p3 (ji,jj,ikt) 149 zchem_data(ji,jj,8) = ak2p3 (ji,jj,ikt) 150 zchem_data(ji,jj,9) = ak3p3 (ji,jj,ikt) 151 zchem_data(ji,jj,10)= aksi3 (ji,jj,ikt) 152 zchem_data(ji,jj,11)= sio3eq(ji,jj,ikt) 153 zchem_data(ji,jj,12)= aks3 (ji,jj,ikt) 154 zchem_data(ji,jj,13)= akf3 (ji,jj,ikt) 155 zchem_data(ji,jj,14)= sulfat(ji,jj,ikt) 156 zchem_data(ji,jj,15)= fluorid(ji,jj,ikt) 157 ENDIF 158 ENDDO 159 ENDDO 140 DO_2D_11_11 141 ikt = mbkt(ji,jj) 142 IF ( tmask(ji,jj,ikt) == 1 ) THEN 143 zchem_data(ji,jj,1) = ak13 (ji,jj,ikt) 144 zchem_data(ji,jj,2) = ak23 (ji,jj,ikt) 145 zchem_data(ji,jj,3) = akb3 (ji,jj,ikt) 146 zchem_data(ji,jj,4) = akw3 (ji,jj,ikt) 147 zchem_data(ji,jj,5) = aksp (ji,jj,ikt) 148 zchem_data(ji,jj,6) = borat (ji,jj,ikt) 149 zchem_data(ji,jj,7) = ak1p3 (ji,jj,ikt) 150 zchem_data(ji,jj,8) = ak2p3 (ji,jj,ikt) 151 zchem_data(ji,jj,9) = ak3p3 (ji,jj,ikt) 152 zchem_data(ji,jj,10)= aksi3 (ji,jj,ikt) 153 zchem_data(ji,jj,11)= sio3eq(ji,jj,ikt) 154 zchem_data(ji,jj,12)= aks3 (ji,jj,ikt) 155 zchem_data(ji,jj,13)= akf3 (ji,jj,ikt) 156 zchem_data(ji,jj,14)= sulfat(ji,jj,ikt) 157 zchem_data(ji,jj,15)= fluorid(ji,jj,ikt) 158 ENDIF 159 END_2D 160 160 161 161 CALL pack_arr ( jpoce, ak1s (1:jpoce), zchem_data(1:jpi,1:jpj,1) , iarroce(1:jpoce) ) -
NEMO/trunk/src/TOP/PISCES/SED/seddta.F90
r10362 r12377 22 22 REAL(wp) :: conv2 ! [kg/m2/month]-->[g/cm2/s] ( 1 month has 30 days ) 23 23 24 !! * Substitutions 25 # include "do_loop_substitute.h90" 24 26 !! $Id$ 25 27 CONTAINS … … 29 31 !!--------------------------------------------------------------------------- 30 32 31 SUBROUTINE sed_dta( kt )33 SUBROUTINE sed_dta( kt, Kbb, Kmm ) 32 34 !!---------------------------------------------------------------------- 33 35 !! *** ROUTINE sed_dta *** … … 43 45 44 46 !! Arguments 45 INTEGER, INTENT(in) :: kt ! time-step 47 INTEGER, INTENT(in) :: kt ! time-step 48 INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices 46 49 47 50 !! * Local declarations … … 92 95 ! ----------------------------------------------------------- 93 96 IF (ln_sediment_offline) THEN 94 DO jj = 1, jpj 95 DO ji = 1, jpi 96 ikt = mbkt(ji,jj) 97 zwsbio4(ji,jj) = wsbio2 / rday 98 zwsbio3(ji,jj) = wsbio / rday 99 END DO 100 END DO 97 DO_2D_11_11 98 ikt = mbkt(ji,jj) 99 zwsbio4(ji,jj) = wsbio2 / rday 100 zwsbio3(ji,jj) = wsbio / rday 101 END_2D 101 102 ELSE 102 DO jj = 1, jpj 103 DO ji = 1, jpi 104 ikt = mbkt(ji,jj) 105 zdep = e3t_n(ji,jj,ikt) / r2dttrc 106 zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) / rday ) 107 zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) / rday ) 108 END DO 109 END DO 103 DO_2D_11_11 104 ikt = mbkt(ji,jj) 105 zdep = e3t(ji,jj,ikt,Kmm) / r2dttrc 106 zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) / rday ) 107 zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) / rday ) 108 END_2D 110 109 ENDIF 111 110 112 111 trc_data(:,:,:) = 0. 113 DO jj = 1,jpj 114 DO ji = 1, jpi 115 ikt = mbkt(ji,jj) 116 IF ( tmask(ji,jj,ikt) == 1 ) THEN 117 trc_data(ji,jj,1) = trb(ji,jj,ikt,jpsil) 118 trc_data(ji,jj,2) = trb(ji,jj,ikt,jpoxy) 119 trc_data(ji,jj,3) = trb(ji,jj,ikt,jpdic) 120 trc_data(ji,jj,4) = trb(ji,jj,ikt,jpno3) / 7.625 121 trc_data(ji,jj,5) = trb(ji,jj,ikt,jppo4) / 122. 122 trc_data(ji,jj,6) = trb(ji,jj,ikt,jptal) 123 trc_data(ji,jj,7) = trb(ji,jj,ikt,jpnh4) / 7.625 124 trc_data(ji,jj,8) = 0.0 125 trc_data(ji,jj,9) = 28.0E-3 126 trc_data(ji,jj,10) = trb(ji,jj,ikt,jpfer) 127 trc_data(ji,jj,11 ) = MIN(trb(ji,jj,ikt,jpgsi), 1E-4) * zwsbio4(ji,jj) * 1E3 128 trc_data(ji,jj,12 ) = MIN(trb(ji,jj,ikt,jppoc), 1E-4) * zwsbio3(ji,jj) * 1E3 129 trc_data(ji,jj,13 ) = MIN(trb(ji,jj,ikt,jpgoc), 1E-4) * zwsbio4(ji,jj) * 1E3 130 trc_data(ji,jj,14) = MIN(trb(ji,jj,ikt,jpcal), 1E-4) * zwsbio4(ji,jj) * 1E3 131 trc_data(ji,jj,15) = tsn(ji,jj,ikt,jp_tem) 132 trc_data(ji,jj,16) = tsn(ji,jj,ikt,jp_sal) 133 trc_data(ji,jj,17 ) = ( trb(ji,jj,ikt,jpsfe) * zwsbio3(ji,jj) + trb(ji,jj,ikt,jpbfe) & 134 & * zwsbio4(ji,jj) ) * 1E3 / ( trc_data(ji,jj,12 ) + trc_data(ji,jj,13 ) + rtrn ) 135 trc_data(ji,jj,17 ) = MIN(1E-3, trc_data(ji,jj,17 ) ) 136 ENDIF 137 ENDDO 138 ENDDO 112 DO_2D_11_11 113 ikt = mbkt(ji,jj) 114 IF ( tmask(ji,jj,ikt) == 1 ) THEN 115 trc_data(ji,jj,1) = tr(ji,jj,ikt,jpsil,Kbb) 116 trc_data(ji,jj,2) = tr(ji,jj,ikt,jpoxy,Kbb) 117 trc_data(ji,jj,3) = tr(ji,jj,ikt,jpdic,Kbb) 118 trc_data(ji,jj,4) = tr(ji,jj,ikt,jpno3,Kbb) / 7.625 119 trc_data(ji,jj,5) = tr(ji,jj,ikt,jppo4,Kbb) / 122. 120 trc_data(ji,jj,6) = tr(ji,jj,ikt,jptal,Kbb) 121 trc_data(ji,jj,7) = tr(ji,jj,ikt,jpnh4,Kbb) / 7.625 122 trc_data(ji,jj,8) = 0.0 123 trc_data(ji,jj,9) = 28.0E-3 124 trc_data(ji,jj,10) = tr(ji,jj,ikt,jpfer,Kbb) 125 trc_data(ji,jj,11 ) = MIN(tr(ji,jj,ikt,jpgsi,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 126 trc_data(ji,jj,12 ) = MIN(tr(ji,jj,ikt,jppoc,Kbb), 1E-4) * zwsbio3(ji,jj) * 1E3 127 trc_data(ji,jj,13 ) = MIN(tr(ji,jj,ikt,jpgoc,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 128 trc_data(ji,jj,14) = MIN(tr(ji,jj,ikt,jpcal,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 129 trc_data(ji,jj,15) = ts(ji,jj,ikt,jp_tem,Kmm) 130 trc_data(ji,jj,16) = ts(ji,jj,ikt,jp_sal,Kmm) 131 trc_data(ji,jj,17 ) = ( tr(ji,jj,ikt,jpsfe,Kbb) * zwsbio3(ji,jj) + tr(ji,jj,ikt,jpbfe,Kbb) & 132 & * zwsbio4(ji,jj) ) * 1E3 / ( trc_data(ji,jj,12 ) + trc_data(ji,jj,13 ) + rtrn ) 133 trc_data(ji,jj,17 ) = MIN(1E-3, trc_data(ji,jj,17 ) ) 134 ENDIF 135 END_2D 139 136 140 137 ! Pore water initial concentration [mol/l] in k=1 -
NEMO/trunk/src/TOP/PISCES/SED/sedini.F90
r11536 r12377 13 13 USE sedarr 14 14 USE sedadv 15 USE trc_oce, ONLY : nn_dttrc16 15 USE trcdmp_sed 17 16 USE trcdta … … 23 22 PRIVATE 24 23 24 !! * Substitutions 25 # include "do_loop_substitute.h90" 25 26 !! Module variables 26 27 REAL(wp) :: & … … 134 135 ! Determination of sediments number of points and allocate global variables 135 136 epkbot(:,:) = 0. 136 DO jj = 1, jpj 137 DO ji = 1, jpi 138 ikt = mbkt(ji,jj) 139 IF( tmask(ji,jj,ikt) == 1 ) epkbot(ji,jj) = e3t_1d(ikt) 140 gdepbot(ji,jj) = gdepw_0(ji,jj,ikt) 141 ENDDO 142 ENDDO 137 DO_2D_11_11 138 ikt = mbkt(ji,jj) 139 IF( tmask(ji,jj,ikt) == 1 ) epkbot(ji,jj) = e3t_1d(ikt) 140 gdepbot(ji,jj) = gdepw_0(ji,jj,ikt) 141 END_2D 143 142 144 143 ! computation of total number of ocean points … … 248 247 ! Computation of 1D array of sediments points 249 248 indoce = 0 250 DO jj = 1, jpj 251 DO ji = 1, jpi 252 IF ( epkbot(ji,jj) > 0. ) THEN 253 indoce = indoce + 1 254 iarroce(indoce) = (jj - 1) * jpi + ji 255 ENDIF 256 END DO 257 END DO 249 DO_2D_11_11 250 IF ( epkbot(ji,jj) > 0. ) THEN 251 indoce = indoce + 1 252 iarroce(indoce) = (jj - 1) * jpi + ji 253 ENDIF 254 END_2D 258 255 259 256 IF ( indoce .EQ. 0 ) THEN … … 406 403 !!---------------------------------------------------------------------- 407 404 408 INTEGER :: numnamsed_ref = -1 !! Logical units fornamelist sediment409 INTEGER :: numnamsed_cfg = -1 !! Logical units fornamelist sediment405 CHARACTER(:), ALLOCATABLE :: numnamsed_ref !! Character buffer for reference namelist sediment 406 CHARACTER(:), ALLOCATABLE :: numnamsed_cfg !! Character buffer for configuration namelist sediment 410 407 INTEGER :: ios ! Local integer output status for namelist read 411 408 CHARACTER(LEN=20) :: clname … … 452 449 IF(lwp) WRITE(numsed,*) ' sed_init_nam : read SEDIMENT namelist' 453 450 IF(lwp) WRITE(numsed,*) ' ~~~~~~~~~~~~~~' 454 CALL ctl_opn( numnamsed_ref, TRIM( clname )//'_ref', 'OLD' , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE.)455 CALL ctl_opn( numnamsed_cfg, TRIM( clname )//'_cfg', 'OLD' , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE.)451 CALL load_nml( numnamsed_ref, TRIM( clname )//'_ref', numout, lwm ) 452 CALL load_nml( numnamsed_cfg, TRIM( clname )//'_cfg', numout, lwm ) 456 453 457 454 nitsed000 = nittrc000 458 455 nitsedend = nitend 459 456 ! Namelist nam_run 460 REWIND( numnamsed_ref ) ! Namelist nam_run in reference namelist : Pisces variables461 457 READ ( numnamsed_ref, nam_run, IOSTAT = ios, ERR = 901) 462 458 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_run in reference namelist' ) 463 459 464 REWIND( numnamsed_cfg ) ! Namelist nam_run in reference namelist : Pisces variables465 460 READ ( numnamsed_cfg, nam_run, IOSTAT = ios, ERR = 902) 466 461 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_run in configuration namelist' ) … … 474 469 IF ( ln_p5z .AND. ln_sed_2way ) CALL ctl_stop( '2 ways coupling with sediment cannot be activated with PISCES-QUOTA' ) 475 470 476 REWIND( numnamsed_ref ) ! Namelist nam_geom in reference namelist : Pisces variables477 471 READ ( numnamsed_ref, nam_geom, IOSTAT = ios, ERR = 903) 478 472 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_geom in reference namelist' ) 479 473 480 REWIND( numnamsed_cfg ) ! Namelist nam_geom in reference namelist : Pisces variables481 474 READ ( numnamsed_cfg, nam_geom, IOSTAT = ios, ERR = 904) 482 475 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_geom in configuration namelist' ) … … 497 490 dtsed = r2dttrc 498 491 499 REWIND( numnamsed_ref ) ! Namelist nam_trased in reference namelist : Pisces variables500 492 READ ( numnamsed_ref, nam_trased, IOSTAT = ios, ERR = 905) 501 493 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_trased in reference namelist' ) 502 494 503 REWIND( numnamsed_cfg ) ! Namelist nam_trased in reference namelist : Pisces variables504 495 READ ( numnamsed_cfg, nam_trased, IOSTAT = ios, ERR = 906) 505 496 906 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_trased in configuration namelist' ) … … 530 521 ENDIF 531 522 532 REWIND( numnamsed_ref ) ! Namelist nam_diased in reference namelist : Pisces variables533 523 READ ( numnamsed_ref, nam_diased, IOSTAT = ios, ERR = 907) 534 524 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diased in reference namelist' ) 535 525 536 REWIND( numnamsed_cfg ) ! Namelist nam_diased in reference namelist : Pisces variables537 526 READ ( numnamsed_cfg, nam_diased, IOSTAT = ios, ERR = 908) 538 527 908 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diased in configuration namelist' ) … … 572 561 ! Inorganic chemistry parameters 573 562 !---------------------------------- 574 REWIND( numnamsed_ref ) ! Namelist nam_inorg in reference namelist : Pisces variables575 563 READ ( numnamsed_ref, nam_inorg, IOSTAT = ios, ERR = 909) 576 564 909 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_inorg in reference namelist' ) 577 565 578 REWIND( numnamsed_cfg ) ! Namelist nam_inorg in reference namelist : Pisces variables579 566 READ ( numnamsed_cfg, nam_inorg, IOSTAT = ios, ERR = 910) 580 567 910 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_inorg in configuration namelist' ) … … 598 585 ! Additional parameter linked to POC/O2/No3/Po4 599 586 !---------------------------------------------- 600 REWIND( numnamsed_ref ) ! Namelist nam_poc in reference namelist : Pisces variables601 587 READ ( numnamsed_ref, nam_poc, IOSTAT = ios, ERR = 911) 602 588 911 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_poc in reference namelist' ) 603 589 604 REWIND( numnamsed_cfg ) ! Namelist nam_poc in reference namelist : Pisces variables605 590 READ ( numnamsed_cfg, nam_poc, IOSTAT = ios, ERR = 912) 606 591 912 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_poc in configuration namelist' ) … … 650 635 ! Bioturbation parameter 651 636 !------------------------ 652 REWIND( numnamsed_ref ) ! Namelist nam_btb in reference namelist : Pisces variables653 637 READ ( numnamsed_ref, nam_btb, IOSTAT = ios, ERR = 913) 654 638 913 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_btb in reference namelist' ) 655 639 656 REWIND( numnamsed_cfg ) ! Namelist nam_btb in reference namelist : Pisces variables657 640 READ ( numnamsed_cfg, nam_btb, IOSTAT = ios, ERR = 914) 658 641 914 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_btb in configuration namelist' ) … … 671 654 ! Initial value (t=0) for sediment pore water and solid components 672 655 !---------------------------------------------------------------- 673 REWIND( numnamsed_ref ) ! Namelist nam_rst in reference namelist : Pisces variables674 656 READ ( numnamsed_ref, nam_rst, IOSTAT = ios, ERR = 915) 675 657 915 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_rst in reference namelist' ) 676 658 677 REWIND( numnamsed_cfg ) ! Namelist nam_rst in reference namelist : Pisces variables678 659 READ ( numnamsed_cfg, nam_rst, IOSTAT = ios, ERR = 916) 679 660 916 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_rst in configuration namelist' ) … … 684 665 WRITE(numsed,*) ' ' 685 666 ENDIF 686 nn_dtsed = nn_dttrc 687 688 CLOSE( numnamsed_cfg ) 689 CLOSE( numnamsed_ref ) 667 nn_dtsed = 1 668 690 669 691 670 END SUBROUTINE sed_init_nam -
NEMO/trunk/src/TOP/PISCES/SED/sedinitrc.F90
r10225 r12377 33 33 34 34 35 SUBROUTINE sed_initrc 35 SUBROUTINE sed_initrc( Kbb, Kmm ) 36 36 !!---------------------------------------------------------------------- 37 37 !! *** ROUTINE sed_init *** … … 50 50 !! ! 06-07 (C. Ethe) Re-organization 51 51 !!---------------------------------------------------------------------- 52 INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices 52 53 INTEGER :: ji, jj, ikt 53 54 !!---------------------------------------------------------------------- … … 65 66 ! ( only clay or reading restart file ) 66 67 !--------------------------------------- 67 CALL sed_init_data 68 CALL sed_init_data( Kbb, Kmm ) 68 69 69 70 … … 74 75 75 76 76 SUBROUTINE sed_init_data 77 SUBROUTINE sed_init_data( Kbb, Kmm ) 77 78 !!---------------------------------------------------------------------- 78 79 !! *** ROUTINE sed_init_data *** … … 85 86 !! ! 06-07 (C. Ethe) original 86 87 !!---------------------------------------------------------------------- 88 INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices 87 89 88 90 ! local variables … … 128 130 129 131 ! Load initial Pisces Data for bot. wat. Chem and fluxes 130 CALL sed_dta ( nitsed000 )132 CALL sed_dta ( nitsed000, Kbb, Kmm ) 131 133 132 134 ! Initialization of chemical constants -
NEMO/trunk/src/TOP/PISCES/SED/sedmodel.F90
r10222 r12377 16 16 CONTAINS 17 17 18 SUBROUTINE sed_model ( kt )18 SUBROUTINE sed_model ( kt, Kbb, Kmm, Krhs ) 19 19 !!--------------------------------------------------------------------- 20 20 !! *** ROUTINE sed_model *** … … 29 29 !! ! 07-02 (C. Ethe) Original 30 30 !!---------------------------------------------------------------------- 31 INTEGER, INTENT(in) :: kt ! number of iteration 31 INTEGER, INTENT(in) :: kt ! number of iteration 32 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 32 33 33 34 34 35 IF( ln_timing ) CALL timing_start('sed_model') 35 36 36 IF( kt == nittrc000 ) CALL sed_initrc ! Initialization of sediment model37 CALL sed_stp( kt ) ! Time stepping of Sediment model37 IF( kt == nittrc000 ) CALL sed_initrc( Kbb, Kmm ) ! Initialization of sediment model 38 CALL sed_stp( kt, Kbb, Kmm, Krhs ) ! Time stepping of Sediment model 38 39 39 40 IF( ln_timing ) CALL timing_stop('sed_model') -
NEMO/trunk/src/TOP/PISCES/SED/sedrst.F90
r11536 r12377 10 10 USE sed 11 11 USE sedarr 12 USE trc_oce, ONLY : l_offline , nn_dttrc12 USE trc_oce, ONLY : l_offline 13 13 USE phycst , ONLY : rday 14 14 USE iom … … 66 66 67 67 ! to get better performances with NetCDF format: 68 ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc +1)69 ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc +168 ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 1) 69 ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 1 70 70 IF( kt == nitrst - 2*nn_dtsed .OR. nn_stock == nn_dtsed .OR. ( kt == nitend - nn_dtsed .AND. .NOT. lrst_sed ) ) THEN 71 71 ! beware of the format used to write kt (default is i8.8, that should be large enough) -
NEMO/trunk/src/TOP/PISCES/SED/sedsfc.F90
r10222 r12377 11 11 PUBLIC sed_sfc 12 12 13 !! * Substitutions 14 # include "do_loop_substitute.h90" 13 15 !! $Id$ 14 16 CONTAINS 15 17 16 SUBROUTINE sed_sfc( kt )18 SUBROUTINE sed_sfc( kt, Kbb ) 17 19 !!--------------------------------------------------------------------- 18 20 !! *** ROUTINE sed_sfc *** … … 26 28 !!* Arguments 27 29 INTEGER, INTENT(in) :: kt ! time step 30 INTEGER, INTENT(in) :: Kbb ! time index 28 31 29 32 ! * local variables … … 45 48 46 49 47 DO jj = 1,jpj 48 DO ji = 1, jpi 49 ikt = mbkt(ji,jj) 50 IF ( tmask(ji,jj,ikt) == 1 ) THEN 51 trb(ji,jj,ikt,jptal) = trc_data(ji,jj,1) 52 trb(ji,jj,ikt,jpdic) = trc_data(ji,jj,2) 53 trb(ji,jj,ikt,jpno3) = trc_data(ji,jj,3) * 7.625 54 trb(ji,jj,ikt,jppo4) = trc_data(ji,jj,4) * 122. 55 trb(ji,jj,ikt,jpoxy) = trc_data(ji,jj,5) 56 trb(ji,jj,ikt,jpsil) = trc_data(ji,jj,6) 57 trb(ji,jj,ikt,jpnh4) = trc_data(ji,jj,7) * 7.625 58 trb(ji,jj,ikt,jpfer) = trc_data(ji,jj,8) 59 ENDIF 60 ENDDO 61 ENDDO 50 DO_2D_11_11 51 ikt = mbkt(ji,jj) 52 IF ( tmask(ji,jj,ikt) == 1 ) THEN 53 tr(ji,jj,ikt,jptal,Kbb) = trc_data(ji,jj,1) 54 tr(ji,jj,ikt,jpdic,Kbb) = trc_data(ji,jj,2) 55 tr(ji,jj,ikt,jpno3,Kbb) = trc_data(ji,jj,3) * 7.625 56 tr(ji,jj,ikt,jppo4,Kbb) = trc_data(ji,jj,4) * 122. 57 tr(ji,jj,ikt,jpoxy,Kbb) = trc_data(ji,jj,5) 58 tr(ji,jj,ikt,jpsil,Kbb) = trc_data(ji,jj,6) 59 tr(ji,jj,ikt,jpnh4,Kbb) = trc_data(ji,jj,7) * 7.625 60 tr(ji,jj,ikt,jpfer,Kbb) = trc_data(ji,jj,8) 61 ENDIF 62 END_2D 62 63 63 64 IF( ln_timing ) CALL timing_stop('sed_sfc') -
NEMO/trunk/src/TOP/PISCES/SED/sedstp.F90
r10222 r12377 29 29 CONTAINS 30 30 31 SUBROUTINE sed_stp ( kt )31 SUBROUTINE sed_stp ( kt, Kbb, Kmm, Krhs ) 32 32 !!--------------------------------------------------------------------- 33 33 !! *** ROUTINE sed_stp *** … … 44 44 !! ! 06-04 (C. Ethe) Re-organization 45 45 !!---------------------------------------------------------------------- 46 INTEGER, INTENT(in) :: kt ! number of iteration 46 INTEGER, INTENT(in) :: kt ! number of iteration 47 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 47 48 INTEGER :: ji,jk,js,jn,jw 48 49 !!---------------------------------------------------------------------- … … 52 53 IF( lrst_sed ) CALL sed_rst_cal ( kt, 'WRITE' ) ! calenda 53 54 54 IF(ln_sediment_offline) CALL trc_dmp_sed ( kt )55 IF(ln_sediment_offline) CALL trc_dmp_sed ( kt, Kbb, Kmm, Krhs ) 55 56 56 57 dtsed = r2dttrc 57 58 ! dtsed2 = dtsed 58 59 IF (kt /= nitsed000) THEN 59 CALL sed_dta( kt ) ! Load Data for bot. wat. Chem and fluxes60 CALL sed_dta( kt, Kbb, Kmm ) ! Load Data for bot. wat. Chem and fluxes 60 61 ENDIF 61 62 … … 80 81 CALL sed_mbc( kt ) ! cumulation for mass balance calculation 81 82 82 IF (ln_sed_2way) CALL sed_sfc( kt ) ! Give back new bottom wat chem to tracer model83 IF (ln_sed_2way) CALL sed_sfc( kt, Kbb ) ! Give back new bottom wat chem to tracer model 83 84 ENDIF 84 85 CALL sed_wri( kt ) ! outputs -
NEMO/trunk/src/TOP/PISCES/SED/trcdmp_sed.F90
r10225 r12377 35 35 36 36 !! * Substitutions 37 # include " vectopt_loop_substitute.h90"37 # include "do_loop_substitute.h90" 38 38 !!---------------------------------------------------------------------- 39 39 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 54 54 55 55 56 SUBROUTINE trc_dmp_sed( kt )56 SUBROUTINE trc_dmp_sed( kt, Kbb, Kmm, Krhs ) 57 57 !!---------------------------------------------------------------------- 58 58 !! *** ROUTINE trc_dmp_sed *** … … 64 64 !! ** Method : Newtonian damping towards trdta computed 65 65 !! and add to the general tracer trends: 66 !! tr n = tra + restotr * (trdta - trb)66 !! tr(Kmm) = tr(Krhs) + restotr * (trdta - tr(Kbb)) 67 67 !! The trend is computed either throughout the water column 68 68 !! (nlmdmptr=0) or in area of weak vertical mixing (nlmdmptr=1) or 69 69 !! below the well mixed layer (nlmdmptr=2) 70 70 !! 71 !! ** Action : - update the tracer trends tr awith the newtonian71 !! ** Action : - update the tracer trends tr(Krhs) with the newtonian 72 72 !! damping trends. 73 73 !! - save the trends ('key_trdmxl_trc') 74 74 !!---------------------------------------------------------------------- 75 INTEGER, INTENT(in) :: kt ! ocean time-step index 75 INTEGER, INTENT(in) :: kt ! ocean time-step index 76 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level index 76 77 ! 77 78 INTEGER :: ji, jj, jk, jn, jl, ikt ! dummy loop indices … … 90 91 ! 91 92 jl = n_trc_index(jn) 92 CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta ) ! read tracer data at nit00093 CALL trc_dta( kt, Kmm, sf_trcdta(jl), rf_trfac(jl), ztrcdta ) ! read tracer data at nit000 93 94 ! 94 DO jj = 1, jpj 95 DO ji = 1, jpi ! vector opt. 96 ikt = mbkt(ji,jj) 97 trb(ji,jj,ikt,jn) = ztrcdta(ji,jj,ikt) + ( trb(ji,jj,ikt,jn) - ztrcdta(ji,jj,ikt) ) & 98 & * exp( -restosed(ji,jj,ikt) * dtsed ) 99 END DO 100 END DO 95 DO_2D_11_11 96 ikt = mbkt(ji,jj) 97 tr(ji,jj,ikt,jn,Kbb) = ztrcdta(ji,jj,ikt) + ( tr(ji,jj,ikt,jn,Kbb) - ztrcdta(ji,jj,ikt) ) & 98 & * exp( -restosed(ji,jj,ikt) * dtsed ) 99 END_2D 101 100 ! 102 101 ENDIF … … 106 105 ! 107 106 ! ! print mean trends (used for debugging) 108 IF( ln_ctl) THEN107 IF( sn_cfctl%l_prttrc ) THEN 109 108 WRITE(charout, FMT="('dmp ')") 110 109 CALL prt_ctl_trc_info(charout) 111 CALL prt_ctl_trc( tab4d=tr a, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )110 CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 112 111 ENDIF 113 112 ! … … 148 147 !!---------------------------------------------------------------------- 149 148 CONTAINS 150 SUBROUTINE trc_dmp_sed( kt )! Empty routine149 SUBROUTINE trc_dmp_sed( kt, Kbb, Kmm, Krhs ) ! Empty routine 151 150 INTEGER, INTENT(in) :: kt 151 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs 152 152 WRITE(*,*) 'trc_dmp_sed: You should not have seen this print! error?', kt 153 153 END SUBROUTINE trc_dmp_sed -
NEMO/trunk/src/TOP/PISCES/par_pisces.F90
r10416 r12377 6 6 !! History : 2.0 ! 2007-12 (C. Ethe, G. Madec) revised architecture 7 7 !!---------------------------------------------------------------------- 8 USE par_kind 8 9 9 10 IMPLICIT NONE … … 60 61 !! Default No CFC geochemical model 61 62 ! Starting/ending PISCES do-loop indices (N.B. no PISCES : jpl_pcs < jpf_pcs the do-loop are never done) 62 INTEGER, PUBLIC :: jp_pcs0 !: First index of PISCES tracers 63 INTEGER, PUBLIC :: jp_pcs1 !: Last index of PISCES tracers 63 INTEGER, PUBLIC :: jp_pcs0 !: First index of PISCES tracers 64 INTEGER, PUBLIC :: jp_pcs1 !: Last index of PISCES tracers 65 66 REAL(wp), PUBLIC :: mMass_C = 12.00 ! Molar mass of carbon 67 REAL(wp), PUBLIC :: mMass_N = 14.00 ! Molar mass of nitrogen 68 REAL(wp), PUBLIC :: mMass_P = 31.00 ! Molar mass of phosphorus 69 REAL(wp), PUBLIC :: mMass_Fe = 55.85 ! Molar mass of iron 70 REAL(wp), PUBLIC :: mMass_Si = 28.00 ! Molar mass of silver 64 71 65 72 !!---------------------------------------------------------------------- -
NEMO/trunk/src/TOP/PISCES/sms_pisces.F90
r10788 r12377 13 13 PUBLIC 14 14 15 INTEGER :: numnatp_ref = -1 !! Logical units fornamelist pisces16 INTEGER :: numnatp_cfg = -1 !! Logical units fornamelist pisces17 INTEGER :: numonp = -1 !! Logical unit for namelist pisces output15 CHARACTER(:), ALLOCATABLE :: numnatp_ref !! Character buffer for reference namelist pisces 16 CHARACTER(:), ALLOCATABLE :: numnatp_cfg !! Character buffer for configuration namelist pisces 17 INTEGER :: numonp = -1 !! Logical unit for namelist pisces output 18 18 19 19 ! !: PISCES : silicon dependant half saturation … … 121 121 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tgfunc2 !: Temp. dependancy of mesozooplankton rates 122 122 123 LOGICAL, SAVE :: lk_sed 124 123 125 !!---------------------------------------------------------------------- 124 126 !! NEMO/TOP 4.0 , NEMO Consortium (2018) -
NEMO/trunk/src/TOP/PISCES/trcini_pisces.F90
r10817 r12377 32 32 CONTAINS 33 33 34 SUBROUTINE trc_ini_pisces 34 SUBROUTINE trc_ini_pisces( Kmm ) 35 35 !!---------------------------------------------------------------------- 36 36 !! *** ROUTINE trc_ini_pisces *** … … 38 38 !! ** Purpose : Initialisation of the PISCES biochemical model 39 39 !!---------------------------------------------------------------------- 40 INTEGER, INTENT(in) :: Kmm ! time level indices 40 41 ! 41 42 CALL trc_nam_pisces 42 43 ! 43 IF( ln_p4z .OR. ln_p5z ) THEN ; CALL p4z_ini ! PISCES44 ELSE ; CALL p2z_ini ! LOBSTER44 IF( ln_p4z .OR. ln_p5z ) THEN ; CALL p4z_ini( Kmm ) ! PISCES 45 ELSE ; CALL p2z_ini( Kmm ) ! LOBSTER 45 46 ENDIF 46 47 … … 48 49 49 50 50 SUBROUTINE p4z_ini 51 SUBROUTINE p4z_ini( Kmm ) 51 52 !!---------------------------------------------------------------------- 52 53 !! *** ROUTINE p4z_ini *** … … 58 59 USE p4zsink ! vertical flux of particulate matter due to sinking 59 60 USE p4zopt ! optical model 60 USE p4z sbc ! Boundary conditions61 USE p4zbc ! Boundary conditions 61 62 USE p4zfechem ! Iron chemistry 62 63 USE p4zrem ! Remineralisation of organic matter … … 77 78 USE p5zmort ! Mortality terms for phytoplankton 78 79 ! 80 INTEGER, INTENT(in) :: Kmm ! time level indices 79 81 REAL(wp), SAVE :: sco2 = 2.312e-3_wp 80 82 REAL(wp), SAVE :: alka0 = 2.426e-3_wp … … 189 191 !-------------------------------------------------------------- 190 192 IF( .NOT.ln_rsttr ) THEN 191 tr n(:,:,:,jpdic) = sco2192 tr n(:,:,:,jpdoc) = bioma0193 tr n(:,:,:,jptal) = alka0194 tr n(:,:,:,jpoxy) = oxyg0195 tr n(:,:,:,jpcal) = bioma0196 tr n(:,:,:,jppo4) = po4 / po4r197 tr n(:,:,:,jppoc) = bioma0198 tr n(:,:,:,jpgoc) = bioma0199 tr n(:,:,:,jpbfe) = bioma0 * 5.e-6200 tr n(:,:,:,jpsil) = silic1201 tr n(:,:,:,jpdsi) = bioma0 * 0.15202 tr n(:,:,:,jpgsi) = bioma0 * 5.e-6203 tr n(:,:,:,jpphy) = bioma0204 tr n(:,:,:,jpdia) = bioma0205 tr n(:,:,:,jpzoo) = bioma0206 tr n(:,:,:,jpmes) = bioma0207 tr n(:,:,:,jpfer) = 0.6E-9208 tr n(:,:,:,jpsfe) = bioma0 * 5.e-6209 tr n(:,:,:,jpdfe) = bioma0 * 5.e-6210 tr n(:,:,:,jpnfe) = bioma0 * 5.e-6211 tr n(:,:,:,jpnch) = bioma0 * 12. / 55.212 tr n(:,:,:,jpdch) = bioma0 * 12. / 55.213 tr n(:,:,:,jpno3) = no3214 tr n(:,:,:,jpnh4) = bioma0193 tr(:,:,:,jpdic,Kmm) = sco2 194 tr(:,:,:,jpdoc,Kmm) = bioma0 195 tr(:,:,:,jptal,Kmm) = alka0 196 tr(:,:,:,jpoxy,Kmm) = oxyg0 197 tr(:,:,:,jpcal,Kmm) = bioma0 198 tr(:,:,:,jppo4,Kmm) = po4 / po4r 199 tr(:,:,:,jppoc,Kmm) = bioma0 200 tr(:,:,:,jpgoc,Kmm) = bioma0 201 tr(:,:,:,jpbfe,Kmm) = bioma0 * 5.e-6 202 tr(:,:,:,jpsil,Kmm) = silic1 203 tr(:,:,:,jpdsi,Kmm) = bioma0 * 0.15 204 tr(:,:,:,jpgsi,Kmm) = bioma0 * 5.e-6 205 tr(:,:,:,jpphy,Kmm) = bioma0 206 tr(:,:,:,jpdia,Kmm) = bioma0 207 tr(:,:,:,jpzoo,Kmm) = bioma0 208 tr(:,:,:,jpmes,Kmm) = bioma0 209 tr(:,:,:,jpfer,Kmm) = 0.6E-9 210 tr(:,:,:,jpsfe,Kmm) = bioma0 * 5.e-6 211 tr(:,:,:,jpdfe,Kmm) = bioma0 * 5.e-6 212 tr(:,:,:,jpnfe,Kmm) = bioma0 * 5.e-6 213 tr(:,:,:,jpnch,Kmm) = bioma0 * 12. / 55. 214 tr(:,:,:,jpdch,Kmm) = bioma0 * 12. / 55. 215 tr(:,:,:,jpno3,Kmm) = no3 216 tr(:,:,:,jpnh4,Kmm) = bioma0 215 217 IF( ln_ligand) THEN 216 tr n(:,:,:,jplgw) = 0.6E-9218 tr(:,:,:,jplgw,Kmm) = 0.6E-9 217 219 ENDIF 218 220 IF( ln_p5z ) THEN 219 tr n(:,:,:,jpdon) = bioma0220 tr n(:,:,:,jpdop) = bioma0221 tr n(:,:,:,jppon) = bioma0222 tr n(:,:,:,jppop) = bioma0223 tr n(:,:,:,jpgon) = bioma0224 tr n(:,:,:,jpgop) = bioma0225 tr n(:,:,:,jpnph) = bioma0226 tr n(:,:,:,jppph) = bioma0227 tr n(:,:,:,jppic) = bioma0228 tr n(:,:,:,jpnpi) = bioma0229 tr n(:,:,:,jpppi) = bioma0230 tr n(:,:,:,jpndi) = bioma0231 tr n(:,:,:,jppdi) = bioma0232 tr n(:,:,:,jppfe) = bioma0 * 5.e-6233 tr n(:,:,:,jppch) = bioma0 * 12. / 55.221 tr(:,:,:,jpdon,Kmm) = bioma0 222 tr(:,:,:,jpdop,Kmm) = bioma0 223 tr(:,:,:,jppon,Kmm) = bioma0 224 tr(:,:,:,jppop,Kmm) = bioma0 225 tr(:,:,:,jpgon,Kmm) = bioma0 226 tr(:,:,:,jpgop,Kmm) = bioma0 227 tr(:,:,:,jpnph,Kmm) = bioma0 228 tr(:,:,:,jppph,Kmm) = bioma0 229 tr(:,:,:,jppic,Kmm) = bioma0 230 tr(:,:,:,jpnpi,Kmm) = bioma0 231 tr(:,:,:,jpppi,Kmm) = bioma0 232 tr(:,:,:,jpndi,Kmm) = bioma0 233 tr(:,:,:,jppdi,Kmm) = bioma0 234 tr(:,:,:,jppfe,Kmm) = bioma0 * 5.e-6 235 tr(:,:,:,jppch,Kmm) = bioma0 * 12. / 55. 234 236 ENDIF 235 237 ! initialize the half saturation constant for silicate … … 254 256 CALL p5z_prod_init ! phytoplankton growth rate over the global ocean. 255 257 ENDIF 256 CALL p4z_ sbc_init! boundary conditions258 CALL p4z_bc_init( Kmm ) ! boundary conditions 257 259 CALL p4z_fechem_init ! Iron chemistry 258 260 CALL p4z_rem_init ! remineralisation … … 275 277 276 278 ! Initialization of the sediment model 277 IF( ln_sediment) CALL sed_init 279 IF( ln_sediment) & 280 & CALL sed_init ! Initialization of the sediment model 281 282 CALL p4z_sed_init ! loss of organic matter in the sediments 278 283 279 284 IF(lwp) WRITE(numout,*) … … 284 289 285 290 286 SUBROUTINE p2z_ini 291 SUBROUTINE p2z_ini( Kmm ) 287 292 !!---------------------------------------------------------------------- 288 293 !! *** ROUTINE p2z_ini *** … … 296 301 USE p2zsed 297 302 ! 303 INTEGER, INTENT(in) :: Kmm ! time level indices 298 304 INTEGER :: ji, jj, jk, jn, ierr 299 305 CHARACTER(len = 10) :: cltra … … 334 340 ! ---------------------- 335 341 IF( .NOT. ln_rsttr ) THEN ! in case of no restart 336 tr n(:,:,:,jpdet) = 0.1 * tmask(:,:,:)337 tr n(:,:,:,jpzoo) = 0.1 * tmask(:,:,:)338 tr n(:,:,:,jpnh4) = 0.1 * tmask(:,:,:)339 tr n(:,:,:,jpphy) = 0.1 * tmask(:,:,:)340 tr n(:,:,:,jpdom) = 1.0 * tmask(:,:,:)341 WHERE( rhd(:,:,:) <= 24.5e-3 ) ; tr n(:,:,:,jpno3) = 2._wp * tmask(:,:,:)342 ELSE WHERE ; tr n(:,:,:,jpno3) = ( 15.55 * ( rhd(:,:,:) * 1000. ) - 380.11 ) * tmask(:,:,:)342 tr(:,:,:,jpdet,Kmm) = 0.1 * tmask(:,:,:) 343 tr(:,:,:,jpzoo,Kmm) = 0.1 * tmask(:,:,:) 344 tr(:,:,:,jpnh4,Kmm) = 0.1 * tmask(:,:,:) 345 tr(:,:,:,jpphy,Kmm) = 0.1 * tmask(:,:,:) 346 tr(:,:,:,jpdom,Kmm) = 1.0 * tmask(:,:,:) 347 WHERE( rhd(:,:,:) <= 24.5e-3 ) ; tr(:,:,:,jpno3,Kmm) = 2._wp * tmask(:,:,:) 348 ELSE WHERE ; tr(:,:,:,jpno3,Kmm) = ( 15.55 * ( rhd(:,:,:) * 1000. ) - 380.11 ) * tmask(:,:,:) 343 349 END WHERE 344 350 ENDIF 345 ! ! Namelist read346 CALL p2z_opt_init ! Optics parameters347 CALL p2z_sed_init ! sedimentation348 CALL p2z_bio_init ! biology349 CALL p2z_exp_init 351 ! ! Namelist read 352 CALL p2z_opt_init ! Optics parameters 353 CALL p2z_sed_init ! sedimentation 354 CALL p2z_bio_init ! biology 355 CALL p2z_exp_init( Kmm ) ! export 350 356 ! 351 357 IF(lwp) WRITE(numout,*) -
NEMO/trunk/src/TOP/PISCES/trcnam_pisces.F90
r11536 r12377 51 51 IF(lwp) WRITE(numout,*) 'trc_nam_pisces : read PISCES namelist' 52 52 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~' 53 CALL ctl_opn( numnatp_ref, TRIM( clname )//'_ref', 'OLD' , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE.)54 CALL ctl_opn( numnatp_cfg, TRIM( clname )//'_cfg', 'OLD' , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE.)53 CALL load_nml( numnatp_ref, TRIM( clname )//'_ref', numout, lwm ) 54 CALL load_nml( numnatp_cfg, TRIM( clname )//'_cfg', numout, lwm ) 55 55 IF(lwm) CALL ctl_opn( numonp , 'output.namelist.pis' , 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 56 56 ! 57 REWIND( numnatp_ref ) ! Namelist nampisbio in reference namelist : Pisces variables58 57 READ ( numnatp_ref, nampismod, IOSTAT = ios, ERR = 901) 59 58 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismod in reference namelist' ) 60 REWIND( numnatp_cfg ) ! Namelist nampisbio in configuration namelist : Pisces variables61 59 READ ( numnatp_cfg, nampismod, IOSTAT = ios, ERR = 902 ) 62 60 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampismod in configuration namelist' ) -
NEMO/trunk/src/TOP/PISCES/trcsms_pisces.F90
r10068 r12377 25 25 CONTAINS 26 26 27 SUBROUTINE trc_sms_pisces( kt )27 SUBROUTINE trc_sms_pisces( kt, Kbb, Kmm, Krhs ) 28 28 !!--------------------------------------------------------------------- 29 29 !! *** ROUTINE trc_sms_pisces *** … … 34 34 !!--------------------------------------------------------------------- 35 35 ! 36 INTEGER, INTENT( in ) :: kt ! ocean time-step index 36 INTEGER, INTENT( in ) :: kt ! ocean time-step index 37 INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs ! time level index 37 38 !!--------------------------------------------------------------------- 38 39 ! 39 IF( ln_p4z .OR. ln_p5z ) THEN ; CALL p4z_sms( kt ) ! PISCES40 ELSE ; CALL p2z_sms( kt ) ! LOBSTER40 IF( ln_p4z .OR. ln_p5z ) THEN ; CALL p4z_sms( kt, Kbb, Kmm, Krhs ) ! PISCES 41 ELSE ; CALL p2z_sms( kt, Kmm, Krhs ) ! LOBSTER 41 42 ENDIF 42 43 -
NEMO/trunk/src/TOP/PISCES/trcwri_pisces.F90
r10069 r12377 19 19 PUBLIC trc_wri_pisces 20 20 21 !! * Substitutions 22 # include "do_loop_substitute.h90" 21 23 !!---------------------------------------------------------------------- 22 24 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 26 28 CONTAINS 27 29 28 SUBROUTINE trc_wri_pisces 30 SUBROUTINE trc_wri_pisces( Kmm ) 29 31 !!--------------------------------------------------------------------- 30 32 !! *** ROUTINE trc_wri_trc *** … … 32 34 !! ** Purpose : output passive tracers fields 33 35 !!--------------------------------------------------------------------- 36 INTEGER, INTENT(in) :: Kmm ! time level indices 34 37 CHARACTER (len=20) :: cltra 35 38 REAL(wp) :: zfact … … 43 46 DO jn = jp_pcs0, jp_pcs1 44 47 cltra = TRIM( ctrcnm(jn) ) ! short title for tracer 45 CALL iom_put( cltra, tr n(:,:,:,jn) )48 CALL iom_put( cltra, tr(:,:,:,jn,Kmm) ) 46 49 END DO 47 50 ELSE … … 51 54 IF( jn == jppo4 ) zfact = po4r * 1.0e+6 52 55 cltra = TRIM( ctrcnm(jn) ) ! short title for tracer 53 IF( iom_use( cltra ) ) CALL iom_put( cltra, tr n(:,:,:,jn) * zfact )56 IF( iom_use( cltra ) ) CALL iom_put( cltra, tr(:,:,:,jn,Kmm) * zfact ) 54 57 END DO 55 58 … … 57 60 zdic(:,:) = 0. 58 61 DO jk = 1, jpkm1 59 zdic(:,:) = zdic(:,:) + tr n(:,:,jk,jpdic) * e3t_n(:,:,jk) * tmask(:,:,jk) * 12.62 zdic(:,:) = zdic(:,:) + tr(:,:,jk,jpdic,Kmm) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) * 12. 60 63 ENDDO 61 64 CALL iom_put( 'INTDIC', zdic ) … … 63 66 ! 64 67 IF( iom_use( "O2MIN" ) .OR. iom_use ( "ZO2MIN" ) ) THEN ! Oxygen minimum concentration and depth 65 zo2min (:,:) = trn(:,:,1,jpoxy) * tmask(:,:,1) 66 zdepo2min(:,:) = gdepw_n(:,:,1) * tmask(:,:,1) 67 DO jk = 2, jpkm1 68 DO jj = 1, jpj 69 DO ji = 1, jpi 70 IF( tmask(ji,jj,jk) == 1 ) then 71 IF( trn(ji,jj,jk,jpoxy) < zo2min(ji,jj) ) then 72 zo2min (ji,jj) = trn(ji,jj,jk,jpoxy) 73 zdepo2min(ji,jj) = gdepw_n(ji,jj,jk) 74 ENDIF 75 ENDIF 76 END DO 77 END DO 78 END DO 68 zo2min (:,:) = tr(:,:,1,jpoxy,Kmm) * tmask(:,:,1) 69 zdepo2min(:,:) = gdepw(:,:,1,Kmm) * tmask(:,:,1) 70 DO_3D_11_11( 2, jpkm1 ) 71 IF( tmask(ji,jj,jk) == 1 ) then 72 IF( tr(ji,jj,jk,jpoxy,Kmm) < zo2min(ji,jj) ) then 73 zo2min (ji,jj) = tr(ji,jj,jk,jpoxy,Kmm) 74 zdepo2min(ji,jj) = gdepw(ji,jj,jk,Kmm) 75 ENDIF 76 ENDIF 77 END_3D 79 78 ! 80 79 CALL iom_put('O2MIN' , zo2min ) ! oxygen minimum concentration
Note: See TracChangeset
for help on using the changeset viewer.