Changeset 12340 for NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP
- Timestamp:
- 2020-01-27T15:31:53+01:00 (5 years ago)
- Location:
- NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP
- Files:
-
- 49 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/C14/trcatm_c14.F90
r10069 r12340 21 21 PUBLIC trc_atm_c14_ini ! called in trcini_c14.F90 22 22 ! 23 !! * Substitutions 24 # include "do_loop_substitute.h90" 23 25 !!---------------------------------------------------------------------- 24 26 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 118 120 IF( ierr3 /= 0 ) CALL ctl_stop( 'STOP', 'trc_atm_c14_ini: unable to allocate fareaz' ) 119 121 ! 120 DO jj = 1 , jpj ! from C14b package 121 DO ji = 1 , jpi 122 IF( gphit(ji,jj) >= yn40 ) THEN 123 fareaz(ji,jj,1) = 0. 124 fareaz(ji,jj,2) = 0. 125 fareaz(ji,jj,3) = 1. 126 ELSE IF( gphit(ji,jj ) <= ys40) THEN 127 fareaz(ji,jj,1) = 1. 128 fareaz(ji,jj,2) = 0. 129 fareaz(ji,jj,3) = 0. 130 ELSE IF( gphit(ji,jj) >= yn20 ) THEN 131 fareaz(ji,jj,1) = 0. 132 fareaz(ji,jj,2) = 2. * ( 1. - gphit(ji,jj) / yn40 ) 133 fareaz(ji,jj,3) = 2. * gphit(ji,jj) / yn40 - 1. 134 ELSE IF( gphit(ji,jj) <= ys20 ) THEN 135 fareaz(ji,jj,1) = 2. * gphit(ji,jj) / ys40 - 1. 136 fareaz(ji,jj,2) = 2. * ( 1. - gphit(ji,jj) / ys40 ) 137 fareaz(ji,jj,3) = 0. 138 ELSE 139 fareaz(ji,jj,1) = 0. 140 fareaz(ji,jj,2) = 1. 141 fareaz(ji,jj,3) = 0. 142 ENDIF 143 END DO 144 END DO 122 DO_2D_11_11 123 IF( gphit(ji,jj) >= yn40 ) THEN 124 fareaz(ji,jj,1) = 0. 125 fareaz(ji,jj,2) = 0. 126 fareaz(ji,jj,3) = 1. 127 ELSE IF( gphit(ji,jj ) <= ys40) THEN 128 fareaz(ji,jj,1) = 1. 129 fareaz(ji,jj,2) = 0. 130 fareaz(ji,jj,3) = 0. 131 ELSE IF( gphit(ji,jj) >= yn20 ) THEN 132 fareaz(ji,jj,1) = 0. 133 fareaz(ji,jj,2) = 2. * ( 1. - gphit(ji,jj) / yn40 ) 134 fareaz(ji,jj,3) = 2. * gphit(ji,jj) / yn40 - 1. 135 ELSE IF( gphit(ji,jj) <= ys20 ) THEN 136 fareaz(ji,jj,1) = 2. * gphit(ji,jj) / ys40 - 1. 137 fareaz(ji,jj,2) = 2. * ( 1. - gphit(ji,jj) / ys40 ) 138 fareaz(ji,jj,3) = 0. 139 ELSE 140 fareaz(ji,jj,1) = 0. 141 fareaz(ji,jj,2) = 1. 142 fareaz(ji,jj,3) = 0. 143 ENDIF 144 END_2D 145 145 ! 146 146 ENDIF -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/C14/trcsms_c14.F90
r11949 r12340 26 26 PUBLIC trc_sms_c14 ! called in trcsms.F90 27 27 28 !! * Substitutions 29 # include "do_loop_substitute.h90" 28 30 !!---------------------------------------------------------------------- 29 31 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 78 80 ! ------------------------------------------------------------------- 79 81 80 DO jj = 1, jpj 81 DO ji = 1, jpi 82 IF( tmask(ji,jj,1) > 0. ) THEN 83 ! 84 zt = MIN( 40. , ts(ji,jj,1,jp_tem,Kmm) ) 85 ! 86 ! Computation of solubility zsol in [mol/(L * atm)] 87 ! after Wanninkhof (2014) referencing Weiss (1974) 88 ztp = ( zt + 273.16 ) * 0.01 89 zsk = 0.027766 + ztp * ( -0.025888 + 0.0050578 * ztp ) ! [mol/(L * atm)] 90 zsol = EXP( -58.0931 + 90.5069 / ztp + 22.2940 * LOG( ztp ) + zsk * ts(ji,jj,1,jp_sal,Kmm) ) 91 ! convert solubilities [mol/(L * atm)] -> [mol/(m^3 * ppm)] 92 zsol = zsol * 1.e-03 82 DO_2D_11_11 83 IF( tmask(ji,jj,1) > 0. ) THEN 84 ! 85 zt = MIN( 40. , ts(ji,jj,1,jp_tem,Kmm) ) 86 ! 87 ! Computation of solubility zsol in [mol/(L * atm)] 88 ! after Wanninkhof (2014) referencing Weiss (1974) 89 ztp = ( zt + 273.16 ) * 0.01 90 zsk = 0.027766 + ztp * ( -0.025888 + 0.0050578 * ztp ) ! [mol/(L * atm)] 91 zsol = EXP( -58.0931 + 90.5069 / ztp + 22.2940 * LOG( ztp ) + zsk * ts(ji,jj,1,jp_sal,Kmm) ) 92 ! convert solubilities [mol/(L * atm)] -> [mol/(m^3 * ppm)] 93 zsol = zsol * 1.e-03 93 94 94 95 96 95 ! Computes the Schmidt number of CO2 in seawater 96 ! Wanninkhof-2014 97 zsch = 2116.8 + zt * ( -136.25 + zt * (4.7353 + zt * (-0.092307 + 0.0007555 * zt ) ) ) 97 98 98 99 100 101 102 103 104 99 ! Wanninkhof Piston velocity: zpv in units [m/s] 100 zv2 = xkwind * (wndm(ji,jj) * wndm(ji,jj)) ! wind speed module at T points 101 ! chemical enhancement (Wanninkhof & Knox, 1996) 102 IF( ln_chemh ) zv2 = zv2 + 2.5 * ( 0.5246 + zt * (0.016256 + 0.00049946 * zt ) ) 103 zv2 = zv2/360000._wp ! conversion cm/h -> m/s 104 ! 105 zpv = ( zv2 * SQRT( 660./ zsch ) ) * ( 1. - fr_i(ji,jj) ) * tmask(ji,jj,1) 105 106 106 ! CO2 piston velocity (m/s) 107 exch_co2(ji,jj)= zpv 108 ! CO2 invasion rate (mol/ppm/m2/s) = 1st part of 14C/C exchange velocity 109 exch_c14(ji,jj)= zpv * zsol 110 ELSE 111 exch_co2(ji,jj) = 0._wp 112 exch_c14(ji,jj) = 0._wp 113 ENDIF 114 END DO 115 END DO 107 ! CO2 piston velocity (m/s) 108 exch_co2(ji,jj)= zpv 109 ! CO2 invasion rate (mol/ppm/m2/s) = 1st part of 14C/C exchange velocity 110 exch_c14(ji,jj)= zpv * zsol 111 ELSE 112 exch_co2(ji,jj) = 0._wp 113 exch_c14(ji,jj) = 0._wp 114 ENDIF 115 END_2D 116 116 117 117 ! Exchange velocity for 14C/C ratio (m/s) … … 127 127 ! 128 128 ! Add the surface flux to the trend of jp_c14 129 DO jj = 1, jpj 130 DO ji = 1, jpi 131 tr(ji,jj,1,jp_c14,Krhs) = tr(ji,jj,1,jp_c14,Krhs) + qtr_c14(ji,jj) / e3t(ji,jj,1,Kmm) 132 END DO 133 END DO 129 DO_2D_11_11 130 tr(ji,jj,1,jp_c14,Krhs) = tr(ji,jj,1,jp_c14,Krhs) + qtr_c14(ji,jj) / e3t(ji,jj,1,Kmm) 131 END_2D 134 132 ! 135 133 ! Computation of decay effects on jp_c14 136 DO jk = 1, jpk 137 DO jj = 1, jpj 138 DO ji = 1, jpi 139 ! 140 tr(ji,jj,jk,jp_c14,Krhs) = tr(ji,jj,jk,jp_c14,Krhs) - rlam14 * tr(ji,jj,jk,jp_c14,Kbb) * tmask(ji,jj,jk) 141 ! 142 END DO 143 END DO 144 END DO 134 DO_3D_11_11( 1, jpk ) 135 ! 136 tr(ji,jj,jk,jp_c14,Krhs) = tr(ji,jj,jk,jp_c14,Krhs) - rlam14 * tr(ji,jj,jk,jp_c14,Kbb) * tmask(ji,jj,jk) 137 ! 138 END_3D 145 139 ! 146 140 IF( lrst_trc ) THEN -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/C14/trcwri_c14.F90
r11949 r12340 23 23 ! Standard ratio: 1.176E-12 ; Avogadro's nbr = 6.022E+23 at/mol ; bomb C14 traditionally reported as 1.E+26 atoms 24 24 REAL(wp), PARAMETER :: atomc14 = 1.176 * 6.022E-15 ! conversion factor 25 !! * Substitutions 26 # include "do_loop_substitute.h90" 25 27 26 28 … … 58 60 zz3d(:,:,:) = 0._wp 59 61 ! 60 DO jk = 1, jpkm1 61 DO jj = 1, jpj 62 DO ji = 1, jpi 63 IF( tmask(ji,jj,jk) > 0._wp) THEN 64 z3d (ji,jj,jk) = tr(ji,jj,jk,jp_c14,Kmm) 65 zz3d(ji,jj,jk) = LOG( z3d(ji,jj,jk) ) 66 ENDIF 67 ENDDO 68 ENDDO 69 ENDDO 62 DO_3D_11_11( 1, jpkm1 ) 63 IF( tmask(ji,jj,jk) > 0._wp) THEN 64 z3d (ji,jj,jk) = tr(ji,jj,jk,jp_c14,Kmm) 65 zz3d(ji,jj,jk) = LOG( z3d(ji,jj,jk) ) 66 ENDIF 67 END_3D 70 68 zres(:,:) = z3d(:,:,1) 71 69 … … 73 71 z2d(:,:) =0._wp 74 72 jk = 1 75 DO jj = 1, jpj 76 DO ji = 1, jpi 77 ztemp = zres(ji,jj) / c14sbc(ji,jj) 78 IF( ztemp > 0._wp .AND. tmask(ji,jj,jk) > 0._wp ) z2d(ji,jj) = LOG( ztemp ) 79 ENDDO 80 ENDDO 73 DO_2D_11_11 74 ztemp = zres(ji,jj) / c14sbc(ji,jj) 75 IF( ztemp > 0._wp .AND. tmask(ji,jj,jk) > 0._wp ) z2d(ji,jj) = LOG( ztemp ) 76 END_2D 81 77 ! 82 78 z3d(:,:,:) = 1.d03 * ( z3d(:,:,:) - 1._wp ) … … 131 127 #endif 132 128 129 !! * Substitutions 130 # include "do_loop_substitute.h90" 133 131 !!---------------------------------------------------------------------- 134 132 !! NEMO/TOP 4.0 , NEMO Consortium (2018) -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/CFC/trcini_cfc.F90
r11949 r12340 24 24 REAL(wp) :: ylatn = 10. ! 10 degrees north 25 25 26 !! * Substitutions 27 # include "do_loop_substitute.h90" 26 28 !!---------------------------------------------------------------------- 27 29 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 130 132 !--------------------------------------------------------------------------------------- 131 133 zyd = ylatn - ylats 132 DO jj = 1 , jpj 133 DO ji = 1 , jpi 134 IF( gphit(ji,jj) >= ylatn ) THEN ; xphem(ji,jj) = 1.e0 135 ELSEIF( gphit(ji,jj) <= ylats ) THEN ; xphem(ji,jj) = 0.e0 136 ELSE ; xphem(ji,jj) = ( gphit(ji,jj) - ylats) / zyd 137 ENDIF 138 END DO 139 END DO 134 DO_2D_11_11 135 IF( gphit(ji,jj) >= ylatn ) THEN ; xphem(ji,jj) = 1.e0 136 ELSEIF( gphit(ji,jj) <= ylats ) THEN ; xphem(ji,jj) = 0.e0 137 ELSE ; xphem(ji,jj) = ( gphit(ji,jj) - ylats) / zyd 138 ENDIF 139 END_2D 140 140 ! 141 141 IF(lwp) WRITE(numout,*) 'Initialization of CFC tracers done' -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/CFC/trcsms_cfc.F90
r12301 r12340 47 47 REAL(wp) :: xconv4 = 1.0e-12 ! conversion from mol/m3/atm to mol/m3/pptv 48 48 49 !! * Substitutions 50 # include "do_loop_substitute.h90" 49 51 !!---------------------------------------------------------------------- 50 52 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 123 125 124 126 ! !------------! 125 DO jj = 1, jpj ! i-j loop ! 126 DO ji = 1, jpi !------------! 127 DO_2D_11_11 127 128 128 ! space interpolation 129 zpp_cfc = xphem(ji,jj) * zpatm(1,jl) & 130 & + ( 1.- xphem(ji,jj) ) * zpatm(2,jl) 131 132 ! Computation of concentration at equilibrium : in picomol/l 133 ! coefficient for solubility for CFC-11/12 in mol/l/atm 134 IF( tmask(ji,jj,1) .GE. 0.5 ) THEN 135 ztap = ( ts(ji,jj,1,jp_tem,Kmm) + 273.16 ) * 0.01 136 zdtap = sob(1,jl) + ztap * ( sob(2,jl) + ztap * sob(3,jl) ) 137 zsol = EXP( soa(1,jl) + soa(2,jl) / ztap + soa(3,jl) * LOG( ztap ) & 138 & + soa(4,jl) * ztap * ztap + ts(ji,jj,1,jp_sal,Kmm) * zdtap ) 139 ELSE 140 zsol = 0.e0 141 ENDIF 142 ! conversion from mol/l/atm to mol/m3/atm and from mol/m3/atm to mol/m3/pptv 143 zsol = xconv4 * xconv3 * zsol * tmask(ji,jj,1) 144 ! concentration at equilibrium 145 zca_cfc = xconv1 * zpp_cfc * zsol * tmask(ji,jj,1) 146 147 ! Computation of speed transfert 148 ! Schmidt number revised in Wanninkhof (2014) 149 zt1 = ts(ji,jj,1,jp_tem,Kmm) 150 zt2 = zt1 * zt1 151 zt3 = zt1 * zt2 152 zt4 = zt2 * zt2 153 zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 + sca(5,jl) * zt4 154 155 ! speed transfert : formulae revised in Wanninkhof (2014) 156 zv2 = wndm(ji,jj) * wndm(ji,jj) 157 zsch = zsch / 660. 158 zak_cfc = ( 0.251 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 159 160 ! Input function : speed *( conc. at equil - concen at surface ) 161 ! tr(:,:,:,:,Kmm) in pico-mol/l idem qtr; ak in en m/a 162 qtr_cfc(ji,jj,jl) = -zak_cfc * ( tr(ji,jj,1,jn,Kbb) - zca_cfc ) & 163 & * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) 164 ! Add the surface flux to the trend 165 tr(ji,jj,1,jn,Krhs) = tr(ji,jj,1,jn,Krhs) + qtr_cfc(ji,jj,jl) / e3t(ji,jj,1,Kmm) 166 167 ! cumulation of surface flux at each time step 168 qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * rdt 169 ! !----------------! 170 END DO ! end i-j loop ! 171 END DO !----------------! 129 ! space interpolation 130 zpp_cfc = xphem(ji,jj) * zpatm(1,jl) & 131 & + ( 1.- xphem(ji,jj) ) * zpatm(2,jl) 132 133 ! Computation of concentration at equilibrium : in picomol/l 134 ! coefficient for solubility for CFC-11/12 in mol/l/atm 135 IF( tmask(ji,jj,1) .GE. 0.5 ) THEN 136 ztap = ( ts(ji,jj,1,jp_tem,Kmm) + 273.16 ) * 0.01 137 zdtap = sob(1,jl) + ztap * ( sob(2,jl) + ztap * sob(3,jl) ) 138 zsol = EXP( soa(1,jl) + soa(2,jl) / ztap + soa(3,jl) * LOG( ztap ) & 139 & + soa(4,jl) * ztap * ztap + ts(ji,jj,1,jp_sal,Kmm) * zdtap ) 140 ELSE 141 zsol = 0.e0 142 ENDIF 143 ! conversion from mol/l/atm to mol/m3/atm and from mol/m3/atm to mol/m3/pptv 144 zsol = xconv4 * xconv3 * zsol * tmask(ji,jj,1) 145 ! concentration at equilibrium 146 zca_cfc = xconv1 * zpp_cfc * zsol * tmask(ji,jj,1) 147 ! Computation of speed transfert 148 ! Schmidt number revised in Wanninkhof (2014) 149 zt1 = ts(ji,jj,1,jp_tem,Kmm) 150 zt2 = zt1 * zt1 151 zt3 = zt1 * zt2 152 zt4 = zt2 * zt2 153 zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 + sca(5,jl) * zt4 154 155 ! speed transfert : formulae revised in Wanninkhof (2014) 156 zv2 = wndm(ji,jj) * wndm(ji,jj) 157 zsch = zsch / 660. 158 zak_cfc = ( 0.251 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 159 160 ! Input function : speed *( conc. at equil - concen at surface ) 161 ! tr(:,:,:,:,Kmm) in pico-mol/l idem qtr; ak in en m/a 162 qtr_cfc(ji,jj,jl) = -zak_cfc * ( tr(ji,jj,1,jn,Kbb) - zca_cfc ) & 163 & * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) 164 ! Add the surface flux to the trend 165 tr(ji,jj,1,jn,Krhs) = tr(ji,jj,1,jn,Krhs) + qtr_cfc(ji,jj,jl) / e3t(ji,jj,1,Kmm) 166 167 ! cumulation of surface flux at each time step 168 qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * rdt 169 ! !----------------! 170 END_2D 172 171 ! !----------------! 173 172 END DO ! end CFC loop ! -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P2Z/p2zbio.F90
r12236 r12340 58 58 !! * Substitutions 59 59 # include "vectopt_loop_substitute.h90" 60 # include "do_loop_substitute.h90" 60 61 !!---------------------------------------------------------------------- 61 62 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 121 122 DO jk = 1, jpkbm1 ! Upper ocean (bio-layers) ! 122 123 ! ! -------------------------- ! 123 DO jj = 2, jpjm1 124 DO ji = fs_2, fs_jpim1 125 ! trophic variables( det, zoo, phy, no3, nh4, dom) 126 ! ------------------------------------------------ 127 128 ! negative trophic variables DO not contribute to the fluxes 129 zdet = MAX( 0.e0, tr(ji,jj,jk,jpdet,Kmm) ) 130 zzoo = MAX( 0.e0, tr(ji,jj,jk,jpzoo,Kmm) ) 131 zphy = MAX( 0.e0, tr(ji,jj,jk,jpphy,Kmm) ) 132 zno3 = MAX( 0.e0, tr(ji,jj,jk,jpno3,Kmm) ) 133 znh4 = MAX( 0.e0, tr(ji,jj,jk,jpnh4,Kmm) ) 134 zdom = MAX( 0.e0, tr(ji,jj,jk,jpdom,Kmm) ) 135 136 ! Limitations 137 zlt = 1. 138 zle = 1. - EXP( -etot(ji,jj,jk) / aki / zlt ) 139 ! psinut,akno3,aknh4 added by asklod AS Kremeur 2005-03 140 zlno3 = zno3 * EXP( -psinut * znh4 ) / ( akno3 + zno3 ) 141 zlnh4 = znh4 / (znh4+aknh4) 142 143 ! sinks and sources 144 ! phytoplankton production and exsudation 145 zno3phy = tmumax * zle * zlt * zlno3 * zphy 146 znh4phy = tmumax * zle * zlt * zlnh4 * zphy 147 148 ! fphylab added by asklod AS Kremeur 2005-03 149 zphydom = rgamma * (1 - fphylab) * (zno3phy + znh4phy) 150 zphynh4 = rgamma * fphylab * (zno3phy + znh4phy) 151 ! zooplankton production 152 ! preferences 153 zppz = rppz 154 zpdz = 1. - rppz 155 zpppz = ( zppz * zphy ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 ) 156 zppdz = ( zpdz * zdet ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 ) 157 zfood = zpppz * zphy + zppdz * zdet 158 ! filtration 159 zfilpz = taus * zpppz / (aks + zfood) 160 zfildz = taus * zppdz / (aks + zfood) 161 ! grazing 162 zphyzoo = zfilpz * zphy * zzoo 163 zdetzoo = zfildz * zdet * zzoo 164 165 ! fecal pellets production 166 zzoodet = rpnaz * zphyzoo + rdnaz * zdetzoo 167 168 ! zooplankton liquide excretion 169 zzoonh4 = tauzn * fzoolab * zzoo 170 zzoodom = tauzn * (1 - fzoolab) * zzoo 171 172 ! mortality 173 ! phytoplankton mortality 174 zphydet = tmminp * zphy 175 176 ! zooplankton mortality 177 ! closure : flux grazing is redistributed below level jpkbio 178 zzoobod = tmminz * zzoo * zzoo 179 xksi(ji,jj) = xksi(ji,jj) + (1-fdbod) * zzoobod * e3t(ji,jj,jk,Kmm) 180 zboddet = fdbod * zzoobod 181 182 ! detritus and dom breakdown 183 zdetnh4 = taudn * fdetlab * zdet 184 zdetdom = taudn * (1 - fdetlab) * zdet 185 186 zdomnh4 = taudomn * zdom 187 188 ! flux added to express how the excess of nitrogen from 189 ! PHY, ZOO and DET to DOM goes directly to NH4 (flux of ajustment) 190 zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 191 192 ! Nitrification 193 znh4no3 = taunn * znh4 194 195 ! determination of trends 196 ! total trend for each biological tracer 197 zphya = zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet 198 zzooa = zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod 199 zno3a = - zno3phy + znh4no3 200 znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju 201 zdeta = zphydet + zzoodet - zdetzoo - zdetnh4 - zdetdom + zboddet 202 zdoma = zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju 203 204 ! tracer flux at totox-point added to the general trend 205 tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + zdeta 206 tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) + zzooa 207 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zphya 208 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + zno3a 209 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + znh4a 210 tr(ji,jj,jk,jpdom,Krhs) = tr(ji,jj,jk,jpdom,Krhs) + zdoma 211 212 IF( lk_iomput ) THEN 213 ! convert fluxes in per day 214 ze3t = e3t(ji,jj,jk,Kmm) * 86400._wp 215 zw2d(ji,jj,1) = zw2d(ji,jj,1) + zno3phy * ze3t 216 zw2d(ji,jj,2) = zw2d(ji,jj,2) + znh4phy * ze3t 217 zw2d(ji,jj,3) = zw2d(ji,jj,3) + zphydom * ze3t 218 zw2d(ji,jj,4) = zw2d(ji,jj,4) + zphynh4 * ze3t 219 zw2d(ji,jj,5) = zw2d(ji,jj,5) + zphyzoo * ze3t 220 zw2d(ji,jj,6) = zw2d(ji,jj,6) + zphydet * ze3t 221 zw2d(ji,jj,7) = zw2d(ji,jj,7) + zdetzoo * ze3t 222 zw2d(ji,jj,8) = zw2d(ji,jj,8) + zzoodet * ze3t 223 zw2d(ji,jj,9) = zw2d(ji,jj,9) + zzoobod * ze3t 224 zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t 225 zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t 226 zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t 227 zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t 228 zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t 229 zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t 230 zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t 231 zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 232 ! 233 zw3d(ji,jj,jk,1) = zno3phy * 86400 234 zw3d(ji,jj,jk,2) = znh4phy * 86400 235 zw3d(ji,jj,jk,3) = znh4no3 * 86400 236 ! 237 ENDIF 238 END DO 239 END DO 124 DO_2D_00_00 125 ! trophic variables( det, zoo, phy, no3, nh4, dom) 126 ! ------------------------------------------------ 127 128 ! negative trophic variables DO not contribute to the fluxes 129 zdet = MAX( 0.e0, tr(ji,jj,jk,jpdet,Kmm) ) 130 zzoo = MAX( 0.e0, tr(ji,jj,jk,jpzoo,Kmm) ) 131 zphy = MAX( 0.e0, tr(ji,jj,jk,jpphy,Kmm) ) 132 zno3 = MAX( 0.e0, tr(ji,jj,jk,jpno3,Kmm) ) 133 znh4 = MAX( 0.e0, tr(ji,jj,jk,jpnh4,Kmm) ) 134 zdom = MAX( 0.e0, tr(ji,jj,jk,jpdom,Kmm) ) 135 136 ! Limitations 137 zlt = 1. 138 zle = 1. - EXP( -etot(ji,jj,jk) / aki / zlt ) 139 ! psinut,akno3,aknh4 added by asklod AS Kremeur 2005-03 140 zlno3 = zno3 * EXP( -psinut * znh4 ) / ( akno3 + zno3 ) 141 zlnh4 = znh4 / (znh4+aknh4) 142 143 ! sinks and sources 144 ! phytoplankton production and exsudation 145 zno3phy = tmumax * zle * zlt * zlno3 * zphy 146 znh4phy = tmumax * zle * zlt * zlnh4 * zphy 147 148 ! fphylab added by asklod AS Kremeur 2005-03 149 zphydom = rgamma * (1 - fphylab) * (zno3phy + znh4phy) 150 zphynh4 = rgamma * fphylab * (zno3phy + znh4phy) 151 ! zooplankton production 152 ! preferences 153 zppz = rppz 154 zpdz = 1. - rppz 155 zpppz = ( zppz * zphy ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 ) 156 zppdz = ( zpdz * zdet ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 ) 157 zfood = zpppz * zphy + zppdz * zdet 158 ! filtration 159 zfilpz = taus * zpppz / (aks + zfood) 160 zfildz = taus * zppdz / (aks + zfood) 161 ! grazing 162 zphyzoo = zfilpz * zphy * zzoo 163 zdetzoo = zfildz * zdet * zzoo 164 165 ! fecal pellets production 166 zzoodet = rpnaz * zphyzoo + rdnaz * zdetzoo 167 168 ! zooplankton liquide excretion 169 zzoonh4 = tauzn * fzoolab * zzoo 170 zzoodom = tauzn * (1 - fzoolab) * zzoo 171 172 ! mortality 173 ! phytoplankton mortality 174 zphydet = tmminp * zphy 175 176 ! zooplankton mortality 177 ! closure : flux grazing is redistributed below level jpkbio 178 zzoobod = tmminz * zzoo * zzoo 179 xksi(ji,jj) = xksi(ji,jj) + (1-fdbod) * zzoobod * e3t(ji,jj,jk,Kmm) 180 zboddet = fdbod * zzoobod 181 182 ! detritus and dom breakdown 183 zdetnh4 = taudn * fdetlab * zdet 184 zdetdom = taudn * (1 - fdetlab) * zdet 185 186 zdomnh4 = taudomn * zdom 187 188 ! flux added to express how the excess of nitrogen from 189 ! PHY, ZOO and DET to DOM goes directly to NH4 (flux of ajustment) 190 zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 191 192 ! Nitrification 193 znh4no3 = taunn * znh4 194 195 ! determination of trends 196 ! total trend for each biological tracer 197 zphya = zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet 198 zzooa = zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod 199 zno3a = - zno3phy + znh4no3 200 znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju 201 zdeta = zphydet + zzoodet - zdetzoo - zdetnh4 - zdetdom + zboddet 202 zdoma = zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju 203 204 ! tracer flux at totox-point added to the general trend 205 tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + zdeta 206 tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) + zzooa 207 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zphya 208 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + zno3a 209 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + znh4a 210 tr(ji,jj,jk,jpdom,Krhs) = tr(ji,jj,jk,jpdom,Krhs) + zdoma 211 212 IF( lk_iomput ) THEN 213 ! convert fluxes in per day 214 ze3t = e3t(ji,jj,jk,Kmm) * 86400._wp 215 zw2d(ji,jj,1) = zw2d(ji,jj,1) + zno3phy * ze3t 216 zw2d(ji,jj,2) = zw2d(ji,jj,2) + znh4phy * ze3t 217 zw2d(ji,jj,3) = zw2d(ji,jj,3) + zphydom * ze3t 218 zw2d(ji,jj,4) = zw2d(ji,jj,4) + zphynh4 * ze3t 219 zw2d(ji,jj,5) = zw2d(ji,jj,5) + zphyzoo * ze3t 220 zw2d(ji,jj,6) = zw2d(ji,jj,6) + zphydet * ze3t 221 zw2d(ji,jj,7) = zw2d(ji,jj,7) + zdetzoo * ze3t 222 zw2d(ji,jj,8) = zw2d(ji,jj,8) + zzoodet * ze3t 223 zw2d(ji,jj,9) = zw2d(ji,jj,9) + zzoobod * ze3t 224 zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t 225 zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t 226 zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t 227 zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t 228 zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t 229 zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t 230 zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t 231 zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 232 ! 233 zw3d(ji,jj,jk,1) = zno3phy * 86400 234 zw3d(ji,jj,jk,2) = znh4phy * 86400 235 zw3d(ji,jj,jk,3) = znh4no3 * 86400 236 ! 237 ENDIF 238 END_2D 240 239 END DO 241 240 … … 243 242 DO jk = jpkb, jpkm1 ! Upper ocean (bio-layers) ! 244 243 ! ! -------------------------- ! 245 DO jj = 2, jpjm1 246 DO ji = fs_2, fs_jpim1 247 ! remineralisation of all quantities towards nitrate 248 249 ! trophic variables( det, zoo, phy, no3, nh4, dom) 250 ! negative trophic variables DO not contribute to the fluxes 251 zdet = MAX( 0.e0, tr(ji,jj,jk,jpdet,Kmm) ) 252 zzoo = MAX( 0.e0, tr(ji,jj,jk,jpzoo,Kmm) ) 253 zphy = MAX( 0.e0, tr(ji,jj,jk,jpphy,Kmm) ) 254 zno3 = MAX( 0.e0, tr(ji,jj,jk,jpno3,Kmm) ) 255 znh4 = MAX( 0.e0, tr(ji,jj,jk,jpnh4,Kmm) ) 256 zdom = MAX( 0.e0, tr(ji,jj,jk,jpdom,Kmm) ) 257 258 ! Limitations 259 zlt = 0.e0 260 zle = 0.e0 261 zlno3 = 0.e0 262 zlnh4 = 0.e0 263 264 ! sinks and sources 265 ! phytoplankton production and exsudation 266 zno3phy = 0.e0 267 znh4phy = 0.e0 268 zphydom = 0.e0 269 zphynh4 = 0.e0 270 271 ! zooplankton production 272 zphyzoo = 0.e0 ! grazing 273 zdetzoo = 0.e0 274 275 zzoodet = 0.e0 ! fecal pellets production 276 277 zzoonh4 = tauzn * fzoolab * zzoo ! zooplankton liquide excretion 278 zzoodom = tauzn * (1 - fzoolab) * zzoo 279 280 ! mortality 281 zphydet = tmminp * zphy ! phytoplankton mortality 282 283 zzoobod = 0.e0 ! zooplankton mortality 284 zboddet = 0.e0 ! closure : flux fbod is redistributed below level jpkbio 285 286 ! detritus and dom breakdown 287 zdetnh4 = taudn * fdetlab * zdet 288 zdetdom = taudn * (1 - fdetlab) * zdet 289 290 zdomnh4 = taudomn * zdom 291 zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 292 293 ! Nitrification 294 znh4no3 = taunn * znh4 295 296 297 ! determination of trends 298 ! total trend for each biological tracer 299 zphya = zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet 300 zzooa = zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod 301 zno3a = - zno3phy + znh4no3 302 znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju 303 zdeta = zphydet + zzoodet - zdetzoo - zdetnh4 - zdetdom + zboddet 304 zdoma = zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju 305 306 ! tracer flux at totox-point added to the general trend 307 tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + zdeta 308 tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) + zzooa 309 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zphya 310 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + zno3a 311 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + znh4a 312 tr(ji,jj,jk,jpdom,Krhs) = tr(ji,jj,jk,jpdom,Krhs) + zdoma 244 DO_2D_00_00 245 ! remineralisation of all quantities towards nitrate 246 247 ! trophic variables( det, zoo, phy, no3, nh4, dom) 248 ! negative trophic variables DO not contribute to the fluxes 249 zdet = MAX( 0.e0, tr(ji,jj,jk,jpdet,Kmm) ) 250 zzoo = MAX( 0.e0, tr(ji,jj,jk,jpzoo,Kmm) ) 251 zphy = MAX( 0.e0, tr(ji,jj,jk,jpphy,Kmm) ) 252 zno3 = MAX( 0.e0, tr(ji,jj,jk,jpno3,Kmm) ) 253 znh4 = MAX( 0.e0, tr(ji,jj,jk,jpnh4,Kmm) ) 254 zdom = MAX( 0.e0, tr(ji,jj,jk,jpdom,Kmm) ) 255 256 ! Limitations 257 zlt = 0.e0 258 zle = 0.e0 259 zlno3 = 0.e0 260 zlnh4 = 0.e0 261 262 ! sinks and sources 263 ! phytoplankton production and exsudation 264 zno3phy = 0.e0 265 znh4phy = 0.e0 266 zphydom = 0.e0 267 zphynh4 = 0.e0 268 269 ! zooplankton production 270 zphyzoo = 0.e0 ! grazing 271 zdetzoo = 0.e0 272 273 zzoodet = 0.e0 ! fecal pellets production 274 275 zzoonh4 = tauzn * fzoolab * zzoo ! zooplankton liquide excretion 276 zzoodom = tauzn * (1 - fzoolab) * zzoo 277 278 ! mortality 279 zphydet = tmminp * zphy ! phytoplankton mortality 280 281 zzoobod = 0.e0 ! zooplankton mortality 282 zboddet = 0.e0 ! closure : flux fbod is redistributed below level jpkbio 283 284 ! detritus and dom breakdown 285 zdetnh4 = taudn * fdetlab * zdet 286 zdetdom = taudn * (1 - fdetlab) * zdet 287 288 zdomnh4 = taudomn * zdom 289 zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 290 291 ! Nitrification 292 znh4no3 = taunn * znh4 293 294 295 ! determination of trends 296 ! total trend for each biological tracer 297 zphya = zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet 298 zzooa = zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod 299 zno3a = - zno3phy + znh4no3 300 znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju 301 zdeta = zphydet + zzoodet - zdetzoo - zdetnh4 - zdetdom + zboddet 302 zdoma = zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju 303 304 ! tracer flux at totox-point added to the general trend 305 tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + zdeta 306 tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) + zzooa 307 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zphya 308 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + zno3a 309 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + znh4a 310 tr(ji,jj,jk,jpdom,Krhs) = tr(ji,jj,jk,jpdom,Krhs) + zdoma 311 ! 312 IF( lk_iomput ) THEN ! convert fluxes in per day 313 ze3t = e3t(ji,jj,jk,Kmm) * 86400._wp 314 zw2d(ji,jj,1) = zw2d(ji,jj,1) + zno3phy * ze3t 315 zw2d(ji,jj,2) = zw2d(ji,jj,2) + znh4phy * ze3t 316 zw2d(ji,jj,3) = zw2d(ji,jj,3) + zphydom * ze3t 317 zw2d(ji,jj,4) = zw2d(ji,jj,4) + zphynh4 * ze3t 318 zw2d(ji,jj,5) = zw2d(ji,jj,5) + zphyzoo * ze3t 319 zw2d(ji,jj,6) = zw2d(ji,jj,6) + zphydet * ze3t 320 zw2d(ji,jj,7) = zw2d(ji,jj,7) + zdetzoo * ze3t 321 zw2d(ji,jj,8) = zw2d(ji,jj,8) + zzoodet * ze3t 322 zw2d(ji,jj,9) = zw2d(ji,jj,9) + zzoobod * ze3t 323 zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t 324 zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t 325 zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t 326 zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t 327 zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t 328 zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t 329 zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t 330 zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 331 ! 332 zw3d(ji,jj,jk,1) = zno3phy * 86400._wp 333 zw3d(ji,jj,jk,2) = znh4phy * 86400._wp 334 zw3d(ji,jj,jk,3) = znh4no3 * 86400._wp 313 335 ! 314 IF( lk_iomput ) THEN ! convert fluxes in per day 315 ze3t = e3t(ji,jj,jk,Kmm) * 86400._wp 316 zw2d(ji,jj,1) = zw2d(ji,jj,1) + zno3phy * ze3t 317 zw2d(ji,jj,2) = zw2d(ji,jj,2) + znh4phy * ze3t 318 zw2d(ji,jj,3) = zw2d(ji,jj,3) + zphydom * ze3t 319 zw2d(ji,jj,4) = zw2d(ji,jj,4) + zphynh4 * ze3t 320 zw2d(ji,jj,5) = zw2d(ji,jj,5) + zphyzoo * ze3t 321 zw2d(ji,jj,6) = zw2d(ji,jj,6) + zphydet * ze3t 322 zw2d(ji,jj,7) = zw2d(ji,jj,7) + zdetzoo * ze3t 323 zw2d(ji,jj,8) = zw2d(ji,jj,8) + zzoodet * ze3t 324 zw2d(ji,jj,9) = zw2d(ji,jj,9) + zzoobod * ze3t 325 zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t 326 zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t 327 zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t 328 zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t 329 zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t 330 zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t 331 zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t 332 zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 333 ! 334 zw3d(ji,jj,jk,1) = zno3phy * 86400._wp 335 zw3d(ji,jj,jk,2) = znh4phy * 86400._wp 336 zw3d(ji,jj,jk,3) = znh4no3 * 86400._wp 337 ! 338 ENDIF 339 END DO 340 END DO 336 ENDIF 337 END_2D 341 338 END DO 342 339 ! -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P2Z/p2zexp.F90
r12236 r12340 39 39 !! * Substitutions 40 40 # include "vectopt_loop_substitute.h90" 41 # include "do_loop_substitute.h90" 41 42 !!---------------------------------------------------------------------- 42 43 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 81 82 ! LAYERS IS DETERMINED BY DMIN3 DEFINED IN sms_p2z.F90 82 83 ! ---------------------------------------------------------------------- 83 DO jk = 1, jpkm1 84 DO jj = 2, jpjm1 85 DO ji = fs_2, fs_jpim1 86 ze3t = 1. / e3t(ji,jj,jk,Kmm) 87 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj) 88 END DO 89 END DO 90 END DO 84 DO_3D_00_00( 1, jpkm1 ) 85 ze3t = 1. / e3t(ji,jj,jk,Kmm) 86 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj) 87 END_3D 91 88 92 89 ! Find the last level of the water column … … 96 93 zgeolpoc = 0.e0 ! Initialization 97 94 ! Release of nutrients from the "simple" sediment 98 DO jj = 2, jpjm1 99 DO ji = fs_2, fs_jpim1 100 ikt = mbkt(ji,jj) 101 tr(ji,jj,ikt,jpno3,Krhs) = tr(ji,jj,ikt,jpno3,Krhs) + sedlam * sedpocn(ji,jj) / e3t(ji,jj,ikt,Kmm) 102 ! Deposition of organic matter in the sediment 103 zwork = vsed * tr(ji,jj,ikt,jpdet,Kmm) 104 zsedpoca(ji,jj) = ( zwork + dminl(ji,jj) * xksi(ji,jj) & 105 & - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rdt 106 zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1e2t(ji,jj) 107 END DO 108 END DO 109 110 DO jj = 2, jpjm1 111 DO ji = fs_2, fs_jpim1 112 tr(ji,jj,1,jpno3,Krhs) = tr(ji,jj,1,jpno3,Krhs) + zgeolpoc * cmask(ji,jj) / areacot / e3t(ji,jj,1,Kmm) 113 END DO 114 END DO 95 DO_2D_00_00 96 ikt = mbkt(ji,jj) 97 tr(ji,jj,ikt,jpno3,Krhs) = tr(ji,jj,ikt,jpno3,Krhs) + sedlam * sedpocn(ji,jj) / e3t(ji,jj,ikt,Kmm) 98 ! Deposition of organic matter in the sediment 99 zwork = vsed * tr(ji,jj,ikt,jpdet,Kmm) 100 zsedpoca(ji,jj) = ( zwork + dminl(ji,jj) * xksi(ji,jj) & 101 & - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rdt 102 zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1e2t(ji,jj) 103 END_2D 104 105 DO_2D_00_00 106 tr(ji,jj,1,jpno3,Krhs) = tr(ji,jj,1,jpno3,Krhs) + zgeolpoc * cmask(ji,jj) / areacot / e3t(ji,jj,1,Kmm) 107 END_2D 115 108 116 109 CALL lbc_lnk( 'p2zexp', sedpocn, 'T', 1. ) … … 128 121 ELSE 129 122 ! 130 DO jj = 1, jpj 131 DO ji = 1, jpi 132 zsedpocd = zsedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj) ! time laplacian on tracers 133 sedpocb(ji,jj) = sedpocn(ji,jj) + atfp * zsedpocd ! sedpocb <-- filtered sedpocn 134 sedpocn(ji,jj) = zsedpoca(ji,jj) ! sedpocn <-- sedpoca 135 END DO 136 END DO 123 DO_2D_11_11 124 zsedpocd = zsedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj) ! time laplacian on tracers 125 sedpocb(ji,jj) = sedpocn(ji,jj) + atfp * zsedpocd ! sedpocb <-- filtered sedpocn 126 sedpocn(ji,jj) = zsedpoca(ji,jj) ! sedpocn <-- sedpoca 127 END_2D 137 128 ! 138 129 ENDIF … … 183 174 zdm0 = 0._wp 184 175 zrro = 1._wp 185 DO jk = jpkb, jpkm1 186 DO jj = 1, jpj 187 DO ji = 1, jpi 188 zfluo = ( gdepw(ji,jj,jk ,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr 189 zfluu = ( gdepw(ji,jj,jk+1,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr 190 IF( zfluo.GT.1. ) zfluo = 1._wp 191 zdm0(ji,jj,jk) = zfluo - zfluu 192 IF( jk <= jpkb-1 ) zdm0(ji,jj,jk) = 0._wp 193 zrro(ji,jj) = zrro(ji,jj) - zdm0(ji,jj,jk) 194 END DO 195 END DO 196 END DO 176 DO_3D_11_11( jpkb, jpkm1 ) 177 zfluo = ( gdepw(ji,jj,jk ,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr 178 zfluu = ( gdepw(ji,jj,jk+1,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr 179 IF( zfluo.GT.1. ) zfluo = 1._wp 180 zdm0(ji,jj,jk) = zfluo - zfluu 181 IF( jk <= jpkb-1 ) zdm0(ji,jj,jk) = 0._wp 182 zrro(ji,jj) = zrro(ji,jj) - zdm0(ji,jj,jk) 183 END_3D 197 184 ! 198 185 zdm0(:,:,jpk) = zrro(:,:) … … 204 191 dminl(:,:) = 0._wp 205 192 dmin3(:,:,:) = zdm0 206 DO jk = 1, jpk 207 DO jj = 1, jpj 208 DO ji = 1, jpi 209 IF( tmask(ji,jj,jk) == 0._wp ) THEN 210 dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk) 211 dmin3(ji,jj,jk) = 0._wp 212 ENDIF 213 END DO 214 END DO 215 END DO 216 217 DO jj = 1, jpj 218 DO ji = 1, jpi 219 IF( tmask(ji,jj,1) == 0 ) dmin3(ji,jj,1) = 0._wp 220 END DO 221 END DO 193 DO_3D_11_11( 1, jpk ) 194 IF( tmask(ji,jj,jk) == 0._wp ) THEN 195 dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk) 196 dmin3(ji,jj,jk) = 0._wp 197 ENDIF 198 END_3D 199 200 DO_2D_11_11 201 IF( tmask(ji,jj,1) == 0 ) dmin3(ji,jj,1) = 0._wp 202 END_2D 222 203 223 204 ! Coastal mask 224 205 cmask(:,:) = 0._wp 225 DO jj = 2, jpjm1 226 DO ji = fs_2, fs_jpim1 227 IF( tmask(ji,jj,1) /= 0. ) THEN 228 zmaskt = tmask(ji+1,jj,1) * tmask(ji-1,jj,1) * tmask(ji,jj+1,1) * tmask(ji,jj-1,1) 229 IF( zmaskt == 0. ) cmask(ji,jj) = 1._wp 230 END IF 231 END DO 232 END DO 206 DO_2D_00_00 207 IF( tmask(ji,jj,1) /= 0. ) THEN 208 zmaskt = tmask(ji+1,jj,1) * tmask(ji-1,jj,1) * tmask(ji,jj+1,1) * tmask(ji,jj-1,1) 209 IF( zmaskt == 0. ) cmask(ji,jj) = 1._wp 210 END IF 211 END_2D 233 212 CALL lbc_lnk( 'p2zexp', cmask , 'T', 1. ) ! lateral boundary conditions on cmask (sign unchanged) 234 213 areacot = glob_sum( 'p2zexp', e1e2t(:,:) * cmask(:,:) ) -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P2Z/p2zopt.F90
r12236 r12340 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) … … 92 94 ! ! Photosynthetically Available Radiation (PAR) 93 95 zcoef = 12 * redf / rcchl / rpig ! -------------------------------------- 94 DO jk = 2, jpk ! local par at w-levels 95 DO jj = 1, jpj 96 DO ji = 1, jpi 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 DO 103 END DO 104 END DO 105 DO jk = 1, jpkm1 ! mean par at t-levels 106 DO jj = 1, jpj 107 DO ji = 1, jpi 108 zpig = LOG( MAX( TINY(0.), tr(ji,jj,jk,jpphy,Kmm) ) * zcoef ) 109 zkr = xkr0 + xkrp * EXP( xlr * zpig ) 110 zkg = xkg0 + xkgp * EXP( xlg * zpig ) 111 zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * e3t(ji,jj,jk,Kmm) ) * ( 1 - EXP( -zkr * e3t(ji,jj,jk,Kmm) ) ) 112 zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * e3t(ji,jj,jk,Kmm) ) * ( 1 - EXP( -zkg * e3t(ji,jj,jk,Kmm) ) ) 113 etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 ) 114 END DO 115 END DO 116 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 117 111 118 112 ! ! Euphotic layer 119 113 ! ! -------------- 120 114 neln(:,:) = 1 ! euphotic layer level 121 DO jk = 1, jpkm1 ! (i.e. 1rst T-level strictly below EL bottom) 122 DO jj = 1, jpj 123 DO ji = 1, jpi 124 IF( etot(ji,jj,jk) >= zpar100(ji,jj) ) neln(ji,jj) = jk + 1 125 END DO 126 END DO 127 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 128 118 ! ! Euphotic layer depth 129 DO jj = 1, jpj 130 DO ji = 1, jpi 131 heup(ji,jj) = gdepw(ji,jj,neln(ji,jj),Kmm) 132 END DO 133 END DO 119 DO_2D_11_11 120 heup(ji,jj) = gdepw(ji,jj,neln(ji,jj),Kmm) 121 END_2D 134 122 135 123 -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P2Z/p2zsed.F90
r12236 r12340 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) … … 86 88 87 89 ! tracer flux divergence at t-point added to the general trend 88 DO jk = 1, jpkm1 89 DO jj = 1, jpj 90 DO ji = 1, jpi 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 DO 94 END DO 95 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 96 94 97 95 IF( lk_iomput ) THEN -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zagg.F90
r12236 r12340 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) … … 58 60 IF( ln_p4z ) THEN 59 61 ! 60 DO jk = 1, jpkm1 61 DO jj = 1, jpj 62 DO ji = 1, jpi 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) 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) 68 68 69 69 ! Part II : Differential settling 70 70 71 72 73 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) 74 74 75 76 75 zagg = zagg1 + zagg2 + zagg3 + zagg4 76 zaggfe = zagg * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 77 77 78 79 80 81 82 83 84 85 86 87 88 89 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) 90 90 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 DO 102 END DO 103 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 104 102 ELSE ! ln_p5z 105 103 ! 106 DO jk = 1, jpkm1 107 DO jj = 1, jpj 108 DO ji = 1, jpi 109 ! 110 zfact = xstep * xdiss(ji,jj,jk) 111 ! Part I : Coagulation dependent on turbulence 112 zaggtmp = 25.9 * zfact * tr(ji,jj,jk,jppoc,Kbb) 113 zaggpoc1 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 114 zaggtmp = 4452. * zfact * tr(ji,jj,jk,jpgoc,Kbb) 115 zaggpoc2 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 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) 116 112 117 ! Part II : Differential settling 118 119 ! Aggregation of small into large particles 120 zaggtmp = 47.1 * xstep * tr(ji,jj,jk,jpgoc,Kbb) 121 zaggpoc3 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 122 zaggtmp = 3.3 * xstep * tr(ji,jj,jk,jppoc,Kbb) 123 zaggpoc4 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 113 ! Part II : Differential settling 124 114 125 zaggpoc = zaggpoc1 + zaggpoc2 + zaggpoc3 + zaggpoc4 126 zaggpon = zaggpoc * tr(ji,jj,jk,jppon,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 127 zaggpop = zaggpoc * tr(ji,jj,jk,jppop,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 128 zaggfe = zaggpoc * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + 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) 129 120 130 ! Aggregation of DOC to POC : 131 ! 1st term is shear aggregation of DOC-DOC 132 ! 2nd term is shear aggregation of DOC-POC 133 ! 3rd term is differential settling of DOC-POC 134 zaggtmp = ( ( 0.369 * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4 * tr(ji,jj,jk,jppoc,Kbb) ) * zfact & 135 & + 2.4 * xstep * tr(ji,jj,jk,jppoc,Kbb) ) 136 zaggdoc = zaggtmp * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 137 zaggdon = zaggtmp * 0.3 * tr(ji,jj,jk,jpdon,Kbb) 138 zaggdop = zaggtmp * 0.3 * tr(ji,jj,jk,jpdop,Kbb) 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 ) 139 125 140 ! transfer of DOC to GOC : 141 ! 1st term is shear aggregation 142 ! 2nd term is differential settling 143 zaggtmp = ( 3.53E3 * zfact + 0.1 * xstep ) * tr(ji,jj,jk,jpgoc,Kbb) 144 zaggdoc2 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 145 zaggdon2 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdon,Kbb) 146 zaggdop2 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdop,Kbb) 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) 147 135 148 ! tranfer of DOC to POC due to brownian motion 149 zaggtmp = ( 114. * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) ) * xstep 150 zaggdoc3 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 151 zaggdon3 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdon,Kbb) 152 zaggdop3 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdop,Kbb) 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) 153 143 154 ! Update the trends 155 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zaggpoc + zaggdoc + zaggdoc3 156 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) - zaggpon + zaggdon + zaggdon3 157 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) - zaggpop + zaggdop + zaggdop3 158 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zaggpoc + zaggdoc2 159 tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zaggpon + zaggdon2 160 tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + zaggpop + zaggdop2 161 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zaggfe 162 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zaggfe 163 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zaggdoc - zaggdoc2 - zaggdoc3 164 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) - zaggdon - zaggdon2 - zaggdon3 165 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) - zaggdop - zaggdop2 - zaggdop3 166 ! 167 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zaggpoc + zaggdoc + zaggdoc3 168 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zaggpoc + zaggdoc2 169 ! 170 END DO 171 END DO 172 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 173 167 ! 174 168 ENDIF -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zbc.F90
r12258 r12340 48 48 !! * Substitutions 49 49 # include "vectopt_loop_substitute.h90" 50 # include "do_loop_substitute.h90" 50 51 !!---------------------------------------------------------------------- 51 52 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 111 112 IF( ll_river ) THEN 112 113 jl = n_trc_indcbc(jpno3) 113 DO jj = 1, jpj 114 DO ji = 1, jpi 115 DO jk = 1, nk_rnf(ji,jj) 116 zcoef = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_cbc_time ) * tmask(ji,jj,1) 117 zrivdin = rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zcoef 118 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - rno3 * zrivdin * rfact 119 ENDDO 120 END DO 121 END DO 114 DO_2D_11_11 115 DO jk = 1, nk_rnf(ji,jj) 116 zcoef = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_cbc_time ) * tmask(ji,jj,1) 117 zrivdin = rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zcoef 118 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - rno3 * zrivdin * rfact 119 ENDDO 120 END_2D 122 121 ENDIF 123 122 … … 146 145 ALLOCATE( zironice(jpi,jpj) ) 147 146 ! 148 DO jj = 1, jpj 149 DO ji = 1, jpi 150 zdep = rfact / e3t(ji,jj,1,Kmm) 151 zwflux = fmmflx(ji,jj) / 1000._wp 152 zironice(ji,jj) = MAX( -0.99 * tr(ji,jj,1,jpfer,Kbb), -zwflux * icefeinput * zdep ) 153 END DO 154 END DO 147 DO_2D_11_11 148 zdep = rfact / e3t(ji,jj,1,Kmm) 149 zwflux = fmmflx(ji,jj) / 1000._wp 150 zironice(ji,jj) = MAX( -0.99 * tr(ji,jj,1,jpfer,Kbb), -zwflux * icefeinput * zdep ) 151 END_2D 155 152 ! 156 153 tr(:,:,1,jpfer,Krhs) = tr(:,:,1,jpfer,Krhs) + zironice(:,:) … … 300 297 IF(lwp) WRITE(numout,*) 301 298 IF(lwp) WRITE(numout,*) ' Level corresponding to 50m depth ', ik50,' ', gdept_1d(ik50+1) 302 DO jk = 1, ik50 303 DO jj = 2, jpjm1 304 DO ji = fs_2, fs_jpim1 305 ze3t = e3t_0(ji,jj,jk) 306 zsurfc = e1u(ji,jj) * ( 1. - umask(ji ,jj ,jk) ) & 307 + e1u(ji,jj) * ( 1. - umask(ji-1,jj ,jk) ) & 308 + e2v(ji,jj) * ( 1. - vmask(ji ,jj ,jk) ) & 309 + e2v(ji,jj) * ( 1. - vmask(ji ,jj-1,jk) ) 310 zsurfp = zsurfc * ze3t / e1e2t(ji,jj) 311 ! estimation of the coastal slope : 5 km off the coast 312 ze3t2 = ze3t * ze3t 313 zcslp = SQRT( ( distcoast*distcoast + ze3t2 ) / ze3t2 ) 314 ! 315 zcmask(ji,jj,jk) = zcmask(ji,jj,jk) + zcslp * zsurfp 316 END DO 317 END DO 318 END DO 299 DO_3D_00_00( 1, ik50 ) 300 ze3t = e3t_0(ji,jj,jk) 301 zsurfc = e1u(ji,jj) * ( 1. - umask(ji ,jj ,jk) ) & 302 + e1u(ji,jj) * ( 1. - umask(ji-1,jj ,jk) ) & 303 + e2v(ji,jj) * ( 1. - vmask(ji ,jj ,jk) ) & 304 + e2v(ji,jj) * ( 1. - vmask(ji ,jj-1,jk) ) 305 zsurfp = zsurfc * ze3t / e1e2t(ji,jj) 306 ! estimation of the coastal slope : 5 km off the coast 307 ze3t2 = ze3t * ze3t 308 zcslp = SQRT( ( distcoast*distcoast + ze3t2 ) / ze3t2 ) 309 ! 310 zcmask(ji,jj,jk) = zcmask(ji,jj,jk) + zcslp * zsurfp 311 END_3D 319 312 ! 320 313 CALL lbc_lnk( 'p4zbc', zcmask , 'T', 1. ) ! lateral boundary conditions on cmask (sign unchanged) 321 314 ! 322 DO jk = 1, jpk 323 DO jj = 1, jpj 324 DO ji = 1, jpi 325 zexpide = MIN( 8.,( gdept(ji,jj,jk,Kmm) / 500. )**(-1.5) ) 326 zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2 327 zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 ) 328 END DO 329 END DO 330 END DO 315 DO_3D_11_11( 1, jpk ) 316 zexpide = MIN( 8.,( gdept(ji,jj,jk,Kmm) / 500. )**(-1.5) ) 317 zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2 318 zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 ) 319 END_3D 331 320 ! Coastal supply of iron 332 321 ! ------------------------- -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zbio.F90
r12236 r12340 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) … … 69 71 xdiss(:,:,:) = 1. 70 72 !!gm the use of nmld should be better here? 71 DO jk = 2, jpkm1 72 DO jj = 1, jpj 73 DO ji = 1, jpi 73 DO_3D_11_11( 2, jpkm1 ) 74 74 !!gm : use nmln and test on jk ... less memory acces 75 IF( gdepw(ji,jj,jk+1,Kmm) > hmld(ji,jj) ) xdiss(ji,jj,jk) = 0.01 76 END DO 77 END DO 78 END DO 75 IF( gdepw(ji,jj,jk+1,Kmm) > hmld(ji,jj) ) xdiss(ji,jj,jk) = 0.01 76 END_3D 79 77 80 78 CALL p4z_opt ( kt, knt, Kbb, Kmm ) ! Optic: PAR in the water column -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zche.F90
r11949 r12340 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) … … 176 178 ! 0.04°C relative to an exact computation 177 179 ! --------------------------------------------------------------------- 178 DO jk = 1, jpk 179 DO jj = 1, jpj 180 DO ji = 1, jpi 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 DO 186 END DO 187 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 188 186 ! 189 187 ! CHEMICAL CONSTANTS - SURFACE LAYER … … 473 471 IF( ln_timing ) CALL timing_start('ahini_for_at') 474 472 ! 475 DO jk = 1, jpk 476 DO jj = 1, jpj 477 DO ji = 1, jpi 478 p_alkcb = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 479 p_dictot = tr(ji,jj,jk,jpdic,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 480 p_bortot = borat(ji,jj,jk) 481 IF (p_alkcb <= 0.) THEN 482 p_hini(ji,jj,jk) = 1.e-3 483 ELSEIF (p_alkcb >= (2.*p_dictot + p_bortot)) THEN 484 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. 485 497 ELSE 486 zca1 = p_dictot/( p_alkcb + rtrn ) 487 zba1 = p_bortot/ (p_alkcb + rtrn ) 488 ! Coefficients of the cubic polynomial 489 za2 = aKb3(ji,jj,jk)*(1. - zba1) + ak13(ji,jj,jk)*(1.-zca1) 490 za1 = ak13(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - zca1) & 491 & + ak13(ji,jj,jk)*ak23(ji,jj,jk)*(1. - (zca1+zca1)) 492 za0 = ak13(ji,jj,jk)*ak23(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - (zca1+zca1)) 493 ! Taylor expansion around the minimum 494 zd = za2*za2 - 3.*za1 ! Discriminant of the quadratic equation 495 ! for the minimum close to the root 496 497 IF(zd > 0.) THEN ! If the discriminant is positive 498 zsqrtd = SQRT(zd) 499 IF(za2 < 0) THEN 500 zhmin = (-za2 + zsqrtd)/3. 501 ELSE 502 zhmin = -za1/(za2 + zsqrtd) 503 ENDIF 504 p_hini(ji,jj,jk) = zhmin + SQRT(-(za0 + zhmin*(za1 + zhmin*(za2 + zhmin)))/zsqrtd) 505 ELSE 506 p_hini(ji,jj,jk) = 1.e-7 507 ENDIF 508 ! 509 ENDIF 510 END DO 511 END DO 512 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 513 507 ! 514 508 IF( ln_timing ) CALL timing_stop('ahini_for_at') … … 575 569 576 570 ! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree 577 DO jk = 1, jpk 578 DO jj = 1, jpj 579 DO ji = 1, jpi 580 IF (rmask(ji,jj,jk) == 1.) THEN 581 p_alktot = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 582 aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 583 zh_ini = p_hini(ji,jj,jk) 584 585 zdelta = (p_alktot-zalknw_inf(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 586 587 IF(p_alktot >= zalknw_inf(ji,jj,jk)) THEN 588 zh_min(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_inf(ji,jj,jk) + SQRT(zdelta) ) 589 ELSE 590 zh_min(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_inf(ji,jj,jk)) + SQRT(zdelta) ) / 2. 591 ENDIF 592 593 zdelta = (p_alktot-zalknw_sup(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 594 595 IF(p_alktot <= zalknw_sup(ji,jj,jk)) THEN 596 zh_max(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_sup(ji,jj,jk)) + SQRT(zdelta) ) / 2. 597 ELSE 598 zh_max(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_sup(ji,jj,jk) + SQRT(zdelta) ) 599 ENDIF 600 601 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 602 722 ENDIF 603 END DO 604 END DO 605 END DO 606 607 zeqn_absmin(:,:,:) = HUGE(1._wp) 608 609 DO jn = 1, jp_maxniter_atgen 610 DO jk = 1, jpk 611 DO jj = 1, jpj 612 DO ji = 1, jpi 613 IF (rmask(ji,jj,jk) == 1.) THEN 614 zfact = rhop(ji,jj,jk) / 1000. + rtrn 615 p_alktot = tr(ji,jj,jk,jptal,Kbb) / zfact 616 zdic = tr(ji,jj,jk,jpdic,Kbb) / zfact 617 zbot = borat(ji,jj,jk) 618 zpt = tr(ji,jj,jk,jppo4,Kbb) / zfact * po4r 619 zsit = tr(ji,jj,jk,jpsil,Kbb) / zfact 620 zst = sulfat (ji,jj,jk) 621 zft = fluorid(ji,jj,jk) 622 aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 623 zh = zhi(ji,jj,jk) 624 zh_prev = zh 625 626 ! H2CO3 - HCO3 - CO3 : n=2, m=0 627 znumer_dic = 2.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk) 628 zdenom_dic = ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*(ak13(ji,jj,jk) + zh) 629 zalk_dic = zdic * (znumer_dic/zdenom_dic) 630 zdnumer_dic = ak13(ji,jj,jk)*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh & 631 *(4.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk)) 632 zdalk_dic = -zdic*(zdnumer_dic/zdenom_dic**2) 633 634 635 ! B(OH)3 - B(OH)4 : n=1, m=0 636 znumer_bor = akb3(ji,jj,jk) 637 zdenom_bor = akb3(ji,jj,jk) + zh 638 zalk_bor = zbot * (znumer_bor/zdenom_bor) 639 zdnumer_bor = akb3(ji,jj,jk) 640 zdalk_bor = -zbot*(zdnumer_bor/zdenom_bor**2) 641 642 643 ! H3PO4 - H2PO4 - HPO4 - PO4 : n=3, m=1 644 znumer_po4 = 3.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk) & 645 & + zh*(2.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh* ak1p3(ji,jj,jk)) 646 zdenom_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk) & 647 & + zh*( ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh*(ak1p3(ji,jj,jk) + zh)) 648 zalk_po4 = zpt * (znumer_po4/zdenom_po4 - 1.) ! Zero level of H3PO4 = 1 649 zdnumer_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk) & 650 & + zh*(4.*ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk) & 651 & + zh*(9.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk) & 652 & + ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) & 653 & + zh*(4.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh * ak1p3(ji,jj,jk) ) ) ) 654 zdalk_po4 = -zpt * (zdnumer_po4/zdenom_po4**2) 655 656 ! H4SiO4 - H3SiO4 : n=1, m=0 657 znumer_sil = aksi3(ji,jj,jk) 658 zdenom_sil = aksi3(ji,jj,jk) + zh 659 zalk_sil = zsit * (znumer_sil/zdenom_sil) 660 zdnumer_sil = aksi3(ji,jj,jk) 661 zdalk_sil = -zsit * (zdnumer_sil/zdenom_sil**2) 662 663 ! HSO4 - SO4 : n=1, m=1 664 aphscale = 1.0 + zst/aks3(ji,jj,jk) 665 znumer_so4 = aks3(ji,jj,jk) * aphscale 666 zdenom_so4 = aks3(ji,jj,jk) * aphscale + zh 667 zalk_so4 = zst * (znumer_so4/zdenom_so4 - 1.) 668 zdnumer_so4 = aks3(ji,jj,jk) 669 zdalk_so4 = -zst * (zdnumer_so4/zdenom_so4**2) 670 671 ! HF - F : n=1, m=1 672 znumer_flu = akf3(ji,jj,jk) 673 zdenom_flu = akf3(ji,jj,jk) + zh 674 zalk_flu = zft * (znumer_flu/zdenom_flu - 1.) 675 zdnumer_flu = akf3(ji,jj,jk) 676 zdalk_flu = -zft * (zdnumer_flu/zdenom_flu**2) 677 678 ! H2O - OH 679 aphscale = 1.0 + zst/aks3(ji,jj,jk) 680 zalk_wat = akw3(ji,jj,jk)/zh - zh/aphscale 681 zdalk_wat = -akw3(ji,jj,jk)/zh**2 - 1./aphscale 682 683 ! CALCULATE [ALK]([CO3--], [HCO3-]) 684 zeqn = zalk_dic + zalk_bor + zalk_po4 + zalk_sil & 685 & + zalk_so4 + zalk_flu & 686 & + zalk_wat - p_alktot 687 688 zalka = p_alktot - (zalk_bor + zalk_po4 + zalk_sil & 689 & + zalk_so4 + zalk_flu + zalk_wat) 690 691 zdeqndh = zdalk_dic + zdalk_bor + zdalk_po4 + zdalk_sil & 692 & + zdalk_so4 + zdalk_flu + zdalk_wat 693 694 ! Adapt bracketing interval 695 IF(zeqn > 0._wp) THEN 696 zh_min(ji,jj,jk) = zh_prev 697 ELSEIF(zeqn < 0._wp) THEN 698 zh_max(ji,jj,jk) = zh_prev 699 ENDIF 700 701 IF(ABS(zeqn) >= 0.5_wp*zeqn_absmin(ji,jj,jk)) THEN 702 ! if the function evaluation at the current point is 703 ! not decreasing faster than with a bisection step (at least linearly) 704 ! in absolute value take one bisection step on [ph_min, ph_max] 705 ! ph_new = (ph_min + ph_max)/2d0 706 ! 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 707 729 ! In terms of [H]_new: 708 730 ! [H]_new = 10**(-ph_new) 709 ! = 10**(-(ph_min + ph_max)/2d0) 710 ! = SQRT(10**(-(ph_min + phmax))) 711 ! = SQRT(zh_max * zh_min) 712 zh = SQRT(zh_max(ji,jj,jk) * zh_min(ji,jj,jk)) 713 zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 714 ELSE 715 ! dzeqn/dpH = dzeqn/d[H] * d[H]/dpH 716 ! = -zdeqndh * LOG(10) * [H] 717 ! \Delta pH = -zeqn/(zdeqndh*d[H]/dpH) = zeqn/(zdeqndh*[H]*LOG(10)) 718 ! 719 ! pH_new = pH_old + \deltapH 720 ! 721 ! [H]_new = 10**(-pH_new) 722 ! = 10**(-pH_old - \Delta pH) 723 ! = [H]_old * 10**(-zeqn/(zdeqndh*[H]_old*LOG(10))) 724 ! = [H]_old * EXP(-LOG(10)*zeqn/(zdeqndh*[H]_old*LOG(10))) 725 ! = [H]_old * EXP(-zeqn/(zdeqndh*[H]_old)) 726 727 zh_lnfactor = -zeqn/(zdeqndh*zh_prev) 728 729 IF(ABS(zh_lnfactor) > pz_exp_threshold) THEN 730 zh = zh_prev*EXP(zh_lnfactor) 731 ELSE 732 zh_delta = zh_lnfactor*zh_prev 733 zh = zh_prev + zh_delta 734 ENDIF 735 736 IF( zh < zh_min(ji,jj,jk) ) THEN 737 ! if [H]_new < [H]_min 738 ! i.e., if ph_new > ph_max then 739 ! take one bisection step on [ph_prev, ph_max] 740 ! ph_new = (ph_prev + ph_max)/2d0 741 ! In terms of [H]_new: 742 ! [H]_new = 10**(-ph_new) 743 ! = 10**(-(ph_prev + ph_max)/2d0) 744 ! = SQRT(10**(-(ph_prev + phmax))) 745 ! = SQRT([H]_old*10**(-ph_max)) 746 ! = SQRT([H]_old * zh_min) 747 zh = SQRT(zh_prev * zh_min(ji,jj,jk)) 748 zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 749 ENDIF 750 751 IF( zh > zh_max(ji,jj,jk) ) THEN 752 ! if [H]_new > [H]_max 753 ! i.e., if ph_new < ph_min, then 754 ! take one bisection step on [ph_min, ph_prev] 755 ! ph_new = (ph_prev + ph_min)/2d0 756 ! In terms of [H]_new: 757 ! [H]_new = 10**(-ph_new) 758 ! = 10**(-(ph_prev + ph_min)/2d0) 759 ! = SQRT(10**(-(ph_prev + ph_min))) 760 ! = SQRT([H]_old*10**(-ph_min)) 761 ! = SQRT([H]_old * zhmax) 762 zh = SQRT(zh_prev * zh_max(ji,jj,jk)) 763 zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 764 ENDIF 765 ENDIF 766 767 zeqn_absmin(ji,jj,jk) = MIN( ABS(zeqn), zeqn_absmin(ji,jj,jk)) 768 769 ! Stop iterations once |\delta{[H]}/[H]| < rdel 770 ! <=> |(zh - zh_prev)/zh_prev| = |EXP(-zeqn/(zdeqndh*zh_prev)) -1| < rdel 771 ! |EXP(-zeqn/(zdeqndh*zh_prev)) -1| ~ |zeqn/(zdeqndh*zh_prev)| 772 773 ! Alternatively: 774 ! |\Delta pH| = |zeqn/(zdeqndh*zh_prev*LOG(10))| 775 ! ~ 1/LOG(10) * |\Delta [H]|/[H] 776 ! < 1/LOG(10) * rdel 777 778 ! Hence |zeqn/(zdeqndh*zh)| < rdel 779 780 ! rdel <-- pp_rdel_ah_target 781 l_exitnow = (ABS(zh_lnfactor) < pp_rdel_ah_target) 782 783 IF(l_exitnow) THEN 784 rmask(ji,jj,jk) = 0. 785 ENDIF 786 787 zhi(ji,jj,jk) = zh 788 789 IF(jn >= jp_maxniter_atgen) THEN 790 zhi(ji,jj,jk) = -1._wp 791 ENDIF 792 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 793 737 ENDIF 794 END DO 795 END DO 796 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 797 783 END DO 798 784 ! -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zfechem.F90
r12258 r12340 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) … … 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 = 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 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 = ( 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 132 IF( ll_dust ) zdust = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) & 133 & * EXP( -gdept(ji,jj,jk,Kmm) / 540. ) 134 IF (ln_ligand) THEN 135 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 ) )) 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 * tr(ji,jj,jk,jppoc,Kbb) / zlam1b 146 zdenom2 = zxlam * tr(ji,jj,jk,jpgoc,Kbb) / 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(ji,jj,jk,Kmm) ) 154 zcoag = 1E-4 * ( 1. - zlamfac ) * zdep * xstep * tr(ji,jj,jk,jpfer,Kbb) 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 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4 * tr(ji,jj,jk,jppoc,Kbb) ) * xdiss(ji,jj,jk) & 161 & + ( 114. * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) ) 162 zaggdfea = zlam1a * xstep * zfecoll 163 ! 164 zlam1b = 3.53E3 * tr(ji,jj,jk,jpgoc,Kbb) * xdiss(ji,jj,jk) 165 zaggdfeb = zlam1b * xstep * zfecoll 166 ! 167 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zscave - zaggdfea - zaggdfeb & 168 & - zcoag - precip(ji,jj,jk) 169 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zscave * zdenom1 + zaggdfea 170 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + 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 … … 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 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4 * tr(ji,jj,jk,jppoc,Kbb) ) * xdiss(ji,jj,jk) & 188 & + ( 114. * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) ) 189 ! 190 zlam1b = 3.53E3 * tr(ji,jj,jk,jpgoc,Kbb) * xdiss(ji,jj,jk) 191 zligco = 0.5 * tr(ji,jj,jk,jplgw,Kmm) 192 zaggliga = zlam1a * xstep * zligco 193 zaggligb = zlam1b * xstep * zligco 194 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) - zaggliga - zaggligb 195 zlcoll3d(ji,jj,jk) = zaggliga + zaggligb 196 END DO 197 END DO 198 END DO 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 199 189 ! 200 190 plig(:,:,:) = MAX( 0., ( ( zFeL1(:,:,:) * 1E-9 ) / ( tr(:,:,:,jpfer,Kbb) +rtrn ) ) ) -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zflx.F90
r12258 r12340 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) … … 107 109 IF( l_co2cpl ) satmco2(:,:) = atm_co2(:,:) 108 110 109 DO jj = 1, jpj 110 DO ji = 1, jpi 111 ! DUMMY VARIABLES FOR DIC, H+, AND BORATE 112 zfact = rhop(ji,jj,1) / 1000. + rtrn 113 zdic = tr(ji,jj,1,jpdic,Kbb) 114 zph = MAX( hi(ji,jj,1), 1.e-10 ) / zfact 115 ! CALCULATE [H2CO3] 116 zh2co3(ji,jj) = zdic/(1. + ak13(ji,jj,1)/zph + ak13(ji,jj,1)*ak23(ji,jj,1)/zph**2) 117 END DO 118 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 119 119 120 120 ! -------------- … … 125 125 ! ------------------------------------------- 126 126 127 DO jj = 1, jpj 128 DO ji = 1, jpi 129 ztc = MIN( 35., ts(ji,jj,1,jp_tem,Kmm) ) 130 ztc2 = ztc * ztc 131 ztc3 = ztc * ztc2 132 ztc4 = ztc2 * ztc2 133 ! Compute the schmidt Number both O2 and CO2 134 zsch_co2 = 2116.8 - 136.25 * ztc + 4.7353 * ztc2 - 0.092307 * ztc3 + 0.0007555 * ztc4 135 zsch_o2 = 1920.4 - 135.6 * ztc + 5.2122 * ztc2 - 0.109390 * ztc3 + 0.0009377 * ztc4 136 ! wind speed 137 zws = wndm(ji,jj) * wndm(ji,jj) 138 ! Compute the piston velocity for O2 and CO2 139 zkgwan = 0.251 * zws 140 zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) 141 ! compute gas exchange for CO2 and O2 142 zkgco2(ji,jj) = zkgwan * SQRT( 660./ zsch_co2 ) 143 zkgo2 (ji,jj) = zkgwan * SQRT( 660./ zsch_o2 ) 144 END DO 145 END DO 146 147 148 DO jj = 1, jpj 149 DO ji = 1, jpi 150 ztkel = tempis(ji,jj,1) + 273.15 151 zsal = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35. 152 zvapsw = EXP(24.4543 - 67.4509*(100.0/ztkel) - 4.8489*LOG(ztkel/100) - 0.000544*zsal) 153 zpco2atm(ji,jj) = satmco2(ji,jj) * ( patm(ji,jj) - zvapsw ) 154 zxc2 = ( 1.0 - zpco2atm(ji,jj) * 1E-6 )**2 155 zfugcoeff = EXP( patm(ji,jj) * (chemc(ji,jj,2) + 2.0 * zxc2 * chemc(ji,jj,3) ) & 156 & / ( 82.05736 * ztkel )) 157 zfco2 = zpco2atm(ji,jj) * zfugcoeff 158 159 ! Compute CO2 flux for the sea and air 160 zfld = zfco2 * chemc(ji,jj,1) * zkgco2(ji,jj) ! (mol/L) * (m/s) 161 zflu = zh2co3(ji,jj) * zkgco2(ji,jj) ! (mol/L) (m/s) ? 162 oce_co2(ji,jj) = ( zfld - zflu ) * tmask(ji,jj,1) 163 ! compute the trend 164 tr(ji,jj,1,jpdic,Krhs) = tr(ji,jj,1,jpdic,Krhs) + oce_co2(ji,jj) * rfact2 / e3t(ji,jj,1,Kmm) 165 166 ! Compute O2 flux 167 zfld16 = patm(ji,jj) * chemo2(ji,jj,1) * zkgo2(ji,jj) ! (mol/L) * (m/s) 168 zflu16 = tr(ji,jj,1,jpoxy,Kbb) * zkgo2(ji,jj) 169 zoflx(ji,jj) = ( zfld16 - zflu16 ) * tmask(ji,jj,1) 170 tr(ji,jj,1,jpoxy,Krhs) = tr(ji,jj,1,jpoxy,Krhs) + zoflx(ji,jj) * rfact2 / e3t(ji,jj,1,Kmm) 171 END DO 172 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 173 169 174 170 IF( iom_use("tcflx") .OR. iom_use("tcflxcum") .OR. kt == nitrst & -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zligand.F90
r12258 r12340 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) … … 50 52 IF( ln_timing ) CALL timing_start('p4z_ligand') 51 53 ! 52 DO jk = 1, jpkm1 53 DO jj = 1, jpj 54 DO ji = 1, jpi 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 DO 74 END DO 75 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 76 74 ! 77 75 ! Output of some diagnostics variables -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zlim.F90
r12258 r12340 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) … … 96 98 IF( ln_timing ) CALL timing_start('p4z_lim') 97 99 ! 98 DO jk = 1, jpkm1 99 DO jj = 1, jpj 100 DO ji = 1, jpi 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 DO 172 END DO 173 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 174 172 175 173 ! Compute the fraction of nanophytoplankton that is made of calcifiers 176 174 ! -------------------------------------------------------------------- 177 DO jk = 1, jpkm1 178 DO jj = 1, jpj 179 DO ji = 1, jpi 180 zlim1 = ( tr(ji,jj,jk,jpno3,Kbb) * concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) * concnno3 ) & 181 & / ( concnno3 * concnnh4 + concnnh4 * tr(ji,jj,jk,jpno3,Kbb) + concnno3 * tr(ji,jj,jk,jpnh4,Kbb) ) 182 zlim2 = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concnnh4 ) 183 zlim3 = tr(ji,jj,jk,jpfer,Kbb) / ( tr(ji,jj,jk,jpfer,Kbb) + 5.E-11 ) 184 ztem1 = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) ) 185 ztem2 = ts(ji,jj,jk,jp_tem,Kmm) - 10. 186 zetot1 = MAX( 0., etot_ndcy(ji,jj,jk) - 1.) / ( 4. + etot_ndcy(ji,jj,jk) ) 187 zetot2 = 30. / ( 30. + etot_ndcy(ji,jj,jk) ) 188 189 xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 ) & 190 & * ztem1 / ( 0.1 + ztem1 ) & 191 & * MAX( 1., tr(ji,jj,jk,jpphy,Kbb) * 1.e6 / 2. ) & 192 & * zetot1 * zetot2 & 193 & * ( 1. + EXP(-ztem2 * ztem2 / 25. ) ) & 194 & * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) ) 195 xfracal(ji,jj,jk) = MIN( 0.8 , xfracal(ji,jj,jk) ) 196 xfracal(ji,jj,jk) = MAX( 0.02, xfracal(ji,jj,jk) ) 197 END DO 198 END DO 199 END DO 200 ! 201 DO jk = 1, jpkm1 202 DO jj = 1, jpj 203 DO ji = 1, jpi 204 ! denitrification factor computed from O2 levels 205 nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - tr(ji,jj,jk,jpoxy,Kbb) ) & 206 & / ( oxymin + tr(ji,jj,jk,jpoxy,Kbb) ) ) 207 nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 208 ! 209 ! denitrification factor computed from NO3 levels 210 nitrfac2(ji,jj,jk) = MAX( 0.e0, ( 1.E-6 - tr(ji,jj,jk,jpno3,Kbb) ) & 211 & / ( 1.E-6 + tr(ji,jj,jk,jpno3,Kbb) ) ) 212 nitrfac2(ji,jj,jk) = MIN( 1., nitrfac2(ji,jj,jk) ) 213 END DO 214 END DO 215 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 216 206 ! 217 207 IF( lk_iomput .AND. knt == nrdttrc ) THEN ! save output diagnostics -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zlys.F90
r12258 r12340 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) … … 73 75 CALL solve_at_general( zhinit, zhi, Kbb ) 74 76 75 DO jk = 1, jpkm1 76 DO jj = 1, jpj 77 DO ji = 1, jpi 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 DO 82 END DO 83 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 84 82 85 83 ! --------------------------------------------------------- … … 89 87 ! --------------------------------------------------------- 90 88 91 DO jk = 1, jpkm1 92 DO jj = 1, jpj 93 DO ji = 1, jpi 89 DO_3D_11_11( 1, jpkm1 ) 94 90 95 96 97 98 99 100 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 ) 101 97 102 103 104 105 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 106 102 107 ! AMOUNT CACO3 (12C) THAT RE-ENTERS SOLUTION 108 ! (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE 109 ! CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION) 110 zdispot = kdca * zexcess * tr(ji,jj,jk,jpcal,Kbb) 111 ! CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3], 112 ! AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION 113 zcaldiss(ji,jj,jk) = zdispot * rfact2 / rmtss ! calcite dissolution 114 ! 115 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + 2. * zcaldiss(ji,jj,jk) 116 tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) - zcaldiss(ji,jj,jk) 117 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zcaldiss(ji,jj,jk) 118 END DO 119 END DO 120 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 121 115 ! 122 116 -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zmeso.F90
r12258 r12340 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) … … 78 80 IF( ln_timing ) CALL timing_start('p4z_meso') 79 81 ! 80 DO jk = 1, jpkm1 81 DO jj = 1, jpj 82 DO ji = 1, jpi 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 DO 223 END DO 224 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 225 223 ! 226 224 IF( lk_iomput .AND. knt == nrdttrc ) THEN -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zmicro.F90
r12258 r12340 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) … … 76 78 IF( ln_timing ) CALL timing_start('p4z_micro') 77 79 ! 78 DO jk = 1, jpkm1 79 DO jj = 1, jpj 80 DO ji = 1, jpi 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 DO 180 END DO 181 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 182 180 ! 183 181 IF( lk_iomput .AND. knt == nrdttrc ) THEN -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zmort.F90
r12236 r12340 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) … … 75 77 ! 76 78 prodcal(:,:,:) = 0._wp ! calcite production variable set to zero 77 DO jk = 1, jpkm1 78 DO jj = 1, jpj 79 DO ji = 1, jpi 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 DO 119 END DO 120 END DO 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 121 119 ! 122 120 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) … … 154 152 ! ------------------------------------------------------------ 155 153 156 DO jk = 1, jpkm1 157 DO jj = 1, jpj 158 DO ji = 1, jpi 159 160 zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1e-9), 0. ) 161 162 ! Aggregation term for diatoms is increased in case of nutrient 163 ! stress as observed in reality. The stressed cells become more 164 ! sticky and coagulate to sink quickly out of the euphotic zone 165 ! ------------------------------------------------------------ 166 ! Phytoplankton respiration 167 ! ------------------------ 168 zlim2 = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk) 169 zlim1 = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 170 zrespp2 = 1.e6 * xstep * ( wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * tr(ji,jj,jk,jpdia,Kbb) 171 172 ! Phytoplankton mortality. 173 ! ------------------------ 174 ztortp2 = mprat2 * xstep * tr(ji,jj,jk,jpdia,Kbb) / ( xkmort + tr(ji,jj,jk,jpdia,Kbb) ) * zcompadi 175 176 zmortp2 = zrespp2 + ztortp2 177 178 ! Update the arrays tr(:,:,:,:,Krhs) which contains the biological sources and sinks 179 ! --------------------------------------------------------------------- 180 zfactch = tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 181 zfactfe = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 182 zfactsi = tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 183 tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zmortp2 184 tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zmortp2 * zfactch 185 tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zmortp2 * zfactfe 186 tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zmortp2 * zfactsi 187 tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zmortp2 * zfactsi 188 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zrespp2 + 0.5 * ztortp2 189 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + 0.5 * ztortp2 190 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + 0.5 * ztortp2 191 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zrespp2 + 0.5 * ztortp2 192 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 0.5 * ztortp2 * zfactfe 193 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + ( zrespp2 + 0.5 * ztortp2 ) * zfactfe 194 END DO 195 END DO 196 END DO 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 197 191 ! 198 192 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zopt.F90
r12258 r12340 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) … … 86 88 IF( ln_p5z ) zchl3d(:,:,:) = zchl3d(:,:,:) + tr(:,:,:,jppch,Kbb) 87 89 ! 88 DO jk = 1, jpkm1 89 DO jj = 1, jpj 90 DO ji = 1, jpi 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 DO 99 END DO 100 END DO 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 101 99 ! !* Photosynthetically Available Radiation (PAR) 102 100 ! ! -------------------------------------- … … 161 159 heup_01(:,:) = gdepw(:,:,2,Kmm) 162 160 163 DO jk = 2, nksrp 164 DO jj = 1, jpj 165 DO ji = 1, jpi 166 IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= zqsr100(ji,jj) ) THEN 167 neln(ji,jj) = jk+1 ! Euphotic level : 1rst T-level strictly below Euphotic layer 168 ! ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint 169 heup(ji,jj) = gdepw(ji,jj,jk+1,Kmm) ! Euphotic layer depth 170 ENDIF 171 IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.50 ) THEN 172 heup_01(ji,jj) = gdepw(ji,jj,jk+1,Kmm) ! Euphotic layer depth (light level definition) 173 ENDIF 174 END DO 175 END DO 176 END DO 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 177 171 ! 178 172 heup (:,:) = MIN( 300., heup (:,:) ) … … 183 177 zetmp2 (:,:) = 0.e0 184 178 185 DO jk = 1, nksrp 186 DO jj = 1, jpj 187 DO ji = 1, jpi 188 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 189 zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! remineralisation 190 zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 191 zdepmoy(ji,jj) = zdepmoy(ji,jj) + e3t(ji,jj,jk,Kmm) 192 ENDIF 193 END DO 194 END DO 195 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 196 186 ! 197 187 emoy(:,:,:) = etot(:,:,:) ! remineralisation 198 188 zpar(:,:,:) = etot_ndcy(:,:,:) ! diagnostic : PAR with no diurnal cycle 199 189 ! 200 DO jk = 1, nksrp 201 DO jj = 1, jpj 202 DO ji = 1, jpi 203 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 204 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 205 emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep 206 zpar (ji,jj,jk) = zetmp2(ji,jj) * z1_dep 207 ENDIF 208 END DO 209 END DO 210 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 211 197 ! 212 198 zdepmoy(:,:) = 0.e0 … … 214 200 zetmp4 (:,:) = 0.e0 215 201 ! 216 DO jk = 1, nksrp 217 DO jj = 1, jpj 218 DO ji = 1, jpi 219 IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 220 zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 221 zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 222 zdepmoy(ji,jj) = zdepmoy(ji,jj) + e3t(ji,jj,jk,Kmm) 223 ENDIF 224 END DO 225 END DO 226 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 227 209 enanom(:,:,:) = enano(:,:,:) 228 210 ediatm(:,:,:) = ediat(:,:,:) 229 211 ! 230 DO jk = 1, nksrp 231 DO jj = 1, jpj 232 DO ji = 1, jpi 233 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 234 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 235 enanom(ji,jj,jk) = zetmp3(ji,jj) * z1_dep 236 ediatm(ji,jj,jk) = zetmp4(ji,jj) * z1_dep 237 ENDIF 238 END DO 239 END DO 240 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 241 219 ! 242 220 IF( ln_p5z ) THEN 243 221 ALLOCATE( zetmp5(jpi,jpj) ) ; zetmp5 (:,:) = 0.e0 244 DO jk = 1, nksrp 245 DO jj = 1, jpj 246 DO ji = 1, jpi 247 IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 248 zetmp5(ji,jj) = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 249 ENDIF 250 END DO 251 END DO 252 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 253 227 ! 254 228 epicom(:,:,:) = epico(:,:,:) 255 229 ! 256 DO jk = 1, nksrp 257 DO jj = 1, jpj 258 DO ji = 1, jpi 259 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 260 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 261 epicom(ji,jj,jk) = zetmp5(ji,jj) * z1_dep 262 ENDIF 263 END DO 264 END DO 265 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 266 236 DEALLOCATE( zetmp5 ) 267 237 ENDIF … … 331 301 pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) ) 332 302 ! 333 DO jk = 2, nksrp 334 DO jj = 1, jpj 335 DO ji = 1, jpi 336 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) 337 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) ) 338 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) ) 339 END DO 340 END DO 341 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 342 308 ! 343 309 ENDIF -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zpoc.F90
r12236 r12340 37 37 38 38 39 !! * Substitutions 40 # include "do_loop_substitute.h90" 39 41 !!---------------------------------------------------------------------- 40 42 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 104 106 ! ----------------------------------------------------------------------- 105 107 ztremint(:,:,:) = zremigoc(:,:,:) 106 DO jk = 2, jpkm1 107 DO jj = 1, jpj 108 DO ji = 1, jpi 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) 180 END DO 181 ! Computation of the mean remineralisation rate 182 ztremint(ji,jj,jk) = MAX(0., remint / ( alphat + rtrn) ) 183 ! 184 ENDIF 185 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) 186 180 END DO 187 END DO 188 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 189 187 190 188 IF( ln_p4z ) THEN ; zremigoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) … … 193 191 194 192 IF( ln_p4z ) THEN 195 DO jk = 1, jpkm1 196 DO jj = 1, jpj 197 DO ji = 1, jpi 198 ! POC disaggregation by turbulence and bacterial activity. 199 ! -------------------------------------------------------- 200 zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 201 zorem2 = zremig * tr(ji,jj,jk,jpgoc,Kbb) 202 orem(ji,jj,jk) = zorem2 203 zorem3(ji,jj,jk) = zremig * solgoc * tr(ji,jj,jk,jpgoc,Kbb) 204 zofer2 = zremig * tr(ji,jj,jk,jpbfe,Kbb) 205 zofer3 = zremig * solgoc * tr(ji,jj,jk,jpbfe,Kbb) 206 207 ! ------------------------------------- 208 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zorem3(ji,jj,jk) 209 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) - zorem2 - zorem3(ji,jj,jk) 210 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zofer3 211 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zofer2 - zofer3 212 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zorem2 213 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer2 214 zfolimi(ji,jj,jk) = zofer2 215 END DO 216 END DO 217 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 218 212 ELSE 219 DO jk = 1, jpkm1 220 DO jj = 1, jpj 221 DO ji = 1, jpi 222 ! POC disaggregation by turbulence and bacterial activity. 223 ! -------------------------------------------------------- 224 zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 225 zopoc2 = zremig * tr(ji,jj,jk,jpgoc,Kbb) 226 orem(ji,jj,jk) = zopoc2 227 zorem3(ji,jj,jk) = zremig * solgoc * tr(ji,jj,jk,jpgoc,Kbb) 228 zopon2 = xremipn / xremipc * zremig * tr(ji,jj,jk,jpgon,Kbb) 229 zopop2 = xremipp / xremipc * zremig * tr(ji,jj,jk,jpgop,Kbb) 230 zofer2 = xremipn / xremipc * zremig * tr(ji,jj,jk,jpbfe,Kbb) 231 232 ! ------------------------------------- 233 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zorem3(ji,jj,jk) 234 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + solgoc * zopon2 235 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + solgoc * zopop2 236 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + solgoc * zofer2 237 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zopoc2 238 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zopon2 239 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zopop2 240 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer2 241 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) - zopoc2 - zorem3(ji,jj,jk) 242 tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) - zopon2 * (1. + solgoc) 243 tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) - zopop2 * (1. + solgoc) 244 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zofer2 * (1. + solgoc) 245 zfolimi(ji,jj,jk) = zofer2 246 END DO 247 END DO 248 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 249 239 ENDIF 250 240 … … 269 259 ! ---------------------------------------------------------------- 270 260 ! 271 DO jk = 1, jpkm1 272 DO jj = 1, jpj 273 DO ji = 1, jpi 274 zdep = hmld(ji,jj) 275 IF (tmask(ji,jj,jk) == 1. .AND. gdept(ji,jj,jk,Kmm) <= zdep ) THEN 276 totprod(ji,jj) = totprod(ji,jj) + prodpoc(ji,jj,jk) * e3t(ji,jj,jk,Kmm) * rday/ rfact2 277 ! The temperature effect is included here 278 totthick(ji,jj) = totthick(ji,jj) + e3t(ji,jj,jk,Kmm)* tgfunc(ji,jj,jk) 279 totcons(ji,jj) = totcons(ji,jj) - conspoc(ji,jj,jk) * e3t(ji,jj,jk,Kmm) * rday/ rfact2 & 280 & / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 281 ENDIF 282 END DO 283 END DO 284 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 285 271 286 272 ! Computation of the lability spectrum in the mixed layer. In the mixed … … 288 274 ! --------------------------------------------------------------------- 289 275 ztremint(:,:,:) = zremipoc(:,:,:) 290 DO jk = 1, jpkm1 291 DO jj = 1, jpj 292 DO ji = 1, jpi 293 IF (tmask(ji,jj,jk) == 1.) THEN 294 zdep = hmld(ji,jj) 295 alphat = 0.0 296 remint = 0.0 297 IF( gdept(ji,jj,jk,Kmm) <= zdep ) THEN 298 DO jn = 1, jcpoc 299 ! For each lability class, the system is supposed to be 300 ! at equilibrium: Prod - Sink - w alphap = 0. 301 alphap(ji,jj,jk,jn) = totprod(ji,jj) * alphan(jn) / ( reminp(jn) & 302 & * totthick(ji,jj) + totcons(ji,jj) + wsbio + rtrn ) 303 alphat = alphat + alphap(ji,jj,jk,jn) 304 END DO 305 DO jn = 1, jcpoc 306 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 307 remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 308 END DO 309 ! Mean remineralization rate in the mixed layer 310 ztremint(ji,jj,jk) = MAX( 0., remint ) 311 ENDIF 312 ENDIF 313 END DO 314 END DO 315 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 316 298 ! 317 299 IF( ln_p4z ) THEN ; zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) … … 327 309 ! ----------------------------------------------------------------------- 328 310 ! 329 DO jk = 2, jpkm1 330 DO jj = 1, jpj 331 DO ji = 1, jpi 332 IF (tmask(ji,jj,jk) == 1.) THEN 333 zdep = hmld(ji,jj) 334 IF( gdept(ji,jj,jk,Kmm) > zdep ) THEN 335 alphat = 0. 336 remint = 0. 337 ! 338 ! the scale factors are corrected with temperature 339 zsizek1 = e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 340 zsizek = e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 341 ! 342 ! Special treatment of the level just below the MXL 343 ! See the comments in the GOC section 344 ! --------------------------------------------------- 345 ! 346 IF ( gdept(ji,jj,jk-1,Kmm) <= zdep ) THEN 347 ! 348 ! Computation of the POC concentration using the 349 ! lagrangian algorithm 350 zpoc = tr(ji,jj,jk-1,jppoc,Kbb) + conspoc(ji,jj,jk) * rday / rfact2 & 351 & * e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn) 352 zpoc = max(0., zpoc) 353 ! 354 DO jn = 1, jcpoc 355 ! computation of the lability spectrum applying the 356 ! different sources and sinks 357 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc & 358 & + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk) * alphag(ji,jj,jk,jn) ) & 359 & / tgfunc(ji,jj,jk) / reminp(jn) * rday / rfact2 * ( 1. - exp( -reminp(jn) & 360 & * zsizek ) ) 361 alphap(ji,jj,jk,jn) = MAX( 0., alphap(ji,jj,jk,jn) ) 362 alphat = alphat + alphap(ji,jj,jk,jn) 363 END DO 364 ELSE 365 ! 366 ! Lability parameterization for the interior of the ocean 367 ! This is very similar to what is done in the previous 368 ! block 369 ! -------------------------------------------------------- 370 ! 371 zpoc = tr(ji,jj,jk-1,jppoc,Kbb) + conspoc(ji,jj,jk-1) * rday / rfact2 & 372 & * e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) + conspoc(ji,jj,jk) & 373 & * rday / rfact2 * e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn) 374 zpoc = max(0., zpoc) 375 ! 376 DO jn = 1, jcpoc 377 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn) & 378 & * ( zsizek + zsizek1 ) ) * zpoc + ( prodpoc(ji,jj,jk-1) * alphan(jn) & 379 & + zorem3(ji,jj,jk-1) * alphag(ji,jj,jk-1,jn) ) * rday / rfact2 / reminp(jn) & 380 & / tgfunc(ji,jj,jk-1) * ( 1. - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn) & 381 & * zsizek ) + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk) & 382 & * alphag(ji,jj,jk,jn) ) * rday / rfact2 / reminp(jn) / tgfunc(ji,jj,jk) * ( 1. & 383 & - exp( -reminp(jn) * zsizek ) ) 384 alphap(ji,jj,jk,jn) = max(0., alphap(ji,jj,jk,jn) ) 385 alphat = alphat + alphap(ji,jj,jk,jn) 386 END DO 387 ENDIF 388 ! Normalization of the lability spectrum so that the 389 ! integral is equal to 1 390 DO jn = 1, jcpoc 391 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 392 remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 393 END DO 394 ! Mean remineralization rate in the water column 395 ztremint(ji,jj,jk) = MAX( 0., remint ) 396 ENDIF 397 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) 398 373 END DO 399 END DO 400 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 401 379 402 380 IF( ln_p4z ) THEN ; zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) … … 405 383 406 384 IF( ln_p4z ) THEN 407 DO jk = 1, jpkm1 408 DO jj = 1, jpj 409 DO ji = 1, jpi 410 IF (tmask(ji,jj,jk) == 1.) THEN 411 ! POC disaggregation by turbulence and bacterial activity. 412 ! -------------------------------------------------------- 413 zremip = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 414 zorem = zremip * tr(ji,jj,jk,jppoc,Kbb) 415 zofer = zremip * tr(ji,jj,jk,jpsfe,Kbb) 416 417 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zorem 418 orem(ji,jj,jk) = orem(ji,jj,jk) + zorem 419 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer 420 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zorem 421 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zofer 422 zfolimi(ji,jj,jk) = zfolimi(ji,jj,jk) + zofer 423 ENDIF 424 END DO 425 END DO 426 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 427 401 ELSE 428 DO jk = 1, jpkm1 429 DO jj = 1, jpj 430 DO ji = 1, jpi 431 ! POC disaggregation by turbulence and bacterial activity. 432 ! -------------------------------------------------------- 433 zremip = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 434 zopoc = zremip * tr(ji,jj,jk,jppoc,Kbb) 435 orem(ji,jj,jk) = orem(ji,jj,jk) + zopoc 436 zopon = xremipn / xremipc * zremip * tr(ji,jj,jk,jppon,Kbb) 437 zopop = xremipp / xremipc * zremip * tr(ji,jj,jk,jppop,Kbb) 438 zofer = xremipn / xremipc * zremip * tr(ji,jj,jk,jpsfe,Kbb) 439 440 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zopoc 441 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) - zopon 442 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) - zopop 443 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zofer 444 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zopoc 445 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zopon 446 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zopop 447 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer 448 zfolimi(ji,jj,jk) = zfolimi(ji,jj,jk) + zofer 449 END DO 450 END DO 451 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 452 422 ENDIF 453 423 -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zprod.F90
r12281 r12340 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) … … 107 109 ! day length in hours 108 110 zstrn(:,:) = 0. 109 DO jj = 1, jpj 110 DO ji = 1, jpi 111 zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 112 zargu = MAX( -1., MIN( 1., zargu ) ) 113 zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 114 END DO 115 END DO 111 DO_2D_11_11 112 zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 113 zargu = MAX( -1., MIN( 1., zargu ) ) 114 zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 115 END_2D 116 116 117 117 ! Impact of the day duration and light intermittency on phytoplankton growth 118 DO jk = 1, jpkm1 119 DO jj = 1 ,jpj 120 DO ji = 1, jpi 121 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 122 zval = MAX( 1., zstrn(ji,jj) ) 123 IF( gdept(ji,jj,jk,Kmm) <= hmld(ji,jj) ) THEN 124 zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 125 ENDIF 126 zmxl_chl(ji,jj,jk) = zval / 24. 127 zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval ) 128 ENDIF 129 END DO 130 END DO 131 END DO 118 DO_3D_11_11( 1, jpkm1 ) 119 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 120 zval = MAX( 1., zstrn(ji,jj) ) 121 IF( gdept(ji,jj,jk,Kmm) <= hmld(ji,jj) ) THEN 122 zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 123 ENDIF 124 zmxl_chl(ji,jj,jk) = zval / 24. 125 zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval ) 126 ENDIF 127 END_3D 132 128 133 129 zprbio(:,:,:) = zprmaxn(:,:,:) * zmxl_fac(:,:,:) … … 138 134 139 135 ! Computation of the P-I slope for nanos and diatoms 140 DO jk = 1, jpkm1 141 DO jj = 1, jpj 142 DO ji = 1, jpi 143 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 144 ztn = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. ) 145 zadap = xadap * ztn / ( 2.+ ztn ) 146 zconctemp = MAX( 0.e0 , tr(ji,jj,jk,jpdia,Kbb) - xsizedia ) 147 zconctemp2 = tr(ji,jj,jk,jpdia,Kbb) - zconctemp 148 ! 149 zpislopeadn(ji,jj,jk) = pislopen * ( 1.+ zadap * EXP( -0.25 * enano(ji,jj,jk) ) ) & 150 & * tr(ji,jj,jk,jpnch,Kbb) /( tr(ji,jj,jk,jpphy,Kbb) * 12. + rtrn) 151 ! 152 zpislopeadd(ji,jj,jk) = (pislopen * zconctemp2 + pisloped * zconctemp) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) & 153 & * tr(ji,jj,jk,jpdch,Kbb) /( tr(ji,jj,jk,jpdia,Kbb) * 12. + rtrn) 154 ENDIF 155 END DO 156 END DO 157 END DO 158 159 DO jk = 1, jpkm1 160 DO jj = 1, jpj 161 DO ji = 1, jpi 162 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 163 ! Computation of production function for Carbon 164 ! --------------------------------------------- 165 zpislopen = zpislopeadn(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 166 & * zmxl_fac(ji,jj,jk) * rday + rtrn) 167 zpisloped = zpislopeadd(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 168 & * zmxl_fac(ji,jj,jk) * rday + rtrn) 169 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 170 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 171 ! Computation of production function for Chlorophyll 172 !-------------------------------------------------- 173 zpislopen = zpislopeadn(ji,jj,jk) / ( zprmaxn(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 174 zpisloped = zpislopeadd(ji,jj,jk) / ( zprmaxd(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 175 zprnch(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) ) ) 176 zprdch(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) ) ) 177 ENDIF 178 END DO 179 END DO 180 END DO 136 DO_3D_11_11( 1, jpkm1 ) 137 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 138 ztn = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. ) 139 zadap = xadap * ztn / ( 2.+ ztn ) 140 zconctemp = MAX( 0.e0 , tr(ji,jj,jk,jpdia,Kbb) - xsizedia ) 141 zconctemp2 = tr(ji,jj,jk,jpdia,Kbb) - zconctemp 142 ! 143 zpislopeadn(ji,jj,jk) = pislopen * ( 1.+ zadap * EXP( -0.25 * enano(ji,jj,jk) ) ) & 144 & * tr(ji,jj,jk,jpnch,Kbb) /( tr(ji,jj,jk,jpphy,Kbb) * 12. + rtrn) 145 ! 146 zpislopeadd(ji,jj,jk) = (pislopen * zconctemp2 + pisloped * zconctemp) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) & 147 & * tr(ji,jj,jk,jpdch,Kbb) /( tr(ji,jj,jk,jpdia,Kbb) * 12. + rtrn) 148 ENDIF 149 END_3D 150 151 DO_3D_11_11( 1, jpkm1 ) 152 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 153 ! Computation of production function for Carbon 154 ! --------------------------------------------- 155 zpislopen = zpislopeadn(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 156 & * zmxl_fac(ji,jj,jk) * rday + rtrn) 157 zpisloped = zpislopeadd(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 158 & * zmxl_fac(ji,jj,jk) * rday + rtrn) 159 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 160 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 161 ! Computation of production function for Chlorophyll 162 !-------------------------------------------------- 163 zpislopen = zpislopeadn(ji,jj,jk) / ( zprmaxn(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 164 zpisloped = zpislopeadd(ji,jj,jk) / ( zprmaxd(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 165 zprnch(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) ) ) 166 zprdch(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) ) ) 167 ENDIF 168 END_3D 181 169 182 170 ! Computation of a proxy of the N/C ratio 183 171 ! --------------------------------------- 184 DO jk = 1, jpkm1 185 DO jj = 1, jpj 186 DO ji = 1, jpi 187 zval = MIN( xnanopo4(ji,jj,jk), ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) ) & 188 & * zprmaxn(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn ) 189 quotan(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval ) 190 zval = MIN( xdiatpo4(ji,jj,jk), ( xdiatnh4(ji,jj,jk) + xdiatno3(ji,jj,jk) ) ) & 191 & * zprmaxd(ji,jj,jk) / ( zprdia(ji,jj,jk) + rtrn ) 192 quotad(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval ) 193 END DO 194 END DO 195 END DO 196 197 198 DO jk = 1, jpkm1 199 DO jj = 1, jpj 200 DO ji = 1, jpi 201 202 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 203 ! Si/C of diatoms 204 ! ------------------------ 205 ! Si/C increases with iron stress and silicate availability 206 ! Si/C is arbitrariliy increased for very high Si concentrations 207 ! to mimic the very high ratios observed in the Southern Ocean (silpot2) 208 zlim = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi1 ) 209 zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 210 zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) ) ) + 1.e0 211 zsiborn = tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) 212 IF (gphit(ji,jj) < -30 ) THEN 213 zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 ) 214 ELSE 215 zsilfac2 = 1. + zsiborn / ( zsiborn + xksi2**3 ) 216 ENDIF 217 zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2 218 ENDIF 219 END DO 220 END DO 221 END DO 172 DO_3D_11_11( 1, jpkm1 ) 173 zval = MIN( xnanopo4(ji,jj,jk), ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) ) & 174 & * zprmaxn(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn ) 175 quotan(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval ) 176 zval = MIN( xdiatpo4(ji,jj,jk), ( xdiatnh4(ji,jj,jk) + xdiatno3(ji,jj,jk) ) ) & 177 & * zprmaxd(ji,jj,jk) / ( zprdia(ji,jj,jk) + rtrn ) 178 quotad(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval ) 179 END_3D 180 181 182 DO_3D_11_11( 1, jpkm1 ) 183 184 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 185 ! Si/C of diatoms 186 ! ------------------------ 187 ! Si/C increases with iron stress and silicate availability 188 ! Si/C is arbitrariliy increased for very high Si concentrations 189 ! to mimic the very high ratios observed in the Southern Ocean (silpot2) 190 zlim = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi1 ) 191 zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 192 zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) ) ) + 1.e0 193 zsiborn = tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) 194 IF (gphit(ji,jj) < -30 ) THEN 195 zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 ) 196 ELSE 197 zsilfac2 = 1. + zsiborn / ( zsiborn + xksi2**3 ) 198 ENDIF 199 zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2 200 ENDIF 201 END_3D 222 202 223 203 ! Mixed-layer effect on production 224 204 ! Sea-ice effect on production 225 205 226 DO jk = 1, jpkm1 227 DO jj = 1, jpj 228 DO ji = 1, jpi 229 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 230 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 231 END DO 232 END DO 233 END DO 206 DO_3D_11_11( 1, jpkm1 ) 207 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 208 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 209 END_3D 234 210 235 211 ! Computation of the various production terms 236 DO jk = 1, jpkm1 237 DO jj = 1, jpj 238 DO ji = 1, jpi 239 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 240 ! production terms for nanophyto. (C) 241 zprorcan(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * tr(ji,jj,jk,jpphy,Kbb) * rfact2 242 zpronewn(ji,jj,jk) = zprorcan(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 243 ! 244 zratio = tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) * fecnm + rtrn ) 245 zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 246 zprofen(ji,jj,jk) = fecnm * zprmaxn(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) ) & 247 & * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) ) & 248 & * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) ) & 249 & * zmax * tr(ji,jj,jk,jpphy,Kbb) * rfact2 250 ! production terms for diatoms (C) 251 zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr(ji,jj,jk,jpdia,Kbb) * rfact2 252 zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 253 ! 254 zratio = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) * fecdm + rtrn ) 255 zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 256 zprofed(ji,jj,jk) = fecdm * zprmaxd(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) ) & 257 & * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) ) & 258 & * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) ) & 259 & * zmax * tr(ji,jj,jk,jpdia,Kbb) * rfact2 260 ENDIF 261 END DO 262 END DO 263 END DO 212 DO_3D_11_11( 1, jpkm1 ) 213 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 214 ! production terms for nanophyto. (C) 215 zprorcan(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * tr(ji,jj,jk,jpphy,Kbb) * rfact2 216 zpronewn(ji,jj,jk) = zprorcan(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 217 ! 218 zratio = tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) * fecnm + rtrn ) 219 zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 220 zprofen(ji,jj,jk) = fecnm * zprmaxn(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) ) & 221 & * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) ) & 222 & * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) ) & 223 & * zmax * tr(ji,jj,jk,jpphy,Kbb) * rfact2 224 ! production terms for diatoms (C) 225 zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr(ji,jj,jk,jpdia,Kbb) * rfact2 226 zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 227 ! 228 zratio = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) * fecdm + rtrn ) 229 zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 230 zprofed(ji,jj,jk) = fecdm * zprmaxd(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) ) & 231 & * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) ) & 232 & * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) ) & 233 & * zmax * tr(ji,jj,jk,jpdia,Kbb) * rfact2 234 ENDIF 235 END_3D 264 236 265 237 ! Computation of the chlorophyll production terms 266 DO jk = 1, jpkm1 267 DO jj = 1, jpj 268 DO ji = 1, jpi 269 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 270 ! production terms for nanophyto. ( chlorophyll ) 271 znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 272 zprod = rday * zprorcan(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 273 zprochln = chlcmin * 12. * zprorcan (ji,jj,jk) 274 chlcnm_n = MIN ( chlcnm, ( chlcnm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm))) * (1. - 1.14 / 43.4 * 20.)) 275 zprochln = zprochln + (chlcnm_n-chlcmin) * 12. * zprod / & 276 & ( zpislopeadn(ji,jj,jk) * znanotot +rtrn) 277 ! production terms for diatoms ( chlorophyll ) 278 zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 279 zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 280 zprochld = chlcmin * 12. * zprorcad(ji,jj,jk) 281 chlcdm_n = MIN ( chlcdm, ( chlcdm / (1. - 1.14 / 43.4 * ts(ji,jj,jk,jp_tem,Kmm))) * (1. - 1.14 / 43.4 * 20.)) 282 zprochld = zprochld + (chlcdm_n-chlcmin) * 12. * zprod / & 283 & ( zpislopeadd(ji,jj,jk) * zdiattot +rtrn ) 284 ! Update the arrays TRA which contain the Chla sources and sinks 285 tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) + zprochln * texcretn 286 tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) + zprochld * texcretd 287 ENDIF 288 END DO 289 END DO 290 END DO 238 DO_3D_11_11( 1, jpkm1 ) 239 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 240 ! production terms for nanophyto. ( chlorophyll ) 241 znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 242 zprod = rday * zprorcan(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 243 zprochln = chlcmin * 12. * zprorcan (ji,jj,jk) 244 chlcnm_n = MIN ( chlcnm, ( chlcnm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm))) * (1. - 1.14 / 43.4 * 20.)) 245 zprochln = zprochln + (chlcnm_n-chlcmin) * 12. * zprod / & 246 & ( zpislopeadn(ji,jj,jk) * znanotot +rtrn) 247 ! production terms for diatoms ( chlorophyll ) 248 zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 249 zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 250 zprochld = chlcmin * 12. * zprorcad(ji,jj,jk) 251 chlcdm_n = MIN ( chlcdm, ( chlcdm / (1. - 1.14 / 43.4 * ts(ji,jj,jk,jp_tem,Kmm))) * (1. - 1.14 / 43.4 * 20.)) 252 zprochld = zprochld + (chlcdm_n-chlcmin) * 12. * zprod / & 253 & ( zpislopeadd(ji,jj,jk) * zdiattot +rtrn ) 254 ! Update the arrays TRA which contain the Chla sources and sinks 255 tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) + zprochln * texcretn 256 tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) + zprochld * texcretd 257 ENDIF 258 END_3D 291 259 292 260 ! Update the arrays TRA which contain the biological sources and sinks 293 DO jk = 1, jpkm1 294 DO jj = 1, jpj 295 DO ji =1 ,jpi 296 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 297 zproreg = zprorcan(ji,jj,jk) - zpronewn(ji,jj,jk) 298 zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk) 299 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 300 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 301 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk) 302 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zproreg - zproreg2 303 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zprorcan(ji,jj,jk) * texcretn 304 tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) + zprofen(ji,jj,jk) * texcretn 305 tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) + zprorcad(ji,jj,jk) * texcretd 306 tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) + zprofed(ji,jj,jk) * texcretd 307 tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 308 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zdocprod 309 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + o2ut * ( zproreg + zproreg2) & 310 & + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) 311 ! 312 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 313 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zfeup 314 tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 315 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 316 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 317 & - rno3 * ( zproreg + zproreg2 ) 318 ENDIF 319 END DO 320 END DO 321 END DO 261 DO_3D_11_11( 1, jpkm1 ) 262 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 263 zproreg = zprorcan(ji,jj,jk) - zpronewn(ji,jj,jk) 264 zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk) 265 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 266 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 267 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk) 268 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zproreg - zproreg2 269 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zprorcan(ji,jj,jk) * texcretn 270 tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) + zprofen(ji,jj,jk) * texcretn 271 tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) + zprorcad(ji,jj,jk) * texcretd 272 tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) + zprofed(ji,jj,jk) * texcretd 273 tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 274 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zdocprod 275 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + o2ut * ( zproreg + zproreg2) & 276 & + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) 277 ! 278 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 279 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zfeup 280 tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 281 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 282 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 283 & - rno3 * ( zproreg + zproreg2 ) 284 ENDIF 285 END_3D 322 286 ! 323 287 IF( ln_ligand ) THEN 324 288 zpligprod1(:,:,:) = 0._wp ; zpligprod2(:,:,:) = 0._wp 325 DO jk = 1, jpkm1 326 DO jj = 1, jpj 327 DO ji =1 ,jpi 328 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 329 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 330 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 331 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 332 zpligprod1(ji,jj,jk) = zdocprod * ldocp 333 zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet 334 ENDIF 335 END DO 336 END DO 337 END DO 289 DO_3D_11_11( 1, jpkm1 ) 290 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 291 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 292 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 293 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 294 zpligprod1(ji,jj,jk) = zdocprod * ldocp 295 zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet 296 ENDIF 297 END_3D 338 298 ENDIF 339 299 -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zrem.F90
r12258 r12340 42 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: denitr !: denitrification array 43 43 44 !! * Substitutions 45 # include "do_loop_substitute.h90" 44 46 !!---------------------------------------------------------------------- 45 47 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 86 88 ! that was modeling explicitely bacteria 87 89 ! ------------------------------------------------------- 88 DO jk = 1, jpkm1 89 DO jj = 1, jpj 90 DO ji = 1, jpi 91 zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 92 IF( gdept(ji,jj,jk,Kmm) < zdep ) THEN 93 zdepbac(ji,jj,jk) = MIN( 0.7 * ( tr(ji,jj,jk,jpzoo,Kbb) + 2.* tr(ji,jj,jk,jpmes,Kbb) ), 4.e-6 ) 94 ztempbac(ji,jj) = zdepbac(ji,jj,jk) 95 ELSE 96 zdepmin = MIN( 1., zdep / gdept(ji,jj,jk,Kmm) ) 97 zdepbac (ji,jj,jk) = zdepmin**0.683 * ztempbac(ji,jj) 98 zdepprod(ji,jj,jk) = zdepmin**0.273 99 zdepeff (ji,jj,jk) = zdepeff(ji,jj,jk) * zdepmin**0.3 100 ENDIF 101 END DO 102 END DO 103 END DO 90 DO_3D_11_11( 1, jpkm1 ) 91 zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 92 IF( gdept(ji,jj,jk,Kmm) < zdep ) THEN 93 zdepbac(ji,jj,jk) = MIN( 0.7 * ( tr(ji,jj,jk,jpzoo,Kbb) + 2.* tr(ji,jj,jk,jpmes,Kbb) ), 4.e-6 ) 94 ztempbac(ji,jj) = zdepbac(ji,jj,jk) 95 ELSE 96 zdepmin = MIN( 1., zdep / gdept(ji,jj,jk,Kmm) ) 97 zdepbac (ji,jj,jk) = zdepmin**0.683 * ztempbac(ji,jj) 98 zdepprod(ji,jj,jk) = zdepmin**0.273 99 zdepeff (ji,jj,jk) = zdepeff(ji,jj,jk) * zdepmin**0.3 100 ENDIF 101 END_3D 104 102 105 103 IF( ln_p4z ) THEN 106 DO jk = 1, jpkm1 107 DO jj = 1, jpj 108 DO ji = 1, jpi 109 ! DOC ammonification. Depends on depth, phytoplankton biomass 110 ! and a limitation term which is supposed to be a parameterization of the bacterial activity. 111 zremik = xremik * xstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk) 112 zremik = MAX( zremik, 2.74e-4 * xstep ) 113 ! Ammonification in oxic waters with oxygen consumption 114 ! ----------------------------------------------------- 115 zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * tr(ji,jj,jk,jpdoc,Kbb) 116 zolimi(ji,jj,jk) = MIN( ( tr(ji,jj,jk,jpoxy,Kbb) - rtrn ) / o2ut, zolimit ) 117 ! Ammonification in suboxic waters with denitrification 118 ! ------------------------------------------------------- 119 zammonic = zremik * nitrfac(ji,jj,jk) * tr(ji,jj,jk,jpdoc,Kbb) 120 denitr(ji,jj,jk) = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 121 denitr(ji,jj,jk) = MIN( ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenit, denitr(ji,jj,jk) ) 122 zoxyremc = zammonic - denitr(ji,jj,jk) 123 ! 124 zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) ) 125 denitr (ji,jj,jk) = MAX( 0.e0, denitr (ji,jj,jk) ) 126 zoxyremc = MAX( 0.e0, zoxyremc ) 127 128 ! 129 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 130 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 131 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - denitr (ji,jj,jk) * rdenit 132 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zolimi (ji,jj,jk) - denitr(ji,jj,jk) - zoxyremc 133 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - zolimi (ji,jj,jk) * o2ut 134 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 135 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zolimi(ji,jj,jk) + zoxyremc & 136 & + ( rdenit + 1.) * denitr(ji,jj,jk) ) 137 END DO 138 END DO 139 END DO 104 DO_3D_11_11( 1, jpkm1 ) 105 ! DOC ammonification. Depends on depth, phytoplankton biomass 106 ! and a limitation term which is supposed to be a parameterization of the bacterial activity. 107 zremik = xremik * xstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk) 108 zremik = MAX( zremik, 2.74e-4 * xstep ) 109 ! Ammonification in oxic waters with oxygen consumption 110 ! ----------------------------------------------------- 111 zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * tr(ji,jj,jk,jpdoc,Kbb) 112 zolimi(ji,jj,jk) = MIN( ( tr(ji,jj,jk,jpoxy,Kbb) - rtrn ) / o2ut, zolimit ) 113 ! Ammonification in suboxic waters with denitrification 114 ! ------------------------------------------------------- 115 zammonic = zremik * nitrfac(ji,jj,jk) * tr(ji,jj,jk,jpdoc,Kbb) 116 denitr(ji,jj,jk) = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 117 denitr(ji,jj,jk) = MIN( ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenit, denitr(ji,jj,jk) ) 118 zoxyremc = zammonic - denitr(ji,jj,jk) 119 ! 120 zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) ) 121 denitr (ji,jj,jk) = MAX( 0.e0, denitr (ji,jj,jk) ) 122 zoxyremc = MAX( 0.e0, zoxyremc ) 123 124 ! 125 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 126 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 127 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - denitr (ji,jj,jk) * rdenit 128 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zolimi (ji,jj,jk) - denitr(ji,jj,jk) - zoxyremc 129 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - zolimi (ji,jj,jk) * o2ut 130 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 131 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zolimi(ji,jj,jk) + zoxyremc & 132 & + ( rdenit + 1.) * denitr(ji,jj,jk) ) 133 END_3D 140 134 ELSE 141 DO jk = 1, jpkm1 142 DO jj = 1, jpj 143 DO ji = 1, jpi 144 ! DOC ammonification. Depends on depth, phytoplankton biomass 145 ! and a limitation term which is supposed to be a parameterization of the bacterial activity. 146 ! ----------------------------------------------------------------- 147 zremik = xstep / 1.e-6 * MAX(0.01, xlimbac(ji,jj,jk)) * zdepbac(ji,jj,jk) 148 zremik = MAX( zremik, 2.74e-4 * xstep / xremikc ) 149 150 zremikc = xremikc * zremik 151 zremikn = xremikn / xremikc 152 zremikp = xremikp / xremikc 153 154 ! Ammonification in oxic waters with oxygen consumption 155 ! ----------------------------------------------------- 156 zolimit = zremikc * ( 1.- nitrfac(ji,jj,jk) ) * tr(ji,jj,jk,jpdoc,Kbb) 157 zolimic = MAX( 0.e0, MIN( ( tr(ji,jj,jk,jpoxy,Kbb) - rtrn ) / o2ut, zolimit ) ) 158 zolimi(ji,jj,jk) = zolimic 159 zolimin = zremikn * zolimic * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 160 zolimip = zremikp * zolimic * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 161 162 ! Ammonification in suboxic waters with denitrification 163 ! ------------------------------------------------------- 164 zammonic = zremikc * nitrfac(ji,jj,jk) * tr(ji,jj,jk,jpdoc,Kbb) 165 denitr(ji,jj,jk) = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 166 denitr(ji,jj,jk) = MAX(0., MIN( ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenit, denitr(ji,jj,jk) ) ) 167 zoxyremc = MAX(0., zammonic - denitr(ji,jj,jk)) 168 zdenitrn = zremikn * denitr(ji,jj,jk) * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 169 zdenitrp = zremikp * denitr(ji,jj,jk) * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 170 zoxyremn = zremikn * zoxyremc * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 171 zoxyremp = zremikp * zoxyremc * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 172 173 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zolimip + zdenitrp + zoxyremp 174 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zolimin + zdenitrn + zoxyremn 175 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - denitr(ji,jj,jk) * rdenit 176 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zolimic - denitr(ji,jj,jk) - zoxyremc 177 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) - zolimin - zdenitrn - zoxyremn 178 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) - zolimip - zdenitrp - zoxyremp 179 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - zolimic * o2ut 180 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zolimic + denitr(ji,jj,jk) + zoxyremc 181 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zolimin + zoxyremn + ( rdenit + 1.) * zdenitrn ) 182 END DO 183 END DO 184 END DO 135 DO_3D_11_11( 1, jpkm1 ) 136 ! DOC ammonification. Depends on depth, phytoplankton biomass 137 ! and a limitation term which is supposed to be a parameterization of the bacterial activity. 138 ! ----------------------------------------------------------------- 139 zremik = xstep / 1.e-6 * MAX(0.01, xlimbac(ji,jj,jk)) * zdepbac(ji,jj,jk) 140 zremik = MAX( zremik, 2.74e-4 * xstep / xremikc ) 141 142 zremikc = xremikc * zremik 143 zremikn = xremikn / xremikc 144 zremikp = xremikp / xremikc 145 146 ! Ammonification in oxic waters with oxygen consumption 147 ! ----------------------------------------------------- 148 zolimit = zremikc * ( 1.- nitrfac(ji,jj,jk) ) * tr(ji,jj,jk,jpdoc,Kbb) 149 zolimic = MAX( 0.e0, MIN( ( tr(ji,jj,jk,jpoxy,Kbb) - rtrn ) / o2ut, zolimit ) ) 150 zolimi(ji,jj,jk) = zolimic 151 zolimin = zremikn * zolimic * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 152 zolimip = zremikp * zolimic * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 153 154 ! Ammonification in suboxic waters with denitrification 155 ! ------------------------------------------------------- 156 zammonic = zremikc * nitrfac(ji,jj,jk) * tr(ji,jj,jk,jpdoc,Kbb) 157 denitr(ji,jj,jk) = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 158 denitr(ji,jj,jk) = MAX(0., MIN( ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenit, denitr(ji,jj,jk) ) ) 159 zoxyremc = MAX(0., zammonic - denitr(ji,jj,jk)) 160 zdenitrn = zremikn * denitr(ji,jj,jk) * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 161 zdenitrp = zremikp * denitr(ji,jj,jk) * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 162 zoxyremn = zremikn * zoxyremc * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 163 zoxyremp = zremikp * zoxyremc * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 164 165 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zolimip + zdenitrp + zoxyremp 166 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zolimin + zdenitrn + zoxyremn 167 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - denitr(ji,jj,jk) * rdenit 168 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zolimic - denitr(ji,jj,jk) - zoxyremc 169 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) - zolimin - zdenitrn - zoxyremn 170 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) - zolimip - zdenitrp - zoxyremp 171 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - zolimic * o2ut 172 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zolimic + denitr(ji,jj,jk) + zoxyremc 173 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zolimin + zoxyremn + ( rdenit + 1.) * zdenitrn ) 174 END_3D 185 175 ! 186 176 ENDIF 187 177 188 178 189 DO jk = 1, jpkm1 190 DO jj = 1, jpj 191 DO ji = 1, jpi 192 ! NH4 nitrification to NO3. Ceased for oxygen concentrations 193 ! below 2 umol/L. Inhibited at strong light 194 ! ---------------------------------------------------------- 195 zonitr = nitrif * xstep * tr(ji,jj,jk,jpnh4,Kbb) * ( 1.- nitrfac(ji,jj,jk) ) & 196 & / ( 1.+ emoy(ji,jj,jk) ) * ( 1. + fr_i(ji,jj) * emoy(ji,jj,jk) ) 197 zdenitnh4 = nitrif * xstep * tr(ji,jj,jk,jpnh4,Kbb) * nitrfac(ji,jj,jk) 198 zdenitnh4 = MIN( ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenita, zdenitnh4 ) 199 ! Update of the tracers trends 200 ! ---------------------------- 201 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zonitr - zdenitnh4 202 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + zonitr - rdenita * zdenitnh4 203 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2nit * zonitr 204 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * zdenitnh4 205 END DO 206 END DO 207 END DO 179 DO_3D_11_11( 1, jpkm1 ) 180 ! NH4 nitrification to NO3. Ceased for oxygen concentrations 181 ! below 2 umol/L. Inhibited at strong light 182 ! ---------------------------------------------------------- 183 zonitr = nitrif * xstep * tr(ji,jj,jk,jpnh4,Kbb) * ( 1.- nitrfac(ji,jj,jk) ) & 184 & / ( 1.+ emoy(ji,jj,jk) ) * ( 1. + fr_i(ji,jj) * emoy(ji,jj,jk) ) 185 zdenitnh4 = nitrif * xstep * tr(ji,jj,jk,jpnh4,Kbb) * nitrfac(ji,jj,jk) 186 zdenitnh4 = MIN( ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenita, zdenitnh4 ) 187 ! Update of the tracers trends 188 ! ---------------------------- 189 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zonitr - zdenitnh4 190 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + zonitr - rdenita * zdenitnh4 191 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2nit * zonitr 192 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * zdenitnh4 193 END_3D 208 194 209 195 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) … … 213 199 ENDIF 214 200 215 DO jk = 1, jpkm1 216 DO jj = 1, jpj 217 DO ji = 1, jpi 218 219 ! Bacterial uptake of iron. No iron is available in DOC. So 220 ! Bacteries are obliged to take up iron from the water. Some 221 ! studies (especially at Papa) have shown this uptake to be significant 222 ! ---------------------------------------------------------- 223 zbactfer = feratb * rfact2 * 0.6_wp / rday * tgfunc(ji,jj,jk) * xlimbacl(ji,jj,jk) & 224 & * tr(ji,jj,jk,jpfer,Kbb) / ( xkferb + tr(ji,jj,jk,jpfer,Kbb) ) & 225 & * zdepprod(ji,jj,jk) * zdepeff(ji,jj,jk) * zdepbac(ji,jj,jk) 226 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zbactfer*0.33 227 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zbactfer*0.25 228 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zbactfer*0.08 229 zfebact(ji,jj,jk) = zbactfer * 0.33 230 blim(ji,jj,jk) = xlimbacl(ji,jj,jk) * zdepbac(ji,jj,jk) / 1.e-6 * zdepprod(ji,jj,jk) 231 END DO 232 END DO 233 END DO 201 DO_3D_11_11( 1, jpkm1 ) 202 203 ! Bacterial uptake of iron. No iron is available in DOC. So 204 ! Bacteries are obliged to take up iron from the water. Some 205 ! studies (especially at Papa) have shown this uptake to be significant 206 ! ---------------------------------------------------------- 207 zbactfer = feratb * rfact2 * 0.6_wp / rday * tgfunc(ji,jj,jk) * xlimbacl(ji,jj,jk) & 208 & * tr(ji,jj,jk,jpfer,Kbb) / ( xkferb + tr(ji,jj,jk,jpfer,Kbb) ) & 209 & * zdepprod(ji,jj,jk) * zdepeff(ji,jj,jk) * zdepbac(ji,jj,jk) 210 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zbactfer*0.33 211 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zbactfer*0.25 212 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zbactfer*0.08 213 zfebact(ji,jj,jk) = zbactfer * 0.33 214 blim(ji,jj,jk) = xlimbacl(ji,jj,jk) * zdepbac(ji,jj,jk) / 1.e-6 * zdepprod(ji,jj,jk) 215 END_3D 234 216 235 217 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) … … 243 225 ! --------------------------------------------------------------- 244 226 245 DO jk = 1, jpkm1 246 DO jj = 1, jpj 247 DO ji = 1, jpi 248 zdep = MAX( hmld(ji,jj), heup_01(ji,jj) ) 249 zsatur = MAX( rtrn, ( sio3eq(ji,jj,jk) - tr(ji,jj,jk,jpsil,Kbb) ) / ( sio3eq(ji,jj,jk) + rtrn ) ) 250 zsatur2 = ( 1. + ts(ji,jj,jk,jp_tem,Kmm) / 400.)**37 251 znusil = 0.225 * ( 1. + ts(ji,jj,jk,jp_tem,Kmm) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25 252 ! Remineralization rate of BSi depedant on T and saturation 253 ! --------------------------------------------------------- 254 IF ( gdept(ji,jj,jk,Kmm) > zdep ) THEN 255 zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk-1) * EXP( -0.5 * ( xsiremlab - xsirem ) & 256 & * znusil * e3t(ji,jj,jk,Kmm) / wsbio4(ji,jj,jk) ) 257 zfacsi(ji,jj,jk) = zfacsib(ji,jj,jk) / ( 1.0 + zfacsib(ji,jj,jk) ) 258 zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk) * EXP( -0.5 * ( xsiremlab - xsirem ) & 259 & * znusil * e3t(ji,jj,jk,Kmm) / wsbio4(ji,jj,jk) ) 260 ENDIF 261 zsiremin = ( xsiremlab * zfacsi(ji,jj,jk) + xsirem * ( 1. - zfacsi(ji,jj,jk) ) ) * xstep * znusil 262 zosil = zsiremin * tr(ji,jj,jk,jpgsi,Kbb) 263 ! 264 tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) - zosil 265 tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) + zosil 266 END DO 267 END DO 268 END DO 227 DO_3D_11_11( 1, jpkm1 ) 228 zdep = MAX( hmld(ji,jj), heup_01(ji,jj) ) 229 zsatur = MAX( rtrn, ( sio3eq(ji,jj,jk) - tr(ji,jj,jk,jpsil,Kbb) ) / ( sio3eq(ji,jj,jk) + rtrn ) ) 230 zsatur2 = ( 1. + ts(ji,jj,jk,jp_tem,Kmm) / 400.)**37 231 znusil = 0.225 * ( 1. + ts(ji,jj,jk,jp_tem,Kmm) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25 232 ! Remineralization rate of BSi depedant on T and saturation 233 ! --------------------------------------------------------- 234 IF ( gdept(ji,jj,jk,Kmm) > zdep ) THEN 235 zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk-1) * EXP( -0.5 * ( xsiremlab - xsirem ) & 236 & * znusil * e3t(ji,jj,jk,Kmm) / wsbio4(ji,jj,jk) ) 237 zfacsi(ji,jj,jk) = zfacsib(ji,jj,jk) / ( 1.0 + zfacsib(ji,jj,jk) ) 238 zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk) * EXP( -0.5 * ( xsiremlab - xsirem ) & 239 & * znusil * e3t(ji,jj,jk,Kmm) / wsbio4(ji,jj,jk) ) 240 ENDIF 241 zsiremin = ( xsiremlab * zfacsi(ji,jj,jk) + xsirem * ( 1. - zfacsi(ji,jj,jk) ) ) * xstep * znusil 242 zosil = zsiremin * tr(ji,jj,jk,jpgsi,Kbb) 243 ! 244 tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) - zosil 245 tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) + zosil 246 END_3D 269 247 270 248 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zsed.F90
r12258 r12340 37 37 REAL(wp), SAVE :: sedsilfrac, sedcalfrac 38 38 39 !! * Substitutions 40 # include "do_loop_substitute.h90" 39 41 !!---------------------------------------------------------------------- 40 42 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 91 93 ! OA: Warning, the following part is necessary to avoid CFL problems above the sediments 92 94 ! -------------------------------------------------------------------- 93 DO jj = 1, jpj 94 DO ji = 1, jpi 95 ikt = mbkt(ji,jj) 96 zdep = e3t(ji,jj,ikt,Kmm) / xstep 97 zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) ) 98 zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) ) 99 END DO 100 END DO 95 DO_2D_11_11 96 ikt = mbkt(ji,jj) 97 zdep = e3t(ji,jj,ikt,Kmm) / xstep 98 zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) ) 99 zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) ) 100 END_2D 101 101 102 102 ! Computation of the sediment denitrification proportion: The metamodel from midlleburg (2006) is being used 103 103 ! Computation of the fraction of organic matter that is permanently buried from Dunne's model 104 104 ! ------------------------------------------------------- 105 DO jj = 1, jpj 106 DO ji = 1, jpi 107 IF( tmask(ji,jj,1) == 1 ) THEN 108 ikt = mbkt(ji,jj) 109 zflx = ( tr(ji,jj,ikt,jpgoc,Kbb) * zwsbio4(ji,jj) & 110 & + tr(ji,jj,ikt,jppoc,Kbb) * zwsbio3(ji,jj) ) * 1E3 * 1E6 / 1E4 111 zflx = LOG10( MAX( 1E-3, zflx ) ) 112 zo2 = LOG10( MAX( 10. , tr(ji,jj,ikt,jpoxy,Kbb) * 1E6 ) ) 113 zno3 = LOG10( MAX( 1. , tr(ji,jj,ikt,jpno3,Kbb) * 1E6 * rno3 ) ) 114 zdep = LOG10( gdepw(ji,jj,ikt+1,Kmm) ) 115 zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3 & 116 & + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2 117 zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) ) 118 ! 119 zflx = ( tr(ji,jj,ikt,jpgoc,Kbb) * zwsbio4(ji,jj) & 120 & + tr(ji,jj,ikt,jppoc,Kbb) * zwsbio3(ji,jj) ) * 1E6 121 zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2 122 ENDIF 123 END DO 124 END DO 105 DO_2D_11_11 106 IF( tmask(ji,jj,1) == 1 ) THEN 107 ikt = mbkt(ji,jj) 108 zflx = ( tr(ji,jj,ikt,jpgoc,Kbb) * zwsbio4(ji,jj) & 109 & + tr(ji,jj,ikt,jppoc,Kbb) * zwsbio3(ji,jj) ) * 1E3 * 1E6 / 1E4 110 zflx = LOG10( MAX( 1E-3, zflx ) ) 111 zo2 = LOG10( MAX( 10. , tr(ji,jj,ikt,jpoxy,Kbb) * 1E6 ) ) 112 zno3 = LOG10( MAX( 1. , tr(ji,jj,ikt,jpno3,Kbb) * 1E6 * rno3 ) ) 113 zdep = LOG10( gdepw(ji,jj,ikt+1,Kmm) ) 114 zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3 & 115 & + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2 116 zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) ) 117 ! 118 zflx = ( tr(ji,jj,ikt,jpgoc,Kbb) * zwsbio4(ji,jj) & 119 & + tr(ji,jj,ikt,jppoc,Kbb) * zwsbio3(ji,jj) ) * 1E6 120 zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2 121 ENDIF 122 END_2D 125 123 ! 126 124 ENDIF … … 131 129 IF( .NOT.lk_sed ) zrivsil = 1._wp - sedsilfrac 132 130 133 DO jj = 1, jpj 134 DO ji = 1, jpi 131 DO_2D_11_11 132 ikt = mbkt(ji,jj) 133 zdep = xstep / e3t(ji,jj,ikt,Kmm) 134 zwsc = zwsbio4(ji,jj) * zdep 135 zsiloss = tr(ji,jj,ikt,jpgsi,Kbb) * zwsc 136 zcaloss = tr(ji,jj,ikt,jpcal,Kbb) * zwsc 137 ! 138 tr(ji,jj,ikt,jpgsi,Krhs) = tr(ji,jj,ikt,jpgsi,Krhs) - zsiloss 139 tr(ji,jj,ikt,jpcal,Krhs) = tr(ji,jj,ikt,jpcal,Krhs) - zcaloss 140 END_2D 141 ! 142 IF( .NOT.lk_sed ) THEN 143 DO_2D_11_11 135 144 ikt = mbkt(ji,jj) 136 145 zdep = xstep / e3t(ji,jj,ikt,Kmm) … … 138 147 zsiloss = tr(ji,jj,ikt,jpgsi,Kbb) * zwsc 139 148 zcaloss = tr(ji,jj,ikt,jpcal,Kbb) * zwsc 149 tr(ji,jj,ikt,jpsil,Krhs) = tr(ji,jj,ikt,jpsil,Krhs) + zsiloss * zrivsil 140 150 ! 141 tr(ji,jj,ikt,jpgsi,Krhs) = tr(ji,jj,ikt,jpgsi,Krhs) - zsiloss 142 tr(ji,jj,ikt,jpcal,Krhs) = tr(ji,jj,ikt,jpcal,Krhs) - zcaloss 143 END DO 144 END DO 145 ! 146 IF( .NOT.lk_sed ) THEN 147 DO jj = 1, jpj 148 DO ji = 1, jpi 149 ikt = mbkt(ji,jj) 150 zdep = xstep / e3t(ji,jj,ikt,Kmm) 151 zwsc = zwsbio4(ji,jj) * zdep 152 zsiloss = tr(ji,jj,ikt,jpgsi,Kbb) * zwsc 153 zcaloss = tr(ji,jj,ikt,jpcal,Kbb) * zwsc 154 tr(ji,jj,ikt,jpsil,Krhs) = tr(ji,jj,ikt,jpsil,Krhs) + zsiloss * zrivsil 155 ! 156 zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 157 zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 158 zrivalk = sedcalfrac * zfactcal 159 tr(ji,jj,ikt,jptal,Krhs) = tr(ji,jj,ikt,jptal,Krhs) + zcaloss * zrivalk * 2.0 160 tr(ji,jj,ikt,jpdic,Krhs) = tr(ji,jj,ikt,jpdic,Krhs) + zcaloss * zrivalk 161 zsedcal(ji,jj) = (1.0 - zrivalk) * zcaloss * e3t(ji,jj,ikt,Kmm) 162 zsedsi (ji,jj) = (1.0 - zrivsil) * zsiloss * e3t(ji,jj,ikt,Kmm) 163 END DO 164 END DO 165 ENDIF 166 ! 167 DO jj = 1, jpj 168 DO ji = 1, jpi 151 zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 152 zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 153 zrivalk = sedcalfrac * zfactcal 154 tr(ji,jj,ikt,jptal,Krhs) = tr(ji,jj,ikt,jptal,Krhs) + zcaloss * zrivalk * 2.0 155 tr(ji,jj,ikt,jpdic,Krhs) = tr(ji,jj,ikt,jpdic,Krhs) + zcaloss * zrivalk 156 zsedcal(ji,jj) = (1.0 - zrivalk) * zcaloss * e3t(ji,jj,ikt,Kmm) 157 zsedsi (ji,jj) = (1.0 - zrivsil) * zsiloss * e3t(ji,jj,ikt,Kmm) 158 END_2D 159 ENDIF 160 ! 161 DO_2D_11_11 162 ikt = mbkt(ji,jj) 163 zdep = xstep / e3t(ji,jj,ikt,Kmm) 164 zws4 = zwsbio4(ji,jj) * zdep 165 zws3 = zwsbio3(ji,jj) * zdep 166 tr(ji,jj,ikt,jpgoc,Krhs) = tr(ji,jj,ikt,jpgoc,Krhs) - tr(ji,jj,ikt,jpgoc,Kbb) * zws4 167 tr(ji,jj,ikt,jppoc,Krhs) = tr(ji,jj,ikt,jppoc,Krhs) - tr(ji,jj,ikt,jppoc,Kbb) * zws3 168 tr(ji,jj,ikt,jpbfe,Krhs) = tr(ji,jj,ikt,jpbfe,Krhs) - tr(ji,jj,ikt,jpbfe,Kbb) * zws4 169 tr(ji,jj,ikt,jpsfe,Krhs) = tr(ji,jj,ikt,jpsfe,Krhs) - tr(ji,jj,ikt,jpsfe,Kbb) * zws3 170 END_2D 171 ! 172 IF( ln_p5z ) THEN 173 DO_2D_11_11 169 174 ikt = mbkt(ji,jj) 170 175 zdep = xstep / e3t(ji,jj,ikt,Kmm) 171 176 zws4 = zwsbio4(ji,jj) * zdep 172 177 zws3 = zwsbio3(ji,jj) * zdep 173 tr(ji,jj,ikt,jpgoc,Krhs) = tr(ji,jj,ikt,jpgoc,Krhs) - tr(ji,jj,ikt,jpgoc,Kbb) * zws4 174 tr(ji,jj,ikt,jppoc,Krhs) = tr(ji,jj,ikt,jppoc,Krhs) - tr(ji,jj,ikt,jppoc,Kbb) * zws3 175 tr(ji,jj,ikt,jpbfe,Krhs) = tr(ji,jj,ikt,jpbfe,Krhs) - tr(ji,jj,ikt,jpbfe,Kbb) * zws4 176 tr(ji,jj,ikt,jpsfe,Krhs) = tr(ji,jj,ikt,jpsfe,Krhs) - tr(ji,jj,ikt,jpsfe,Kbb) * zws3 177 END DO 178 END DO 179 ! 180 IF( ln_p5z ) THEN 181 DO jj = 1, jpj 182 DO ji = 1, jpi 183 ikt = mbkt(ji,jj) 184 zdep = xstep / e3t(ji,jj,ikt,Kmm) 185 zws4 = zwsbio4(ji,jj) * zdep 186 zws3 = zwsbio3(ji,jj) * zdep 187 tr(ji,jj,ikt,jpgon,Krhs) = tr(ji,jj,ikt,jpgon,Krhs) - tr(ji,jj,ikt,jpgon,Kbb) * zws4 188 tr(ji,jj,ikt,jppon,Krhs) = tr(ji,jj,ikt,jppon,Krhs) - tr(ji,jj,ikt,jppon,Kbb) * zws3 189 tr(ji,jj,ikt,jpgop,Krhs) = tr(ji,jj,ikt,jpgop,Krhs) - tr(ji,jj,ikt,jpgop,Kbb) * zws4 190 tr(ji,jj,ikt,jppop,Krhs) = tr(ji,jj,ikt,jppop,Krhs) - tr(ji,jj,ikt,jppop,Kbb) * zws3 191 END DO 192 END DO 178 tr(ji,jj,ikt,jpgon,Krhs) = tr(ji,jj,ikt,jpgon,Krhs) - tr(ji,jj,ikt,jpgon,Kbb) * zws4 179 tr(ji,jj,ikt,jppon,Krhs) = tr(ji,jj,ikt,jppon,Krhs) - tr(ji,jj,ikt,jppon,Kbb) * zws3 180 tr(ji,jj,ikt,jpgop,Krhs) = tr(ji,jj,ikt,jpgop,Krhs) - tr(ji,jj,ikt,jpgop,Kbb) * zws4 181 tr(ji,jj,ikt,jppop,Krhs) = tr(ji,jj,ikt,jppop,Krhs) - tr(ji,jj,ikt,jppop,Kbb) * zws3 182 END_2D 193 183 ENDIF 194 184 … … 196 186 ! The 0.5 factor in zpdenit is to avoid negative NO3 concentration after 197 187 ! denitrification in the sediments. Not very clever, but simpliest option. 198 DO jj = 1, jpj 199 DO ji = 1, jpi 200 ikt = mbkt(ji,jj) 201 zdep = xstep / e3t(ji,jj,ikt,Kmm) 202 zws4 = zwsbio4(ji,jj) * zdep 203 zws3 = zwsbio3(ji,jj) * zdep 204 zrivno3 = 1. - zbureff(ji,jj) 205 zwstpoc = tr(ji,jj,ikt,jpgoc,Kbb) * zws4 + tr(ji,jj,ikt,jppoc,Kbb) * zws3 206 zpdenit = MIN( 0.5 * ( tr(ji,jj,ikt,jpno3,Kbb) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 ) 207 z1pdenit = zwstpoc * zrivno3 - zpdenit 208 zolimit = MIN( ( tr(ji,jj,ikt,jpoxy,Kbb) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) ) 209 tr(ji,jj,ikt,jpdoc,Krhs) = tr(ji,jj,ikt,jpdoc,Krhs) + z1pdenit - zolimit 210 tr(ji,jj,ikt,jppo4,Krhs) = tr(ji,jj,ikt,jppo4,Krhs) + zpdenit + zolimit 211 tr(ji,jj,ikt,jpnh4,Krhs) = tr(ji,jj,ikt,jpnh4,Krhs) + zpdenit + zolimit 212 tr(ji,jj,ikt,jpno3,Krhs) = tr(ji,jj,ikt,jpno3,Krhs) - rdenit * zpdenit 213 tr(ji,jj,ikt,jpoxy,Krhs) = tr(ji,jj,ikt,jpoxy,Krhs) - zolimit * o2ut 214 tr(ji,jj,ikt,jptal,Krhs) = tr(ji,jj,ikt,jptal,Krhs) + rno3 * (zolimit + (1.+rdenit) * zpdenit ) 215 tr(ji,jj,ikt,jpdic,Krhs) = tr(ji,jj,ikt,jpdic,Krhs) + zpdenit + zolimit 216 sdenit(ji,jj) = rdenit * zpdenit * e3t(ji,jj,ikt,Kmm) 217 zsedc(ji,jj) = (1. - zrivno3) * zwstpoc * e3t(ji,jj,ikt,Kmm) 218 IF( ln_p5z ) THEN 219 zwstpop = tr(ji,jj,ikt,jpgop,Kbb) * zws4 + tr(ji,jj,ikt,jppop,Kbb) * zws3 220 zwstpon = tr(ji,jj,ikt,jpgon,Kbb) * zws4 + tr(ji,jj,ikt,jppon,Kbb) * zws3 221 tr(ji,jj,ikt,jpdon,Krhs) = tr(ji,jj,ikt,jpdon,Krhs) + ( z1pdenit - zolimit ) * zwstpon / (zwstpoc + rtrn) 222 tr(ji,jj,ikt,jpdop,Krhs) = tr(ji,jj,ikt,jpdop,Krhs) + ( z1pdenit - zolimit ) * zwstpop / (zwstpoc + rtrn) 223 ENDIF 224 END DO 225 END DO 188 DO_2D_11_11 189 ikt = mbkt(ji,jj) 190 zdep = xstep / e3t(ji,jj,ikt,Kmm) 191 zws4 = zwsbio4(ji,jj) * zdep 192 zws3 = zwsbio3(ji,jj) * zdep 193 zrivno3 = 1. - zbureff(ji,jj) 194 zwstpoc = tr(ji,jj,ikt,jpgoc,Kbb) * zws4 + tr(ji,jj,ikt,jppoc,Kbb) * zws3 195 zpdenit = MIN( 0.5 * ( tr(ji,jj,ikt,jpno3,Kbb) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 ) 196 z1pdenit = zwstpoc * zrivno3 - zpdenit 197 zolimit = MIN( ( tr(ji,jj,ikt,jpoxy,Kbb) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) ) 198 tr(ji,jj,ikt,jpdoc,Krhs) = tr(ji,jj,ikt,jpdoc,Krhs) + z1pdenit - zolimit 199 tr(ji,jj,ikt,jppo4,Krhs) = tr(ji,jj,ikt,jppo4,Krhs) + zpdenit + zolimit 200 tr(ji,jj,ikt,jpnh4,Krhs) = tr(ji,jj,ikt,jpnh4,Krhs) + zpdenit + zolimit 201 tr(ji,jj,ikt,jpno3,Krhs) = tr(ji,jj,ikt,jpno3,Krhs) - rdenit * zpdenit 202 tr(ji,jj,ikt,jpoxy,Krhs) = tr(ji,jj,ikt,jpoxy,Krhs) - zolimit * o2ut 203 tr(ji,jj,ikt,jptal,Krhs) = tr(ji,jj,ikt,jptal,Krhs) + rno3 * (zolimit + (1.+rdenit) * zpdenit ) 204 tr(ji,jj,ikt,jpdic,Krhs) = tr(ji,jj,ikt,jpdic,Krhs) + zpdenit + zolimit 205 sdenit(ji,jj) = rdenit * zpdenit * e3t(ji,jj,ikt,Kmm) 206 zsedc(ji,jj) = (1. - zrivno3) * zwstpoc * e3t(ji,jj,ikt,Kmm) 207 IF( ln_p5z ) THEN 208 zwstpop = tr(ji,jj,ikt,jpgop,Kbb) * zws4 + tr(ji,jj,ikt,jppop,Kbb) * zws3 209 zwstpon = tr(ji,jj,ikt,jpgon,Kbb) * zws4 + tr(ji,jj,ikt,jppon,Kbb) * zws3 210 tr(ji,jj,ikt,jpdon,Krhs) = tr(ji,jj,ikt,jpdon,Krhs) + ( z1pdenit - zolimit ) * zwstpon / (zwstpoc + rtrn) 211 tr(ji,jj,ikt,jpdop,Krhs) = tr(ji,jj,ikt,jpdop,Krhs) + ( z1pdenit - zolimit ) * zwstpop / (zwstpoc + rtrn) 212 ENDIF 213 END_2D 226 214 ENDIF 227 215 … … 235 223 ENDDO 236 224 IF( ln_p4z ) THEN 237 DO jk = 1, jpkm1 238 DO jj = 1, jpj 239 DO ji = 1, jpi 240 ! ! Potential nitrogen fixation dependant on temperature and iron 241 ztemp = ts(ji,jj,jk,jp_tem,Kmm) 242 zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 243 ! Potential nitrogen fixation dependant on temperature and iron 244 xdianh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 245 xdiano3 = tr(ji,jj,jk,jpno3,Kbb) / ( concnno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - xdianh4) 246 zlim = ( 1.- xdiano3 - xdianh4 ) 247 IF( zlim <= 0.1 ) zlim = 0.01 248 zfact = zlim * rfact2 249 ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 250 ztrpo4(ji,jj,jk) = tr(ji,jj,jk,jppo4,Kbb) / ( 1E-6 + tr(ji,jj,jk,jppo4,Kbb) ) 251 ztrdp = ztrpo4(ji,jj,jk) 252 nitrpot(ji,jj,jk) = zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 253 END DO 254 END DO 255 END DO 225 DO_3D_11_11( 1, jpkm1 ) 226 ! ! Potential nitrogen fixation dependant on temperature and iron 227 ztemp = ts(ji,jj,jk,jp_tem,Kmm) 228 zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 229 ! Potential nitrogen fixation dependant on temperature and iron 230 xdianh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 231 xdiano3 = tr(ji,jj,jk,jpno3,Kbb) / ( concnno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - xdianh4) 232 zlim = ( 1.- xdiano3 - xdianh4 ) 233 IF( zlim <= 0.1 ) zlim = 0.01 234 zfact = zlim * rfact2 235 ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 236 ztrpo4(ji,jj,jk) = tr(ji,jj,jk,jppo4,Kbb) / ( 1E-6 + tr(ji,jj,jk,jppo4,Kbb) ) 237 ztrdp = ztrpo4(ji,jj,jk) 238 nitrpot(ji,jj,jk) = zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 239 END_3D 256 240 ELSE ! p5z 257 DO jk = 1, jpkm1 258 DO jj = 1, jpj 259 DO ji = 1, jpi 260 ! ! Potential nitrogen fixation dependant on temperature and iron 261 ztemp = ts(ji,jj,jk,jp_tem,Kmm) 262 zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 263 ! Potential nitrogen fixation dependant on temperature and iron 264 xdianh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 265 xdiano3 = tr(ji,jj,jk,jpno3,Kbb) / ( concnno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - xdianh4) 266 zlim = ( 1.- xdiano3 - xdianh4 ) 267 IF( zlim <= 0.1 ) zlim = 0.01 268 zfact = zlim * rfact2 269 ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 270 ztrpo4(ji,jj,jk) = tr(ji,jj,jk,jppo4,Kbb) / ( 1E-6 + tr(ji,jj,jk,jppo4,Kbb) ) 271 ztrdop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( 1E-6 + tr(ji,jj,jk,jpdop,Kbb) ) * (1. - ztrpo4(ji,jj,jk)) 272 ztrdp = ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) 273 nitrpot(ji,jj,jk) = zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 274 END DO 275 END DO 276 END DO 241 DO_3D_11_11( 1, jpkm1 ) 242 ! ! Potential nitrogen fixation dependant on temperature and iron 243 ztemp = ts(ji,jj,jk,jp_tem,Kmm) 244 zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 245 ! Potential nitrogen fixation dependant on temperature and iron 246 xdianh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 247 xdiano3 = tr(ji,jj,jk,jpno3,Kbb) / ( concnno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - xdianh4) 248 zlim = ( 1.- xdiano3 - xdianh4 ) 249 IF( zlim <= 0.1 ) zlim = 0.01 250 zfact = zlim * rfact2 251 ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 252 ztrpo4(ji,jj,jk) = tr(ji,jj,jk,jppo4,Kbb) / ( 1E-6 + tr(ji,jj,jk,jppo4,Kbb) ) 253 ztrdop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( 1E-6 + tr(ji,jj,jk,jpdop,Kbb) ) * (1. - ztrpo4(ji,jj,jk)) 254 ztrdp = ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) 255 nitrpot(ji,jj,jk) = zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 256 END_3D 277 257 ENDIF 278 258 … … 280 260 ! ---------------------------------------- 281 261 IF( ln_p4z ) THEN 282 DO jk = 1, jpkm1 283 DO jj = 1, jpj 284 DO ji = 1, jpi 285 zfact = nitrpot(ji,jj,jk) * nitrfix 286 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0 287 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zfact / 3.0 288 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zfact * 2.0 / 3.0 289 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zfact * 1.0 / 3.0 290 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zfact * 1.0 / 3.0 * 2.0 / 3.0 291 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfact * 1.0 / 3.0 * 1.0 / 3.0 292 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 293 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - 30E-6 * zfact * 1.0 / 3.0 294 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 295 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 296 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 297 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + concdnh4 / ( concdnh4 + tr(ji,jj,jk,jppo4,Kbb) ) & 298 & * 0.001 * tr(ji,jj,jk,jpdoc,Kbb) * xstep 299 END DO 300 END DO 301 END DO 262 DO_3D_11_11( 1, jpkm1 ) 263 zfact = nitrpot(ji,jj,jk) * nitrfix 264 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0 265 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zfact / 3.0 266 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zfact * 2.0 / 3.0 267 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zfact * 1.0 / 3.0 268 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zfact * 1.0 / 3.0 * 2.0 / 3.0 269 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfact * 1.0 / 3.0 * 1.0 / 3.0 270 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 271 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - 30E-6 * zfact * 1.0 / 3.0 272 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 273 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 274 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 275 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + concdnh4 / ( concdnh4 + tr(ji,jj,jk,jppo4,Kbb) ) & 276 & * 0.001 * tr(ji,jj,jk,jpdoc,Kbb) * xstep 277 END_3D 302 278 ELSE ! p5z 303 DO jk = 1, jpkm1 304 DO jj = 1, jpj 305 DO ji = 1, jpi 306 zfact = nitrpot(ji,jj,jk) * nitrfix 307 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0 308 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zfact / 3.0 309 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - 16.0 / 46.0 * zfact * ( 1.0 - 1.0 / 3.0 ) & 310 & * ztrpo4(ji,jj,jk) / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 311 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zfact * 1.0 / 3.0 312 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zfact * 1.0 / 3.0 313 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + 16.0 / 46.0 * zfact / 3.0 & 314 & - 16.0 / 46.0 * zfact * ztrdop(ji,jj,jk) & 315 & / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 316 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zfact * 1.0 / 3.0 * 2.0 / 3.0 317 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zfact * 1.0 / 3.0 * 2.0 /3.0 318 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 2.0 /3.0 319 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfact * 1.0 / 3.0 * 1.0 / 3.0 320 tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zfact * 1.0 / 3.0 * 1.0 /3.0 321 tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 1.0 /3.0 322 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 323 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - 30E-6 * zfact * 1.0 / 3.0 324 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 325 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 326 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 327 END DO 328 END DO 329 END DO 279 DO_3D_11_11( 1, jpkm1 ) 280 zfact = nitrpot(ji,jj,jk) * nitrfix 281 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0 282 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zfact / 3.0 283 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - 16.0 / 46.0 * zfact * ( 1.0 - 1.0 / 3.0 ) & 284 & * ztrpo4(ji,jj,jk) / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 285 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zfact * 1.0 / 3.0 286 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zfact * 1.0 / 3.0 287 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + 16.0 / 46.0 * zfact / 3.0 & 288 & - 16.0 / 46.0 * zfact * ztrdop(ji,jj,jk) & 289 & / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 290 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zfact * 1.0 / 3.0 * 2.0 / 3.0 291 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zfact * 1.0 / 3.0 * 2.0 /3.0 292 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 2.0 /3.0 293 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfact * 1.0 / 3.0 * 1.0 / 3.0 294 tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zfact * 1.0 / 3.0 * 1.0 /3.0 295 tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 1.0 /3.0 296 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 297 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - 30E-6 * zfact * 1.0 / 3.0 298 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 299 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 300 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 301 END_3D 330 302 ! 331 303 ENDIF -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zsink.F90
r12258 r12340 38 38 INTEGER :: ik100 39 39 40 !! * Substitutions 41 # include "do_loop_substitute.h90" 40 42 !!---------------------------------------------------------------------- 41 43 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 78 80 ! by data and from the coagulation theory 79 81 ! ----------------------------------------------------------- 80 DO jk = 1, jpkm1 81 DO jj = 1, jpj 82 DO ji = 1,jpi 83 zmax = MAX( heup_01(ji,jj), hmld(ji,jj) ) 84 zfact = MAX( 0., gdepw(ji,jj,jk+1,Kmm) - zmax ) / wsbio2scale 85 wsbio4(ji,jj,jk) = wsbio2 + MAX(0., ( wsbio2max - wsbio2 )) * zfact 86 END DO 87 END DO 88 END DO 82 DO_3D_11_11( 1, jpkm1 ) 83 zmax = MAX( heup_01(ji,jj), hmld(ji,jj) ) 84 zfact = MAX( 0., gdepw(ji,jj,jk+1,Kmm) - zmax ) / wsbio2scale 85 wsbio4(ji,jj,jk) = wsbio2 + MAX(0., ( wsbio2max - wsbio2 )) * zfact 86 END_3D 89 87 90 88 ! limit the values of the sinking speeds to avoid numerical instabilities -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zsms.F90
r12193 r12340 39 39 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnegtr ! Array used to indicate negative tracer values 40 40 41 !! * Substitutions 42 # include "do_loop_substitute.h90" 41 43 !!---------------------------------------------------------------------- 42 44 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 130 132 xnegtr(:,:,:) = 1.e0 131 133 DO jn = jp_pcs0, jp_pcs1 132 DO jk = 1, jpk 133 DO jj = 1, jpj 134 DO ji = 1, jpi 135 IF( ( tr(ji,jj,jk,jn,Kbb) + tr(ji,jj,jk,jn,Krhs) ) < 0.e0 ) THEN 136 ztra = ABS( tr(ji,jj,jk,jn,Kbb) ) / ( ABS( tr(ji,jj,jk,jn,Krhs) ) + rtrn ) 137 xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk), ztra ) 138 ENDIF 139 END DO 140 END DO 141 END DO 134 DO_3D_11_11( 1, jpk ) 135 IF( ( tr(ji,jj,jk,jn,Kbb) + tr(ji,jj,jk,jn,Krhs) ) < 0.e0 ) THEN 136 ztra = ABS( tr(ji,jj,jk,jn,Kbb) ) / ( ABS( tr(ji,jj,jk,jn,Krhs) ) + rtrn ) 137 xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk), ztra ) 138 ENDIF 139 END_3D 142 140 END DO 143 141 ! ! where at least 1 tracer concentration becomes negative -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p5zlim.F90
r12258 r12340 91 91 REAL(wp) :: xcoef2 = 1.21E-5 * 14. / 55.85 / 7.625 * 0.5 * 1.5 92 92 REAL(wp) :: xcoef3 = 1.15E-4 * 14. / 55.85 / 7.625 * 0.5 93 !! * Substitutions 94 # include "do_loop_substitute.h90" 93 95 !!---------------------------------------------------------------------- 94 96 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 129 131 zratchl = 6.0 130 132 ! 131 DO jk = 1, jpkm1 132 DO jj = 1, jpj 133 DO ji = 1, jpi 134 ! 135 ! Tuning of the iron concentration to a minimum level that is set to the detection limit 136 !------------------------------------- 137 zno3 = tr(ji,jj,jk,jpno3,Kbb) / 40.e-6 138 zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 ) 139 zferlim = MIN( zferlim, 7e-11 ) 140 tr(ji,jj,jk,jpfer,Kbb) = MAX( tr(ji,jj,jk,jpfer,Kbb), zferlim ) 141 142 ! Computation of the mean relative size of each community 143 ! ------------------------------------------------------- 144 z1_trnphy = 1. / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 145 z1_trnpic = 1. / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 146 z1_trndia = 1. / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 147 znanochl = tr(ji,jj,jk,jpnch,Kbb) * z1_trnphy 148 zpicochl = tr(ji,jj,jk,jppch,Kbb) * z1_trnpic 149 zdiatchl = tr(ji,jj,jk,jpdch,Kbb) * z1_trndia 150 151 ! Computation of a variable Ks for iron on diatoms taking into account 152 ! that increasing biomass is made of generally bigger cells 153 !------------------------------------------------ 154 zsized = sized(ji,jj,jk)**0.81 155 zconcdfe = concdfer * zsized 156 zconc1d = concdno3 * zsized 157 zconc1dnh4 = concdnh4 * zsized 158 zconc0dpo4 = concdpo4 * zsized 159 160 zsizep = 1. 161 zconcpfe = concpfer * zsizep 162 zconc0p = concpno3 * zsizep 163 zconc0pnh4 = concpnh4 * zsizep 164 zconc0ppo4 = concppo4 * zsizep 165 166 zsizen = 1. 167 zconcnfe = concnfer * zsizen 168 zconc0n = concnno3 * zsizen 169 zconc0nnh4 = concnnh4 * zsizen 170 zconc0npo4 = concnpo4 * zsizen 171 172 ! Allometric variations of the minimum and maximum quotas 173 ! From Talmy et al. (2014) and Maranon et al. (2013) 174 ! ------------------------------------------------------- 175 xqnnmin(ji,jj,jk) = qnnmin 176 xqnnmax(ji,jj,jk) = qnnmax 177 xqndmin(ji,jj,jk) = qndmin * sized(ji,jj,jk)**(-0.27) 178 xqndmax(ji,jj,jk) = qndmax 179 xqnpmin(ji,jj,jk) = qnpmin 180 xqnpmax(ji,jj,jk) = qnpmax 181 182 ! Computation of the optimal allocation parameters 183 ! Based on the different papers by Pahlow et al., and Smith et al. 184 ! ----------------------------------------------------------------- 185 znutlim = MAX( tr(ji,jj,jk,jpnh4,Kbb) / zconc0nnh4, & 186 & tr(ji,jj,jk,jpno3,Kbb) / zconc0n) 187 fanano = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 188 znutlim = tr(ji,jj,jk,jppo4,Kbb) / zconc0npo4 189 fananop = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 190 znutlim = biron(ji,jj,jk) / zconcnfe 191 fananof = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 192 znutlim = MAX( tr(ji,jj,jk,jpnh4,Kbb) / zconc0pnh4, & 193 & tr(ji,jj,jk,jpno3,Kbb) / zconc0p) 194 fapico = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 195 znutlim = tr(ji,jj,jk,jppo4,Kbb) / zconc0ppo4 196 fapicop = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 197 znutlim = biron(ji,jj,jk) / zconcpfe 198 fapicof = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 199 znutlim = MAX( tr(ji,jj,jk,jpnh4,Kbb) / zconc1dnh4, & 200 & tr(ji,jj,jk,jpno3,Kbb) / zconc1d ) 201 fadiat = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 202 znutlim = tr(ji,jj,jk,jppo4,Kbb) / zconc0dpo4 203 fadiatp = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 204 znutlim = biron(ji,jj,jk) / zconcdfe 205 fadiatf = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 206 ! 207 ! Michaelis-Menten Limitation term for nutrients Small bacteria 208 ! ------------------------------------------------------------- 209 zbactnh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concbnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 210 zbactno3 = tr(ji,jj,jk,jpno3,Kbb) / ( concbno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - zbactnh4) 211 ! 212 zlim1 = zbactno3 + zbactnh4 213 zlim2 = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concbpo4) 214 zlim3 = biron(ji,jj,jk) / ( concbfe + biron(ji,jj,jk) ) 215 zlim4 = tr(ji,jj,jk,jpdoc,Kbb) / ( xkdoc + tr(ji,jj,jk,jpdoc,Kbb) ) 216 xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 217 xlimbac (ji,jj,jk) = xlimbacl(ji,jj,jk) * zlim4 218 ! 219 ! Michaelis-Menten Limitation term for nutrients Small flagellates 220 ! ----------------------------------------------- 221 zfalim = (1.-fanano) / fanano 222 xnanonh4(ji,jj,jk) = (1. - fanano) * tr(ji,jj,jk,jpnh4,Kbb) / ( zfalim * zconc0nnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 223 xnanono3(ji,jj,jk) = (1. - fanano) * tr(ji,jj,jk,jpno3,Kbb) / ( zfalim * zconc0n + tr(ji,jj,jk,jpno3,Kbb) ) & 224 & * (1. - xnanonh4(ji,jj,jk)) 225 ! 226 zfalim = (1.-fananop) / fananop 227 xnanopo4(ji,jj,jk) = (1. - fananop) * tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zfalim * zconc0npo4 ) 228 xnanodop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdop,Kbb) + xkdoc ) & 229 & * ( 1.0 - xnanopo4(ji,jj,jk) ) 230 xnanodop(ji,jj,jk) = 0. 231 ! 232 zfalim = (1.-fananof) / fananof 233 xnanofer(ji,jj,jk) = (1. - fananof) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcnfe ) 234 ! 235 zratiof = tr(ji,jj,jk,jpnfe,Kbb) * z1_trnphy 236 zqfemn = xcoef1 * znanochl + xcoef2 + xcoef3 * xnanono3(ji,jj,jk) 237 ! 238 zration = tr(ji,jj,jk,jpnph,Kbb) * z1_trnphy 239 zration = MIN(xqnnmax(ji,jj,jk), MAX( 2. * xqnnmin(ji,jj,jk), zration )) 240 fvnuptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqnnmin(ji,jj,jk) / (zration + rtrn) & 241 & * MAX(0., (1. - zratchl * znanochl / 12. ) ) 242 ! 243 zlim1 = max(0., (zration - 2. * xqnnmin(ji,jj,jk) ) & 244 & / (xqnnmax(ji,jj,jk) - 2. * xqnnmin(ji,jj,jk) ) ) * xqnnmax(ji,jj,jk) & 245 & / (zration + rtrn) 246 zlim3 = MAX( 0.,( zratiof - zqfemn ) / qfnopt ) 247 xlimnfe(ji,jj,jk) = MIN( 1., zlim3 ) 248 xlimphy(ji,jj,jk) = MIN( 1., zlim1, zlim3 ) 249 ! 250 ! Michaelis-Menten Limitation term for nutrients picophytoplankton 251 ! ---------------------------------------------------------------- 252 zfalim = (1.-fapico) / fapico 253 xpiconh4(ji,jj,jk) = (1. - fapico) * tr(ji,jj,jk,jpnh4,Kbb) / ( zfalim * zconc0pnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 254 xpicono3(ji,jj,jk) = (1. - fapico) * tr(ji,jj,jk,jpno3,Kbb) / ( zfalim * zconc0p + tr(ji,jj,jk,jpno3,Kbb) ) & 255 & * (1. - xpiconh4(ji,jj,jk)) 256 ! 257 zfalim = (1.-fapicop) / fapicop 258 xpicopo4(ji,jj,jk) = (1. - fapicop) * tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zfalim * zconc0ppo4 ) 259 xpicodop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdop,Kbb) + xkdoc ) & 260 & * ( 1.0 - xpicopo4(ji,jj,jk) ) 261 xpicodop(ji,jj,jk) = 0. 262 ! 263 zfalim = (1.-fapicof) / fapicof 264 xpicofer(ji,jj,jk) = (1. - fapicof) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcpfe ) 265 ! 266 zratiof = tr(ji,jj,jk,jppfe,Kbb) * z1_trnpic 267 zqfemp = xcoef1 * zpicochl + xcoef2 + xcoef3 * xpicono3(ji,jj,jk) 268 ! 269 zration = tr(ji,jj,jk,jpnpi,Kbb) * z1_trnpic 270 zration = MIN(xqnpmax(ji,jj,jk), MAX( 2. * xqnpmin(ji,jj,jk), zration )) 271 fvpuptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqnpmin(ji,jj,jk) / (zration + rtrn) & 272 & * MAX(0., (1. - zratchl * zpicochl / 12. ) ) 273 ! 274 zlim1 = max(0., (zration - 2. * xqnpmin(ji,jj,jk) ) & 275 & / (xqnpmax(ji,jj,jk) - 2. * xqnpmin(ji,jj,jk) ) ) * xqnpmax(ji,jj,jk) & 276 & / (zration + rtrn) 277 zlim3 = MAX( 0.,( zratiof - zqfemp ) / qfpopt ) 278 xlimpfe(ji,jj,jk) = MIN( 1., zlim3 ) 279 xlimpic(ji,jj,jk) = MIN( 1., zlim1, zlim3 ) 280 ! 281 ! Michaelis-Menten Limitation term for nutrients Diatoms 282 ! ------------------------------------------------------ 283 zfalim = (1.-fadiat) / fadiat 284 xdiatnh4(ji,jj,jk) = (1. - fadiat) * tr(ji,jj,jk,jpnh4,Kbb) / ( zfalim * zconc1dnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 285 xdiatno3(ji,jj,jk) = (1. - fadiat) * tr(ji,jj,jk,jpno3,Kbb) / ( zfalim * zconc1d + tr(ji,jj,jk,jpno3,Kbb) ) & 286 & * (1. - xdiatnh4(ji,jj,jk)) 287 ! 288 zfalim = (1.-fadiatp) / fadiatp 289 xdiatpo4(ji,jj,jk) = (1. - fadiatp) * tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zfalim * zconc0dpo4 ) 290 xdiatdop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdop,Kbb) + xkdoc ) & 291 & * ( 1.0 - xdiatpo4(ji,jj,jk) ) 292 xdiatdop(ji,jj,jk) = 0. 293 ! 294 zfalim = (1.-fadiatf) / fadiatf 295 xdiatfer(ji,jj,jk) = (1. - fadiatf) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcdfe ) 296 ! 297 zratiof = tr(ji,jj,jk,jpdfe,Kbb) * z1_trndia 298 zqfemd = xcoef1 * zdiatchl + xcoef2 + xcoef3 * xdiatno3(ji,jj,jk) 299 ! 300 zration = tr(ji,jj,jk,jpndi,Kbb) * z1_trndia 301 zration = MIN(xqndmax(ji,jj,jk), MAX( 2. * xqndmin(ji,jj,jk), zration )) 302 fvduptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqndmin(ji,jj,jk) / (zration + rtrn) & 303 & * MAX(0., (1. - zratchl * zdiatchl / 12. ) ) 304 ! 305 zlim1 = max(0., (zration - 2. * xqndmin(ji,jj,jk) ) & 306 & / (xqndmax(ji,jj,jk) - 2. * xqndmin(ji,jj,jk) ) ) & 307 & * xqndmax(ji,jj,jk) / (zration + rtrn) 308 zlim3 = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi(ji,jj) ) 309 zlim4 = MAX( 0., ( zratiof - zqfemd ) / qfdopt ) 310 xlimdfe(ji,jj,jk) = MIN( 1., zlim4 ) 311 xlimdia(ji,jj,jk) = MIN( 1., zlim1, zlim3, zlim4 ) 312 xlimsi(ji,jj,jk) = MIN( zlim1, zlim4 ) 313 END DO 314 END DO 315 END DO 133 DO_3D_11_11( 1, jpkm1 ) 134 ! 135 ! Tuning of the iron concentration to a minimum level that is set to the detection limit 136 !------------------------------------- 137 zno3 = tr(ji,jj,jk,jpno3,Kbb) / 40.e-6 138 zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 ) 139 zferlim = MIN( zferlim, 7e-11 ) 140 tr(ji,jj,jk,jpfer,Kbb) = MAX( tr(ji,jj,jk,jpfer,Kbb), zferlim ) 141 142 ! Computation of the mean relative size of each community 143 ! ------------------------------------------------------- 144 z1_trnphy = 1. / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 145 z1_trnpic = 1. / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 146 z1_trndia = 1. / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 147 znanochl = tr(ji,jj,jk,jpnch,Kbb) * z1_trnphy 148 zpicochl = tr(ji,jj,jk,jppch,Kbb) * z1_trnpic 149 zdiatchl = tr(ji,jj,jk,jpdch,Kbb) * z1_trndia 150 151 ! Computation of a variable Ks for iron on diatoms taking into account 152 ! that increasing biomass is made of generally bigger cells 153 !------------------------------------------------ 154 zsized = sized(ji,jj,jk)**0.81 155 zconcdfe = concdfer * zsized 156 zconc1d = concdno3 * zsized 157 zconc1dnh4 = concdnh4 * zsized 158 zconc0dpo4 = concdpo4 * zsized 159 160 zsizep = 1. 161 zconcpfe = concpfer * zsizep 162 zconc0p = concpno3 * zsizep 163 zconc0pnh4 = concpnh4 * zsizep 164 zconc0ppo4 = concppo4 * zsizep 165 166 zsizen = 1. 167 zconcnfe = concnfer * zsizen 168 zconc0n = concnno3 * zsizen 169 zconc0nnh4 = concnnh4 * zsizen 170 zconc0npo4 = concnpo4 * zsizen 171 172 ! Allometric variations of the minimum and maximum quotas 173 ! From Talmy et al. (2014) and Maranon et al. (2013) 174 ! ------------------------------------------------------- 175 xqnnmin(ji,jj,jk) = qnnmin 176 xqnnmax(ji,jj,jk) = qnnmax 177 xqndmin(ji,jj,jk) = qndmin * sized(ji,jj,jk)**(-0.27) 178 xqndmax(ji,jj,jk) = qndmax 179 xqnpmin(ji,jj,jk) = qnpmin 180 xqnpmax(ji,jj,jk) = qnpmax 181 182 ! Computation of the optimal allocation parameters 183 ! Based on the different papers by Pahlow et al., and Smith et al. 184 ! ----------------------------------------------------------------- 185 znutlim = MAX( tr(ji,jj,jk,jpnh4,Kbb) / zconc0nnh4, & 186 & tr(ji,jj,jk,jpno3,Kbb) / zconc0n) 187 fanano = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 188 znutlim = tr(ji,jj,jk,jppo4,Kbb) / zconc0npo4 189 fananop = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 190 znutlim = biron(ji,jj,jk) / zconcnfe 191 fananof = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 192 znutlim = MAX( tr(ji,jj,jk,jpnh4,Kbb) / zconc0pnh4, & 193 & tr(ji,jj,jk,jpno3,Kbb) / zconc0p) 194 fapico = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 195 znutlim = tr(ji,jj,jk,jppo4,Kbb) / zconc0ppo4 196 fapicop = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 197 znutlim = biron(ji,jj,jk) / zconcpfe 198 fapicof = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 199 znutlim = MAX( tr(ji,jj,jk,jpnh4,Kbb) / zconc1dnh4, & 200 & tr(ji,jj,jk,jpno3,Kbb) / zconc1d ) 201 fadiat = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 202 znutlim = tr(ji,jj,jk,jppo4,Kbb) / zconc0dpo4 203 fadiatp = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 204 znutlim = biron(ji,jj,jk) / zconcdfe 205 fadiatf = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 206 ! 207 ! Michaelis-Menten Limitation term for nutrients Small bacteria 208 ! ------------------------------------------------------------- 209 zbactnh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concbnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 210 zbactno3 = tr(ji,jj,jk,jpno3,Kbb) / ( concbno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - zbactnh4) 211 ! 212 zlim1 = zbactno3 + zbactnh4 213 zlim2 = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concbpo4) 214 zlim3 = biron(ji,jj,jk) / ( concbfe + biron(ji,jj,jk) ) 215 zlim4 = tr(ji,jj,jk,jpdoc,Kbb) / ( xkdoc + tr(ji,jj,jk,jpdoc,Kbb) ) 216 xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 217 xlimbac (ji,jj,jk) = xlimbacl(ji,jj,jk) * zlim4 218 ! 219 ! Michaelis-Menten Limitation term for nutrients Small flagellates 220 ! ----------------------------------------------- 221 zfalim = (1.-fanano) / fanano 222 xnanonh4(ji,jj,jk) = (1. - fanano) * tr(ji,jj,jk,jpnh4,Kbb) / ( zfalim * zconc0nnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 223 xnanono3(ji,jj,jk) = (1. - fanano) * tr(ji,jj,jk,jpno3,Kbb) / ( zfalim * zconc0n + tr(ji,jj,jk,jpno3,Kbb) ) & 224 & * (1. - xnanonh4(ji,jj,jk)) 225 ! 226 zfalim = (1.-fananop) / fananop 227 xnanopo4(ji,jj,jk) = (1. - fananop) * tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zfalim * zconc0npo4 ) 228 xnanodop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdop,Kbb) + xkdoc ) & 229 & * ( 1.0 - xnanopo4(ji,jj,jk) ) 230 xnanodop(ji,jj,jk) = 0. 231 ! 232 zfalim = (1.-fananof) / fananof 233 xnanofer(ji,jj,jk) = (1. - fananof) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcnfe ) 234 ! 235 zratiof = tr(ji,jj,jk,jpnfe,Kbb) * z1_trnphy 236 zqfemn = xcoef1 * znanochl + xcoef2 + xcoef3 * xnanono3(ji,jj,jk) 237 ! 238 zration = tr(ji,jj,jk,jpnph,Kbb) * z1_trnphy 239 zration = MIN(xqnnmax(ji,jj,jk), MAX( 2. * xqnnmin(ji,jj,jk), zration )) 240 fvnuptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqnnmin(ji,jj,jk) / (zration + rtrn) & 241 & * MAX(0., (1. - zratchl * znanochl / 12. ) ) 242 ! 243 zlim1 = max(0., (zration - 2. * xqnnmin(ji,jj,jk) ) & 244 & / (xqnnmax(ji,jj,jk) - 2. * xqnnmin(ji,jj,jk) ) ) * xqnnmax(ji,jj,jk) & 245 & / (zration + rtrn) 246 zlim3 = MAX( 0.,( zratiof - zqfemn ) / qfnopt ) 247 xlimnfe(ji,jj,jk) = MIN( 1., zlim3 ) 248 xlimphy(ji,jj,jk) = MIN( 1., zlim1, zlim3 ) 249 ! 250 ! Michaelis-Menten Limitation term for nutrients picophytoplankton 251 ! ---------------------------------------------------------------- 252 zfalim = (1.-fapico) / fapico 253 xpiconh4(ji,jj,jk) = (1. - fapico) * tr(ji,jj,jk,jpnh4,Kbb) / ( zfalim * zconc0pnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 254 xpicono3(ji,jj,jk) = (1. - fapico) * tr(ji,jj,jk,jpno3,Kbb) / ( zfalim * zconc0p + tr(ji,jj,jk,jpno3,Kbb) ) & 255 & * (1. - xpiconh4(ji,jj,jk)) 256 ! 257 zfalim = (1.-fapicop) / fapicop 258 xpicopo4(ji,jj,jk) = (1. - fapicop) * tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zfalim * zconc0ppo4 ) 259 xpicodop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdop,Kbb) + xkdoc ) & 260 & * ( 1.0 - xpicopo4(ji,jj,jk) ) 261 xpicodop(ji,jj,jk) = 0. 262 ! 263 zfalim = (1.-fapicof) / fapicof 264 xpicofer(ji,jj,jk) = (1. - fapicof) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcpfe ) 265 ! 266 zratiof = tr(ji,jj,jk,jppfe,Kbb) * z1_trnpic 267 zqfemp = xcoef1 * zpicochl + xcoef2 + xcoef3 * xpicono3(ji,jj,jk) 268 ! 269 zration = tr(ji,jj,jk,jpnpi,Kbb) * z1_trnpic 270 zration = MIN(xqnpmax(ji,jj,jk), MAX( 2. * xqnpmin(ji,jj,jk), zration )) 271 fvpuptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqnpmin(ji,jj,jk) / (zration + rtrn) & 272 & * MAX(0., (1. - zratchl * zpicochl / 12. ) ) 273 ! 274 zlim1 = max(0., (zration - 2. * xqnpmin(ji,jj,jk) ) & 275 & / (xqnpmax(ji,jj,jk) - 2. * xqnpmin(ji,jj,jk) ) ) * xqnpmax(ji,jj,jk) & 276 & / (zration + rtrn) 277 zlim3 = MAX( 0.,( zratiof - zqfemp ) / qfpopt ) 278 xlimpfe(ji,jj,jk) = MIN( 1., zlim3 ) 279 xlimpic(ji,jj,jk) = MIN( 1., zlim1, zlim3 ) 280 ! 281 ! Michaelis-Menten Limitation term for nutrients Diatoms 282 ! ------------------------------------------------------ 283 zfalim = (1.-fadiat) / fadiat 284 xdiatnh4(ji,jj,jk) = (1. - fadiat) * tr(ji,jj,jk,jpnh4,Kbb) / ( zfalim * zconc1dnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 285 xdiatno3(ji,jj,jk) = (1. - fadiat) * tr(ji,jj,jk,jpno3,Kbb) / ( zfalim * zconc1d + tr(ji,jj,jk,jpno3,Kbb) ) & 286 & * (1. - xdiatnh4(ji,jj,jk)) 287 ! 288 zfalim = (1.-fadiatp) / fadiatp 289 xdiatpo4(ji,jj,jk) = (1. - fadiatp) * tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zfalim * zconc0dpo4 ) 290 xdiatdop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdop,Kbb) + xkdoc ) & 291 & * ( 1.0 - xdiatpo4(ji,jj,jk) ) 292 xdiatdop(ji,jj,jk) = 0. 293 ! 294 zfalim = (1.-fadiatf) / fadiatf 295 xdiatfer(ji,jj,jk) = (1. - fadiatf) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcdfe ) 296 ! 297 zratiof = tr(ji,jj,jk,jpdfe,Kbb) * z1_trndia 298 zqfemd = xcoef1 * zdiatchl + xcoef2 + xcoef3 * xdiatno3(ji,jj,jk) 299 ! 300 zration = tr(ji,jj,jk,jpndi,Kbb) * z1_trndia 301 zration = MIN(xqndmax(ji,jj,jk), MAX( 2. * xqndmin(ji,jj,jk), zration )) 302 fvduptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqndmin(ji,jj,jk) / (zration + rtrn) & 303 & * MAX(0., (1. - zratchl * zdiatchl / 12. ) ) 304 ! 305 zlim1 = max(0., (zration - 2. * xqndmin(ji,jj,jk) ) & 306 & / (xqndmax(ji,jj,jk) - 2. * xqndmin(ji,jj,jk) ) ) & 307 & * xqndmax(ji,jj,jk) / (zration + rtrn) 308 zlim3 = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi(ji,jj) ) 309 zlim4 = MAX( 0., ( zratiof - zqfemd ) / qfdopt ) 310 xlimdfe(ji,jj,jk) = MIN( 1., zlim4 ) 311 xlimdia(ji,jj,jk) = MIN( 1., zlim1, zlim3, zlim4 ) 312 xlimsi(ji,jj,jk) = MIN( zlim1, zlim4 ) 313 END_3D 316 314 ! 317 315 ! Compute the phosphorus quota values. It is based on Litchmann et al., 2004 and Daines et al, 2013. … … 320 318 ! phytoplankton (see Daines et al., 2013). 321 319 ! -------------------------------------------------------------------------------------------------- 322 DO jk = 1, jpkm1 323 DO jj = 1, jpj 324 DO ji = 1, jpi 325 ! Size estimation of nanophytoplankton 326 ! ------------------------------------ 327 zfvn = 2. * fvnuptk(ji,jj,jk) 328 sizen(ji,jj,jk) = MAX(1., MIN(xsizern, 1.0 / ( MAX(rtrn, zfvn) ) ) ) 329 330 ! N/P ratio of nanophytoplankton 331 ! ------------------------------ 332 zfuptk = 0.23 * zfvn 333 zrpho = 2.24 * tr(ji,jj,jk,jpnch,Kbb) / ( tr(ji,jj,jk,jpnph,Kbb) * rno3 * 15. + rtrn ) 334 zrass = 1. - 0.2 - zrpho - zfuptk 335 xqpnmax(ji,jj,jk) = ( zfuptk + zrpho ) * 0.0128 * 16. + zrass * 1./ 7.2 * 16. 336 xqpnmax(ji,jj,jk) = xqpnmax(ji,jj,jk) * tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) + 0.13 337 xqpnmin(ji,jj,jk) = 0.13 + 0.23 * 0.0128 * 16. 338 339 ! Size estimation of picophytoplankton 340 ! ------------------------------------ 341 zfvn = 2. * fvpuptk(ji,jj,jk) 342 sizep(ji,jj,jk) = MAX(1., MIN(xsizerp, 1.0 / ( MAX(rtrn, zfvn) ) ) ) 343 344 ! N/P ratio of picophytoplankton 345 ! ------------------------------ 346 zfuptk = 0.35 * zfvn 347 zrpho = 2.24 * tr(ji,jj,jk,jppch,Kbb) / ( tr(ji,jj,jk,jpnpi,Kbb) * rno3 * 15. + rtrn ) 348 zrass = 1. - 0.4 - zrpho - zfuptk 349 xqppmax(ji,jj,jk) = (zrpho + zfuptk) * 0.0128 * 16. + zrass * 1./ 9. * 16. 350 xqppmax(ji,jj,jk) = xqppmax(ji,jj,jk) * tr(ji,jj,jk,jpnpi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) + 0.13 351 xqppmin(ji,jj,jk) = 0.13 352 353 ! Size estimation of diatoms 354 ! -------------------------- 355 zfvn = 2. * fvduptk(ji,jj,jk) 356 sized(ji,jj,jk) = MAX(1., MIN(xsizerd, 1.0 / ( MAX(rtrn, zfvn) ) ) ) 357 zcoef = tr(ji,jj,jk,jpdia,Kbb) - MIN(xsizedia, tr(ji,jj,jk,jpdia,Kbb) ) 358 sized(ji,jj,jk) = 1. + xsizerd * zcoef *1E6 / ( 1. + zcoef * 1E6 ) 359 360 ! N/P ratio of diatoms 361 ! -------------------- 362 zfuptk = 0.2 * zfvn 363 zrpho = 2.24 * tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpndi,Kbb) * rno3 * 15. + rtrn ) 364 zrass = 1. - 0.2 - zrpho - zfuptk 365 xqpdmax(ji,jj,jk) = ( zfuptk + zrpho ) * 0.0128 * 16. + zrass * 1./ 7.2 * 16. 366 xqpdmax(ji,jj,jk) = xqpdmax(ji,jj,jk) * tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) + 0.13 367 xqpdmin(ji,jj,jk) = 0.13 + 0.2 * 0.0128 * 16. 368 369 END DO 370 END DO 371 END DO 320 DO_3D_11_11( 1, jpkm1 ) 321 ! Size estimation of nanophytoplankton 322 ! ------------------------------------ 323 zfvn = 2. * fvnuptk(ji,jj,jk) 324 sizen(ji,jj,jk) = MAX(1., MIN(xsizern, 1.0 / ( MAX(rtrn, zfvn) ) ) ) 325 326 ! N/P ratio of nanophytoplankton 327 ! ------------------------------ 328 zfuptk = 0.23 * zfvn 329 zrpho = 2.24 * tr(ji,jj,jk,jpnch,Kbb) / ( tr(ji,jj,jk,jpnph,Kbb) * rno3 * 15. + rtrn ) 330 zrass = 1. - 0.2 - zrpho - zfuptk 331 xqpnmax(ji,jj,jk) = ( zfuptk + zrpho ) * 0.0128 * 16. + zrass * 1./ 7.2 * 16. 332 xqpnmax(ji,jj,jk) = xqpnmax(ji,jj,jk) * tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) + 0.13 333 xqpnmin(ji,jj,jk) = 0.13 + 0.23 * 0.0128 * 16. 334 335 ! Size estimation of picophytoplankton 336 ! ------------------------------------ 337 zfvn = 2. * fvpuptk(ji,jj,jk) 338 sizep(ji,jj,jk) = MAX(1., MIN(xsizerp, 1.0 / ( MAX(rtrn, zfvn) ) ) ) 339 340 ! N/P ratio of picophytoplankton 341 ! ------------------------------ 342 zfuptk = 0.35 * zfvn 343 zrpho = 2.24 * tr(ji,jj,jk,jppch,Kbb) / ( tr(ji,jj,jk,jpnpi,Kbb) * rno3 * 15. + rtrn ) 344 zrass = 1. - 0.4 - zrpho - zfuptk 345 xqppmax(ji,jj,jk) = (zrpho + zfuptk) * 0.0128 * 16. + zrass * 1./ 9. * 16. 346 xqppmax(ji,jj,jk) = xqppmax(ji,jj,jk) * tr(ji,jj,jk,jpnpi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) + 0.13 347 xqppmin(ji,jj,jk) = 0.13 348 349 ! Size estimation of diatoms 350 ! -------------------------- 351 zfvn = 2. * fvduptk(ji,jj,jk) 352 sized(ji,jj,jk) = MAX(1., MIN(xsizerd, 1.0 / ( MAX(rtrn, zfvn) ) ) ) 353 zcoef = tr(ji,jj,jk,jpdia,Kbb) - MIN(xsizedia, tr(ji,jj,jk,jpdia,Kbb) ) 354 sized(ji,jj,jk) = 1. + xsizerd * zcoef *1E6 / ( 1. + zcoef * 1E6 ) 355 356 ! N/P ratio of diatoms 357 ! -------------------- 358 zfuptk = 0.2 * zfvn 359 zrpho = 2.24 * tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpndi,Kbb) * rno3 * 15. + rtrn ) 360 zrass = 1. - 0.2 - zrpho - zfuptk 361 xqpdmax(ji,jj,jk) = ( zfuptk + zrpho ) * 0.0128 * 16. + zrass * 1./ 7.2 * 16. 362 xqpdmax(ji,jj,jk) = xqpdmax(ji,jj,jk) * tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) + 0.13 363 xqpdmin(ji,jj,jk) = 0.13 + 0.2 * 0.0128 * 16. 364 365 END_3D 372 366 373 367 ! Compute the fraction of nanophytoplankton that is made of calcifiers 374 368 ! -------------------------------------------------------------------- 375 DO jk = 1, jpkm1 376 DO jj = 1, jpj 377 DO ji = 1, jpi 378 zlim1 = tr(ji,jj,jk,jpnh4,Kbb) / ( tr(ji,jj,jk,jpnh4,Kbb) + concnnh4 ) + tr(ji,jj,jk,jpno3,Kbb) & 379 & / ( tr(ji,jj,jk,jpno3,Kbb) + concnno3 ) * ( 1.0 - tr(ji,jj,jk,jpnh4,Kbb) & 380 & / ( tr(ji,jj,jk,jpnh4,Kbb) + concnnh4 ) ) 381 zlim2 = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concnpo4 ) 382 zlim3 = tr(ji,jj,jk,jpfer,Kbb) / ( tr(ji,jj,jk,jpfer,Kbb) + 5.E-11 ) 383 ztem1 = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) ) 384 ztem2 = ts(ji,jj,jk,jp_tem,Kmm) - 10. 385 zetot1 = MAX( 0., etot(ji,jj,jk) - 1.) / ( 4. + etot(ji,jj,jk) ) * 20. / ( 20. + etot(ji,jj,jk) ) 369 DO_3D_11_11( 1, jpkm1 ) 370 zlim1 = tr(ji,jj,jk,jpnh4,Kbb) / ( tr(ji,jj,jk,jpnh4,Kbb) + concnnh4 ) + tr(ji,jj,jk,jpno3,Kbb) & 371 & / ( tr(ji,jj,jk,jpno3,Kbb) + concnno3 ) * ( 1.0 - tr(ji,jj,jk,jpnh4,Kbb) & 372 & / ( tr(ji,jj,jk,jpnh4,Kbb) + concnnh4 ) ) 373 zlim2 = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concnpo4 ) 374 zlim3 = tr(ji,jj,jk,jpfer,Kbb) / ( tr(ji,jj,jk,jpfer,Kbb) + 5.E-11 ) 375 ztem1 = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) ) 376 ztem2 = ts(ji,jj,jk,jp_tem,Kmm) - 10. 377 zetot1 = MAX( 0., etot(ji,jj,jk) - 1.) / ( 4. + etot(ji,jj,jk) ) * 20. / ( 20. + etot(ji,jj,jk) ) 386 378 387 379 ! xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 ) & 388 xfracal(ji,jj,jk) = caco3r & 389 & * ztem1 / ( 1. + ztem1 ) * MAX( 1., tr(ji,jj,jk,jpphy,Kbb)*1E6 ) & 390 & * ( 1. + EXP(-ztem2 * ztem2 / 25. ) ) & 391 & * zetot1 * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) ) 392 xfracal(ji,jj,jk) = MAX( 0.02, MIN( 0.8 , xfracal(ji,jj,jk) ) ) 393 END DO 394 END DO 395 END DO 396 ! 397 DO jk = 1, jpkm1 398 DO jj = 1, jpj 399 DO ji = 1, jpi 400 ! denitrification factor computed from O2 levels 401 nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - tr(ji,jj,jk,jpoxy,Kbb) ) & 402 & / ( oxymin + tr(ji,jj,jk,jpoxy,Kbb) ) ) 403 nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 404 END DO 405 END DO 406 END DO 380 xfracal(ji,jj,jk) = caco3r & 381 & * ztem1 / ( 1. + ztem1 ) * MAX( 1., tr(ji,jj,jk,jpphy,Kbb)*1E6 ) & 382 & * ( 1. + EXP(-ztem2 * ztem2 / 25. ) ) & 383 & * zetot1 * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) ) 384 xfracal(ji,jj,jk) = MAX( 0.02, MIN( 0.8 , xfracal(ji,jj,jk) ) ) 385 END_3D 386 ! 387 DO_3D_11_11( 1, jpkm1 ) 388 ! denitrification factor computed from O2 levels 389 nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - tr(ji,jj,jk,jpoxy,Kbb) ) & 390 & / ( oxymin + tr(ji,jj,jk,jpoxy,Kbb) ) ) 391 nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 392 END_3D 407 393 ! 408 394 IF( lk_iomput .AND. knt == nrdttrc ) THEN ! save output diagnostics -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p5zmeso.F90
r12260 r12340 51 51 LOGICAL, PUBLIC :: bmetexc2 !: Use of excess carbon for respiration 52 52 53 !! * Substitutions 54 # include "do_loop_substitute.h90" 53 55 !!---------------------------------------------------------------------- 54 56 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 96 98 IF ( bmetexc2 ) zmetexcess = 1.0 97 99 98 DO jk = 1, jpkm1 99 DO jj = 1, jpj 100 DO ji = 1, jpi 101 zcompam = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - 1.e-9 ), 0.e0 ) 102 zfact = xstep * tgfunc2(ji,jj,jk) * zcompam 103 104 ! Michaelis-Menten mortality rates of mesozooplankton 105 ! --------------------------------------------------- 106 zrespz = resrat2 * zfact * ( tr(ji,jj,jk,jpmes,Kbb) / ( xkmort + tr(ji,jj,jk,jpmes,Kbb) ) & 107 & + 3. * nitrfac(ji,jj,jk) ) 108 109 ! Zooplankton mortality. A square function has been selected with 110 ! no real reason except that it seems to be more stable and may mimic predation 111 ! --------------------------------------------------------------- 112 ztortz = mzrat2 * 1.e6 * zfact * tr(ji,jj,jk,jpmes,Kbb) * (1. - nitrfac(ji,jj,jk)) 113 114 ! Computation of the abundance of the preys 115 ! A threshold can be specified in the namelist 116 ! -------------------------------------------- 117 zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthresh2dia ), 0.e0 ) 118 zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - xthresh2zoo ), 0.e0 ) 119 zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthresh2phy ), 0.e0 ) 120 zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthresh2poc ), 0.e0 ) 121 zcompames = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - xthresh2mes ), 0.e0 ) 122 123 ! Mesozooplankton grazing 124 ! ------------------------ 125 zfood = xpref2d * zcompadi + xpref2z * zcompaz + xpref2n * zcompaph + xpref2c * zcompapoc & 126 & + xpref2m * zcompames 127 zfoodlim = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) ) 128 zdenom = zfoodlim / ( xkgraz2 + zfoodlim ) 129 zgraze2 = grazrat2 * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpmes,Kbb) * (1. - nitrfac(ji,jj,jk)) 130 131 ! An active switching parameterization is used here. 132 ! We don't use the KTW parameterization proposed by 133 ! Vallina et al. because it tends to produce to steady biomass 134 ! composition and the variance of Chl is too low as it grazes 135 ! too strongly on winning organisms. Thus, instead of a square 136 ! a 1.5 power value is used which decreases the pressure on the 137 ! most abundant species 138 ! ------------------------------------------------------------ 139 ztmp1 = xpref2n * zcompaph**1.5 140 ztmp2 = xpref2m * zcompames**1.5 141 ztmp3 = xpref2c * zcompapoc**1.5 142 ztmp4 = xpref2d * zcompadi**1.5 143 ztmp5 = xpref2z * zcompaz**1.5 144 ztmptot = ztmp1 + ztmp2 + ztmp3 + ztmp4 + ztmp5 + rtrn 145 ztmp1 = ztmp1 / ztmptot 146 ztmp2 = ztmp2 / ztmptot 147 ztmp3 = ztmp3 / ztmptot 148 ztmp4 = ztmp4 / ztmptot 149 ztmp5 = ztmp5 / ztmptot 150 151 ! Mesozooplankton regular grazing on the different preys 152 ! ------------------------------------------------------ 153 zgrazdc = zgraze2 * ztmp4 * zdenom 154 zgrazdn = zgrazdc * tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn) 155 zgrazdp = zgrazdc * tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn) 156 zgrazdf = zgrazdc * tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn) 157 zgrazz = zgraze2 * ztmp5 * zdenom 158 zgrazm = zgraze2 * ztmp2 * zdenom 159 zgraznc = zgraze2 * ztmp1 * zdenom 160 zgraznn = zgraznc * tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn) 161 zgraznp = zgraznc * tr(ji,jj,jk,jppph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn) 162 zgraznf = zgraznc * tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn) 163 zgrazpoc = zgraze2 * ztmp3 * zdenom 164 zgrazpon = zgrazpoc * tr(ji,jj,jk,jppon,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 165 zgrazpop = zgrazpoc * tr(ji,jj,jk,jppop,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 166 zgrazpof = zgrazpoc * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 167 168 ! Mesozooplankton flux feeding on GOC 169 ! ---------------------------------- 170 zgrazffeg = grazflux * xstep * wsbio4(ji,jj,jk) & 171 & * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 172 & * (1. - nitrfac(ji,jj,jk)) 173 zgrazfffg = zgrazffeg * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 174 zgrazffng = zgrazffeg * tr(ji,jj,jk,jpgon,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 175 zgrazffpg = zgrazffeg * tr(ji,jj,jk,jpgop,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 176 zgrazffep = grazflux * xstep * wsbio3(ji,jj,jk) & 177 & * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 178 & * (1. - nitrfac(ji,jj,jk)) 179 zgrazfffp = zgrazffep * tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 180 zgrazffnp = zgrazffep * tr(ji,jj,jk,jppon,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 181 zgrazffpp = zgrazffep * tr(ji,jj,jk,jppop,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 182 ! 183 zgraztotc = zgrazdc + zgrazz + zgraznc + zgrazm + zgrazpoc + zgrazffep + zgrazffeg 184 185 ! Compute the proportion of filter feeders 186 ! ---------------------------------------- 187 zproport = (zgrazffep + zgrazffeg)/(rtrn + zgraztotc) 188 189 ! Compute fractionation of aggregates. It is assumed that 190 ! diatoms based aggregates are more prone to fractionation 191 ! since they are more porous (marine snow instead of fecal pellets) 192 ! ---------------------------------------------------------------- 193 zratio = tr(ji,jj,jk,jpgsi,Kbb) / ( tr(ji,jj,jk,jpgoc,Kbb) + rtrn ) 194 zratio2 = zratio * zratio 195 zfracc = zproport * grazflux * xstep * wsbio4(ji,jj,jk) & 196 & * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 197 & * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) ) 198 zfracfe = zfracc * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 199 zfracn = zfracc * tr(ji,jj,jk,jpgon,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 200 zfracp = zfracc * tr(ji,jj,jk,jpgop,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 201 202 zgrazffep = zproport * zgrazffep ; zgrazffeg = zproport * zgrazffeg 203 zgrazfffp = zproport * zgrazfffp ; zgrazfffg = zproport * zgrazfffg 204 zgrazffnp = zproport * zgrazffnp ; zgrazffng = zproport * zgrazffng 205 zgrazffpp = zproport * zgrazffpp ; zgrazffpg = zproport * zgrazffpg 206 207 zgraztotc = zgrazdc + zgrazz + zgraznc + zgrazm + zgrazpoc + zgrazffep + zgrazffeg 208 zgraztotf = zgrazdf + zgraznf + ( zgrazz + zgrazm ) * ferat3 + zgrazpof & 209 & + zgrazfffp + zgrazfffg 210 zgraztotn = zgrazdn + (zgrazm + zgrazz) * no3rat3 + zgraznn + zgrazpon & 211 & + zgrazffnp + zgrazffng 212 zgraztotp = zgrazdp + (zgrazz + zgrazm) * po4rat3 + zgraznp + zgrazpop & 213 & + zgrazffpp + zgrazffpg 214 215 216 ! Total grazing ( grazing by microzoo is already computed in p5zmicro ) 217 zgrazing(ji,jj,jk) = zgraztotc 218 219 ! Stoichiometruc ratios of the food ingested by zooplanton 220 ! -------------------------------------------------------- 221 zgrasratf = (zgraztotf + rtrn) / ( zgraztotc + rtrn ) 222 zgrasratn = (zgraztotn + rtrn) / ( zgraztotc + rtrn ) 223 zgrasratp = (zgraztotp + rtrn) / ( zgraztotc + rtrn ) 224 225 ! Growth efficiency is made a function of the quality 226 ! and the quantity of the preys 227 ! --------------------------------------------------- 228 zepshert = MIN( 1., zgrasratn/ no3rat3, zgrasratp/ po4rat3, zgrasratf / ferat3) 229 zbeta = MAX(0., (epsher2 - epsher2min) ) 230 zepsherf = epsher2min + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 231 zepsherv = zepsherf * zepshert 232 233 ! Respiration of mesozooplankton 234 ! Excess carbon in the food is used preferentially 235 ! ---------------- ------------------------------ 236 zexcess = zgraztotc * zepsherf * (1.0 - zepshert) * zmetexcess 237 zbasresb = MAX(0., zrespz - zexcess) 238 zbasresi = zexcess + MIN(0., zrespz - zexcess) 239 zrespirc = srespir2 * zepsherv * zgraztotc + zbasresb 240 241 ! When excess carbon is used, the other elements in excess 242 ! are also used proportionally to their abundance 243 ! -------------------------------------------------------- 244 zexcess = ( zgrasratn/ no3rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 245 zbasresn = zbasresi * zexcess * zgrasratn 246 zexcess = ( zgrasratp/ po4rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 247 zbasresp = zbasresi * zexcess * zgrasratp 248 zexcess = ( zgrasratf/ ferat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 249 zbasresf = zbasresi * zexcess * zgrasratf 250 251 ! Voiding of the excessive elements as organic matter 252 ! -------------------------------------------------------- 253 zgradoct = (1. - unass2c - zepsherv) * zgraztotc - zbasresi 254 zgradont = (1. - unass2n) * zgraztotn - zepsherv * no3rat3 * zgraztotc - zbasresn 255 zgradopt = (1. - unass2p) * zgraztotp - zepsherv * po4rat3 * zgraztotc - zbasresp 256 zgrareft = (1. - unass2c) * zgraztotf - zepsherv * ferat3 * zgraztotc - zbasresf 257 ztmp1 = ( 1. - epsher2 - unass2c ) /( 1. - 0.8 * epsher2 ) * ztortz 258 zgradoc = (zgradoct + ztmp1) * ssigma2 259 zgradon = (zgradont + no3rat3 * ztmp1) * ssigma2 260 zgradop = (zgradopt + po4rat3 * ztmp1) * ssigma2 261 zgratmp = 0.2 * epsher2 /( 1. - 0.8 * epsher2 ) * ztortz 262 263 ! Since only semilabile DOM is represented in PISCES 264 ! part of DOM is in fact labile and is then released 265 ! as dissolved inorganic compounds (ssigma2) 266 ! -------------------------------------------------- 267 zgrarem = zgratmp + ( zgradoct + ztmp1 ) * (1.0 - ssigma2) 268 zgraren = no3rat3 * zgratmp + ( zgradont + no3rat3 * ztmp1 ) * (1.0 - ssigma2) 269 zgrarep = po4rat3 * zgratmp + ( zgradopt + po4rat3 * ztmp1 ) * (1.0 - ssigma2) 270 zgraref = zgrareft + ferat3 * ( ztmp1 + zgratmp ) 271 272 ! Defecation as a result of non assimilated products 273 ! -------------------------------------------------- 274 zgrapoc = zgraztotc * unass2c + unass2c / ( 1. - 0.8 * epsher2 ) * ztortz 275 zgrapon = zgraztotn * unass2n + no3rat3 * unass2n / ( 1. - 0.8 * epsher2 ) * ztortz 276 zgrapop = zgraztotp * unass2p + po4rat3 * unass2p / ( 1. - 0.8 * epsher2 ) * ztortz 277 zgrapof = zgraztotf * unass2c + ferat3 * unass2c / ( 1. - 0.8 * epsher2 ) * ztortz 278 279 ! Addition of respiration to the release of inorganic nutrients 280 ! ------------------------------------------------------------- 281 zgrarem = zgrarem + zbasresi + zrespirc 282 zgraren = zgraren + zbasresn + zrespirc * no3rat3 283 zgrarep = zgrarep + zbasresp + zrespirc * po4rat3 284 zgraref = zgraref + zbasresf + zrespirc * ferat3 285 286 ! Update the arrays TRA which contain the biological sources and 287 ! sinks 288 ! -------------------------------------------------------------- 289 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarep 290 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgraren 291 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgradoc 292 ! 293 IF( ln_ligand ) THEN 294 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zgradoc * ldocz 295 zz2ligprod(ji,jj,jk) = zgradoc * ldocz 296 ENDIF 297 ! 298 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zgradon 299 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zgradop 300 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarem 301 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgraref 302 zfezoo2(ji,jj,jk) = zgraref 303 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarem 304 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zgraren 305 tr(ji,jj,jk,jpmes,Krhs) = tr(ji,jj,jk,jpmes,Krhs) + zepsherv * zgraztotc - zrespirc & 306 & - ztortz - zgrazm 307 tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazdc 308 tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zgrazdn 309 tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zgrazdp 310 tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazdf 311 tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) - zgrazz 312 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgraznc 313 tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) - zgraznn 314 tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) - zgraznp 315 tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgraznf 316 tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgraznc * tr(ji,jj,jk,jpnch,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 317 tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazdc * tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 318 tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazdc * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 319 tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazdc * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 320 321 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zgrazpoc - zgrazffep + zfracc 322 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfracc 323 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep 324 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) - zgrazpon - zgrazffnp + zfracn 325 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) - zgrazpop - zgrazffpp + zfracp 326 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) - zgrazffeg + zgrapoc - zfracc 327 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zgrapoc 328 consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfracc 329 tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) - zgrazffng + zgrapon - zfracn 330 tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) - zgrazffpg + zgrapop - zfracp 331 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zgrazpof - zgrazfffp + zfracfe 332 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zgrazfffg + zgrapof - zfracfe 333 zfracal = tr(ji,jj,jk,jpcal,Kbb) / ( tr(ji,jj,jk,jpgoc,Kbb) + rtrn ) 334 zgrazcal = zgrazffeg * (1. - part2) * zfracal 335 336 ! calcite production 337 ! ------------------ 338 zprcaca = xfracal(ji,jj,jk) * zgraznc 339 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 340 zprcaca = part2 * zprcaca 341 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrazcal - zprcaca 342 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + 2. * ( zgrazcal - zprcaca ) 343 tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) - zgrazcal + zprcaca 344 END DO 345 END DO 346 END DO 100 DO_3D_11_11( 1, jpkm1 ) 101 zcompam = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - 1.e-9 ), 0.e0 ) 102 zfact = xstep * tgfunc2(ji,jj,jk) * zcompam 103 104 ! Michaelis-Menten mortality rates of mesozooplankton 105 ! --------------------------------------------------- 106 zrespz = resrat2 * zfact * ( tr(ji,jj,jk,jpmes,Kbb) / ( xkmort + tr(ji,jj,jk,jpmes,Kbb) ) & 107 & + 3. * nitrfac(ji,jj,jk) ) 108 109 ! Zooplankton mortality. A square function has been selected with 110 ! no real reason except that it seems to be more stable and may mimic predation 111 ! --------------------------------------------------------------- 112 ztortz = mzrat2 * 1.e6 * zfact * tr(ji,jj,jk,jpmes,Kbb) * (1. - nitrfac(ji,jj,jk)) 113 114 ! Computation of the abundance of the preys 115 ! A threshold can be specified in the namelist 116 ! -------------------------------------------- 117 zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthresh2dia ), 0.e0 ) 118 zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - xthresh2zoo ), 0.e0 ) 119 zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthresh2phy ), 0.e0 ) 120 zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthresh2poc ), 0.e0 ) 121 zcompames = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - xthresh2mes ), 0.e0 ) 122 123 ! Mesozooplankton grazing 124 ! ------------------------ 125 zfood = xpref2d * zcompadi + xpref2z * zcompaz + xpref2n * zcompaph + xpref2c * zcompapoc & 126 & + xpref2m * zcompames 127 zfoodlim = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) ) 128 zdenom = zfoodlim / ( xkgraz2 + zfoodlim ) 129 zgraze2 = grazrat2 * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpmes,Kbb) * (1. - nitrfac(ji,jj,jk)) 130 131 ! An active switching parameterization is used here. 132 ! We don't use the KTW parameterization proposed by 133 ! Vallina et al. because it tends to produce to steady biomass 134 ! composition and the variance of Chl is too low as it grazes 135 ! too strongly on winning organisms. Thus, instead of a square 136 ! a 1.5 power value is used which decreases the pressure on the 137 ! most abundant species 138 ! ------------------------------------------------------------ 139 ztmp1 = xpref2n * zcompaph**1.5 140 ztmp2 = xpref2m * zcompames**1.5 141 ztmp3 = xpref2c * zcompapoc**1.5 142 ztmp4 = xpref2d * zcompadi**1.5 143 ztmp5 = xpref2z * zcompaz**1.5 144 ztmptot = ztmp1 + ztmp2 + ztmp3 + ztmp4 + ztmp5 + rtrn 145 ztmp1 = ztmp1 / ztmptot 146 ztmp2 = ztmp2 / ztmptot 147 ztmp3 = ztmp3 / ztmptot 148 ztmp4 = ztmp4 / ztmptot 149 ztmp5 = ztmp5 / ztmptot 150 151 ! Mesozooplankton regular grazing on the different preys 152 ! ------------------------------------------------------ 153 zgrazdc = zgraze2 * ztmp4 * zdenom 154 zgrazdn = zgrazdc * tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn) 155 zgrazdp = zgrazdc * tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn) 156 zgrazdf = zgrazdc * tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn) 157 zgrazz = zgraze2 * ztmp5 * zdenom 158 zgrazm = zgraze2 * ztmp2 * zdenom 159 zgraznc = zgraze2 * ztmp1 * zdenom 160 zgraznn = zgraznc * tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn) 161 zgraznp = zgraznc * tr(ji,jj,jk,jppph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn) 162 zgraznf = zgraznc * tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn) 163 zgrazpoc = zgraze2 * ztmp3 * zdenom 164 zgrazpon = zgrazpoc * tr(ji,jj,jk,jppon,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 165 zgrazpop = zgrazpoc * tr(ji,jj,jk,jppop,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 166 zgrazpof = zgrazpoc * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 167 168 ! Mesozooplankton flux feeding on GOC 169 ! ---------------------------------- 170 zgrazffeg = grazflux * xstep * wsbio4(ji,jj,jk) & 171 & * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 172 & * (1. - nitrfac(ji,jj,jk)) 173 zgrazfffg = zgrazffeg * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 174 zgrazffng = zgrazffeg * tr(ji,jj,jk,jpgon,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 175 zgrazffpg = zgrazffeg * tr(ji,jj,jk,jpgop,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 176 zgrazffep = grazflux * xstep * wsbio3(ji,jj,jk) & 177 & * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 178 & * (1. - nitrfac(ji,jj,jk)) 179 zgrazfffp = zgrazffep * tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 180 zgrazffnp = zgrazffep * tr(ji,jj,jk,jppon,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 181 zgrazffpp = zgrazffep * tr(ji,jj,jk,jppop,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 182 ! 183 zgraztotc = zgrazdc + zgrazz + zgraznc + zgrazm + zgrazpoc + zgrazffep + zgrazffeg 184 185 ! Compute the proportion of filter feeders 186 ! ---------------------------------------- 187 zproport = (zgrazffep + zgrazffeg)/(rtrn + zgraztotc) 188 189 ! Compute fractionation of aggregates. It is assumed that 190 ! diatoms based aggregates are more prone to fractionation 191 ! since they are more porous (marine snow instead of fecal pellets) 192 ! ---------------------------------------------------------------- 193 zratio = tr(ji,jj,jk,jpgsi,Kbb) / ( tr(ji,jj,jk,jpgoc,Kbb) + rtrn ) 194 zratio2 = zratio * zratio 195 zfracc = zproport * grazflux * xstep * wsbio4(ji,jj,jk) & 196 & * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 197 & * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) ) 198 zfracfe = zfracc * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 199 zfracn = zfracc * tr(ji,jj,jk,jpgon,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 200 zfracp = zfracc * tr(ji,jj,jk,jpgop,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 201 202 zgrazffep = zproport * zgrazffep ; zgrazffeg = zproport * zgrazffeg 203 zgrazfffp = zproport * zgrazfffp ; zgrazfffg = zproport * zgrazfffg 204 zgrazffnp = zproport * zgrazffnp ; zgrazffng = zproport * zgrazffng 205 zgrazffpp = zproport * zgrazffpp ; zgrazffpg = zproport * zgrazffpg 206 207 zgraztotc = zgrazdc + zgrazz + zgraznc + zgrazm + zgrazpoc + zgrazffep + zgrazffeg 208 zgraztotf = zgrazdf + zgraznf + ( zgrazz + zgrazm ) * ferat3 + zgrazpof & 209 & + zgrazfffp + zgrazfffg 210 zgraztotn = zgrazdn + (zgrazm + zgrazz) * no3rat3 + zgraznn + zgrazpon & 211 & + zgrazffnp + zgrazffng 212 zgraztotp = zgrazdp + (zgrazz + zgrazm) * po4rat3 + zgraznp + zgrazpop & 213 & + zgrazffpp + zgrazffpg 214 215 216 ! Total grazing ( grazing by microzoo is already computed in p5zmicro ) 217 zgrazing(ji,jj,jk) = zgraztotc 218 219 ! Stoichiometruc ratios of the food ingested by zooplanton 220 ! -------------------------------------------------------- 221 zgrasratf = (zgraztotf + rtrn) / ( zgraztotc + rtrn ) 222 zgrasratn = (zgraztotn + rtrn) / ( zgraztotc + rtrn ) 223 zgrasratp = (zgraztotp + rtrn) / ( zgraztotc + rtrn ) 224 225 ! Growth efficiency is made a function of the quality 226 ! and the quantity of the preys 227 ! --------------------------------------------------- 228 zepshert = MIN( 1., zgrasratn/ no3rat3, zgrasratp/ po4rat3, zgrasratf / ferat3) 229 zbeta = MAX(0., (epsher2 - epsher2min) ) 230 zepsherf = epsher2min + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 231 zepsherv = zepsherf * zepshert 232 233 ! Respiration of mesozooplankton 234 ! Excess carbon in the food is used preferentially 235 ! ---------------- ------------------------------ 236 zexcess = zgraztotc * zepsherf * (1.0 - zepshert) * zmetexcess 237 zbasresb = MAX(0., zrespz - zexcess) 238 zbasresi = zexcess + MIN(0., zrespz - zexcess) 239 zrespirc = srespir2 * zepsherv * zgraztotc + zbasresb 240 241 ! When excess carbon is used, the other elements in excess 242 ! are also used proportionally to their abundance 243 ! -------------------------------------------------------- 244 zexcess = ( zgrasratn/ no3rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 245 zbasresn = zbasresi * zexcess * zgrasratn 246 zexcess = ( zgrasratp/ po4rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 247 zbasresp = zbasresi * zexcess * zgrasratp 248 zexcess = ( zgrasratf/ ferat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 249 zbasresf = zbasresi * zexcess * zgrasratf 250 251 ! Voiding of the excessive elements as organic matter 252 ! -------------------------------------------------------- 253 zgradoct = (1. - unass2c - zepsherv) * zgraztotc - zbasresi 254 zgradont = (1. - unass2n) * zgraztotn - zepsherv * no3rat3 * zgraztotc - zbasresn 255 zgradopt = (1. - unass2p) * zgraztotp - zepsherv * po4rat3 * zgraztotc - zbasresp 256 zgrareft = (1. - unass2c) * zgraztotf - zepsherv * ferat3 * zgraztotc - zbasresf 257 ztmp1 = ( 1. - epsher2 - unass2c ) /( 1. - 0.8 * epsher2 ) * ztortz 258 zgradoc = (zgradoct + ztmp1) * ssigma2 259 zgradon = (zgradont + no3rat3 * ztmp1) * ssigma2 260 zgradop = (zgradopt + po4rat3 * ztmp1) * ssigma2 261 zgratmp = 0.2 * epsher2 /( 1. - 0.8 * epsher2 ) * ztortz 262 263 ! Since only semilabile DOM is represented in PISCES 264 ! part of DOM is in fact labile and is then released 265 ! as dissolved inorganic compounds (ssigma2) 266 ! -------------------------------------------------- 267 zgrarem = zgratmp + ( zgradoct + ztmp1 ) * (1.0 - ssigma2) 268 zgraren = no3rat3 * zgratmp + ( zgradont + no3rat3 * ztmp1 ) * (1.0 - ssigma2) 269 zgrarep = po4rat3 * zgratmp + ( zgradopt + po4rat3 * ztmp1 ) * (1.0 - ssigma2) 270 zgraref = zgrareft + ferat3 * ( ztmp1 + zgratmp ) 271 272 ! Defecation as a result of non assimilated products 273 ! -------------------------------------------------- 274 zgrapoc = zgraztotc * unass2c + unass2c / ( 1. - 0.8 * epsher2 ) * ztortz 275 zgrapon = zgraztotn * unass2n + no3rat3 * unass2n / ( 1. - 0.8 * epsher2 ) * ztortz 276 zgrapop = zgraztotp * unass2p + po4rat3 * unass2p / ( 1. - 0.8 * epsher2 ) * ztortz 277 zgrapof = zgraztotf * unass2c + ferat3 * unass2c / ( 1. - 0.8 * epsher2 ) * ztortz 278 279 ! Addition of respiration to the release of inorganic nutrients 280 ! ------------------------------------------------------------- 281 zgrarem = zgrarem + zbasresi + zrespirc 282 zgraren = zgraren + zbasresn + zrespirc * no3rat3 283 zgrarep = zgrarep + zbasresp + zrespirc * po4rat3 284 zgraref = zgraref + zbasresf + zrespirc * ferat3 285 286 ! Update the arrays TRA which contain the biological sources and 287 ! sinks 288 ! -------------------------------------------------------------- 289 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarep 290 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgraren 291 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgradoc 292 ! 293 IF( ln_ligand ) THEN 294 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zgradoc * ldocz 295 zz2ligprod(ji,jj,jk) = zgradoc * ldocz 296 ENDIF 297 ! 298 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zgradon 299 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zgradop 300 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarem 301 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgraref 302 zfezoo2(ji,jj,jk) = zgraref 303 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarem 304 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zgraren 305 tr(ji,jj,jk,jpmes,Krhs) = tr(ji,jj,jk,jpmes,Krhs) + zepsherv * zgraztotc - zrespirc & 306 & - ztortz - zgrazm 307 tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazdc 308 tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zgrazdn 309 tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zgrazdp 310 tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazdf 311 tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) - zgrazz 312 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgraznc 313 tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) - zgraznn 314 tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) - zgraznp 315 tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgraznf 316 tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgraznc * tr(ji,jj,jk,jpnch,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 317 tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazdc * tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 318 tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazdc * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 319 tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazdc * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 320 321 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zgrazpoc - zgrazffep + zfracc 322 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfracc 323 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep 324 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) - zgrazpon - zgrazffnp + zfracn 325 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) - zgrazpop - zgrazffpp + zfracp 326 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) - zgrazffeg + zgrapoc - zfracc 327 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zgrapoc 328 consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfracc 329 tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) - zgrazffng + zgrapon - zfracn 330 tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) - zgrazffpg + zgrapop - zfracp 331 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zgrazpof - zgrazfffp + zfracfe 332 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zgrazfffg + zgrapof - zfracfe 333 zfracal = tr(ji,jj,jk,jpcal,Kbb) / ( tr(ji,jj,jk,jpgoc,Kbb) + rtrn ) 334 zgrazcal = zgrazffeg * (1. - part2) * zfracal 335 336 ! calcite production 337 ! ------------------ 338 zprcaca = xfracal(ji,jj,jk) * zgraznc 339 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 340 zprcaca = part2 * zprcaca 341 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrazcal - zprcaca 342 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + 2. * ( zgrazcal - zprcaca ) 343 tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) - zgrazcal + zprcaca 344 END_3D 347 345 ! 348 346 IF( lk_iomput .AND. knt == nrdttrc ) THEN -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p5zmicro.F90
r12258 r12340 52 52 LOGICAL, PUBLIC :: bmetexc !: Use of excess carbon for respiration 53 53 54 !! * Substitutions 55 # include "do_loop_substitute.h90" 54 56 !!---------------------------------------------------------------------- 55 57 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 94 96 IF ( bmetexc ) zmetexcess = 1.0 95 97 ! 96 DO jk = 1, jpkm1 97 DO jj = 1, jpj 98 DO ji = 1, jpi 99 zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - 1.e-9 ), 0.e0 ) 100 zfact = xstep * tgfunc2(ji,jj,jk) * zcompaz 101 102 ! Michaelis-Menten mortality rates of microzooplankton 103 ! ----------------------------------------------------- 104 zrespz = resrat * zfact * ( tr(ji,jj,jk,jpzoo,Kbb) / ( xkmort + tr(ji,jj,jk,jpzoo,Kbb) ) & 105 & + 3. * nitrfac(ji,jj,jk) ) 106 107 ! Zooplankton mortality. A square function has been selected with 108 ! no real reason except that it seems to be more stable and may mimic predation. 109 ! ------------------------------------------------------------------------------ 110 ztortz = mzrat * 1.e6 * zfact * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk)) 111 112 ! Computation of the abundance of the preys 113 ! A threshold can be specified in the namelist 114 ! -------------------------------------------- 115 zcompadi = MIN( MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthreshdia ), 0.e0 ), xsizedia ) 116 zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthreshphy ), 0.e0 ) 117 zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - xthreshzoo ), 0.e0 ) 118 zcompapi = MAX( ( tr(ji,jj,jk,jppic,Kbb) - xthreshpic ), 0.e0 ) 119 zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthreshpoc ), 0.e0 ) 120 121 ! Microzooplankton grazing 122 ! ------------------------ 123 zfood = xprefn * zcompaph + xprefc * zcompapoc + xprefd * zcompadi & 124 & + xprefz * zcompaz + xprefp * zcompapi 125 zfoodlim = MAX( 0. , zfood - min(xthresh,0.5*zfood) ) 126 zdenom = zfoodlim / ( xkgraz + zfoodlim ) 127 zgraze = grazrat * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk)) 128 129 ! An active switching parameterization is used here. 130 ! We don't use the KTW parameterization proposed by 131 ! Vallina et al. because it tends to produce to steady biomass 132 ! composition and the variance of Chl is too low as it grazes 133 ! too strongly on winning organisms. Thus, instead of a square 134 ! a 1.5 power value is used which decreases the pressure on the 135 ! most abundant species 136 ! ------------------------------------------------------------ 137 ztmp1 = xprefn * zcompaph**1.5 138 ztmp2 = xprefp * zcompapi**1.5 139 ztmp3 = xprefc * zcompapoc**1.5 140 ztmp4 = xprefd * zcompadi**1.5 141 ztmp5 = xprefz * zcompaz**1.5 142 ztmptot = ztmp1 + ztmp2 + ztmp3 + ztmp4 + ztmp5 + rtrn 143 ztmp1 = ztmp1 / ztmptot 144 ztmp2 = ztmp2 / ztmptot 145 ztmp3 = ztmp3 / ztmptot 146 ztmp4 = ztmp4 / ztmptot 147 ztmp5 = ztmp5 / ztmptot 148 149 ! Microzooplankton regular grazing on the different preys 150 ! ------------------------------------------------------- 151 zgraznc = zgraze * ztmp1 * zdenom 152 zgraznn = zgraznc * tr(ji,jj,jk,jpnph,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 153 zgraznp = zgraznc * tr(ji,jj,jk,jppph,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 154 zgraznf = zgraznc * tr(ji,jj,jk,jpnfe,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 155 zgrazpc = zgraze * ztmp2 * zdenom 156 zgrazpn = zgrazpc * tr(ji,jj,jk,jpnpi,Kbb) / (tr(ji,jj,jk,jppic,Kbb) + rtrn) 157 zgrazpp = zgrazpc * tr(ji,jj,jk,jpppi,Kbb) / (tr(ji,jj,jk,jppic,Kbb) + rtrn) 158 zgrazpf = zgrazpc * tr(ji,jj,jk,jppfe,Kbb) / (tr(ji,jj,jk,jppic,Kbb) + rtrn) 159 zgrazz = zgraze * ztmp5 * zdenom 160 zgrazpoc = zgraze * ztmp3 * zdenom 161 zgrazpon = zgrazpoc * tr(ji,jj,jk,jppon,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 162 zgrazpop = zgrazpoc * tr(ji,jj,jk,jppop,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 163 zgrazpof = zgrazpoc* tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 164 zgrazdc = zgraze * ztmp4 * zdenom 165 zgrazdn = zgrazdc * tr(ji,jj,jk,jpndi,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 166 zgrazdp = zgrazdc * tr(ji,jj,jk,jppdi,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 167 zgrazdf = zgrazdc * tr(ji,jj,jk,jpdfe,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 168 ! 169 zgraztotc = zgraznc + zgrazpoc + zgrazdc + zgrazz + zgrazpc 170 zgraztotn = zgraznn + zgrazpn + zgrazpon + zgrazdn + zgrazz * no3rat3 171 zgraztotp = zgraznp + zgrazpp + zgrazpop + zgrazdp + zgrazz * po4rat3 172 zgraztotf = zgraznf + zgrazpf + zgrazpof + zgrazdf + zgrazz * ferat3 173 ! 174 ! Grazing by microzooplankton 175 zgrazing(ji,jj,jk) = zgraztotc 176 177 ! Stoichiometruc ratios of the food ingested by zooplanton 178 ! -------------------------------------------------------- 179 zgrasratf = (zgraztotf + rtrn) / ( zgraztotc + rtrn ) 180 zgrasratn = (zgraztotn + rtrn) / ( zgraztotc + rtrn ) 181 zgrasratp = (zgraztotp + rtrn) / ( zgraztotc + rtrn ) 182 183 ! Growth efficiency is made a function of the quality 184 ! and the quantity of the preys 185 ! --------------------------------------------------- 186 zepshert = MIN( 1., zgrasratn/ no3rat3, zgrasratp/ po4rat3, zgrasratf / ferat3) 187 zbeta = MAX( 0., (epsher - epshermin) ) 188 zepsherf = epshermin + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 189 zepsherv = zepsherf * zepshert 190 191 ! Respiration of microzooplankton 192 ! Excess carbon in the food is used preferentially 193 ! ------------------------------------------------ 194 zexcess = zgraztotc * zepsherf * (1.0 - zepshert) * zmetexcess 195 zbasresb = MAX(0., zrespz - zexcess) 196 zbasresi = zexcess + MIN(0., zrespz - zexcess) 197 zrespirc = srespir * zepsherv * zgraztotc + zbasresb 198 199 ! When excess carbon is used, the other elements in excess 200 ! are also used proportionally to their abundance 201 ! -------------------------------------------------------- 202 zexcess = ( zgrasratn/ no3rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 203 zbasresn = zbasresi * zexcess * zgrasratn 204 zexcess = ( zgrasratp/ po4rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 205 zbasresp = zbasresi * zexcess * zgrasratp 206 zexcess = ( zgrasratf/ ferat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 207 zbasresf = zbasresi * zexcess * zgrasratf 208 209 ! Voiding of the excessive elements as DOM 210 ! ---------------------------------------- 211 zgradoct = (1. - unassc - zepsherv) * zgraztotc - zbasresi 212 zgradont = (1. - unassn) * zgraztotn - zepsherv * no3rat3 * zgraztotc - zbasresn 213 zgradopt = (1. - unassp) * zgraztotp - zepsherv * po4rat3 * zgraztotc - zbasresp 214 zgrareft = (1. - unassc) * zgraztotf - zepsherv * ferat3 * zgraztotc - zbasresf 215 216 ! Since only semilabile DOM is represented in PISCES 217 ! part of DOM is in fact labile and is then released 218 ! as dissolved inorganic compounds (ssigma) 219 ! -------------------------------------------------- 220 zgradoc = zgradoct * ssigma 221 zgradon = zgradont * ssigma 222 zgradop = zgradopt * ssigma 223 zgrarem = (1.0 - ssigma) * zgradoct 224 zgraren = (1.0 - ssigma) * zgradont 225 zgrarep = (1.0 - ssigma) * zgradopt 226 zgraref = zgrareft 227 228 ! Defecation as a result of non assimilated products 229 ! -------------------------------------------------- 230 zgrapoc = zgraztotc * unassc 231 zgrapon = zgraztotn * unassn 232 zgrapop = zgraztotp * unassp 233 zgrapof = zgraztotf * unassc 234 235 ! Addition of respiration to the release of inorganic nutrients 236 ! ------------------------------------------------------------- 237 zgrarem = zgrarem + zbasresi + zrespirc 238 zgraren = zgraren + zbasresn + zrespirc * no3rat3 239 zgrarep = zgrarep + zbasresp + zrespirc * po4rat3 240 zgraref = zgraref + zbasresf + zrespirc * ferat3 241 242 ! Update of the TRA arrays 243 ! ------------------------ 244 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarep 245 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgraren 246 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgradoc 247 ! 248 IF( ln_ligand ) THEN 249 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zgradoc * ldocz 250 zzligprod(ji,jj,jk) = zgradoc * ldocz 251 ENDIF 252 ! 253 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zgradon 254 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zgradop 255 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarem 256 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgraref 257 zfezoo(ji,jj,jk) = zgraref 258 tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) + zepsherv * zgraztotc - zrespirc - ztortz - zgrazz 259 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgraznc 260 tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) - zgraznn 261 tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) - zgraznp 262 tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) - zgrazpc 263 tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) - zgrazpn 264 tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) - zgrazpp 265 tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazdc 266 tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zgrazdn 267 tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zgrazdp 268 tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgraznc * tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 269 tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) - zgrazpc * tr(ji,jj,jk,jppch,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 270 tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazdc * tr(ji,jj,jk,jpdch,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 271 tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazdc * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 272 tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazdc * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 273 tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgraznf 274 tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) - zgrazpf 275 tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazdf 276 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + ztortz + zgrapoc - zgrazpoc 277 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ztortz + zgrapoc 278 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc 279 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + no3rat3 * ztortz + zgrapon - zgrazpon 280 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + po4rat3 * ztortz + zgrapop - zgrazpop 281 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ferat3 * ztortz + zgrapof - zgrazpof 282 ! 283 ! calcite production 284 zprcaca = xfracal(ji,jj,jk) * zgraznc 285 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 286 ! 287 zprcaca = part * zprcaca 288 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarem - zprcaca 289 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca & 290 & + rno3 * zgraren 291 tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca 292 END DO 293 END DO 294 END DO 98 DO_3D_11_11( 1, jpkm1 ) 99 zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - 1.e-9 ), 0.e0 ) 100 zfact = xstep * tgfunc2(ji,jj,jk) * zcompaz 101 102 ! Michaelis-Menten mortality rates of microzooplankton 103 ! ----------------------------------------------------- 104 zrespz = resrat * zfact * ( tr(ji,jj,jk,jpzoo,Kbb) / ( xkmort + tr(ji,jj,jk,jpzoo,Kbb) ) & 105 & + 3. * nitrfac(ji,jj,jk) ) 106 107 ! Zooplankton mortality. A square function has been selected with 108 ! no real reason except that it seems to be more stable and may mimic predation. 109 ! ------------------------------------------------------------------------------ 110 ztortz = mzrat * 1.e6 * zfact * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk)) 111 112 ! Computation of the abundance of the preys 113 ! A threshold can be specified in the namelist 114 ! -------------------------------------------- 115 zcompadi = MIN( MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthreshdia ), 0.e0 ), xsizedia ) 116 zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthreshphy ), 0.e0 ) 117 zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - xthreshzoo ), 0.e0 ) 118 zcompapi = MAX( ( tr(ji,jj,jk,jppic,Kbb) - xthreshpic ), 0.e0 ) 119 zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthreshpoc ), 0.e0 ) 120 121 ! Microzooplankton grazing 122 ! ------------------------ 123 zfood = xprefn * zcompaph + xprefc * zcompapoc + xprefd * zcompadi & 124 & + xprefz * zcompaz + xprefp * zcompapi 125 zfoodlim = MAX( 0. , zfood - min(xthresh,0.5*zfood) ) 126 zdenom = zfoodlim / ( xkgraz + zfoodlim ) 127 zgraze = grazrat * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk)) 128 129 ! An active switching parameterization is used here. 130 ! We don't use the KTW parameterization proposed by 131 ! Vallina et al. because it tends to produce to steady biomass 132 ! composition and the variance of Chl is too low as it grazes 133 ! too strongly on winning organisms. Thus, instead of a square 134 ! a 1.5 power value is used which decreases the pressure on the 135 ! most abundant species 136 ! ------------------------------------------------------------ 137 ztmp1 = xprefn * zcompaph**1.5 138 ztmp2 = xprefp * zcompapi**1.5 139 ztmp3 = xprefc * zcompapoc**1.5 140 ztmp4 = xprefd * zcompadi**1.5 141 ztmp5 = xprefz * zcompaz**1.5 142 ztmptot = ztmp1 + ztmp2 + ztmp3 + ztmp4 + ztmp5 + rtrn 143 ztmp1 = ztmp1 / ztmptot 144 ztmp2 = ztmp2 / ztmptot 145 ztmp3 = ztmp3 / ztmptot 146 ztmp4 = ztmp4 / ztmptot 147 ztmp5 = ztmp5 / ztmptot 148 149 ! Microzooplankton regular grazing on the different preys 150 ! ------------------------------------------------------- 151 zgraznc = zgraze * ztmp1 * zdenom 152 zgraznn = zgraznc * tr(ji,jj,jk,jpnph,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 153 zgraznp = zgraznc * tr(ji,jj,jk,jppph,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 154 zgraznf = zgraznc * tr(ji,jj,jk,jpnfe,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 155 zgrazpc = zgraze * ztmp2 * zdenom 156 zgrazpn = zgrazpc * tr(ji,jj,jk,jpnpi,Kbb) / (tr(ji,jj,jk,jppic,Kbb) + rtrn) 157 zgrazpp = zgrazpc * tr(ji,jj,jk,jpppi,Kbb) / (tr(ji,jj,jk,jppic,Kbb) + rtrn) 158 zgrazpf = zgrazpc * tr(ji,jj,jk,jppfe,Kbb) / (tr(ji,jj,jk,jppic,Kbb) + rtrn) 159 zgrazz = zgraze * ztmp5 * zdenom 160 zgrazpoc = zgraze * ztmp3 * zdenom 161 zgrazpon = zgrazpoc * tr(ji,jj,jk,jppon,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 162 zgrazpop = zgrazpoc * tr(ji,jj,jk,jppop,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 163 zgrazpof = zgrazpoc* tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 164 zgrazdc = zgraze * ztmp4 * zdenom 165 zgrazdn = zgrazdc * tr(ji,jj,jk,jpndi,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 166 zgrazdp = zgrazdc * tr(ji,jj,jk,jppdi,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 167 zgrazdf = zgrazdc * tr(ji,jj,jk,jpdfe,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 168 ! 169 zgraztotc = zgraznc + zgrazpoc + zgrazdc + zgrazz + zgrazpc 170 zgraztotn = zgraznn + zgrazpn + zgrazpon + zgrazdn + zgrazz * no3rat3 171 zgraztotp = zgraznp + zgrazpp + zgrazpop + zgrazdp + zgrazz * po4rat3 172 zgraztotf = zgraznf + zgrazpf + zgrazpof + zgrazdf + zgrazz * ferat3 173 ! 174 ! Grazing by microzooplankton 175 zgrazing(ji,jj,jk) = zgraztotc 176 177 ! Stoichiometruc ratios of the food ingested by zooplanton 178 ! -------------------------------------------------------- 179 zgrasratf = (zgraztotf + rtrn) / ( zgraztotc + rtrn ) 180 zgrasratn = (zgraztotn + rtrn) / ( zgraztotc + rtrn ) 181 zgrasratp = (zgraztotp + rtrn) / ( zgraztotc + rtrn ) 182 183 ! Growth efficiency is made a function of the quality 184 ! and the quantity of the preys 185 ! --------------------------------------------------- 186 zepshert = MIN( 1., zgrasratn/ no3rat3, zgrasratp/ po4rat3, zgrasratf / ferat3) 187 zbeta = MAX( 0., (epsher - epshermin) ) 188 zepsherf = epshermin + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 189 zepsherv = zepsherf * zepshert 190 191 ! Respiration of microzooplankton 192 ! Excess carbon in the food is used preferentially 193 ! ------------------------------------------------ 194 zexcess = zgraztotc * zepsherf * (1.0 - zepshert) * zmetexcess 195 zbasresb = MAX(0., zrespz - zexcess) 196 zbasresi = zexcess + MIN(0., zrespz - zexcess) 197 zrespirc = srespir * zepsherv * zgraztotc + zbasresb 198 199 ! When excess carbon is used, the other elements in excess 200 ! are also used proportionally to their abundance 201 ! -------------------------------------------------------- 202 zexcess = ( zgrasratn/ no3rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 203 zbasresn = zbasresi * zexcess * zgrasratn 204 zexcess = ( zgrasratp/ po4rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 205 zbasresp = zbasresi * zexcess * zgrasratp 206 zexcess = ( zgrasratf/ ferat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 207 zbasresf = zbasresi * zexcess * zgrasratf 208 209 ! Voiding of the excessive elements as DOM 210 ! ---------------------------------------- 211 zgradoct = (1. - unassc - zepsherv) * zgraztotc - zbasresi 212 zgradont = (1. - unassn) * zgraztotn - zepsherv * no3rat3 * zgraztotc - zbasresn 213 zgradopt = (1. - unassp) * zgraztotp - zepsherv * po4rat3 * zgraztotc - zbasresp 214 zgrareft = (1. - unassc) * zgraztotf - zepsherv * ferat3 * zgraztotc - zbasresf 215 216 ! Since only semilabile DOM is represented in PISCES 217 ! part of DOM is in fact labile and is then released 218 ! as dissolved inorganic compounds (ssigma) 219 ! -------------------------------------------------- 220 zgradoc = zgradoct * ssigma 221 zgradon = zgradont * ssigma 222 zgradop = zgradopt * ssigma 223 zgrarem = (1.0 - ssigma) * zgradoct 224 zgraren = (1.0 - ssigma) * zgradont 225 zgrarep = (1.0 - ssigma) * zgradopt 226 zgraref = zgrareft 227 228 ! Defecation as a result of non assimilated products 229 ! -------------------------------------------------- 230 zgrapoc = zgraztotc * unassc 231 zgrapon = zgraztotn * unassn 232 zgrapop = zgraztotp * unassp 233 zgrapof = zgraztotf * unassc 234 235 ! Addition of respiration to the release of inorganic nutrients 236 ! ------------------------------------------------------------- 237 zgrarem = zgrarem + zbasresi + zrespirc 238 zgraren = zgraren + zbasresn + zrespirc * no3rat3 239 zgrarep = zgrarep + zbasresp + zrespirc * po4rat3 240 zgraref = zgraref + zbasresf + zrespirc * ferat3 241 242 ! Update of the TRA arrays 243 ! ------------------------ 244 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarep 245 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgraren 246 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgradoc 247 ! 248 IF( ln_ligand ) THEN 249 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zgradoc * ldocz 250 zzligprod(ji,jj,jk) = zgradoc * ldocz 251 ENDIF 252 ! 253 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zgradon 254 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zgradop 255 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarem 256 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgraref 257 zfezoo(ji,jj,jk) = zgraref 258 tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) + zepsherv * zgraztotc - zrespirc - ztortz - zgrazz 259 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgraznc 260 tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) - zgraznn 261 tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) - zgraznp 262 tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) - zgrazpc 263 tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) - zgrazpn 264 tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) - zgrazpp 265 tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazdc 266 tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zgrazdn 267 tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zgrazdp 268 tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgraznc * tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 269 tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) - zgrazpc * tr(ji,jj,jk,jppch,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 270 tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazdc * tr(ji,jj,jk,jpdch,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 271 tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazdc * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 272 tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazdc * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 273 tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgraznf 274 tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) - zgrazpf 275 tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazdf 276 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + ztortz + zgrapoc - zgrazpoc 277 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ztortz + zgrapoc 278 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc 279 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + no3rat3 * ztortz + zgrapon - zgrazpon 280 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + po4rat3 * ztortz + zgrapop - zgrazpop 281 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ferat3 * ztortz + zgrapof - zgrazpof 282 ! 283 ! calcite production 284 zprcaca = xfracal(ji,jj,jk) * zgraznc 285 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 286 ! 287 zprcaca = part * zprcaca 288 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarem - zprcaca 289 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca & 290 & + rno3 * zgraren 291 tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca 292 END_3D 295 293 ! 296 294 IF( lk_iomput .AND. knt == nrdttrc ) THEN -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p5zmort.F90
r12236 r12340 33 33 REAL(wp), PUBLIC :: mpratd !: 34 34 35 !! * Substitutions 36 # include "do_loop_substitute.h90" 35 37 !!---------------------------------------------------------------------- 36 38 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 80 82 ! 81 83 prodcal(:,:,:) = 0. !: calcite production variable set to zero 82 DO jk = 1, jpkm1 83 DO jj = 1, jpj 84 DO ji = 1, jpi 85 zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-9 ), 0.e0 ) 86 ! Squared mortality of Phyto similar to a sedimentation term during 87 ! blooms (Doney et al. 1996) 88 ! ----------------------------------------------------------------- 89 zrespp = wchln * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * tr(ji,jj,jk,jpphy,Kbb) 90 91 ! Phytoplankton linear mortality 92 ! ------------------------------ 93 ztortp = mpratn * xstep * zcompaph 94 zmortp = zrespp + ztortp 95 96 ! Update the arrays TRA which contains the biological sources and sinks 97 98 zfactn = tr(ji,jj,jk,jpnph,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 99 zfactp = tr(ji,jj,jk,jppph,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 100 zfactfe = tr(ji,jj,jk,jpnfe,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 101 zfactch = tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 102 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zmortp 103 tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) - zmortp * zfactn 104 tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) - zmortp * zfactp 105 tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zmortp * zfactch 106 tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zmortp * zfactfe 107 zprcaca = xfracal(ji,jj,jk) * zmortp 108 ! 109 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 110 ! 111 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprcaca 112 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca 113 tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca 114 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortp 115 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zmortp * zfactn 116 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + zmortp * zfactp 117 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp 118 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zmortp * zfactfe 119 END DO 120 END DO 121 END DO 84 DO_3D_11_11( 1, jpkm1 ) 85 zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-9 ), 0.e0 ) 86 ! Squared mortality of Phyto similar to a sedimentation term during 87 ! blooms (Doney et al. 1996) 88 ! ----------------------------------------------------------------- 89 zrespp = wchln * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * tr(ji,jj,jk,jpphy,Kbb) 90 91 ! Phytoplankton linear mortality 92 ! ------------------------------ 93 ztortp = mpratn * xstep * zcompaph 94 zmortp = zrespp + ztortp 95 96 ! Update the arrays TRA which contains the biological sources and sinks 97 98 zfactn = tr(ji,jj,jk,jpnph,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 99 zfactp = tr(ji,jj,jk,jppph,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 100 zfactfe = tr(ji,jj,jk,jpnfe,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 101 zfactch = tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 102 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zmortp 103 tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) - zmortp * zfactn 104 tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) - zmortp * zfactp 105 tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zmortp * zfactch 106 tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zmortp * zfactfe 107 zprcaca = xfracal(ji,jj,jk) * zmortp 108 ! 109 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 110 ! 111 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprcaca 112 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca 113 tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca 114 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortp 115 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zmortp * zfactn 116 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + zmortp * zfactp 117 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp 118 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zmortp * zfactfe 119 END_3D 122 120 ! 123 121 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) … … 150 148 IF( ln_timing ) CALL timing_start('p5z_pico') 151 149 ! 152 DO jk = 1, jpkm1 153 DO jj = 1, jpj 154 DO ji = 1, jpi 155 zcompaph = MAX( ( tr(ji,jj,jk,jppic,Kbb) - 1e-9 ), 0.e0 ) 156 ! Squared mortality of Phyto similar to a sedimentation term during 157 ! blooms (Doney et al. 1996) 158 ! ----------------------------------------------------------------- 159 zrespp = wchlp * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * tr(ji,jj,jk,jppic,Kbb) 160 161 ! Phytoplankton mortality 162 ztortp = mpratp * xstep * zcompaph 163 zmortp = zrespp + ztortp 164 165 ! Update the arrays TRA which contains the biological sources and sinks 166 167 zfactn = tr(ji,jj,jk,jpnpi,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 168 zfactp = tr(ji,jj,jk,jpppi,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 169 zfactfe = tr(ji,jj,jk,jppfe,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 170 zfactch = tr(ji,jj,jk,jppch,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 171 tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) - zmortp 172 tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) - zmortp * zfactn 173 tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) - zmortp * zfactp 174 tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) - zmortp * zfactch 175 tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) - zmortp * zfactfe 176 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortp 177 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zmortp * zfactn 178 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + zmortp * zfactp 179 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zmortp * zfactfe 180 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp 181 END DO 182 END DO 183 END DO 150 DO_3D_11_11( 1, jpkm1 ) 151 zcompaph = MAX( ( tr(ji,jj,jk,jppic,Kbb) - 1e-9 ), 0.e0 ) 152 ! Squared mortality of Phyto similar to a sedimentation term during 153 ! blooms (Doney et al. 1996) 154 ! ----------------------------------------------------------------- 155 zrespp = wchlp * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * tr(ji,jj,jk,jppic,Kbb) 156 157 ! Phytoplankton mortality 158 ztortp = mpratp * xstep * zcompaph 159 zmortp = zrespp + ztortp 160 161 ! Update the arrays TRA which contains the biological sources and sinks 162 163 zfactn = tr(ji,jj,jk,jpnpi,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 164 zfactp = tr(ji,jj,jk,jpppi,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 165 zfactfe = tr(ji,jj,jk,jppfe,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 166 zfactch = tr(ji,jj,jk,jppch,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 167 tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) - zmortp 168 tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) - zmortp * zfactn 169 tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) - zmortp * zfactp 170 tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) - zmortp * zfactch 171 tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) - zmortp * zfactfe 172 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortp 173 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zmortp * zfactn 174 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + zmortp * zfactp 175 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zmortp * zfactfe 176 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp 177 END_3D 184 178 ! 185 179 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) … … 213 207 ! 214 208 215 DO jk = 1, jpkm1 216 DO jj = 1, jpj 217 DO ji = 1, jpi 218 219 zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1E-9), 0. ) 220 221 ! Aggregation term for diatoms is increased in case of nutrient 222 ! stress as observed in reality. The stressed cells become more 223 ! sticky and coagulate to sink quickly out of the euphotic zone 224 ! ------------------------------------------------------------- 225 ! Phytoplankton squared mortality 226 ! ------------------------------- 227 zlim2 = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk) 228 zlim1 = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 229 zrespp2 = 1.e6 * xstep * ( wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * tr(ji,jj,jk,jpdia,Kbb) 230 231 ! Phytoplankton linear mortality 232 ! ------------------------------ 233 ztortp2 = mpratd * xstep * zcompadi 234 zmortp2 = zrespp2 + ztortp2 235 236 ! Update the arrays tr(:,:,:,:,Krhs) which contains the biological sources and sinks 237 ! --------------------------------------------------------------------- 238 zfactn = tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 239 zfactp = tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 240 zfactch = tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 241 zfactfe = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 242 zfactsi = tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 243 tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zmortp2 244 tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zmortp2 * zfactn 245 tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zmortp2 * zfactp 246 tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zmortp2 * zfactch 247 tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zmortp2 * zfactfe 248 tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zmortp2 * zfactsi 249 tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zmortp2 * zfactsi 250 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zrespp2 251 tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zrespp2 * zfactn 252 tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + zrespp2 * zfactp 253 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zrespp2 * zfactfe 254 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + ztortp2 255 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + ztortp2 * zfactn 256 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + ztortp2 * zfactp 257 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ztortp2 * zfactfe 258 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ztortp2 259 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zrespp2 260 END DO 261 END DO 262 END DO 209 DO_3D_11_11( 1, jpkm1 ) 210 211 zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1E-9), 0. ) 212 213 ! Aggregation term for diatoms is increased in case of nutrient 214 ! stress as observed in reality. The stressed cells become more 215 ! sticky and coagulate to sink quickly out of the euphotic zone 216 ! ------------------------------------------------------------- 217 ! Phytoplankton squared mortality 218 ! ------------------------------- 219 zlim2 = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk) 220 zlim1 = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 221 zrespp2 = 1.e6 * xstep * ( wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * tr(ji,jj,jk,jpdia,Kbb) 222 223 ! Phytoplankton linear mortality 224 ! ------------------------------ 225 ztortp2 = mpratd * xstep * zcompadi 226 zmortp2 = zrespp2 + ztortp2 227 228 ! Update the arrays tr(:,:,:,:,Krhs) which contains the biological sources and sinks 229 ! --------------------------------------------------------------------- 230 zfactn = tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 231 zfactp = tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 232 zfactch = tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 233 zfactfe = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 234 zfactsi = tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 235 tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zmortp2 236 tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zmortp2 * zfactn 237 tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zmortp2 * zfactp 238 tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zmortp2 * zfactch 239 tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zmortp2 * zfactfe 240 tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zmortp2 * zfactsi 241 tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zmortp2 * zfactsi 242 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zrespp2 243 tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zrespp2 * zfactn 244 tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + zrespp2 * zfactp 245 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zrespp2 * zfactfe 246 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + ztortp2 247 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + ztortp2 * zfactn 248 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + ztortp2 * zfactp 249 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ztortp2 * zfactfe 250 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ztortp2 251 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zrespp2 252 END_3D 263 253 ! 264 254 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p5zprod.F90
r12281 r12340 50 50 REAL(wp) :: texcretd !: 1 - excret2 51 51 52 !! * Substitutions 53 # include "do_loop_substitute.h90" 52 54 !!---------------------------------------------------------------------- 53 55 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 122 124 ! day length in hours 123 125 zstrn(:,:) = 0. 124 DO jj = 1, jpj 125 DO ji = 1, jpi 126 zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 127 zargu = MAX( -1., MIN( 1., zargu ) ) 128 zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 129 END DO 130 END DO 126 DO_2D_11_11 127 zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 128 zargu = MAX( -1., MIN( 1., zargu ) ) 129 zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 130 END_2D 131 131 132 132 ! Impact of the day duration on phytoplankton growth 133 DO jk = 1, jpkm1 134 DO jj = 1 ,jpj 135 DO ji = 1, jpi 136 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 137 zval = MAX( 1., zstrn(ji,jj) ) 138 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 139 zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 140 ENDIF 141 zmxl_chl(ji,jj,jk) = zval / 24. 142 zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval ) 143 ENDIF 144 END DO 145 END DO 146 END DO 133 DO_3D_11_11( 1, jpkm1 ) 134 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 135 zval = MAX( 1., zstrn(ji,jj) ) 136 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 137 zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 138 ENDIF 139 zmxl_chl(ji,jj,jk) = zval / 24. 140 zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval ) 141 ENDIF 142 END_3D 147 143 148 144 zprbio(:,:,:) = zprmaxn(:,:,:) * zmxl_fac(:,:,:) … … 155 151 WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 156 152 157 DO jk = 1, jpkm1 158 DO jj = 1, jpj 159 DO ji = 1, jpi 160 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 161 ! Computation of the P-I slope for nanos and diatoms 162 ztn = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. ) 163 zadap = xadap * ztn / ( 2.+ ztn ) 164 ! 165 zpislopeadn(ji,jj,jk) = pislopen * tr(ji,jj,jk,jpnch,Kbb) & 166 & /( tr(ji,jj,jk,jpphy,Kbb) * 12. + rtrn) 167 zpislopeadp(ji,jj,jk) = pislopep * ( 1. + zadap * EXP( -0.25 * epico(ji,jj,jk) ) ) & 168 & * tr(ji,jj,jk,jppch,Kbb) /( tr(ji,jj,jk,jppic,Kbb) * 12. + rtrn) 169 zpislopeadd(ji,jj,jk) = pisloped * tr(ji,jj,jk,jpdch,Kbb) & 170 & /( tr(ji,jj,jk,jpdia,Kbb) * 12. + rtrn) 171 ! 172 zpislopen = zpislopeadn(ji,jj,jk) / ( zprbio(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 173 zpislopep = zpislopeadp(ji,jj,jk) / ( zprpic(ji,jj,jk) * rday * xlimpic(ji,jj,jk) + rtrn ) 174 zpisloped = zpislopeadd(ji,jj,jk) / ( zprdia(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 175 176 ! Computation of production function for Carbon 177 ! --------------------------------------------- 178 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 179 zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1.- EXP( -zpislopep * epico(ji,jj,jk) ) ) 180 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 181 182 ! Computation of production function for Chlorophyll 183 ! ------------------------------------------------- 184 zpislopen = zpislopen * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 185 zpisloped = zpisloped * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 186 zpislopep = zpislopep * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 187 zprchln(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) ) ) 188 zprchlp(ji,jj,jk) = zprmaxp(ji,jj,jk) * ( 1.- EXP( -zpislopep * epicom(ji,jj,jk) ) ) 189 zprchld(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) ) ) 190 ENDIF 191 END DO 192 END DO 193 END DO 194 195 DO jk = 1, jpkm1 196 DO jj = 1, jpj 197 DO ji = 1, jpi 198 199 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 200 ! Si/C of diatoms 201 ! ------------------------ 202 ! Si/C increases with iron stress and silicate availability 203 ! Si/C is arbitrariliy increased for very high Si concentrations 204 ! to mimic the very high ratios observed in the Southern Ocean (silpot2) 205 zlim = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi1 ) 206 zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 207 zsilfac = 3.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) ) ) + 1.e0 208 zsiborn = tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) 209 IF (gphit(ji,jj) < -30 ) THEN 210 zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 ) 211 ELSE 212 zsilfac2 = 1. + zsiborn / ( zsiborn + xksi2**3 ) 213 ENDIF 214 zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2 215 ENDIF 216 END DO 217 END DO 218 END DO 153 DO_3D_11_11( 1, jpkm1 ) 154 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 155 ! Computation of the P-I slope for nanos and diatoms 156 ztn = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. ) 157 zadap = xadap * ztn / ( 2.+ ztn ) 158 ! 159 zpislopeadn(ji,jj,jk) = pislopen * tr(ji,jj,jk,jpnch,Kbb) & 160 & /( tr(ji,jj,jk,jpphy,Kbb) * 12. + rtrn) 161 zpislopeadp(ji,jj,jk) = pislopep * ( 1. + zadap * EXP( -0.25 * epico(ji,jj,jk) ) ) & 162 & * tr(ji,jj,jk,jppch,Kbb) /( tr(ji,jj,jk,jppic,Kbb) * 12. + rtrn) 163 zpislopeadd(ji,jj,jk) = pisloped * tr(ji,jj,jk,jpdch,Kbb) & 164 & /( tr(ji,jj,jk,jpdia,Kbb) * 12. + rtrn) 165 ! 166 zpislopen = zpislopeadn(ji,jj,jk) / ( zprbio(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 167 zpislopep = zpislopeadp(ji,jj,jk) / ( zprpic(ji,jj,jk) * rday * xlimpic(ji,jj,jk) + rtrn ) 168 zpisloped = zpislopeadd(ji,jj,jk) / ( zprdia(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 169 170 ! Computation of production function for Carbon 171 ! --------------------------------------------- 172 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 173 zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1.- EXP( -zpislopep * epico(ji,jj,jk) ) ) 174 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 175 176 ! Computation of production function for Chlorophyll 177 ! ------------------------------------------------- 178 zpislopen = zpislopen * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 179 zpisloped = zpisloped * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 180 zpislopep = zpislopep * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 181 zprchln(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) ) ) 182 zprchlp(ji,jj,jk) = zprmaxp(ji,jj,jk) * ( 1.- EXP( -zpislopep * epicom(ji,jj,jk) ) ) 183 zprchld(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) ) ) 184 ENDIF 185 END_3D 186 187 DO_3D_11_11( 1, jpkm1 ) 188 189 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 190 ! Si/C of diatoms 191 ! ------------------------ 192 ! Si/C increases with iron stress and silicate availability 193 ! Si/C is arbitrariliy increased for very high Si concentrations 194 ! to mimic the very high ratios observed in the Southern Ocean (silpot2) 195 zlim = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi1 ) 196 zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 197 zsilfac = 3.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) ) ) + 1.e0 198 zsiborn = tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) 199 IF (gphit(ji,jj) < -30 ) THEN 200 zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 ) 201 ELSE 202 zsilfac2 = 1. + zsiborn / ( zsiborn + xksi2**3 ) 203 ENDIF 204 zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2 205 ENDIF 206 END_3D 219 207 220 208 ! Sea-ice effect on production 221 DO jk = 1, jpkm1 222 DO jj = 1, jpj 223 DO ji = 1, jpi 224 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 225 zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 226 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 227 zprnut(ji,jj,jk) = zprnut(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 228 END DO 229 END DO 230 END DO 209 DO_3D_11_11( 1, jpkm1 ) 210 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 211 zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 212 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 213 zprnut(ji,jj,jk) = zprnut(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 214 END_3D 231 215 232 216 ! Computation of the various production terms of nanophytoplankton 233 DO jk = 1, jpkm1 234 DO jj = 1, jpj 235 DO ji = 1, jpi 236 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 237 ! production terms for nanophyto. 238 zprorcan(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * tr(ji,jj,jk,jpphy,Kbb) * rfact2 239 ! 240 zration = tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 241 zratiop = tr(ji,jj,jk,jppph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 242 zratiof = tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 243 zprnutmax = zprnut(ji,jj,jk) * fvnuptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jpphy,Kbb) * rfact2 244 ! Uptake of nitrogen 245 zrat = MIN( 1., zration / (xqnnmax(ji,jj,jk) + rtrn) ) 246 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 247 zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpnmin(ji,jj,jk) ) & 248 & / ( xqpnmax(ji,jj,jk) - xqpnmin(ji,jj,jk) + rtrn ), xlimnfe(ji,jj,jk) ) ) 249 zpronewn(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xnanono3(ji,jj,jk) 250 zproregn(ji,jj,jk) = zpronmax * xnanonh4(ji,jj,jk) 251 ! Uptake of phosphorus 252 zrat = MIN( 1., zratiop / (xqpnmax(ji,jj,jk) + rtrn) ) 253 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 254 zpropmax = zprnutmax * zmax * xlimnfe(ji,jj,jk) 255 zpropo4n(ji,jj,jk) = zpropmax * xnanopo4(ji,jj,jk) 256 zprodopn(ji,jj,jk) = zpropmax * xnanodop(ji,jj,jk) 257 ! Uptake of iron 258 zrat = MIN( 1., zratiof / qfnmax ) 259 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 260 zprofmax = zprnutmax * qfnmax * zmax 261 zprofen(ji,jj,jk) = zprofmax * xnanofer(ji,jj,jk) * ( 3. - 2.4 * xlimnfe(ji,jj,jk) & 262 & / ( xlimnfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xnanono3(ji,jj,jk) / ( rtrn & 263 & + xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) ) * (1. - xnanofer(ji,jj,jk) ) ) 264 ENDIF 265 END DO 266 END DO 267 END DO 217 DO_3D_11_11( 1, jpkm1 ) 218 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 219 ! production terms for nanophyto. 220 zprorcan(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * tr(ji,jj,jk,jpphy,Kbb) * rfact2 221 ! 222 zration = tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 223 zratiop = tr(ji,jj,jk,jppph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 224 zratiof = tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 225 zprnutmax = zprnut(ji,jj,jk) * fvnuptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jpphy,Kbb) * rfact2 226 ! Uptake of nitrogen 227 zrat = MIN( 1., zration / (xqnnmax(ji,jj,jk) + rtrn) ) 228 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 229 zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpnmin(ji,jj,jk) ) & 230 & / ( xqpnmax(ji,jj,jk) - xqpnmin(ji,jj,jk) + rtrn ), xlimnfe(ji,jj,jk) ) ) 231 zpronewn(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xnanono3(ji,jj,jk) 232 zproregn(ji,jj,jk) = zpronmax * xnanonh4(ji,jj,jk) 233 ! Uptake of phosphorus 234 zrat = MIN( 1., zratiop / (xqpnmax(ji,jj,jk) + rtrn) ) 235 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 236 zpropmax = zprnutmax * zmax * xlimnfe(ji,jj,jk) 237 zpropo4n(ji,jj,jk) = zpropmax * xnanopo4(ji,jj,jk) 238 zprodopn(ji,jj,jk) = zpropmax * xnanodop(ji,jj,jk) 239 ! Uptake of iron 240 zrat = MIN( 1., zratiof / qfnmax ) 241 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 242 zprofmax = zprnutmax * qfnmax * zmax 243 zprofen(ji,jj,jk) = zprofmax * xnanofer(ji,jj,jk) * ( 3. - 2.4 * xlimnfe(ji,jj,jk) & 244 & / ( xlimnfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xnanono3(ji,jj,jk) / ( rtrn & 245 & + xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) ) * (1. - xnanofer(ji,jj,jk) ) ) 246 ENDIF 247 END_3D 268 248 269 249 ! Computation of the various production terms of picophytoplankton 270 DO jk = 1, jpkm1 271 DO jj = 1, jpj 272 DO ji = 1, jpi 273 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 274 ! production terms for picophyto. 275 zprorcap(ji,jj,jk) = zprpic(ji,jj,jk) * xlimpic(ji,jj,jk) * tr(ji,jj,jk,jppic,Kbb) * rfact2 276 ! 277 zration = tr(ji,jj,jk,jpnpi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 278 zratiop = tr(ji,jj,jk,jpppi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 279 zratiof = tr(ji,jj,jk,jppfe,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 280 zprnutmax = zprnut(ji,jj,jk) * fvpuptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jppic,Kbb) * rfact2 281 ! Uptake of nitrogen 282 zrat = MIN( 1., zration / (xqnpmax(ji,jj,jk) + rtrn) ) 283 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 284 zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqppmin(ji,jj,jk) ) & 285 & / ( xqppmax(ji,jj,jk) - xqppmin(ji,jj,jk) + rtrn ), xlimpfe(ji,jj,jk) ) ) 286 zpronewp(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xpicono3(ji,jj,jk) 287 zproregp(ji,jj,jk) = zpronmax * xpiconh4(ji,jj,jk) 288 ! Uptake of phosphorus 289 zrat = MIN( 1., zratiop / (xqppmax(ji,jj,jk) + rtrn) ) 290 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 291 zpropmax = zprnutmax * zmax * xlimpfe(ji,jj,jk) 292 zpropo4p(ji,jj,jk) = zpropmax * xpicopo4(ji,jj,jk) 293 zprodopp(ji,jj,jk) = zpropmax * xpicodop(ji,jj,jk) 294 ! Uptake of iron 295 zrat = MIN( 1., zratiof / qfpmax ) 296 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 297 zprofmax = zprnutmax * qfpmax * zmax 298 zprofep(ji,jj,jk) = zprofmax * xpicofer(ji,jj,jk) * ( 3. - 2.4 * xlimpfe(ji,jj,jk) & 299 & / ( xlimpfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xpicono3(ji,jj,jk) / ( rtrn & 300 & + xpicono3(ji,jj,jk) + xpiconh4(ji,jj,jk) ) * (1. - xpicofer(ji,jj,jk) ) ) 301 ENDIF 302 END DO 303 END DO 304 END DO 250 DO_3D_11_11( 1, jpkm1 ) 251 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 252 ! production terms for picophyto. 253 zprorcap(ji,jj,jk) = zprpic(ji,jj,jk) * xlimpic(ji,jj,jk) * tr(ji,jj,jk,jppic,Kbb) * rfact2 254 ! 255 zration = tr(ji,jj,jk,jpnpi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 256 zratiop = tr(ji,jj,jk,jpppi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 257 zratiof = tr(ji,jj,jk,jppfe,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 258 zprnutmax = zprnut(ji,jj,jk) * fvpuptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jppic,Kbb) * rfact2 259 ! Uptake of nitrogen 260 zrat = MIN( 1., zration / (xqnpmax(ji,jj,jk) + rtrn) ) 261 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 262 zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqppmin(ji,jj,jk) ) & 263 & / ( xqppmax(ji,jj,jk) - xqppmin(ji,jj,jk) + rtrn ), xlimpfe(ji,jj,jk) ) ) 264 zpronewp(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xpicono3(ji,jj,jk) 265 zproregp(ji,jj,jk) = zpronmax * xpiconh4(ji,jj,jk) 266 ! Uptake of phosphorus 267 zrat = MIN( 1., zratiop / (xqppmax(ji,jj,jk) + rtrn) ) 268 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 269 zpropmax = zprnutmax * zmax * xlimpfe(ji,jj,jk) 270 zpropo4p(ji,jj,jk) = zpropmax * xpicopo4(ji,jj,jk) 271 zprodopp(ji,jj,jk) = zpropmax * xpicodop(ji,jj,jk) 272 ! Uptake of iron 273 zrat = MIN( 1., zratiof / qfpmax ) 274 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 275 zprofmax = zprnutmax * qfpmax * zmax 276 zprofep(ji,jj,jk) = zprofmax * xpicofer(ji,jj,jk) * ( 3. - 2.4 * xlimpfe(ji,jj,jk) & 277 & / ( xlimpfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xpicono3(ji,jj,jk) / ( rtrn & 278 & + xpicono3(ji,jj,jk) + xpiconh4(ji,jj,jk) ) * (1. - xpicofer(ji,jj,jk) ) ) 279 ENDIF 280 END_3D 305 281 306 282 ! Computation of the various production terms of diatoms 307 DO jk = 1, jpkm1 308 DO jj = 1, jpj 309 DO ji = 1, jpi 310 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 311 ! production terms for diatomees 312 zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr(ji,jj,jk,jpdia,Kbb) * rfact2 313 ! Computation of the respiration term according to pahlow 314 ! & oschlies (2013) 315 ! 316 zration = tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 317 zratiop = tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 318 zratiof = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 319 zprnutmax = zprnut(ji,jj,jk) * fvduptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jpdia,Kbb) * rfact2 320 ! Uptake of nitrogen 321 zrat = MIN( 1., zration / (xqndmax(ji,jj,jk) + rtrn) ) 322 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 323 zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpdmin(ji,jj,jk) ) & 324 & / ( xqpdmax(ji,jj,jk) - xqpdmin(ji,jj,jk) + rtrn ), xlimdfe(ji,jj,jk) ) ) 325 zpronewd(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xdiatno3(ji,jj,jk) 326 zproregd(ji,jj,jk) = zpronmax * xdiatnh4(ji,jj,jk) 327 ! Uptake of phosphorus 328 zrat = MIN( 1., zratiop / (xqpdmax(ji,jj,jk) + rtrn) ) 329 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 330 zpropmax = zprnutmax * zmax * xlimdfe(ji,jj,jk) 331 zpropo4d(ji,jj,jk) = zpropmax * xdiatpo4(ji,jj,jk) 332 zprodopd(ji,jj,jk) = zpropmax * xdiatdop(ji,jj,jk) 333 ! Uptake of iron 334 zrat = MIN( 1., zratiof / qfdmax ) 335 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 336 zprofmax = zprnutmax * qfdmax * zmax 337 zprofed(ji,jj,jk) = zprofmax * xdiatfer(ji,jj,jk) * ( 3. - 2.4 * xlimdfe(ji,jj,jk) & 338 & / ( xlimdfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xdiatno3(ji,jj,jk) / ( rtrn & 339 & + xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) ) * (1. - xdiatfer(ji,jj,jk) ) ) 340 ENDIF 341 END DO 342 END DO 343 END DO 344 345 DO jk = 1, jpkm1 346 DO jj = 1, jpj 347 DO ji = 1, jpi 348 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 349 ! production terms for nanophyto. ( chlorophyll ) 350 znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 351 zprod = rday * (zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)) * zprchln(ji,jj,jk) * xlimphy(ji,jj,jk) 352 thetannm_n = MIN ( thetannm, ( thetannm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm))) & 353 & * (1. - 1.14 / 43.4 * 20.)) 354 zprochln = thetannm_n * zprod / ( zpislopeadn(ji,jj,jk) * znanotot + rtrn ) 355 zprochln = MAX(zprochln, chlcmin * 12. * zprorcan (ji,jj,jk) ) 356 ! production terms for picophyto. ( chlorophyll ) 357 zpicotot = epicom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 358 zprod = rday * (zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)) * zprchlp(ji,jj,jk) * xlimpic(ji,jj,jk) 359 thetanpm_n = MIN ( thetanpm, ( thetanpm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm))) & 360 & * (1. - 1.14 / 43.4 * 20.)) 361 zprochlp = thetanpm_n * zprod / ( zpislopeadp(ji,jj,jk) * zpicotot + rtrn ) 362 zprochlp = MAX(zprochlp, chlcmin * 12. * zprorcap(ji,jj,jk) ) 363 ! production terms for diatomees ( chlorophyll ) 364 zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 365 zprod = rday * (zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)) * zprchld(ji,jj,jk) * xlimdia(ji,jj,jk) 366 thetandm_n = MIN ( thetandm, ( thetandm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm))) & 367 & * (1. - 1.14 / 43.4 * 20.)) 368 zprochld = thetandm_n * zprod / ( zpislopeadd(ji,jj,jk) * zdiattot + rtrn ) 369 zprochld = MAX(zprochld, chlcmin * 12. * zprorcad(ji,jj,jk) ) 370 ! Update the arrays TRA which contain the Chla sources and sinks 371 tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) + zprochln * texcretn 372 tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) + zprochld * texcretd 373 tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) + zprochlp * texcretp 374 ENDIF 375 END DO 376 END DO 377 END DO 283 DO_3D_11_11( 1, jpkm1 ) 284 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 285 ! production terms for diatomees 286 zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr(ji,jj,jk,jpdia,Kbb) * rfact2 287 ! Computation of the respiration term according to pahlow 288 ! & oschlies (2013) 289 ! 290 zration = tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 291 zratiop = tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 292 zratiof = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 293 zprnutmax = zprnut(ji,jj,jk) * fvduptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jpdia,Kbb) * rfact2 294 ! Uptake of nitrogen 295 zrat = MIN( 1., zration / (xqndmax(ji,jj,jk) + rtrn) ) 296 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 297 zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpdmin(ji,jj,jk) ) & 298 & / ( xqpdmax(ji,jj,jk) - xqpdmin(ji,jj,jk) + rtrn ), xlimdfe(ji,jj,jk) ) ) 299 zpronewd(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xdiatno3(ji,jj,jk) 300 zproregd(ji,jj,jk) = zpronmax * xdiatnh4(ji,jj,jk) 301 ! Uptake of phosphorus 302 zrat = MIN( 1., zratiop / (xqpdmax(ji,jj,jk) + rtrn) ) 303 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 304 zpropmax = zprnutmax * zmax * xlimdfe(ji,jj,jk) 305 zpropo4d(ji,jj,jk) = zpropmax * xdiatpo4(ji,jj,jk) 306 zprodopd(ji,jj,jk) = zpropmax * xdiatdop(ji,jj,jk) 307 ! Uptake of iron 308 zrat = MIN( 1., zratiof / qfdmax ) 309 zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 310 zprofmax = zprnutmax * qfdmax * zmax 311 zprofed(ji,jj,jk) = zprofmax * xdiatfer(ji,jj,jk) * ( 3. - 2.4 * xlimdfe(ji,jj,jk) & 312 & / ( xlimdfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xdiatno3(ji,jj,jk) / ( rtrn & 313 & + xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) ) * (1. - xdiatfer(ji,jj,jk) ) ) 314 ENDIF 315 END_3D 316 317 DO_3D_11_11( 1, jpkm1 ) 318 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 319 ! production terms for nanophyto. ( chlorophyll ) 320 znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 321 zprod = rday * (zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)) * zprchln(ji,jj,jk) * xlimphy(ji,jj,jk) 322 thetannm_n = MIN ( thetannm, ( thetannm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm))) & 323 & * (1. - 1.14 / 43.4 * 20.)) 324 zprochln = thetannm_n * zprod / ( zpislopeadn(ji,jj,jk) * znanotot + rtrn ) 325 zprochln = MAX(zprochln, chlcmin * 12. * zprorcan (ji,jj,jk) ) 326 ! production terms for picophyto. ( chlorophyll ) 327 zpicotot = epicom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 328 zprod = rday * (zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)) * zprchlp(ji,jj,jk) * xlimpic(ji,jj,jk) 329 thetanpm_n = MIN ( thetanpm, ( thetanpm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm))) & 330 & * (1. - 1.14 / 43.4 * 20.)) 331 zprochlp = thetanpm_n * zprod / ( zpislopeadp(ji,jj,jk) * zpicotot + rtrn ) 332 zprochlp = MAX(zprochlp, chlcmin * 12. * zprorcap(ji,jj,jk) ) 333 ! production terms for diatomees ( chlorophyll ) 334 zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 335 zprod = rday * (zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)) * zprchld(ji,jj,jk) * xlimdia(ji,jj,jk) 336 thetandm_n = MIN ( thetandm, ( thetandm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm))) & 337 & * (1. - 1.14 / 43.4 * 20.)) 338 zprochld = thetandm_n * zprod / ( zpislopeadd(ji,jj,jk) * zdiattot + rtrn ) 339 zprochld = MAX(zprochld, chlcmin * 12. * zprorcad(ji,jj,jk) ) 340 ! Update the arrays TRA which contain the Chla sources and sinks 341 tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) + zprochln * texcretn 342 tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) + zprochld * texcretd 343 tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) + zprochlp * texcretp 344 ENDIF 345 END_3D 378 346 379 347 ! Update the arrays TRA which contain the biological sources and sinks 380 DO jk = 1, jpkm1 381 DO jj = 1, jpj 382 DO ji =1 ,jpi 383 zprontot = zpronewn(ji,jj,jk) + zproregn(ji,jj,jk) 384 zproptot = zpronewp(ji,jj,jk) + zproregp(ji,jj,jk) 385 zprodtot = zpronewd(ji,jj,jk) + zproregd(ji,jj,jk) 386 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) & 387 & + excretp * zprorcap(ji,jj,jk) 388 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zpropo4n(ji,jj,jk) - zpropo4d(ji,jj,jk) & 389 & - zpropo4p(ji,jj,jk) 390 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk) & 391 & - zpronewp(ji,jj,jk) 392 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zproregn(ji,jj,jk) - zproregd(ji,jj,jk) & 393 & - zproregp(ji,jj,jk) 394 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zprorcan(ji,jj,jk) * texcretn & 395 & - zpsino3 * zpronewn(ji,jj,jk) - zpsinh4 * zproregn(ji,jj,jk) & 396 & - zrespn(ji,jj,jk) 397 zcroissn(ji,jj,jk) = tr(ji,jj,jk,jpphy,Krhs) / rfact2/ (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 398 tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) + zprontot * texcretn 399 tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) + zpropo4n(ji,jj,jk) * texcretn & 400 & + zprodopn(ji,jj,jk) * texcretn 401 tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) + zprofen(ji,jj,jk) * texcretn 402 tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) + zprorcap(ji,jj,jk) * texcretp & 403 & - zpsino3 * zpronewp(ji,jj,jk) - zpsinh4 * zproregp(ji,jj,jk) & 404 & - zrespp(ji,jj,jk) 405 zcroissp(ji,jj,jk) = tr(ji,jj,jk,jppic,Krhs) / rfact2/ (tr(ji,jj,jk,jppic,Kbb) + rtrn) 406 tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) + zproptot * texcretp 407 tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) + zpropo4p(ji,jj,jk) * texcretp & 408 & + zprodopp(ji,jj,jk) * texcretp 409 tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) + zprofep(ji,jj,jk) * texcretp 410 tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) + zprorcad(ji,jj,jk) * texcretd & 411 & - zpsino3 * zpronewd(ji,jj,jk) - zpsinh4 * zproregd(ji,jj,jk) & 412 & - zrespd(ji,jj,jk) 413 zcroissd(ji,jj,jk) = tr(ji,jj,jk,jpdia,Krhs) / rfact2 / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 414 tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) + zprodtot * texcretd 415 tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) + zpropo4d(ji,jj,jk) * texcretd & 416 & + zprodopd(ji,jj,jk) * texcretd 417 tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) + zprofed(ji,jj,jk) * texcretd 418 tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 419 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) & 420 & + excretp * zprorcap(ji,jj,jk) 421 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + excretd * zprodtot + excretn * zprontot & 422 & + excretp * zproptot 423 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + excretd * zpropo4d(ji,jj,jk) + excretn * zpropo4n(ji,jj,jk) & 424 & - texcretn * zprodopn(ji,jj,jk) - texcretd * zprodopd(ji,jj,jk) + excretp * zpropo4p(ji,jj,jk) & 425 & - texcretp * zprodopp(ji,jj,jk) 426 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + o2ut * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk) & 427 & + zproregp(ji,jj,jk) ) + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) & 428 & + zpronewd(ji,jj,jk) + zpronewp(ji,jj,jk) ) & 429 & - o2ut * ( zrespn(ji,jj,jk) + zrespp(ji,jj,jk) + zrespd(ji,jj,jk) ) 430 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) 431 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zfeup 432 tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 433 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) - zprorcap(ji,jj,jk) & 434 & + zpsino3 * zpronewn(ji,jj,jk) + zpsinh4 * zproregn(ji,jj,jk) & 435 & + zpsino3 * zpronewp(ji,jj,jk) + zpsinh4 * zproregp(ji,jj,jk) & 436 & + zpsino3 * zpronewd(ji,jj,jk) + zpsinh4 * zproregd(ji,jj,jk) & 437 & + zrespn(ji,jj,jk) + zrespd(ji,jj,jk) + zrespp(ji,jj,jk) 438 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) & 439 & + zpronewp(ji,jj,jk) ) - rno3 * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk) & 440 & + zproregp(ji,jj,jk) ) 441 END DO 442 END DO 443 END DO 348 DO_3D_11_11( 1, jpkm1 ) 349 zprontot = zpronewn(ji,jj,jk) + zproregn(ji,jj,jk) 350 zproptot = zpronewp(ji,jj,jk) + zproregp(ji,jj,jk) 351 zprodtot = zpronewd(ji,jj,jk) + zproregd(ji,jj,jk) 352 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) & 353 & + excretp * zprorcap(ji,jj,jk) 354 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zpropo4n(ji,jj,jk) - zpropo4d(ji,jj,jk) & 355 & - zpropo4p(ji,jj,jk) 356 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk) & 357 & - zpronewp(ji,jj,jk) 358 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zproregn(ji,jj,jk) - zproregd(ji,jj,jk) & 359 & - zproregp(ji,jj,jk) 360 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zprorcan(ji,jj,jk) * texcretn & 361 & - zpsino3 * zpronewn(ji,jj,jk) - zpsinh4 * zproregn(ji,jj,jk) & 362 & - zrespn(ji,jj,jk) 363 zcroissn(ji,jj,jk) = tr(ji,jj,jk,jpphy,Krhs) / rfact2/ (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 364 tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) + zprontot * texcretn 365 tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) + zpropo4n(ji,jj,jk) * texcretn & 366 & + zprodopn(ji,jj,jk) * texcretn 367 tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) + zprofen(ji,jj,jk) * texcretn 368 tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) + zprorcap(ji,jj,jk) * texcretp & 369 & - zpsino3 * zpronewp(ji,jj,jk) - zpsinh4 * zproregp(ji,jj,jk) & 370 & - zrespp(ji,jj,jk) 371 zcroissp(ji,jj,jk) = tr(ji,jj,jk,jppic,Krhs) / rfact2/ (tr(ji,jj,jk,jppic,Kbb) + rtrn) 372 tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) + zproptot * texcretp 373 tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) + zpropo4p(ji,jj,jk) * texcretp & 374 & + zprodopp(ji,jj,jk) * texcretp 375 tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) + zprofep(ji,jj,jk) * texcretp 376 tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) + zprorcad(ji,jj,jk) * texcretd & 377 & - zpsino3 * zpronewd(ji,jj,jk) - zpsinh4 * zproregd(ji,jj,jk) & 378 & - zrespd(ji,jj,jk) 379 zcroissd(ji,jj,jk) = tr(ji,jj,jk,jpdia,Krhs) / rfact2 / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 380 tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) + zprodtot * texcretd 381 tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) + zpropo4d(ji,jj,jk) * texcretd & 382 & + zprodopd(ji,jj,jk) * texcretd 383 tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) + zprofed(ji,jj,jk) * texcretd 384 tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 385 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) & 386 & + excretp * zprorcap(ji,jj,jk) 387 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + excretd * zprodtot + excretn * zprontot & 388 & + excretp * zproptot 389 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + excretd * zpropo4d(ji,jj,jk) + excretn * zpropo4n(ji,jj,jk) & 390 & - texcretn * zprodopn(ji,jj,jk) - texcretd * zprodopd(ji,jj,jk) + excretp * zpropo4p(ji,jj,jk) & 391 & - texcretp * zprodopp(ji,jj,jk) 392 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + o2ut * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk) & 393 & + zproregp(ji,jj,jk) ) + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) & 394 & + zpronewd(ji,jj,jk) + zpronewp(ji,jj,jk) ) & 395 & - o2ut * ( zrespn(ji,jj,jk) + zrespp(ji,jj,jk) + zrespd(ji,jj,jk) ) 396 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) 397 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zfeup 398 tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 399 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) - zprorcap(ji,jj,jk) & 400 & + zpsino3 * zpronewn(ji,jj,jk) + zpsinh4 * zproregn(ji,jj,jk) & 401 & + zpsino3 * zpronewp(ji,jj,jk) + zpsinh4 * zproregp(ji,jj,jk) & 402 & + zpsino3 * zpronewd(ji,jj,jk) + zpsinh4 * zproregd(ji,jj,jk) & 403 & + zrespn(ji,jj,jk) + zrespd(ji,jj,jk) + zrespp(ji,jj,jk) 404 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) & 405 & + zpronewp(ji,jj,jk) ) - rno3 * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk) & 406 & + zproregp(ji,jj,jk) ) 407 END_3D 444 408 ! 445 409 IF( ln_ligand ) THEN 446 410 zpligprod1(:,:,:) = 0._wp ; zpligprod2(:,:,:) = 0._wp 447 DO jk = 1, jpkm1 448 DO jj = 1, jpj 449 DO ji =1 ,jpi 450 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) + excretp * zprorcap(ji,jj,jk) 451 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) 452 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 453 zpligprod1(ji,jj,jk) = zdocprod * ldocp 454 zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet 455 END DO 456 END DO 457 END DO 411 DO_3D_11_11( 1, jpkm1 ) 412 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) + excretp * zprorcap(ji,jj,jk) 413 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) 414 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 415 zpligprod1(ji,jj,jk) = zdocprod * ldocp 416 zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet 417 END_3D 458 418 ENDIF 459 419 -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/SED/sedchem.F90
r10356 r12340 23 23 REAL(wp), PARAMETER :: pp_rdel_ah_target = 1.E-4_wp 24 24 25 !! * Substitutions 26 # include "do_loop_substitute.h90" 25 27 !! * Module variables 26 28 REAL(wp) :: & … … 136 138 CALL sed_chem_cst 137 139 ELSE 138 DO jj = 1,jpj 139 DO ji = 1, jpi 140 ikt = mbkt(ji,jj) 141 IF ( tmask(ji,jj,ikt) == 1 ) THEN 142 zchem_data(ji,jj,1) = ak13 (ji,jj,ikt) 143 zchem_data(ji,jj,2) = ak23 (ji,jj,ikt) 144 zchem_data(ji,jj,3) = akb3 (ji,jj,ikt) 145 zchem_data(ji,jj,4) = akw3 (ji,jj,ikt) 146 zchem_data(ji,jj,5) = aksp (ji,jj,ikt) 147 zchem_data(ji,jj,6) = borat (ji,jj,ikt) 148 zchem_data(ji,jj,7) = ak1p3 (ji,jj,ikt) 149 zchem_data(ji,jj,8) = ak2p3 (ji,jj,ikt) 150 zchem_data(ji,jj,9) = ak3p3 (ji,jj,ikt) 151 zchem_data(ji,jj,10)= aksi3 (ji,jj,ikt) 152 zchem_data(ji,jj,11)= sio3eq(ji,jj,ikt) 153 zchem_data(ji,jj,12)= aks3 (ji,jj,ikt) 154 zchem_data(ji,jj,13)= akf3 (ji,jj,ikt) 155 zchem_data(ji,jj,14)= sulfat(ji,jj,ikt) 156 zchem_data(ji,jj,15)= fluorid(ji,jj,ikt) 157 ENDIF 158 ENDDO 159 ENDDO 140 DO_2D_11_11 141 ikt = mbkt(ji,jj) 142 IF ( tmask(ji,jj,ikt) == 1 ) THEN 143 zchem_data(ji,jj,1) = ak13 (ji,jj,ikt) 144 zchem_data(ji,jj,2) = ak23 (ji,jj,ikt) 145 zchem_data(ji,jj,3) = akb3 (ji,jj,ikt) 146 zchem_data(ji,jj,4) = akw3 (ji,jj,ikt) 147 zchem_data(ji,jj,5) = aksp (ji,jj,ikt) 148 zchem_data(ji,jj,6) = borat (ji,jj,ikt) 149 zchem_data(ji,jj,7) = ak1p3 (ji,jj,ikt) 150 zchem_data(ji,jj,8) = ak2p3 (ji,jj,ikt) 151 zchem_data(ji,jj,9) = ak3p3 (ji,jj,ikt) 152 zchem_data(ji,jj,10)= aksi3 (ji,jj,ikt) 153 zchem_data(ji,jj,11)= sio3eq(ji,jj,ikt) 154 zchem_data(ji,jj,12)= aks3 (ji,jj,ikt) 155 zchem_data(ji,jj,13)= akf3 (ji,jj,ikt) 156 zchem_data(ji,jj,14)= sulfat(ji,jj,ikt) 157 zchem_data(ji,jj,15)= fluorid(ji,jj,ikt) 158 ENDIF 159 END_2D 160 160 161 161 CALL pack_arr ( jpoce, ak1s (1:jpoce), zchem_data(1:jpi,1:jpj,1) , iarroce(1:jpoce) ) -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/SED/seddta.F90
r11949 r12340 22 22 REAL(wp) :: conv2 ! [kg/m2/month]-->[g/cm2/s] ( 1 month has 30 days ) 23 23 24 !! * Substitutions 25 # include "do_loop_substitute.h90" 24 26 !! $Id$ 25 27 CONTAINS … … 93 95 ! ----------------------------------------------------------- 94 96 IF (ln_sediment_offline) THEN 95 DO jj = 1, jpj 96 DO ji = 1, jpi 97 ikt = mbkt(ji,jj) 98 zwsbio4(ji,jj) = wsbio2 / rday 99 zwsbio3(ji,jj) = wsbio / rday 100 END DO 101 END DO 97 DO_2D_11_11 98 ikt = mbkt(ji,jj) 99 zwsbio4(ji,jj) = wsbio2 / rday 100 zwsbio3(ji,jj) = wsbio / rday 101 END_2D 102 102 ELSE 103 DO jj = 1, jpj 104 DO ji = 1, jpi 105 ikt = mbkt(ji,jj) 106 zdep = e3t(ji,jj,ikt,Kmm) / r2dttrc 107 zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) / rday ) 108 zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) / rday ) 109 END DO 110 END DO 103 DO_2D_11_11 104 ikt = mbkt(ji,jj) 105 zdep = e3t(ji,jj,ikt,Kmm) / r2dttrc 106 zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) / rday ) 107 zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) / rday ) 108 END_2D 111 109 ENDIF 112 110 113 111 trc_data(:,:,:) = 0. 114 DO jj = 1,jpj 115 DO ji = 1, jpi 116 ikt = mbkt(ji,jj) 117 IF ( tmask(ji,jj,ikt) == 1 ) THEN 118 trc_data(ji,jj,1) = tr(ji,jj,ikt,jpsil,Kbb) 119 trc_data(ji,jj,2) = tr(ji,jj,ikt,jpoxy,Kbb) 120 trc_data(ji,jj,3) = tr(ji,jj,ikt,jpdic,Kbb) 121 trc_data(ji,jj,4) = tr(ji,jj,ikt,jpno3,Kbb) / 7.625 122 trc_data(ji,jj,5) = tr(ji,jj,ikt,jppo4,Kbb) / 122. 123 trc_data(ji,jj,6) = tr(ji,jj,ikt,jptal,Kbb) 124 trc_data(ji,jj,7) = tr(ji,jj,ikt,jpnh4,Kbb) / 7.625 125 trc_data(ji,jj,8) = 0.0 126 trc_data(ji,jj,9) = 28.0E-3 127 trc_data(ji,jj,10) = tr(ji,jj,ikt,jpfer,Kbb) 128 trc_data(ji,jj,11 ) = MIN(tr(ji,jj,ikt,jpgsi,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 129 trc_data(ji,jj,12 ) = MIN(tr(ji,jj,ikt,jppoc,Kbb), 1E-4) * zwsbio3(ji,jj) * 1E3 130 trc_data(ji,jj,13 ) = MIN(tr(ji,jj,ikt,jpgoc,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 131 trc_data(ji,jj,14) = MIN(tr(ji,jj,ikt,jpcal,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 132 trc_data(ji,jj,15) = ts(ji,jj,ikt,jp_tem,Kmm) 133 trc_data(ji,jj,16) = ts(ji,jj,ikt,jp_sal,Kmm) 134 trc_data(ji,jj,17 ) = ( tr(ji,jj,ikt,jpsfe,Kbb) * zwsbio3(ji,jj) + tr(ji,jj,ikt,jpbfe,Kbb) & 135 & * zwsbio4(ji,jj) ) * 1E3 / ( trc_data(ji,jj,12 ) + trc_data(ji,jj,13 ) + rtrn ) 136 trc_data(ji,jj,17 ) = MIN(1E-3, trc_data(ji,jj,17 ) ) 137 ENDIF 138 ENDDO 139 ENDDO 112 DO_2D_11_11 113 ikt = mbkt(ji,jj) 114 IF ( tmask(ji,jj,ikt) == 1 ) THEN 115 trc_data(ji,jj,1) = tr(ji,jj,ikt,jpsil,Kbb) 116 trc_data(ji,jj,2) = tr(ji,jj,ikt,jpoxy,Kbb) 117 trc_data(ji,jj,3) = tr(ji,jj,ikt,jpdic,Kbb) 118 trc_data(ji,jj,4) = tr(ji,jj,ikt,jpno3,Kbb) / 7.625 119 trc_data(ji,jj,5) = tr(ji,jj,ikt,jppo4,Kbb) / 122. 120 trc_data(ji,jj,6) = tr(ji,jj,ikt,jptal,Kbb) 121 trc_data(ji,jj,7) = tr(ji,jj,ikt,jpnh4,Kbb) / 7.625 122 trc_data(ji,jj,8) = 0.0 123 trc_data(ji,jj,9) = 28.0E-3 124 trc_data(ji,jj,10) = tr(ji,jj,ikt,jpfer,Kbb) 125 trc_data(ji,jj,11 ) = MIN(tr(ji,jj,ikt,jpgsi,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 126 trc_data(ji,jj,12 ) = MIN(tr(ji,jj,ikt,jppoc,Kbb), 1E-4) * zwsbio3(ji,jj) * 1E3 127 trc_data(ji,jj,13 ) = MIN(tr(ji,jj,ikt,jpgoc,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 128 trc_data(ji,jj,14) = MIN(tr(ji,jj,ikt,jpcal,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 129 trc_data(ji,jj,15) = ts(ji,jj,ikt,jp_tem,Kmm) 130 trc_data(ji,jj,16) = ts(ji,jj,ikt,jp_sal,Kmm) 131 trc_data(ji,jj,17 ) = ( tr(ji,jj,ikt,jpsfe,Kbb) * zwsbio3(ji,jj) + tr(ji,jj,ikt,jpbfe,Kbb) & 132 & * zwsbio4(ji,jj) ) * 1E3 / ( trc_data(ji,jj,12 ) + trc_data(ji,jj,13 ) + rtrn ) 133 trc_data(ji,jj,17 ) = MIN(1E-3, trc_data(ji,jj,17 ) ) 134 ENDIF 135 END_2D 140 136 141 137 ! Pore water initial concentration [mol/l] in k=1 -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/SED/sedini.F90
r11960 r12340 22 22 PRIVATE 23 23 24 !! * Substitutions 25 # include "do_loop_substitute.h90" 24 26 !! Module variables 25 27 REAL(wp) :: & … … 133 135 ! Determination of sediments number of points and allocate global variables 134 136 epkbot(:,:) = 0. 135 DO jj = 1, jpj 136 DO ji = 1, jpi 137 ikt = mbkt(ji,jj) 138 IF( tmask(ji,jj,ikt) == 1 ) epkbot(ji,jj) = e3t_1d(ikt) 139 gdepbot(ji,jj) = gdepw_0(ji,jj,ikt) 140 ENDDO 141 ENDDO 137 DO_2D_11_11 138 ikt = mbkt(ji,jj) 139 IF( tmask(ji,jj,ikt) == 1 ) epkbot(ji,jj) = e3t_1d(ikt) 140 gdepbot(ji,jj) = gdepw_0(ji,jj,ikt) 141 END_2D 142 142 143 143 ! computation of total number of ocean points … … 247 247 ! Computation of 1D array of sediments points 248 248 indoce = 0 249 DO jj = 1, jpj 250 DO ji = 1, jpi 251 IF ( epkbot(ji,jj) > 0. ) THEN 252 indoce = indoce + 1 253 iarroce(indoce) = (jj - 1) * jpi + ji 254 ENDIF 255 END DO 256 END DO 249 DO_2D_11_11 250 IF ( epkbot(ji,jj) > 0. ) THEN 251 indoce = indoce + 1 252 iarroce(indoce) = (jj - 1) * jpi + ji 253 ENDIF 254 END_2D 257 255 258 256 IF ( indoce .EQ. 0 ) THEN -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/SED/sedsfc.F90
r11949 r12340 11 11 PUBLIC sed_sfc 12 12 13 !! * Substitutions 14 # include "do_loop_substitute.h90" 13 15 !! $Id$ 14 16 CONTAINS … … 46 48 47 49 48 DO jj = 1,jpj 49 DO ji = 1, jpi 50 ikt = mbkt(ji,jj) 51 IF ( tmask(ji,jj,ikt) == 1 ) THEN 52 tr(ji,jj,ikt,jptal,Kbb) = trc_data(ji,jj,1) 53 tr(ji,jj,ikt,jpdic,Kbb) = trc_data(ji,jj,2) 54 tr(ji,jj,ikt,jpno3,Kbb) = trc_data(ji,jj,3) * 7.625 55 tr(ji,jj,ikt,jppo4,Kbb) = trc_data(ji,jj,4) * 122. 56 tr(ji,jj,ikt,jpoxy,Kbb) = trc_data(ji,jj,5) 57 tr(ji,jj,ikt,jpsil,Kbb) = trc_data(ji,jj,6) 58 tr(ji,jj,ikt,jpnh4,Kbb) = trc_data(ji,jj,7) * 7.625 59 tr(ji,jj,ikt,jpfer,Kbb) = trc_data(ji,jj,8) 60 ENDIF 61 ENDDO 62 ENDDO 50 DO_2D_11_11 51 ikt = mbkt(ji,jj) 52 IF ( tmask(ji,jj,ikt) == 1 ) THEN 53 tr(ji,jj,ikt,jptal,Kbb) = trc_data(ji,jj,1) 54 tr(ji,jj,ikt,jpdic,Kbb) = trc_data(ji,jj,2) 55 tr(ji,jj,ikt,jpno3,Kbb) = trc_data(ji,jj,3) * 7.625 56 tr(ji,jj,ikt,jppo4,Kbb) = trc_data(ji,jj,4) * 122. 57 tr(ji,jj,ikt,jpoxy,Kbb) = trc_data(ji,jj,5) 58 tr(ji,jj,ikt,jpsil,Kbb) = trc_data(ji,jj,6) 59 tr(ji,jj,ikt,jpnh4,Kbb) = trc_data(ji,jj,7) * 7.625 60 tr(ji,jj,ikt,jpfer,Kbb) = trc_data(ji,jj,8) 61 ENDIF 62 END_2D 63 63 64 64 IF( ln_timing ) CALL timing_stop('sed_sfc') -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/SED/trcdmp_sed.F90
r12236 r12340 36 36 !! * Substitutions 37 37 # include "vectopt_loop_substitute.h90" 38 # include "do_loop_substitute.h90" 38 39 !!---------------------------------------------------------------------- 39 40 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 93 94 CALL trc_dta( kt, Kmm, sf_trcdta(jl), rf_trfac(jl), ztrcdta ) ! read tracer data at nit000 94 95 ! 95 DO jj = 1, jpj 96 DO ji = 1, jpi ! vector opt. 97 ikt = mbkt(ji,jj) 98 tr(ji,jj,ikt,jn,Kbb) = ztrcdta(ji,jj,ikt) + ( tr(ji,jj,ikt,jn,Kbb) - ztrcdta(ji,jj,ikt) ) & 99 & * exp( -restosed(ji,jj,ikt) * dtsed ) 100 END DO 101 END DO 96 DO_2D_11_11 97 ikt = mbkt(ji,jj) 98 tr(ji,jj,ikt,jn,Kbb) = ztrcdta(ji,jj,ikt) + ( tr(ji,jj,ikt,jn,Kbb) - ztrcdta(ji,jj,ikt) ) & 99 & * exp( -restosed(ji,jj,ikt) * dtsed ) 100 END_2D 102 101 ! 103 102 ENDIF -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/trcwri_pisces.F90
r11949 r12340 19 19 PUBLIC trc_wri_pisces 20 20 21 !! * Substitutions 22 # include "do_loop_substitute.h90" 21 23 !!---------------------------------------------------------------------- 22 24 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 66 68 zo2min (:,:) = tr(:,:,1,jpoxy,Kmm) * tmask(:,:,1) 67 69 zdepo2min(:,:) = gdepw(:,:,1,Kmm) * tmask(:,:,1) 68 DO jk = 2, jpkm1 69 DO jj = 1, jpj 70 DO ji = 1, jpi 71 IF( tmask(ji,jj,jk) == 1 ) then 72 IF( tr(ji,jj,jk,jpoxy,Kmm) < zo2min(ji,jj) ) then 73 zo2min (ji,jj) = tr(ji,jj,jk,jpoxy,Kmm) 74 zdepo2min(ji,jj) = gdepw(ji,jj,jk,Kmm) 75 ENDIF 76 ENDIF 77 END DO 78 END DO 79 END DO 70 DO_3D_11_11( 2, jpkm1 ) 71 IF( tmask(ji,jj,jk) == 1 ) then 72 IF( tr(ji,jj,jk,jpoxy,Kmm) < zo2min(ji,jj) ) then 73 zo2min (ji,jj) = tr(ji,jj,jk,jpoxy,Kmm) 74 zdepo2min(ji,jj) = gdepw(ji,jj,jk,Kmm) 75 ENDIF 76 ENDIF 77 END_3D 80 78 ! 81 79 CALL iom_put('O2MIN' , zo2min ) ! oxygen minimum concentration -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/TRP/trcatf.F90
r12236 r12340 48 48 REAL(wp) :: rfact1, rfact2 49 49 50 !! * Substitutions 51 # include "do_loop_substitute.h90" 50 52 !!---------------------------------------------------------------------- 51 53 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 227 229 ! 228 230 DO jn = 1, jptra 229 DO jk = 1, jpkm1 230 DO jj = 1, jpj 231 DO ji = 1, jpi 232 ze3t_b = e3t(ji,jj,jk,Kbb) 233 ze3t_n = e3t(ji,jj,jk,Kmm) 234 ze3t_a = e3t(ji,jj,jk,Kaa) 235 ! ! tracer content at Before, now and after 236 ztc_b = ptr(ji,jj,jk,jn,Kbb) * ze3t_b 237 ztc_n = ptr(ji,jj,jk,jn,Kmm) * ze3t_n 238 ztc_a = ptr(ji,jj,jk,jn,Kaa) * ze3t_a 239 ! 240 ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b 241 ztc_d = ztc_a - 2. * ztc_n + ztc_b 242 ! 243 ze3t_f = ze3t_n + atfp * ze3t_d 244 ztc_f = ztc_n + atfp * ztc_d 245 ! 246 IF( .NOT. ln_linssh .AND. jk == mikt(ji,jj) ) THEN ! first level 247 ze3t_f = ze3t_f - rfact2 * ( emp_b(ji,jj) - emp(ji,jj) ) 248 ztc_f = ztc_f - rfact1 * ( sbc_trc(ji,jj,jn) - sbc_trc_b(ji,jj,jn) ) 249 ENDIF 250 251 ze3t_f = 1.e0 / ze3t_f 252 ptr(ji,jj,jk,jn,Kmm) = ztc_f * ze3t_f ! time filtered "now" field 253 ! 254 END DO 255 END DO 256 END DO 231 DO_3D_11_11( 1, jpkm1 ) 232 ze3t_b = e3t(ji,jj,jk,Kbb) 233 ze3t_n = e3t(ji,jj,jk,Kmm) 234 ze3t_a = e3t(ji,jj,jk,Kaa) 235 ! ! tracer content at Before, now and after 236 ztc_b = ptr(ji,jj,jk,jn,Kbb) * ze3t_b 237 ztc_n = ptr(ji,jj,jk,jn,Kmm) * ze3t_n 238 ztc_a = ptr(ji,jj,jk,jn,Kaa) * ze3t_a 239 ! 240 ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b 241 ztc_d = ztc_a - 2. * ztc_n + ztc_b 242 ! 243 ze3t_f = ze3t_n + atfp * ze3t_d 244 ztc_f = ztc_n + atfp * ztc_d 245 ! 246 IF( .NOT. ln_linssh .AND. jk == mikt(ji,jj) ) THEN ! first level 247 ze3t_f = ze3t_f - rfact2 * ( emp_b(ji,jj) - emp(ji,jj) ) 248 ztc_f = ztc_f - rfact1 * ( sbc_trc(ji,jj,jn) - sbc_trc_b(ji,jj,jn) ) 249 ENDIF 250 251 ze3t_f = 1.e0 / ze3t_f 252 ptr(ji,jj,jk,jn,Kmm) = ztc_f * ze3t_f ! time filtered "now" field 253 ! 254 END_3D 257 255 ! 258 256 END DO -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/TRP/trcdmp.F90
r12236 r12340 45 45 !! * Substitutions 46 46 # include "vectopt_loop_substitute.h90" 47 # include "do_loop_substitute.h90" 47 48 !!---------------------------------------------------------------------- 48 49 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 112 113 ! 113 114 CASE( 0 ) !== newtonian damping throughout the water column ==! 114 DO jk = 1, jpkm1 115 DO jj = 2, jpjm1 116 DO ji = fs_2, fs_jpim1 ! vector opt. 117 ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) ) 118 END DO 119 END DO 120 END DO 115 DO_3D_00_00( 1, jpkm1 ) 116 ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) ) 117 END_3D 121 118 ! 122 119 CASE ( 1 ) !== no damping in the turbocline (avt > 5 cm2/s) ==! 123 DO jk = 1, jpkm1 124 DO jj = 2, jpjm1 125 DO ji = fs_2, fs_jpim1 ! vector opt. 126 IF( avt(ji,jj,jk) <= avt_c ) THEN 127 ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) ) 128 ENDIF 129 END DO 130 END DO 131 END DO 120 DO_3D_00_00( 1, jpkm1 ) 121 IF( avt(ji,jj,jk) <= avt_c ) THEN 122 ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) ) 123 ENDIF 124 END_3D 132 125 ! 133 126 CASE ( 2 ) !== no damping in the mixed layer ==! 134 DO jk = 1, jpkm1 135 DO jj = 2, jpjm1 136 DO ji = fs_2, fs_jpim1 ! vector opt. 137 IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 138 ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) ) 139 END IF 140 END DO 141 END DO 142 END DO 127 DO_3D_00_00( 1, jpkm1 ) 128 IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 129 ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) ) 130 END IF 131 END_3D 143 132 ! 144 133 END SELECT -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/TRP/trcldf.F90
r12236 r12340 44 44 !! * Substitutions 45 45 # include "vectopt_loop_substitute.h90" 46 # include "do_loop_substitute.h90" 46 47 !!---------------------------------------------------------------------- 47 48 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 81 82 zahv(:,:,:) = rldf * ahtv(:,:,:) 82 83 ! !* Enhanced zonal diffusivity coefficent in the equatorial domain 83 DO jk= 1, jpk 84 DO jj = 1, jpj 85 DO ji = 1, jpi 86 IF( gdept(ji,jj,jk,Kmm) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN 87 zdep = MAX( gdept(ji,jj,jk,Kmm) - 1000., 0. ) / 1000. 88 zahu(ji,jj,jk) = zahu(ji,jj,jk) * MAX( 1., rn_fact_lap * EXP( -zdep ) ) 89 ENDIF 90 END DO 91 END DO 92 END DO 84 DO_3D_11_11( 1, jpk ) 85 IF( gdept(ji,jj,jk,Kmm) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN 86 zdep = MAX( gdept(ji,jj,jk,Kmm) - 1000., 0. ) / 1000. 87 zahu(ji,jj,jk) = zahu(ji,jj,jk) * MAX( 1., rn_fact_lap * EXP( -zdep ) ) 88 ENDIF 89 END_3D 93 90 ! 94 91 SELECT CASE ( nldf_trc ) !* compute lateral mixing trend and add it to the general trend -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/TRP/trcrad.F90
r12236 r12340 31 31 REAL(wp), DIMENSION(:,:), ALLOCATABLE:: gainmass 32 32 33 !! * Substitutions 34 # include "do_loop_substitute.h90" 33 35 !!---------------------------------------------------------------------- 34 36 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 166 168 IF( l_trdtrc ) ztrtrd(:,:,:) = ptr(:,:,:,jn,itime) ! save input tr(:,:,:,:,Kbb) for trend computation 167 169 ! 168 DO jk = 1, jpkm1 169 DO jj = 1, jpj 170 DO ji = 1, jpi 171 IF( ztrneg(ji,jj,jn) /= 0. ) THEN ! if negative values over the 3x3 box 172 ! 173 ptr(ji,jj,jk,jn,itime) = ptr(ji,jj,jk,jn,itime) * tmask(ji,jj,jk) ! really needed? 174 IF( ptr(ji,jj,jk,jn,itime) < 0. ) ptr(ji,jj,jk,jn,itime) = 0. ! suppress negative values 175 IF( ptr(ji,jj,jk,jn,itime) > 0. ) THEN ! use positive values to compensate mass gain 176 zcoef = 1. + ztrneg(ji,jj,jn) / ztrpos(ji,jj,jn) ! ztrpos > 0 as ptr > 0 177 ptr(ji,jj,jk,jn,itime) = ptr(ji,jj,jk,jn,itime) * zcoef 178 IF( zcoef < 0. ) THEN ! if the compensation exceed the positive value 179 gainmass(jn,1) = gainmass(jn,1) - ptr(ji,jj,jk,jn,itime) * cvol(ji,jj,jk) ! we are adding mass... 180 ptr(ji,jj,jk,jn,itime) = 0. ! limit the compensation to keep positive value 181 ENDIF 182 ENDIF 183 ! 170 DO_3D_11_11( 1, jpkm1 ) 171 IF( ztrneg(ji,jj,jn) /= 0. ) THEN ! if negative values over the 3x3 box 172 ! 173 ptr(ji,jj,jk,jn,itime) = ptr(ji,jj,jk,jn,itime) * tmask(ji,jj,jk) ! really needed? 174 IF( ptr(ji,jj,jk,jn,itime) < 0. ) ptr(ji,jj,jk,jn,itime) = 0. ! suppress negative values 175 IF( ptr(ji,jj,jk,jn,itime) > 0. ) THEN ! use positive values to compensate mass gain 176 zcoef = 1. + ztrneg(ji,jj,jn) / ztrpos(ji,jj,jn) ! ztrpos > 0 as ptr > 0 177 ptr(ji,jj,jk,jn,itime) = ptr(ji,jj,jk,jn,itime) * zcoef 178 IF( zcoef < 0. ) THEN ! if the compensation exceed the positive value 179 gainmass(jn,1) = gainmass(jn,1) - ptr(ji,jj,jk,jn,itime) * cvol(ji,jj,jk) ! we are adding mass... 180 ptr(ji,jj,jk,jn,itime) = 0. ! limit the compensation to keep positive value 184 181 ENDIF 185 END DO 186 END DO 187 END DO 182 ENDIF 183 ! 184 ENDIF 185 END_3D 188 186 ! 189 187 IF( l_trdtrc ) THEN -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/TRP/trcsbc.F90
r12236 r12340 30 30 !! * Substitutions 31 31 # include "vectopt_loop_substitute.h90" 32 # include "do_loop_substitute.h90" 32 33 !!---------------------------------------------------------------------- 33 34 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 120 121 ! 121 122 DO jn = 1, jptra 122 DO jj = 2, jpj 123 DO ji = fs_2, fs_jpim1 ! vector opt. 124 sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rau0 * ptr(ji,jj,1,jn,Kmm) 125 END DO 126 END DO 123 DO_2D_01_00 124 sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rau0 * ptr(ji,jj,1,jn,Kmm) 125 END_2D 127 126 END DO 128 127 ! … … 130 129 ! 131 130 DO jn = 1, jptra 132 DO jj = 2, jpj 133 DO ji = fs_2, fs_jpim1 ! vector opt. 134 sbc_trc(ji,jj,jn) = ( zsfx(ji,jj) + fmmflx(ji,jj) ) * r1_rau0 * ptr(ji,jj,1,jn,Kmm) 135 END DO 136 END DO 131 DO_2D_01_00 132 sbc_trc(ji,jj,jn) = ( zsfx(ji,jj) + fmmflx(ji,jj) ) * r1_rau0 * ptr(ji,jj,1,jn,Kmm) 133 END_2D 137 134 END DO 138 135 ! … … 140 137 ! 141 138 DO jn = 1, jptra 142 DO jj = 2, jpj 143 DO ji = fs_2, fs_jpim1 ! vector opt. 144 zse3t = 1. / e3t(ji,jj,1,Kmm) 145 ! tracer flux at the ice/ocean interface (tracer/m2/s) 146 zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice 147 ! ! only used in the levitating sea ice case 148 ! tracer flux only : add concentration dilution term in net tracer flux, no F-M in volume flux 149 ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux 150 ztfx = zftra ! net tracer flux 151 ! 152 zdtra = r1_rau0 * ( ztfx + ( zsfx(ji,jj) + fmmflx(ji,jj) ) * ptr(ji,jj,1,jn,Kmm) ) 153 IF ( zdtra < 0. ) THEN 154 zdtra = MAX(zdtra, -ptr(ji,jj,1,jn,Kmm) * e3t(ji,jj,1,Kmm) / r2dttrc ) ! avoid negative concentrations to arise 155 ENDIF 156 sbc_trc(ji,jj,jn) = zdtra 157 END DO 158 END DO 139 DO_2D_01_00 140 zse3t = 1. / e3t(ji,jj,1,Kmm) 141 ! tracer flux at the ice/ocean interface (tracer/m2/s) 142 zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice 143 ! ! only used in the levitating sea ice case 144 ! tracer flux only : add concentration dilution term in net tracer flux, no F-M in volume flux 145 ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux 146 ztfx = zftra ! net tracer flux 147 ! 148 zdtra = r1_rau0 * ( ztfx + ( zsfx(ji,jj) + fmmflx(ji,jj) ) * ptr(ji,jj,1,jn,Kmm) ) 149 IF ( zdtra < 0. ) THEN 150 zdtra = MAX(zdtra, -ptr(ji,jj,1,jn,Kmm) * e3t(ji,jj,1,Kmm) / r2dttrc ) ! avoid negative concentrations to arise 151 ENDIF 152 sbc_trc(ji,jj,jn) = zdtra 153 END_2D 159 154 END DO 160 155 END SELECT … … 166 161 IF( l_trdtrc ) ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) ! save trends 167 162 ! 168 DO jj = 2, jpj 169 DO ji = fs_2, fs_jpim1 ! vector opt. 170 zse3t = zfact / e3t(ji,jj,1,Kmm) 171 ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t 172 END DO 173 END DO 163 DO_2D_01_00 164 zse3t = zfact / e3t(ji,jj,1,Kmm) 165 ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t 166 END_2D 174 167 ! 175 168 IF( l_trdtrc ) THEN -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/TRP/trcsink.F90
r11960 r12340 24 24 INTEGER, PUBLIC :: nitermax !: Maximum number of iterations for sinking 25 25 26 !! * Substitutions 27 # include "do_loop_substitute.h90" 26 28 !!---------------------------------------------------------------------- 27 29 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 71 73 iiter(:,:) = 1 72 74 ELSE 73 DO jj = 1, jpj 74 DO ji = 1, jpi 75 iiter(ji,jj) = 1 76 DO jk = 1, jpkm1 77 IF( tmask(ji,jj,jk) == 1.0 ) THEN 78 zwsmax = 0.5 * e3t(ji,jj,jk,Kmm) * rday / rsfact 79 iiter(ji,jj) = MAX( iiter(ji,jj), INT( pwsink(ji,jj,jk) / zwsmax ) ) 80 ENDIF 81 END DO 82 END DO 83 END DO 75 DO_2D_11_11 76 iiter(ji,jj) = 1 77 DO jk = 1, jpkm1 78 IF( tmask(ji,jj,jk) == 1.0 ) THEN 79 zwsmax = 0.5 * e3t(ji,jj,jk,Kmm) * rday / rsfact 80 iiter(ji,jj) = MAX( iiter(ji,jj), INT( pwsink(ji,jj,jk) / zwsmax ) ) 81 ENDIF 82 END DO 83 END_2D 84 84 iiter(:,:) = MIN( iiter(:,:), nitermax ) 85 85 ENDIF 86 86 87 DO jk = 1,jpkm1 88 DO jj = 1, jpj 89 DO ji = 1, jpi 90 IF( tmask(ji,jj,jk) == 1.0 ) THEN 91 zwsmax = 0.5 * e3t(ji,jj,jk,Kmm) * rday / rsfact 92 zwsink(ji,jj,jk) = MIN( pwsink(ji,jj,jk), zwsmax * REAL( iiter(ji,jj), wp ) ) 93 ELSE 94 ! provide a default value so there is no use of undefinite value in trc_sink2 for zwsink2 initialization 95 zwsink(ji,jj,jk) = 0. 96 ENDIF 97 END DO 98 END DO 99 END DO 87 DO_3D_11_11( 1,jpkm1 ) 88 IF( tmask(ji,jj,jk) == 1.0 ) THEN 89 zwsmax = 0.5 * e3t(ji,jj,jk,Kmm) * rday / rsfact 90 zwsink(ji,jj,jk) = MIN( pwsink(ji,jj,jk), zwsmax * REAL( iiter(ji,jj), wp ) ) 91 ELSE 92 ! provide a default value so there is no use of undefinite value in trc_sink2 for zwsink2 initialization 93 zwsink(ji,jj,jk) = 0. 94 ENDIF 95 END_3D 100 96 101 97 ! Initializa to zero all the sinking arrays … … 149 145 DO jn = 1, 2 150 146 ! first guess of the slopes interior values 151 DO jj = 1, jpj 152 DO ji = 1, jpi 153 ! 154 zstep = rsfact / REAL( kiter(ji,jj), wp ) / 2. 155 ! 156 DO jk = 2, jpkm1 157 ztraz(ji,jj,jk) = ( tr(ji,jj,jk-1,jp_tra,Kbb) - tr(ji,jj,jk,jp_tra,Kbb) ) * tmask(ji,jj,jk) 158 END DO 159 ztraz(ji,jj,1 ) = 0.0 160 ztraz(ji,jj,jpk) = 0.0 161 162 ! slopes 163 DO jk = 2, jpkm1 164 zign = 0.25 + SIGN( 0.25, ztraz(ji,jj,jk) * ztraz(ji,jj,jk+1) ) 165 zakz(ji,jj,jk) = ( ztraz(ji,jj,jk) + ztraz(ji,jj,jk+1) ) * zign 166 END DO 167 168 ! Slopes limitation 169 DO jk = 2, jpkm1 170 zakz(ji,jj,jk) = SIGN( 1., zakz(ji,jj,jk) ) * & 171 & MIN( ABS( zakz(ji,jj,jk) ), 2. * ABS(ztraz(ji,jj,jk+1)), 2. * ABS(ztraz(ji,jj,jk) ) ) 172 END DO 173 174 ! vertical advective flux 175 DO jk = 1, jpkm1 176 zigma = zwsink2(ji,jj,jk+1) * zstep / e3w(ji,jj,jk+1,Kmm) 177 zew = zwsink2(ji,jj,jk+1) 178 psinkflx(ji,jj,jk+1) = -zew * ( tr(ji,jj,jk,jp_tra,Kbb) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep 179 END DO 180 ! 181 ! Boundary conditions 182 psinkflx(ji,jj,1 ) = 0.e0 183 psinkflx(ji,jj,jpk) = 0.e0 184 185 DO jk=1,jpkm1 186 zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 187 tr(ji,jj,jk,jp_tra,Kbb) = tr(ji,jj,jk,jp_tra,Kbb) + zflx 188 END DO 189 END DO 190 END DO 147 DO_2D_11_11 148 ! 149 zstep = rsfact / REAL( kiter(ji,jj), wp ) / 2. 150 ! 151 DO jk = 2, jpkm1 152 ztraz(ji,jj,jk) = ( tr(ji,jj,jk-1,jp_tra,Kbb) - tr(ji,jj,jk,jp_tra,Kbb) ) * tmask(ji,jj,jk) 153 END DO 154 ztraz(ji,jj,1 ) = 0.0 155 ztraz(ji,jj,jpk) = 0.0 156 157 ! slopes 158 DO jk = 2, jpkm1 159 zign = 0.25 + SIGN( 0.25, ztraz(ji,jj,jk) * ztraz(ji,jj,jk+1) ) 160 zakz(ji,jj,jk) = ( ztraz(ji,jj,jk) + ztraz(ji,jj,jk+1) ) * zign 161 END DO 162 163 ! Slopes limitation 164 DO jk = 2, jpkm1 165 zakz(ji,jj,jk) = SIGN( 1., zakz(ji,jj,jk) ) * & 166 & MIN( ABS( zakz(ji,jj,jk) ), 2. * ABS(ztraz(ji,jj,jk+1)), 2. * ABS(ztraz(ji,jj,jk) ) ) 167 END DO 168 169 ! vertical advective flux 170 DO jk = 1, jpkm1 171 zigma = zwsink2(ji,jj,jk+1) * zstep / e3w(ji,jj,jk+1,Kmm) 172 zew = zwsink2(ji,jj,jk+1) 173 psinkflx(ji,jj,jk+1) = -zew * ( tr(ji,jj,jk,jp_tra,Kbb) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep 174 END DO 175 ! 176 ! Boundary conditions 177 psinkflx(ji,jj,1 ) = 0.e0 178 psinkflx(ji,jj,jpk) = 0.e0 179 180 DO jk=1,jpkm1 181 zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 182 tr(ji,jj,jk,jp_tra,Kbb) = tr(ji,jj,jk,jp_tra,Kbb) + zflx 183 END DO 184 END_2D 191 185 END DO 192 186 193 DO jk = 1,jpkm1 194 DO jj = 1,jpj 195 DO ji = 1, jpi 196 zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 197 ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx 198 END DO 199 END DO 200 END DO 187 DO_3D_11_11( 1,jpkm1 ) 188 zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 189 ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx 190 END_3D 201 191 202 192 tr(:,:,:,jp_tra,Kbb) = ztrb(:,:,:) -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/TRP/trdmxl_trc.F90
r11949 r12340 49 49 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: ztmltrd2 ! 50 50 51 !! * Substitutions 52 # include "do_loop_substitute.h90" 51 53 !!---------------------------------------------------------------------- 52 54 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 122 124 123 125 IF( jpktrd_trc < jpk ) THEN ! description ??? 124 DO jj = 1, jpj 125 DO ji = 1, jpi 126 IF( nmld_trc(ji,jj) <= jpktrd_trc ) THEN 127 zvlmsk(ji,jj) = tmask(ji,jj,1) 128 ELSE 129 isum = isum + 1 130 zvlmsk(ji,jj) = 0.e0 131 ENDIF 132 END DO 133 END DO 126 DO_2D_11_11 127 IF( nmld_trc(ji,jj) <= jpktrd_trc ) THEN 128 zvlmsk(ji,jj) = tmask(ji,jj,1) 129 ELSE 130 isum = isum + 1 131 zvlmsk(ji,jj) = 0.e0 132 ENDIF 133 END_2D 134 134 ENDIF 135 135 … … 147 147 ! ... Weights for vertical averaging 148 148 wkx_trc(:,:,:) = 0.e0 149 DO jk = 1, jpktrd_trc ! initialize wkx_trc with vertical scale factor in mixed-layer 150 DO jj = 1, jpj 151 DO ji = 1, jpi 152 IF( jk - nmld_trc(ji,jj) < 0 ) wkx_trc(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 153 END DO 154 END DO 155 END DO 149 DO_3D_11_11( 1, jpktrd_trc ) 150 IF( jk - nmld_trc(ji,jj) < 0 ) wkx_trc(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 151 END_3D 156 152 157 153 rmld_trc(:,:) = 0.e0 … … 262 258 ! 263 259 DO jn = 1, jptra 264 DO jj = 1, jpj 265 DO ji = 1, jpi 266 ik = nmld_trc(ji,jj) 267 IF( ln_trdtrc(jn) ) & 268 tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - avs(ji,jj,ik) / e3w(ji,jj,ik,Kmm) * tmask(ji,jj,ik) & 269 & * ( tr(ji,jj,ik-1,jn,Kmm) - tr(ji,jj,ik,jn,Kmm) ) & 270 & / MAX( 1., rmld_trc(ji,jj) ) * tmask(ji,jj,1) 271 END DO 272 END DO 260 DO_2D_11_11 261 ik = nmld_trc(ji,jj) 262 IF( ln_trdtrc(jn) ) & 263 tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - avs(ji,jj,ik) / e3w(ji,jj,ik,Kmm) * tmask(ji,jj,ik) & 264 & * ( tr(ji,jj,ik-1,jn,Kmm) - tr(ji,jj,ik,jn,Kmm) ) & 265 & / MAX( 1., rmld_trc(ji,jj) ) * tmask(ji,jj,1) 266 END_2D 273 267 END DO 274 268 -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/trc.F90
r12193 r12340 131 131 !$AGRIF_END_DO_NOT_TREAT 132 132 ! 133 !! Substitutions 134 #include "do_loop_substitute.h90" 133 135 !!---------------------------------------------------------------------- 134 136 !! NEMO/TOP 4.0 , NEMO Consortium (2018) -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/trcbc.F90
r12328 r12340 48 48 !! * Substitutions 49 49 # include "vectopt_loop_substitute.h90" 50 # include "do_loop_substitute.h90" 50 51 !!---------------------------------------------------------------------- 51 52 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 414 415 ! Remove river dilution for tracers with absent river load 415 416 IF( ln_rnf_ctl .AND. .NOT.ln_trc_cbc(jn) ) THEN 416 DO jj = 2, jpj 417 DO ji = fs_2, fs_jpim1 418 DO jk = 1, nk_rnf(ji,jj) 419 zrnf = (rnf(ji,jj) + rnf_b(ji,jj)) * 0.5_wp * r1_rau0 / h_rnf(ji,jj) 420 ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + (ptr(ji,jj,jk,jn,Kmm) * zrnf) 421 END DO 417 DO_2D_01_00 418 DO jk = 1, nk_rnf(ji,jj) 419 zrnf = (rnf(ji,jj) + rnf_b(ji,jj)) * 0.5_wp * r1_rau0 / h_rnf(ji,jj) 420 ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + (ptr(ji,jj,jk,jn,Kmm) * zrnf) 422 421 END DO 423 END DO422 END_2D 424 423 ENDIF 425 424 ! … … 430 429 jl = n_trc_indsbc(jn) 431 430 sf_trcsbc(jl)%fnow(:,:,1) = MAX( rtrn, sf_trcsbc(jl)%fnow(:,:,1) ) ! avoid nedgative value due to interpolation 432 DO jj = 2, jpj 433 DO ji = fs_2, fs_jpim1 ! vector opt. 434 zfact = 1. / ( e3t(ji,jj,1,Kmm) * rn_sbc_time ) 435 ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) * zfact 436 END DO 437 END DO 431 DO_2D_01_00 432 zfact = 1. / ( e3t(ji,jj,1,Kmm) * rn_sbc_time ) 433 ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) * zfact 434 END_2D 438 435 ENDIF 439 436 ! … … 442 439 IF( l_offline ) rn_rfact = 1._wp 443 440 jl = n_trc_indcbc(jn) 444 DO jj = 2, jpj 445 DO ji = fs_2, fs_jpim1 ! vector opt. 446 DO jk = 1, nk_rnf(ji,jj) 447 zfact = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_cbc_time ) * tmask(ji,jj,1) 448 ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zfact 449 END DO 441 DO_2D_01_00 442 DO jk = 1, nk_rnf(ji,jj) 443 zfact = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_cbc_time ) * tmask(ji,jj,1) 444 ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zfact 450 445 END DO 451 END DO446 END_2D 452 447 ENDIF 453 448 ! ! =========== -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/trcdta.F90
r12193 r12340 39 39 !$AGRIF_END_DO_NOT_TREAT 40 40 41 !! Substitutions 42 #include "do_loop_substitute.h90" 41 43 !!---------------------------------------------------------------------- 42 44 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 196 198 WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh' 197 199 ENDIF 198 DO jj = 1, jpj ! vertical interpolation of T & S 199 DO ji = 1, jpi 200 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 201 zl = gdept(ji,jj,jk,Kmm) 202 IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data 203 ztp(jk) = ptrcdta(ji,jj,1) 204 ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data 205 ztp(jk) = ptrcdta(ji,jj,jpkm1) 206 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 207 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 208 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 209 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 210 ztp(jk) = ptrcdta(ji,jj,jkk) + ( ptrcdta(ji,jj,jkk+1) - ptrcdta(ji,jj,jkk) ) * zi 211 ENDIF 212 END DO 213 ENDIF 214 END DO 215 DO jk = 1, jpkm1 216 ptrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 217 END DO 218 ptrcdta(ji,jj,jpk) = 0._wp 219 END DO 220 END DO 200 DO_2D_11_11 201 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 202 zl = gdept(ji,jj,jk,Kmm) 203 IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data 204 ztp(jk) = ptrcdta(ji,jj,1) 205 ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data 206 ztp(jk) = ptrcdta(ji,jj,jpkm1) 207 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 208 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 209 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 210 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 211 ztp(jk) = ptrcdta(ji,jj,jkk) + ( ptrcdta(ji,jj,jkk+1) - ptrcdta(ji,jj,jkk) ) * zi 212 ENDIF 213 END DO 214 ENDIF 215 END DO 216 DO jk = 1, jpkm1 217 ptrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 218 END DO 219 ptrcdta(ji,jj,jpk) = 0._wp 220 END_2D 221 221 ! 222 222 ELSE !== z- or zps- coordinate ==!
Note: See TracChangeset
for help on using the changeset viewer.