Changeset 12377 for NEMO/trunk/src/TOP/PISCES
- Timestamp:
- 2020-02-12T15:39:06+01:00 (12 months 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 &nbs