Changeset 7646 for trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
- Timestamp:
- 2017-02-06T10:25:03+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
r6945 r7646 8 8 !! 3.4 ! 2011-05 (O. Aumont, C. Ethe) New parameterization of light limitation 9 9 !!---------------------------------------------------------------------- 10 #if defined key_pisces11 !!----------------------------------------------------------------------12 !! 'key_pisces' PISCES bio-model13 !!----------------------------------------------------------------------14 10 !! p4z_prod : Compute the growth Rate of the two phytoplanktons groups 15 11 !! p4z_prod_init : Initialization of the parameters for growth … … 19 15 USE trc ! passive tracers common variables 20 16 USE sms_pisces ! PISCES Source Minus Sink variables 21 USE p4zopt ! optical model22 17 USE p4zlim ! Co-limitations of differents nutrients 23 18 USE prtctl_trc ! print control for debugging … … 33 28 !! * Shared module variables 34 29 LOGICAL , PUBLIC :: ln_newprod !: 35 REAL(wp), PUBLIC :: pislope !:36 REAL(wp), PUBLIC :: pislope 2!:30 REAL(wp), PUBLIC :: pislopen !: 31 REAL(wp), PUBLIC :: pisloped !: 37 32 REAL(wp), PUBLIC :: xadap !: 38 REAL(wp), PUBLIC :: excret !:39 REAL(wp), PUBLIC :: excret 2!:33 REAL(wp), PUBLIC :: excretn !: 34 REAL(wp), PUBLIC :: excretd !: 40 35 REAL(wp), PUBLIC :: bresp !: 41 36 REAL(wp), PUBLIC :: chlcnm !: … … 51 46 52 47 REAL(wp) :: r1_rday !: 1 / rday 53 REAL(wp) :: texcret !: 1 - excret54 REAL(wp) :: texcret 2 !: 1 - excret248 REAL(wp) :: texcretn !: 1 - excretn 49 REAL(wp) :: texcretd !: 1 - excretd 55 50 56 51 !!---------------------------------------------------------------------- … … 75 70 INTEGER :: ji, jj, jk 76 71 REAL(wp) :: zsilfac, znanotot, zdiattot, zconctemp, zconctemp2 77 REAL(wp) :: zratio, zmax, zsilim, ztn, zadap 78 REAL(wp) :: z lim, zsilfac2, zsiborn, zprod, zproreg, zproreg279 REAL(wp) :: zm xltst, zmxlday, zmaxday80 REAL(wp) :: z pislopen , zpislope2n81 REAL(wp) :: zrum, zcodel, zargu, zval 72 REAL(wp) :: zratio, zmax, zsilim, ztn, zadap, zlim, zsilfac2, zsiborn 73 REAL(wp) :: zprod, zproreg, zproreg2, zprochln, zprochld 74 REAL(wp) :: zmaxday, zdocprod, zpislopen, zpisloped 75 REAL(wp) :: zmxltst, zmxlday 76 REAL(wp) :: zrum, zcodel, zargu, zval, zfeup, chlcnm_n, chlcdm_n 82 77 REAL(wp) :: zfact 83 78 CHARACTER (len=25) :: charout 84 REAL(wp), POINTER, DIMENSION(:,: ) :: zmixnano, zmixdiat, zstrn, zw2d 85 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt, zw3d 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd 79 REAL(wp), POINTER, DIMENSION(:,: ) :: zstrn, zw2d, zmixnano, zmixdiat 80 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopeadn, zpislopeadd, zysopt, zw3d 81 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprdia, zprbio, zprdch, zprnch 82 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorcan, zprorcad, zprofed, zprofen 83 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpronewn, zpronewd 84 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmxl_fac, zmxl_chl 87 85 !!--------------------------------------------------------------------- 88 86 ! … … 90 88 ! 91 89 ! Allocate temporary workspace 92 CALL wrk_alloc( jpi, jpj, zmixnano, zmixdiat, zstrn ) 93 CALL wrk_alloc( jpi, jpj, jpk, zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt ) 94 CALL wrk_alloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd ) 95 ! 96 zprorca (:,:,:) = 0._wp 97 zprorcad(:,:,:) = 0._wp 98 zprofed (:,:,:) = 0._wp 99 zprofen (:,:,:) = 0._wp 100 zprochln(:,:,:) = 0._wp 101 zprochld(:,:,:) = 0._wp 102 zpronew (:,:,:) = 0._wp 103 zpronewd(:,:,:) = 0._wp 104 zprdia (:,:,:) = 0._wp 105 zprbio (:,:,:) = 0._wp 106 zprdch (:,:,:) = 0._wp 107 zprnch (:,:,:) = 0._wp 108 zysopt (:,:,:) = 0._wp 90 CALL wrk_alloc( jpi, jpj, zmixnano, zmixdiat, zstrn ) 91 CALL wrk_alloc( jpi, jpj, jpk, zpislopeadn, zpislopeadd, zprdia, zprbio, zprdch, zprnch, zysopt ) 92 CALL wrk_alloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl ) 93 CALL wrk_alloc( jpi, jpj, jpk, zprorcan, zprorcad, zprofed, zprofen, zpronewn, zpronewd ) 94 ! 95 zprorcan(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp ; zprofed (:,:,:) = 0._wp 96 zprofen (:,:,:) = 0._wp ; zysopt (:,:,:) = 0._wp 97 zpronewn(:,:,:) = 0._wp ; zpronewd(:,:,:) = 0._wp ; zprdia (:,:,:) = 0._wp 98 zprbio (:,:,:) = 0._wp ; zprdch (:,:,:) = 0._wp ; zprnch (:,:,:) = 0._wp 99 zmxl_fac(:,:,:) = 0._wp ; zmxl_chl(:,:,:) = 0._wp 109 100 110 101 ! Computation of the optimal production 111 prmax(:,:,:) = 0.6_wp * r1_rday * tgfunc(:,:,:) 112 IF( lk_degrad ) prmax(:,:,:) = prmax(:,:,:) * facvol(:,:,:) 102 prmax(:,:,:) = 0.8_wp * r1_rday * tgfunc(:,:,:) 113 103 114 104 ! compute the day length depending on latitude and the day … … 126 116 END DO 127 117 128 ! Impact of the day duration on phytoplankton growth118 ! Impact of the day duration and light intermittency on phytoplankton growth 129 119 DO jk = 1, jpkm1 130 120 DO jj = 1 ,jpj … … 132 122 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 133 123 zval = MAX( 1., zstrn(ji,jj) ) 134 zval = 1.5 * zval / ( 12. + zval ) 135 zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval * ( 1. - fr_i(ji,jj) ) 136 zprdia(ji,jj,jk) = zprbio(ji,jj,jk) 124 IF( gdept_n(ji,jj,jk) <= hmld(ji,jj) ) THEN 125 zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 126 ENDIF 127 zmxl_chl(ji,jj,jk) = zval / 24. 128 zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval ) 137 129 ENDIF 138 130 END DO 139 131 END DO 140 132 END DO 133 134 zprbio(:,:,:) = prmax(:,:,:) * zmxl_fac(:,:,:) 135 zprdia(:,:,:) = zprbio(:,:,:) 141 136 142 137 ! Maximum light intensity 143 138 WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 144 zstrn(:,:) = 24. / zstrn(:,:) 139 140 ! Computation of the P-I slope for nanos and diatoms 141 DO jk = 1, jpkm1 142 DO jj = 1, jpj 143 DO ji = 1, jpi 144 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 145 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 146 zadap = xadap * ztn / ( 2.+ ztn ) 147 zconctemp = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia ) 148 zconctemp2 = trb(ji,jj,jk,jpdia) - zconctemp 149 ! 150 zpislopeadn(ji,jj,jk) = pislopen * ( 1.+ zadap * EXP( -0.25 * enano(ji,jj,jk) ) ) & 151 & * trb(ji,jj,jk,jpnch) /( trb(ji,jj,jk,jpphy) * 12. + rtrn) 152 ! 153 zpislopeadd(ji,jj,jk) = (pislopen * zconctemp2 + pisloped * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn ) & 154 & * trb(ji,jj,jk,jpdch) /( trb(ji,jj,jk,jpdia) * 12. + rtrn) 155 ENDIF 156 END DO 157 END DO 158 END DO 145 159 146 160 IF( ln_newprod ) THEN … … 148 162 DO jj = 1, jpj 149 163 DO ji = 1, jpi 150 ! Computation of the P-I slope for nanos and diatoms151 164 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 152 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )153 zadap = xadap * ztn / ( 2.+ ztn )154 zconctemp = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia )155 zconctemp2 = trb(ji,jj,jk,jpdia) - zconctemp156 znanotot = enano(ji,jj,jk) * zstrn(ji,jj)157 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj)158 !159 zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * EXP( -znanotot ) ) &160 & * trb(ji,jj,jk,jpnch) /( trb(ji,jj,jk,jpphy) * 12. + rtrn)161 !162 zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn ) &163 & * trb(ji,jj,jk,jpdch) /( trb(ji,jj,jk,jpdia) * 12. + rtrn)164 165 165 ! Computation of production function for Carbon 166 166 ! --------------------------------------------- 167 zpislopen = zpislopead (ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) * rday + rtrn) 168 zpislope2n = zpislopead2(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) * rday + rtrn) 169 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * znanotot ) ) 170 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot ) ) 171 167 zpislopen = zpislopeadn(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 168 & * zmxl_fac(ji,jj,jk) * rday + rtrn) 169 zpisloped = zpislopeadd(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 170 & * zmxl_fac(ji,jj,jk) * rday + rtrn) 171 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 172 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 172 173 ! Computation of production function for Chlorophyll 173 174 !-------------------------------------------------- 174 zmaxday = 1._wp / ( prmax(ji,jj,jk) * rday + rtrn ) 175 zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead (ji,jj,jk) * zmaxday * znanotot ) ) 176 zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead2(ji,jj,jk) * zmaxday * zdiattot ) ) 175 zpislopen = zpislopeadn(ji,jj,jk) / ( prmax(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 176 zpisloped = zpislopeadd(ji,jj,jk) / ( prmax(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 177 zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 178 zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 177 179 ENDIF 178 180 END DO … … 183 185 DO jj = 1, jpj 184 186 DO ji = 1, jpi 185 186 ! Computation of the P-I slope for nanos and diatoms187 187 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 188 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )189 zadap = ztn / ( 2.+ ztn )190 zconctemp = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia )191 zconctemp2 = trb(ji,jj,jk,jpdia) - zconctemp192 znanotot = enano(ji,jj,jk) * zstrn(ji,jj)193 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj)194 !195 zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * EXP( -znanotot ) )196 zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn )197 198 zpislopen = zpislopead(ji,jj,jk) * trb(ji,jj,jk,jpnch) &199 & / ( trb(ji,jj,jk,jpphy) * 12. + rtrn ) &200 & / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn )201 202 zpislope2n = zpislopead2(ji,jj,jk) * trb(ji,jj,jk,jpdch) &203 & / ( trb(ji,jj,jk,jpdia) * 12. + rtrn ) &204 & / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn )205 206 188 ! Computation of production function for Carbon 207 189 ! --------------------------------------------- 208 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * znanotot ) ) 209 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot ) ) 210 190 zpislopen = zpislopeadn(ji,jj,jk) / ( zprbio(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 191 zpisloped = zpislopeadd(ji,jj,jk) / ( zprdia(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 192 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 193 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 211 194 ! Computation of production function for Chlorophyll 212 195 !-------------------------------------------------- 213 zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 214 zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) ) 196 zpislopen = zpislopen * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 197 zpisloped = zpisloped * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 198 zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 199 zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 215 200 ENDIF 216 201 END DO … … 218 203 END DO 219 204 ENDIF 220 221 205 222 206 ! Computation of a proxy of the N/C ratio … … 261 245 END DO 262 246 263 ! Computation of the limitation term due to a mixed layer deeper than the euphotic depth 264 DO jj = 1, jpj 265 DO ji = 1, jpi 266 zmxltst = MAX( 0.e0, hmld(ji,jj) - heup(ji,jj) ) 267 zmxlday = zmxltst * zmxltst * r1_rday 268 zmixnano(ji,jj) = 1. - zmxlday / ( 2. + zmxlday ) 269 zmixdiat(ji,jj) = 1. - zmxlday / ( 4. + zmxlday ) 270 END DO 271 END DO 272 273 ! Mixed-layer effect on production 274 DO jk = 1, jpkm1 275 DO jj = 1, jpj 276 DO ji = 1, jpi 277 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 278 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * zmixnano(ji,jj) 279 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * zmixdiat(ji,jj) 280 ENDIF 247 ! Mixed-layer effect on production 248 ! Sea-ice effect on production 249 250 DO jk = 1, jpkm1 251 DO jj = 1, jpj 252 DO ji = 1, jpi 281 253 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 282 254 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 255 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 256 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 283 257 END DO 284 258 END DO … … 290 264 DO ji = 1, jpi 291 265 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 292 ! production terms for nanophyto. 293 zprorca (ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2294 zpronew (ji,jj,jk) = zprorca(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn )266 ! production terms for nanophyto. (C) 267 zprorcan(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2 268 zpronewn(ji,jj,jk) = zprorcan(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 295 269 ! 296 zratio = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn ) 297 zratio = zratio / fecnm 270 zratio = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) * fecnm + rtrn ) 298 271 zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 299 zprofen(ji,jj,jk) = fecnm * prmax(ji,jj,jk) &272 zprofen(ji,jj,jk) = fecnm * prmax(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) ) & 300 273 & * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) ) & 301 274 & * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) ) & 302 275 & * zmax * trb(ji,jj,jk,jpphy) * rfact2 303 ! production terms for diatom ees276 ! production terms for diatoms (C) 304 277 zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trb(ji,jj,jk,jpdia) * rfact2 305 278 zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 306 279 ! 307 zratio = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn ) 308 zratio = zratio / fecdm 280 zratio = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) * fecdm + rtrn ) 309 281 zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 310 zprofed(ji,jj,jk) = fecdm * prmax(ji,jj,jk) &282 zprofed(ji,jj,jk) = fecdm * prmax(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) ) & 311 283 & * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) ) & 312 284 & * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) ) & … … 317 289 END DO 318 290 319 DO jk = 1, jpkm1 320 DO jj = 1, jpj 321 DO ji = 1, jpi 322 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 323 zprnch(ji,jj,jk) = zprnch(ji,jj,jk) * zmixnano(ji,jj) 324 zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj) 325 ENDIF 291 ! Computation of the chlorophyll production terms 292 DO jk = 1, jpkm1 293 DO jj = 1, jpj 294 DO ji = 1, jpi 326 295 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 327 296 ! production terms for nanophyto. ( chlorophyll ) 328 znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 329 zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 330 zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk) 331 zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + (chlcnm-chlcmin) * 12. * zprod / & 332 & ( zpislopead(ji,jj,jk) * znanotot +rtrn) 333 ! production terms for diatomees ( chlorophyll ) 334 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 335 zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 336 zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk) 337 zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + (chlcdm-chlcmin) * 12. * zprod / & 338 & ( zpislopead2(ji,jj,jk) * zdiattot +rtrn ) 297 znanotot = enano(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 298 zprod = rday * zprorcan(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 299 zprochln = chlcmin * 12. * zprorcan (ji,jj,jk) 300 chlcnm_n = MIN ( chlcnm, ( chlcnm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem))) * (1. - 1.14 / 43.4 * 20.)) 301 zprochln = zprochln + (chlcnm_n-chlcmin) * 12. * zprod / & 302 & ( zpislopeadn(ji,jj,jk) * znanotot +rtrn) 303 ! production terms for diatoms ( chlorophyll ) 304 zdiattot = ediat(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 305 zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 306 zprochld = chlcmin * 12. * zprorcad(ji,jj,jk) 307 chlcdm_n = MIN ( chlcdm, ( chlcdm / (1. - 1.14 / 43.4 * tsn(ji,jj,jk,jp_tem))) * (1. - 1.14 / 43.4 * 20.)) 308 zprochld = zprochld + (chlcdm_n-chlcmin) * 12. * zprod / & 309 & ( zpislopeadd(ji,jj,jk) * zdiattot +rtrn ) 310 ! Update the arrays TRA which contain the Chla sources and sinks 311 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln * texcretn 312 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld * texcretd 339 313 ENDIF 340 314 END DO … … 346 320 DO jj = 1, jpj 347 321 DO ji =1 ,jpi 348 zproreg = zprorca(ji,jj,jk) - zpronew(ji,jj,jk) 349 zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk) 350 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zprorca(ji,jj,jk) - zprorcad(ji,jj,jk) 351 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronew(ji,jj,jk) - zpronewd(ji,jj,jk) 352 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproreg - zproreg2 353 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorca(ji,jj,jk) * texcret 354 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln(ji,jj,jk) * texcret 355 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcret 356 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcret2 357 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld(ji,jj,jk) * texcret2 358 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcret2 359 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcret2 360 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + excret2 * zprorcad(ji,jj,jk) + excret * zprorca(ji,jj,jk) 361 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) & 362 & + ( o2ut + o2nit ) * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) 363 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - texcret * zprofen(ji,jj,jk) - texcret2 * zprofed(ji,jj,jk) 364 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcret2 * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 365 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorca(ji,jj,jk) - zprorcad(ji,jj,jk) 366 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 367 & - rno3 * ( zproreg + zproreg2 ) 368 END DO 322 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 323 zproreg = zprorcan(ji,jj,jk) - zpronewn(ji,jj,jk) 324 zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk) 325 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 326 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 327 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk) 328 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproreg - zproreg2 329 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorcan(ji,jj,jk) * texcretn 330 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcretn 331 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcretd 332 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcretd 333 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 334 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zdocprod 335 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) & 336 & + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) 337 ! 338 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 339 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zfeup 340 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 341 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 342 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 343 & - rno3 * ( zproreg + zproreg2 ) 344 ENDIF 345 END DO 369 346 END DO 370 347 END DO 348 ! 349 IF( ln_ligand ) THEN 350 DO jk = 1, jpkm1 351 DO jj = 1, jpj 352 DO ji =1 ,jpi 353 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 354 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 355 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 356 tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 357 ENDIF 358 END DO 359 END DO 360 END DO 361 ENDIF 371 362 372 363 373 364 ! Total primary production per year 374 365 IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc ) ) & 375 & tpp = glob_sum( ( zprorca (:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) )366 & tpp = glob_sum( ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) ) 376 367 377 368 IF( lk_iomput ) THEN … … 381 372 zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s 382 373 ! 383 IF( iom_use( "PPPHY " ) .OR. iom_use( "PPPHY2" ) ) THEN384 zw3d(:,:,:) = zprorca 385 CALL iom_put( "PPPHY " , zw3d )374 IF( iom_use( "PPPHYN" ) .OR. iom_use( "PPPHYD" ) ) THEN 375 zw3d(:,:,:) = zprorcan(:,:,:) * zfact * tmask(:,:,:) ! primary production by nanophyto 376 CALL iom_put( "PPPHYN" , zw3d ) 386 377 ! 387 378 zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:) ! primary production by diatomes 388 CALL iom_put( "PPPHY 2" , zw3d )379 CALL iom_put( "PPPHYD" , zw3d ) 389 380 ENDIF 390 381 IF( iom_use( "PPNEWN" ) .OR. iom_use( "PPNEWD" ) ) THEN 391 zw3d(:,:,:) = zpronew 382 zw3d(:,:,:) = zpronewn(:,:,:) * zfact * tmask(:,:,:) ! new primary production by nanophyto 392 383 CALL iom_put( "PPNEWN" , zw3d ) 393 384 ! … … 425 416 ENDIF 426 417 IF( iom_use( "TPP" ) ) THEN 427 zw3d(:,:,:) = ( zprorca (:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:) ! total primary production418 zw3d(:,:,:) = ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:) ! total primary production 428 419 CALL iom_put( "TPP" , zw3d ) 429 420 ENDIF 430 421 IF( iom_use( "TPNEW" ) ) THEN 431 zw3d(:,:,:) = ( zpronew (:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:) ! total new production422 zw3d(:,:,:) = ( zpronewn(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:) ! total new production 432 423 CALL iom_put( "TPNEW" , zw3d ) 433 424 ENDIF … … 436 427 CALL iom_put( "TPBFE" , zw3d ) 437 428 ENDIF 438 IF( iom_use( "INTPPPHY " ) .OR. iom_use( "INTPPPHY2" ) ) THEN429 IF( iom_use( "INTPPPHYN" ) .OR. iom_use( "INTPPPHYD" ) ) THEN 439 430 zw2d(:,:) = 0. 440 431 DO jk = 1, jpkm1 441 zw2d(:,:) = zw2d(:,:) + zprorca 432 zw2d(:,:) = zw2d(:,:) + zprorcan(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by nano 442 433 ENDDO 443 CALL iom_put( "INTPPPHY " , zw2d )434 CALL iom_put( "INTPPPHYN" , zw2d ) 444 435 ! 445 436 zw2d(:,:) = 0. … … 447 438 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by diatom 448 439 ENDDO 449 CALL iom_put( "INTPPPHY 2" , zw2d )440 CALL iom_put( "INTPPPHYD" , zw2d ) 450 441 ENDIF 451 442 IF( iom_use( "INTPP" ) ) THEN 452 443 zw2d(:,:) = 0. 453 444 DO jk = 1, jpkm1 454 zw2d(:,:) = zw2d(:,:) + ( zprorca (:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp445 zw2d(:,:) = zw2d(:,:) + ( zprorcan(:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp 455 446 ENDDO 456 447 CALL iom_put( "INTPP" , zw2d ) … … 459 450 zw2d(:,:) = 0. 460 451 DO jk = 1, jpkm1 461 zw2d(:,:) = zw2d(:,:) + ( zpronew (:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated new prod452 zw2d(:,:) = zw2d(:,:) + ( zpronewn(:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated new prod 462 453 ENDDO 463 454 CALL iom_put( "INTPNEW" , zw2d ) … … 482 473 CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 483 474 ENDIF 484 ELSE485 IF( ln_diatrc ) THEN486 zfact = 1.e+3 * rfact2r487 trc3d(:,:,:,jp_pcs0_3d + 4) = zprorca (:,:,:) * zfact * tmask(:,:,:)488 trc3d(:,:,:,jp_pcs0_3d + 5) = zprorcad(:,:,:) * zfact * tmask(:,:,:)489 trc3d(:,:,:,jp_pcs0_3d + 6) = zpronew (:,:,:) * zfact * tmask(:,:,:)490 trc3d(:,:,:,jp_pcs0_3d + 7) = zpronewd(:,:,:) * zfact * tmask(:,:,:)491 trc3d(:,:,:,jp_pcs0_3d + 8) = zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:)492 trc3d(:,:,:,jp_pcs0_3d + 9) = zprofed (:,:,:) * zfact * tmask(:,:,:)493 # if ! defined key_kriest494 trc3d(:,:,:,jp_pcs0_3d + 10) = zprofen (:,:,:) * zfact * tmask(:,:,:)495 # endif496 ENDIF497 475 ENDIF 498 476 … … 503 481 ENDIF 504 482 ! 505 CALL wrk_dealloc( jpi, jpj, zmixnano, zmixdiat, zstrn ) 506 CALL wrk_dealloc( jpi, jpj, jpk, zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt ) 507 CALL wrk_dealloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd ) 483 CALL wrk_dealloc( jpi, jpj, zmixnano, zmixdiat, zstrn ) 484 CALL wrk_dealloc( jpi, jpj, jpk, zpislopeadn, zpislopeadd, zprdia, zprbio, zprdch, zprnch, zysopt ) 485 CALL wrk_dealloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl ) 486 CALL wrk_dealloc( jpi, jpj, jpk, zprorcan, zprorcad, zprofed, zprofen, zpronewn, zpronewd ) 508 487 ! 509 488 IF( nn_timing == 1 ) CALL timing_stop('p4z_prod') … … 524 503 !!---------------------------------------------------------------------- 525 504 ! 526 NAMELIST/namp isprod/ pislope, pislope2, xadap, ln_newprod, bresp, excret, excret2, &505 NAMELIST/namp4zprod/ pislopen, pisloped, xadap, ln_newprod, bresp, excretn, excretd, & 527 506 & chlcnm, chlcdm, chlcmin, fecnm, fecdm, grosip 528 507 INTEGER :: ios ! Local integer output status for namelist read … … 530 509 531 510 REWIND( numnatp_ref ) ! Namelist nampisprod in reference namelist : Pisces phytoplankton production 532 READ ( numnatp_ref, namp isprod, IOSTAT = ios, ERR = 901)533 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp isprod in reference namelist', lwp )511 READ ( numnatp_ref, namp4zprod, IOSTAT = ios, ERR = 901) 512 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zprod in reference namelist', lwp ) 534 513 535 514 REWIND( numnatp_cfg ) ! Namelist nampisprod in configuration namelist : Pisces phytoplankton production 536 READ ( numnatp_cfg, namp isprod, IOSTAT = ios, ERR = 902 )537 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp isprod in configuration namelist', lwp )538 IF(lwm) WRITE ( numonp, namp isprod )515 READ ( numnatp_cfg, namp4zprod, IOSTAT = ios, ERR = 902 ) 516 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zprod in configuration namelist', lwp ) 517 IF(lwm) WRITE ( numonp, namp4zprod ) 539 518 540 519 IF(lwp) THEN ! control print 541 520 WRITE(numout,*) ' ' 542 WRITE(numout,*) ' Namelist parameters for phytoplankton growth, namp isprod'521 WRITE(numout,*) ' Namelist parameters for phytoplankton growth, namp4zprod' 543 522 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 544 WRITE(numout,*) ' Enable new parame. of production (T/F) ln_newprod =', ln_newprod523 WRITE(numout,*) ' Enable new parame. of production (T/F) ln_newprod =', ln_newprod 545 524 WRITE(numout,*) ' mean Si/C ratio grosip =', grosip 546 WRITE(numout,*) ' P-I slope pislope =', pislope547 WRITE(numout,*) ' Acclimation factor to low light xadap =', xadap548 WRITE(numout,*) ' excretion ratio of nanophytoplankton excret =', excret549 WRITE(numout,*) ' excretion ratio of diatoms excret 2 =', excret2525 WRITE(numout,*) ' P-I slope pislopen =', pislopen 526 WRITE(numout,*) ' Acclimation factor to low light xadap =', xadap 527 WRITE(numout,*) ' excretion ratio of nanophytoplankton excretn =', excretn 528 WRITE(numout,*) ' excretion ratio of diatoms excretd =', excretd 550 529 IF( ln_newprod ) THEN 551 530 WRITE(numout,*) ' basal respiration in phytoplankton bresp =', bresp 552 531 WRITE(numout,*) ' Maximum Chl/C in phytoplankton chlcmin =', chlcmin 553 532 ENDIF 554 WRITE(numout,*) ' P-I slope for diatoms pislope 2 =', pislope2533 WRITE(numout,*) ' P-I slope for diatoms pisloped =', pisloped 555 534 WRITE(numout,*) ' Minimum Chl/C in nanophytoplankton chlcnm =', chlcnm 556 535 WRITE(numout,*) ' Minimum Chl/C in diatoms chlcdm =', chlcdm … … 560 539 ! 561 540 r1_rday = 1._wp / rday 562 texcret = 1._wp - excret563 texcret 2 = 1._wp - excret2541 texcretn = 1._wp - excretn 542 texcretd = 1._wp - excretd 564 543 tpp = 0._wp 565 544 ! … … 576 555 ! 577 556 END FUNCTION p4z_prod_alloc 578 579 #else580 !!======================================================================581 !! Dummy module : No PISCES bio-model582 !!======================================================================583 CONTAINS584 SUBROUTINE p4z_prod ! Empty routine585 END SUBROUTINE p4z_prod586 #endif587 588 557 !!====================================================================== 589 558 END MODULE p4zprod
Note: See TracChangeset
for help on using the changeset viewer.
