Changeset 3294 for trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90
- Timestamp:
- 2012-01-28T17:44:18+01:00 (12 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90 (modified) (18 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90
r2730 r3294 2 2 !!====================================================================== 3 3 !! *** MODULE p4zprod *** 4 !! TOP : PISCES4 !! TOP : Growth Rate of the two phytoplanktons groups 5 5 !!====================================================================== 6 6 !! History : 1.0 ! 2004 (O. Aumont) Original code 7 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 8 !! 3.4 ! 2011-05 (O. Aumont, C. Ethe) New parameterization of light limitation 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_pisces … … 11 12 !! 'key_pisces' PISCES bio-model 12 13 !!---------------------------------------------------------------------- 13 !! p4z_prod : 14 !! p4z_prod : Compute the growth Rate of the two phytoplanktons groups 15 !! p4z_prod_init : Initialization of the parameters for growth 16 !! p4z_prod_alloc : Allocate variables for growth 14 17 !!---------------------------------------------------------------------- 15 USE trc 16 USE oce_trc ! 17 USE sms_pisces ! 18 USE prtctl_trc 19 USE p4zopt 20 USE p4zint 21 USE p4zlim 22 USE iom 18 USE oce_trc ! shared variables between ocean and passive tracers 19 USE trc ! passive tracers common variables 20 USE sms_pisces ! PISCES Source Minus Sink variables 21 USE p4zopt ! optical model 22 USE p4zlim ! Co-limitations of differents nutrients 23 USE prtctl_trc ! print control for debugging 24 USE iom ! I/O manager 23 25 24 26 IMPLICIT NONE … … 29 31 PUBLIC p4z_prod_alloc 30 32 31 REAL(wp), PUBLIC :: & 32 pislope = 3.0_wp , & !: 33 pislope2 = 3.0_wp , & !: 34 excret = 10.e-5_wp , & !: 35 excret2 = 0.05_wp , & !: 36 chlcnm = 0.033_wp , & !: 37 chlcdm = 0.05_wp , & !: 38 fecnm = 10.E-6_wp , & !: 39 fecdm = 15.E-6_wp , & !: 40 grosip = 0.151_wp 41 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: prmax !: 33 !! * Shared module variables 34 LOGICAL , PUBLIC :: ln_newprod = .FALSE. 35 REAL(wp), PUBLIC :: pislope = 3.0_wp !: 36 REAL(wp), PUBLIC :: pislope2 = 3.0_wp !: 37 REAL(wp), PUBLIC :: excret = 10.e-5_wp !: 38 REAL(wp), PUBLIC :: excret2 = 0.05_wp !: 39 REAL(wp), PUBLIC :: bresp = 0.00333_wp !: 40 REAL(wp), PUBLIC :: chlcnm = 0.033_wp !: 41 REAL(wp), PUBLIC :: chlcdm = 0.05_wp !: 42 REAL(wp), PUBLIC :: chlcmin = 0.00333_wp !: 43 REAL(wp), PUBLIC :: fecnm = 10.E-6_wp !: 44 REAL(wp), PUBLIC :: fecdm = 15.E-6_wp !: 45 REAL(wp), PUBLIC :: grosip = 0.151_wp !: 46 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: prmax !: optimal production = f(temperature) 48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: quotan !: proxy of N quota in Nanophyto 49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: quotad !: proxy of N quota in diatomee 43 50 44 REAL(wp) :: &45 rday1 , & !: 0.6 / rday46 texcret , & !: 1 - excret47 texcret2 , & !: 1 - excret248 tpp !: Total primary production 51 REAL(wp) :: r1_rday !: 1 / rday 52 REAL(wp) :: texcret !: 1 - excret 53 REAL(wp) :: texcret2 !: 1 - excret2 54 REAL(wp) :: tpp !: Total primary production 55 49 56 50 57 !!* Substitution … … 66 73 !! ** Method : - ??? 67 74 !!--------------------------------------------------------------------- 68 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released69 USE wrk_nemo, ONLY: zmixnano => wrk_2d_1 , zmixdiat => wrk_2d_2 , zstrn => wrk_2d_370 USE wrk_nemo, ONLY: zpislopead => wrk_3d_2 , zpislopead2 => wrk_3d_371 USE wrk_nemo, ONLY: zprdia => wrk_3d_4 , zprbio => wrk_3d_5 , zysopt => wrk_3d_672 USE wrk_nemo, ONLY: zprorca => wrk_3d_7 , zprorcad => wrk_3d_873 USE wrk_nemo, ONLY: zprofed => wrk_3d_9 , zprofen => wrk_3d_1074 USE wrk_nemo, ONLY: zprochln => wrk_3d_11 , zprochld => wrk_3d_1275 USE wrk_nemo, ONLY: zpronew => wrk_3d_13 , zpronewd => wrk_3d_1476 75 ! 77 76 INTEGER, INTENT(in) :: kt, jnt 78 77 ! 79 78 INTEGER :: ji, jj, jk 80 REAL(wp) :: zsilfac, zfact 81 REAL(wp) :: z prdiachl, zprbiochl, zsilim, ztn, zadap, zadap282 REAL(wp) :: zlim, zsilfac2, zsiborn, zprod, z etot2, zmax, zproreg, zproreg283 REAL(wp) :: zmxltst, zmxlday, z lim179 REAL(wp) :: zsilfac, zfact, znanotot, zdiattot, zconctemp, zconctemp2 80 REAL(wp) :: zratio, zmax, zsilim, ztn, zadap 81 REAL(wp) :: zlim, zsilfac2, zsiborn, zprod, zproreg, zproreg2 82 REAL(wp) :: zmxltst, zmxlday, zmaxday 84 83 REAL(wp) :: zpislopen , zpislope2n 85 REAL(wp) :: zrum, zcodel, zargu, zval, zvol 86 #if defined key_diatrc 84 REAL(wp) :: zrum, zcodel, zargu, zval 87 85 REAL(wp) :: zrfact2 88 #endif89 86 CHARACTER (len=25) :: charout 87 REAL(wp), POINTER, DIMENSION(:,: ) :: zmixnano, zmixdiat, zstrn 88 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt 89 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd 90 90 !!--------------------------------------------------------------------- 91 92 IF( wrk_in_use(2, 1,2,3) .OR. & 93 wrk_in_use(3, 2,3,4,5,6,7,8,9,10,11,12,13,14) ) THEN 94 CALL ctl_stop('p4z_prod: requested workspace arrays unavailable') ; RETURN 95 ENDIF 96 91 ! 92 IF( nn_timing == 1 ) CALL timing_start('p4z_prod') 93 ! 94 ! Allocate temporary workspace 95 CALL wrk_alloc( jpi, jpj, zmixnano, zmixdiat, zstrn ) 96 CALL wrk_alloc( jpi, jpj, jpk, zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt ) 97 CALL wrk_alloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd ) 98 ! 97 99 zprorca (:,:,:) = 0._wp 98 100 zprorcad(:,:,:) = 0._wp … … 105 107 zprdia (:,:,:) = 0._wp 106 108 zprbio (:,:,:) = 0._wp 109 zprdch (:,:,:) = 0._wp 110 zprnch (:,:,:) = 0._wp 107 111 zysopt (:,:,:) = 0._wp 108 112 109 113 ! Computation of the optimal production 110 # if defined key_degrad 111 prmax(:,:,:) = rday1 * tgfunc(:,:,:) * facvol(:,:,:) 112 # else 113 prmax(:,:,:) = rday1 * tgfunc(:,:,:) 114 # endif 114 prmax(:,:,:) = 0.6_wp * r1_rday * tgfunc(:,:,:) 115 IF( lk_degrad ) prmax(:,:,:) = prmax(:,:,:) * facvol(:,:,:) 115 116 116 117 ! compute the day length depending on latitude and the day … … 119 120 120 121 ! day length in hours 121 zstrn(:,:) = 0. _wp122 zstrn(:,:) = 0. 122 123 DO jj = 1, jpj 123 124 DO ji = 1, jpi 124 125 zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 125 126 zargu = MAX( -1., MIN( 1., zargu ) ) 126 zval = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 127 IF( zval < 1.e0 ) zval = 24. 128 zstrn(ji,jj) = 24. / zval 127 zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 129 128 END DO 130 129 END DO 131 130 132 131 IF( ln_newprod ) THEN 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 zval = MAX( 1., zstrn(ji,jj) ) 137 zval = 1.5 * zval / ( 12. + zval ) 138 zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval 139 zprdia(ji,jj,jk) = zprbio(ji,jj,jk) 140 END DO 141 END DO 142 END DO 143 ENDIF 144 145 ! Maximum light intensity 146 WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 147 zstrn(:,:) = 24. / zstrn(:,:) 148 149 IF( ln_newprod ) THEN 150 !CDIR NOVERRCHK 151 DO jk = 1, jpkm1 152 !CDIR NOVERRCHK 153 DO jj = 1, jpj 154 !CDIR NOVERRCHK 155 DO ji = 1, jpi 156 157 ! Computation of the P-I slope for nanos and diatoms 158 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 159 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 160 zadap = ztn / ( 2.+ ztn ) 161 162 zconctemp = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - 5e-7 ) 163 zconctemp2 = trn(ji,jj,jk,jpdia) - zconctemp 164 165 znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 166 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 167 168 zfact = EXP( -0.21 * znanotot ) 169 zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * zfact ) & 170 & * trn(ji,jj,jk,jpnch) /( trn(ji,jj,jk,jpphy) * 12. + rtrn) 171 172 zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trn(ji,jj,jk,jpdia) + rtrn ) & 173 & * trn(ji,jj,jk,jpdch) /( trn(ji,jj,jk,jpdia) * 12. + rtrn) 174 175 ! Computation of production function for Carbon 176 ! --------------------------------------------- 177 zpislopen = zpislopead (ji,jj,jk) / ( ( r1_rday + bresp * r1_rday / chlcnm ) * rday + rtrn) 178 zpislope2n = zpislopead2(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday / chlcdm ) * rday + rtrn) 179 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * znanotot ) ) 180 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot ) ) 181 182 ! Computation of production function for Chlorophyll 183 !-------------------------------------------------- 184 zmaxday = 1._wp / ( prmax(ji,jj,jk) * rday + rtrn ) 185 zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead (ji,jj,jk) * zmaxday * znanotot ) ) 186 zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead2(ji,jj,jk) * zmaxday * zdiattot ) ) 187 ENDIF 188 END DO 189 END DO 190 END DO 191 ELSE 192 !CDIR NOVERRCHK 193 DO jk = 1, jpkm1 194 !CDIR NOVERRCHK 195 DO jj = 1, jpj 196 !CDIR NOVERRCHK 197 DO ji = 1, jpi 198 199 ! Computation of the P-I slope for nanos and diatoms 200 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 201 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 202 zadap = ztn / ( 2.+ ztn ) 203 204 zfact = EXP( -0.21 * enano(ji,jj,jk) ) 205 zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * zfact ) 206 zpislopead2(ji,jj,jk) = pislope2 207 208 zpislopen = zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch) & 209 & / ( trn(ji,jj,jk,jpphy) * 12. + rtrn ) & 210 & / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 211 212 zpislope2n = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch) & 213 & / ( trn(ji,jj,jk,jpdia) * 12. + rtrn ) & 214 & / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 215 216 ! Computation of production function for Carbon 217 ! --------------------------------------------- 218 zprbio(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 219 zprdia(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) ) 220 221 ! Computation of production function for Chlorophyll 222 !-------------------------------------------------- 223 zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) * zstrn(ji,jj) ) ) 224 zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) * zstrn(ji,jj) ) ) 225 ENDIF 226 END DO 227 END DO 228 END DO 229 ENDIF 230 231 ! Computation of a proxy of the N/C ratio 232 ! --------------------------------------- 133 233 !CDIR NOVERRCHK 134 234 DO jk = 1, jpkm1 … … 137 237 !CDIR NOVERRCHK 138 238 DO ji = 1, jpi 139 140 ! Computation of the P-I slope for nanos and diatoms 141 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 142 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 143 zadap = 0.+ 1.* ztn / ( 2.+ ztn ) 144 zadap2 = 0.e0 145 146 zfact = EXP( -0.21 * emoy(ji,jj,jk) ) 147 148 zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * zfact ) 149 zpislopead2(ji,jj,jk) = pislope2 * ( 1.+ zadap2 * zfact ) 150 151 zpislopen = zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch) & 152 & / ( trn(ji,jj,jk,jpphy) * 12. + rtrn ) & 153 & / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 154 155 zpislope2n = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch) & 156 & / ( trn(ji,jj,jk,jpdia) * 12. + rtrn ) & 157 & / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 158 159 ! Computation of production function 160 zprbio(ji,jj,jk) = prmax(ji,jj,jk) * & 161 & ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 162 zprdia(ji,jj,jk) = prmax(ji,jj,jk) * & 163 & ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) ) 164 ENDIF 239 zval = ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) * prmax(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn ) 240 quotan(ji,jj,jk) = MIN( 1., 0.5 + 0.5 * zval ) 241 zval = ( xdiatnh4(ji,jj,jk) + xdiatno3(ji,jj,jk) ) * prmax(ji,jj,jk) / ( zprdia(ji,jj,jk) + rtrn ) 242 quotad(ji,jj,jk) = MIN( 1., 0.5 + 0.5 * zval ) 165 243 END DO 166 244 END DO … … 178 256 ! Si/C is arbitrariliy increased for very high Si concentrations 179 257 ! to mimic the very high ratios observed in the Southern Ocean (silpot2) 180 181 zlim1 = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi1 ) 182 zlim = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 183 184 zsilim = MIN( zprdia(ji,jj,jk) / ( rtrn + prmax(ji,jj,jk) ), & 185 & trn(ji,jj,jk,jpfer) / ( concdfe(ji,jj,jk) + trn(ji,jj,jk,jpfer) ), & 186 & trn(ji,jj,jk,jppo4) / ( concdnh4 + trn(ji,jj,jk,jppo4) ), & 187 & zlim ) 188 zsilfac = 5.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim1 - 0.5 ) ) ) + 1.e0 258 zlim = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi1 ) 259 zsilim = MIN( zprdia(ji,jj,jk) / ( prmax(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 260 zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) ) ) + 1.e0 189 261 zsiborn = MAX( 0.e0, ( trn(ji,jj,jk,jpsil) - 15.e-6 ) ) 190 zsilfac2 = 1.+ 3.* zsiborn / ( zsiborn + xksi2 )191 zsilfac = MIN( 6.4,zsilfac * zsilfac2)192 zysopt(ji,jj,jk) = grosip * zlim 1* zsilfac262 zsilfac2 = 1.+ 2.* zsiborn / ( zsiborn + xksi2 ) 263 zsilfac = MIN( 5.4, zsilfac * zsilfac2) 264 zysopt(ji,jj,jk) = grosip * zlim * zsilfac 193 265 ENDIF 194 266 END DO … … 196 268 END DO 197 269 198 ! Computation of the limitation term due to 199 ! A mixed layer deeper than the euphotic depth 270 ! Computation of the limitation term due to a mixed layer deeper than the euphotic depth 200 271 DO jj = 1, jpj 201 272 DO ji = 1, jpi 202 273 zmxltst = MAX( 0.e0, hmld(ji,jj) - heup(ji,jj) ) 203 zmxlday = zmxltst **2 /rday204 zmixnano(ji,jj) = 1. - zmxlday / ( 1.+ zmxlday )205 zmixdiat(ji,jj) = 1. - zmxlday / ( 3.+ zmxlday )274 zmxlday = zmxltst * zmxltst * r1_rday 275 zmixnano(ji,jj) = 1. - zmxlday / ( 3. + zmxlday ) 276 zmixdiat(ji,jj) = 1. - zmxlday / ( 4. + zmxlday ) 206 277 END DO 207 278 END DO … … 219 290 END DO 220 291 221 222 !CDIR NOVERRCHK 223 DO jk = 1, jpkm1 224 !CDIR NOVERRCHK 225 DO jj = 1, jpj 226 !CDIR NOVERRCHK 227 DO ji = 1, jpi 228 229 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 230 ! Computation of the various production terms for nanophyto. 231 zetot2 = enano(ji,jj,jk) * zstrn(ji,jj) 232 zmax = MAX( 0.1, xlimphy(ji,jj,jk) ) 233 zpislopen = zpislopead(ji,jj,jk) & 234 & * trn(ji,jj,jk,jpnch) / ( rtrn + trn(ji,jj,jk,jpphy) * 12.) & 235 & / ( prmax(ji,jj,jk) * rday * zmax + rtrn ) 236 237 zprbiochl = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * zetot2 ) ) 238 239 zprorca(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * trn(ji,jj,jk,jpphy) * rfact2 240 241 zpronew(ji,jj,jk) = zprorca(ji,jj,jk) * xnanono3(ji,jj,jk) & 242 & / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 243 zprod = rday * zprorca(ji,jj,jk) * zprbiochl * trn(ji,jj,jk,jpphy) *zmax 244 245 zprofen(ji,jj,jk) = (fecnm)**2 * zprod / chlcnm & 246 & / ( zpislopead(ji,jj,jk) * zetot2 * trn(ji,jj,jk,jpnfe) + rtrn ) 247 248 zprochln(ji,jj,jk) = chlcnm * 144. * zprod & 249 & / ( zpislopead(ji,jj,jk) * zetot2 * trn(ji,jj,jk,jpnch) + rtrn ) 250 ENDIF 251 END DO 252 END DO 253 END DO 254 292 ! Computation of the various production terms 255 293 !CDIR NOVERRCHK 256 294 DO jk = 1, jpkm1 … … 260 298 DO ji = 1, jpi 261 299 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 262 ! Computation of the various production terms for diatoms 263 zetot2 = ediat(ji,jj,jk) * zstrn(ji,jj) 264 zmax = MAX( 0.1, xlimdia(ji,jj,jk) ) 265 zpislope2n = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch) & 266 & / ( rtrn + trn(ji,jj,jk,jpdia) * 12.) & 267 & / ( prmax(ji,jj,jk) * rday * zmax + rtrn ) 268 269 zprdiachl = prmax(ji,jj,jk) * ( 1.- EXP( -zetot2 * zpislope2n ) ) 270 300 ! production terms for nanophyto. 301 zprorca(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * trn(ji,jj,jk,jpphy) * rfact2 302 zpronew(ji,jj,jk) = zprorca(ji,jj,jk) * xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 303 ! 304 zratio = trn(ji,jj,jk,jpnfe) / ( trn(ji,jj,jk,jpphy) + rtrn ) 305 zratio = zratio / fecnm 306 zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 307 zprofen(ji,jj,jk) = fecnm * prmax(ji,jj,jk) & 308 & * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) ) & 309 & * trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concnfe(ji,jj,jk) ) & 310 & * zmax * trn(ji,jj,jk,jpphy) * rfact2 311 ! production terms for diatomees 271 312 zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trn(ji,jj,jk,jpdia) * rfact2 272 273 zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) & 274 & / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 275 276 zprod = rday * zprorcad(ji,jj,jk) * zprdiachl * trn(ji,jj,jk,jpdia) * zmax 277 278 zprofed(ji,jj,jk) = (fecdm)**2 * zprod / chlcdm & 279 & / ( zpislopead2(ji,jj,jk) * zetot2 * trn(ji,jj,jk,jpdfe) + rtrn ) 280 281 zprochld(ji,jj,jk) = chlcdm * 144. * zprod & 282 & / ( zpislopead2(ji,jj,jk) * zetot2 * trn(ji,jj,jk,jpdch) + rtrn ) 283 313 zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 314 ! 315 zratio = trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn ) 316 zratio = zratio / fecdm 317 zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 318 zprofed(ji,jj,jk) = fecdm * prmax(ji,jj,jk) & 319 & * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) ) & 320 & * trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concdfe(ji,jj,jk) ) & 321 & * zmax * trn(ji,jj,jk,jpdia) * rfact2 284 322 ENDIF 285 323 END DO 286 324 END DO 287 325 END DO 288 ! 326 327 IF( ln_newprod ) THEN 328 !CDIR NOVERRCHK 329 DO jk = 1, jpkm1 330 !CDIR NOVERRCHK 331 DO jj = 1, jpj 332 !CDIR NOVERRCHK 333 DO ji = 1, jpi 334 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 335 zprnch(ji,jj,jk) = zprnch(ji,jj,jk) * zmixnano(ji,jj) 336 zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj) 337 ENDIF 338 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 339 ! production terms for nanophyto. ( chlorophyll ) 340 znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 341 zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 342 zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk) 343 zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + chlcnm * 12. * zprod / ( zpislopead(ji,jj,jk) * znanotot +rtrn) 344 ! production terms for diatomees ( chlorophyll ) 345 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 346 zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 347 zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk) 348 zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + chlcdm * 12. * zprod / ( zpislopead2(ji,jj,jk) * zdiattot +rtrn ) 349 ENDIF 350 END DO 351 END DO 352 END DO 353 ELSE 354 !CDIR NOVERRCHK 355 DO jk = 1, jpkm1 356 !CDIR NOVERRCHK 357 DO jj = 1, jpj 358 !CDIR NOVERRCHK 359 DO ji = 1, jpi 360 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 361 ! production terms for nanophyto. ( chlorophyll ) 362 znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 363 zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * trn(ji,jj,jk,jpphy) * xlimphy(ji,jj,jk) 364 zprochln(ji,jj,jk) = chlcnm * 144. * zprod / ( zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch) * znanotot +rtrn) 365 ! production terms for diatomees ( chlorophyll ) 366 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 367 zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * trn(ji,jj,jk,jpdia) * xlimdia(ji,jj,jk) 368 zprochld(ji,jj,jk) = chlcdm * 144. * zprod / ( zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch) * zdiattot +rtrn ) 369 ENDIF 370 END DO 371 END DO 372 END DO 373 ENDIF 289 374 290 375 ! Update the arrays TRA which contain the biological sources and sinks … … 304 389 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcret2 305 390 tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcret2 306 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + & 307 & excret2 * zprorcad(ji,jj,jk) + excret * zprorca(ji,jj,jk) 391 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + excret2 * zprorcad(ji,jj,jk) + excret * zprorca(ji,jj,jk) 308 392 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) & 309 & + ( o2ut + o2nit ) * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) 310 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) & 311 & - texcret * zprofen(ji,jj,jk) - texcret2 * zprofed(ji,jj,jk) 312 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) & 313 & - texcret2 * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 393 & + ( o2ut + o2nit ) * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) 394 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - texcret * zprofen(ji,jj,jk) - texcret2 * zprofed(ji,jj,jk) 395 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcret2 * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 314 396 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorca(ji,jj,jk) - zprorcad(ji,jj,jk) 315 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) &316 & + rno3 * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk))397 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 398 & - rno3 * ( zproreg + zproreg2 ) 317 399 END DO 318 400 END DO … … 320 402 321 403 ! Total primary production per year 322 323 #if defined key_degrad324 tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) * facvol(:,:,:) )325 #else326 404 tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) ) 327 #endif 328 329 IF( kt == nitend .AND. jnt == nrdttrc .AND. lwp ) THEN 405 406 IF( kt == nitend .AND. jnt == nrdttrc ) THEN 330 407 WRITE(numout,*) 'Total PP (Gtc) :' 331 408 WRITE(numout,*) '-------------------- : ',tpp * 12. / 1.E12 … … 333 410 ENDIF 334 411 335 #if defined key_diatrc && ! defined key_iomput 336 ! Supplementary diagnostics 337 zrfact2 = 1.e3 * rfact2r 338 trc3d(:,:,:,jp_pcs0_3d + 4) = zprorca (:,:,:) * zrfact2 * tmask(:,:,:) 339 trc3d(:,:,:,jp_pcs0_3d + 5) = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) 340 trc3d(:,:,:,jp_pcs0_3d + 6) = zpronew (:,:,:) * zrfact2 * tmask(:,:,:) 341 trc3d(:,:,:,jp_pcs0_3d + 7) = zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) 342 trc3d(:,:,:,jp_pcs0_3d + 8) = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) 343 trc3d(:,:,:,jp_pcs0_3d + 9) = zprofed (:,:,:) * zrfact2 * tmask(:,:,:) 412 IF( ln_diatrc ) THEN 413 ! 414 zrfact2 = 1.e3 * rfact2r 415 IF( lk_iomput ) THEN 416 IF( jnt == nrdttrc ) THEN 417 CALL iom_put( "PPPHY" , zprorca (:,:,:) * zrfact2 * tmask(:,:,:) ) ! primary production by nanophyto 418 CALL iom_put( "PPPHY2", zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) ) ! primary production by diatom 419 CALL iom_put( "PPNEWN", zpronew (:,:,:) * zrfact2 * tmask(:,:,:) ) ! new primary production by nanophyto 420 CALL iom_put( "PPNEWD", zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) ) ! new primary production by diatom 421 CALL iom_put( "PBSi" , zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) ) ! biogenic silica production 422 CALL iom_put( "PFeD" , zprofed (:,:,:) * zrfact2 * tmask(:,:,:) ) ! biogenic iron production by diatom 423 CALL iom_put( "PFeN" , zprofen (:,:,:) * zrfact2 * tmask(:,:,:) ) ! biogenic iron production by nanophyto 424 ENDIF 425 ELSE 426 trc3d(:,:,:,jp_pcs0_3d + 4) = zprorca (:,:,:) * zrfact2 * tmask(:,:,:) 427 trc3d(:,:,:,jp_pcs0_3d + 5) = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) 428 trc3d(:,:,:,jp_pcs0_3d + 6) = zpronew (:,:,:) * zrfact2 * tmask(:,:,:) 429 trc3d(:,:,:,jp_pcs0_3d + 7) = zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) 430 trc3d(:,:,:,jp_pcs0_3d + 8) = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) 431 trc3d(:,:,:,jp_pcs0_3d + 9) = zprofed (:,:,:) * zrfact2 * tmask(:,:,:) 344 432 # if ! defined key_kriest 345 trc3d(:,:,:,jp_pcs0_3d + 10) = zprofen (:,:,:) * zrfact2 * tmask(:,:,:)433 trc3d(:,:,:,jp_pcs0_3d + 10) = zprofen (:,:,:) * zrfact2 * tmask(:,:,:) 346 434 # endif 347 #endif 348 349 #if defined key_diatrc && defined key_iomput 350 zrfact2 = 1.e3 * rfact2r 351 IF ( jnt == nrdttrc ) then 352 CALL iom_put( "PPPHY" , zprorca (:,:,:) * zrfact2 * tmask(:,:,:) ) ! primary production by nanophyto 353 CALL iom_put( "PPPHY2", zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) ) ! primary production by diatom 354 CALL iom_put( "PPNEWN", zpronew (:,:,:) * zrfact2 * tmask(:,:,:) ) ! new primary production by nanophyto 355 CALL iom_put( "PPNEWD", zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) ) ! new primary production by diatom 356 CALL iom_put( "PBSi" , zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) ) ! biogenic silica production 357 CALL iom_put( "PFeD" , zprofed (:,:,:) * zrfact2 * tmask(:,:,:) ) ! biogenic iron production by diatom 358 CALL iom_put( "PFeN" , zprofen (:,:,:) * zrfact2 * tmask(:,:,:) ) ! biogenic iron production by nanophyto 359 ENDIF 360 #endif 435 ENDIF 436 ! 437 ENDIF 361 438 362 439 IF(ln_ctl) THEN ! print mean trends (used for debugging) … … 365 442 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 366 443 ENDIF 367 368 IF( wrk_not_released(2, 1,2,3) .OR. & 369 wrk_not_released(3, 2,3,4,5,6,7,8,9,10,11,12,13,14) ) & 370 CALL ctl_stop('p4z_prod: failed to release workspace arrays') 444 ! 445 CALL wrk_dealloc( jpi, jpj, zmixnano, zmixdiat, zstrn ) 446 CALL wrk_dealloc( jpi, jpj, jpk, zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt ) 447 CALL wrk_dealloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd ) 448 ! 449 IF( nn_timing == 1 ) CALL timing_stop('p4z_prod') 371 450 ! 372 451 END SUBROUTINE p4z_prod … … 380 459 !! 381 460 !! ** Method : Read the nampisprod namelist and check the parameters 382 !! called at the first timestep (nit 000)461 !! called at the first timestep (nittrc000) 383 462 !! 384 463 !! ** input : Namelist nampisprod 385 464 !!---------------------------------------------------------------------- 386 NAMELIST/nampisprod/ pislope, pislope2, excret, excret2, chlcnm, chlcdm, & 387 & fecnm, fecdm, grosip 465 ! 466 NAMELIST/nampisprod/ pislope, pislope2, ln_newprod, bresp, excret, excret2, & 467 & chlcnm, chlcdm, chlcmin, fecnm, fecdm, grosip 388 468 !!---------------------------------------------------------------------- 389 469 390 REWIND( numnat ) ! read numnat391 READ ( numnat , nampisprod )470 REWIND( numnatp ) ! read numnatp 471 READ ( numnatp, nampisprod ) 392 472 393 473 IF(lwp) THEN ! control print … … 395 475 WRITE(numout,*) ' Namelist parameters for phytoplankton growth, nampisprod' 396 476 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 397 WRITE(numout,*) ' mean Si/C ratio grosip =', grosip 398 WRITE(numout,*) ' P-I slope pislope =', pislope 399 WRITE(numout,*) ' excretion ratio of nanophytoplankton excret =', excret 400 WRITE(numout,*) ' excretion ratio of diatoms excret2 =', excret2 401 WRITE(numout,*) ' P-I slope for diatoms pislope2 =', pislope2 402 WRITE(numout,*) ' Minimum Chl/C in nanophytoplankton chlcnm =', chlcnm 403 WRITE(numout,*) ' Minimum Chl/C in diatoms chlcdm =', chlcdm 404 WRITE(numout,*) ' Maximum Fe/C in nanophytoplankton fecnm =', fecnm 405 WRITE(numout,*) ' Minimum Fe/C in diatoms fecdm =', fecdm 406 ENDIF 407 ! 408 rday1 = 0.6 / rday 409 texcret = 1.0 - excret 410 texcret2 = 1.0 - excret2 411 tpp = 0. 477 WRITE(numout,*) ' Enable new parame. of production (T/F) ln_newprod =', ln_newprod 478 WRITE(numout,*) ' mean Si/C ratio grosip =', grosip 479 WRITE(numout,*) ' P-I slope pislope =', pislope 480 WRITE(numout,*) ' excretion ratio of nanophytoplankton excret =', excret 481 WRITE(numout,*) ' excretion ratio of diatoms excret2 =', excret2 482 IF( ln_newprod ) THEN 483 WRITE(numout,*) ' basal respiration in phytoplankton bresp =', bresp 484 WRITE(numout,*) ' Maximum Chl/C in phytoplankton chlcmin =', chlcmin 485 ENDIF 486 WRITE(numout,*) ' P-I slope for diatoms pislope2 =', pislope2 487 WRITE(numout,*) ' Minimum Chl/C in nanophytoplankton chlcnm =', chlcnm 488 WRITE(numout,*) ' Minimum Chl/C in diatoms chlcdm =', chlcdm 489 WRITE(numout,*) ' Maximum Fe/C in nanophytoplankton fecnm =', fecnm 490 WRITE(numout,*) ' Minimum Fe/C in diatoms fecdm =', fecdm 491 ENDIF 492 ! 493 r1_rday = 1._wp / rday 494 texcret = 1._wp - excret 495 texcret2 = 1._wp - excret2 496 tpp = 0._wp 412 497 ! 413 498 END SUBROUTINE p4z_prod_init … … 418 503 !! *** ROUTINE p4z_prod_alloc *** 419 504 !!---------------------------------------------------------------------- 420 ALLOCATE( prmax(jpi,jpj,jpk), STAT=p4z_prod_alloc )505 ALLOCATE( prmax(jpi,jpj,jpk), quotan(jpi,jpj,jpk), quotad(jpi,jpj,jpk), STAT = p4z_prod_alloc ) 421 506 ! 422 507 IF( p4z_prod_alloc /= 0 ) CALL ctl_warn('p4z_prod_alloc : failed to allocate arrays.')
Note: See TracChangeset
for help on using the changeset viewer.
