- Timestamp:
- 2016-11-01T14:23:51+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_r7012_ROBUST5_CNRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
r7068 r7162 15 15 USE trc ! passive tracers common variables 16 16 USE sms_pisces ! PISCES Source Minus Sink variables 17 USE p4zopt ! optical model18 17 USE p4zlim ! Co-limitations of differents nutrients 19 18 USE prtctl_trc ! print control for debugging … … 29 28 !! * Shared module variables 30 29 LOGICAL , PUBLIC :: ln_newprod !: 31 REAL(wp), PUBLIC :: pislope !:32 REAL(wp), PUBLIC :: pislope 2!:30 REAL(wp), PUBLIC :: pislopen !: 31 REAL(wp), PUBLIC :: pisloped !: 33 32 REAL(wp), PUBLIC :: xadap !: 34 REAL(wp), PUBLIC :: excret !:35 REAL(wp), PUBLIC :: excret 2!:33 REAL(wp), PUBLIC :: excretn !: 34 REAL(wp), PUBLIC :: excretd !: 36 35 REAL(wp), PUBLIC :: bresp !: 37 36 REAL(wp), PUBLIC :: chlcnm !: … … 47 46 48 47 REAL(wp) :: r1_rday !: 1 / rday 49 REAL(wp) :: texcret !: 1 - excret50 REAL(wp) :: texcret 2 !: 1 - excret248 REAL(wp) :: texcretn !: 1 - excretn 49 REAL(wp) :: texcretd !: 1 - excretd 51 50 52 51 !!---------------------------------------------------------------------- … … 71 70 INTEGER :: ji, jj, jk 72 71 REAL(wp) :: zsilfac, znanotot, zdiattot, zconctemp, zconctemp2 73 REAL(wp) :: zratio, zmax, zsilim, ztn, zadap 74 REAL(wp) :: z lim, zsilfac2, zsiborn, zprod, zproreg, zproreg275 REAL(wp) :: zm xltst, zmxlday, zmaxday76 REAL(wp) :: z pislopen , zpislope2n77 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 78 77 REAL(wp) :: zfact 79 78 CHARACTER (len=25) :: charout 80 REAL(wp), POINTER, DIMENSION(:,: ) :: zmixnano, zmixdiat, zstrn, zw2d 81 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt, zw3d 82 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 83 85 !!--------------------------------------------------------------------- 84 86 ! … … 86 88 ! 87 89 ! Allocate temporary workspace 88 CALL wrk_alloc( jpi, jpj, zmixnano, zmixdiat, zstrn ) 89 CALL wrk_alloc( jpi, jpj, jpk, zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt ) 90 CALL wrk_alloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd ) 91 ! 92 zprorca (:,:,:) = 0._wp 93 zprorcad(:,:,:) = 0._wp 94 zprofed (:,:,:) = 0._wp 95 zprofen (:,:,:) = 0._wp 96 zprochln(:,:,:) = 0._wp 97 zprochld(:,:,:) = 0._wp 98 zpronew (:,:,:) = 0._wp 99 zpronewd(:,:,:) = 0._wp 100 zprdia (:,:,:) = 0._wp 101 zprbio (:,:,:) = 0._wp 102 zprdch (:,:,:) = 0._wp 103 zprnch (:,:,:) = 0._wp 104 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 105 100 106 101 ! Computation of the optimal production 107 prmax(:,:,:) = 0. 6_wp * r1_rday * tgfunc(:,:,:)102 prmax(:,:,:) = 0.8_wp * r1_rday * tgfunc(:,:,:) 108 103 109 104 ! compute the day length depending on latitude and the day … … 121 116 END DO 122 117 123 ! Impact of the day duration on phytoplankton growth118 ! Impact of the day duration and light intermittency on phytoplankton growth 124 119 DO jk = 1, jpkm1 125 120 DO jj = 1 ,jpj … … 127 122 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 128 123 zval = MAX( 1., zstrn(ji,jj) ) 129 zval = 1.5 * zval / ( 12. + zval ) 130 zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval * ( 1. - fr_i(ji,jj) ) 131 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 ) 132 129 ENDIF 133 130 END DO 134 131 END DO 135 132 END DO 133 134 zprbio(:,:,:) = prmax(:,:,:) * zmxl_fac(:,:,:) 135 zprdia(:,:,:) = zprbio(:,:,:) 136 136 137 137 ! Maximum light intensity 138 138 WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 139 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 140 159 141 160 IF( ln_newprod ) THEN … … 143 162 DO jj = 1, jpj 144 163 DO ji = 1, jpi 145 ! Computation of the P-I slope for nanos and diatoms146 164 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 147 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )148 zadap = xadap * ztn / ( 2.+ ztn )149 zconctemp = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia )150 zconctemp2 = trb(ji,jj,jk,jpdia) - zconctemp151 znanotot = enano(ji,jj,jk) * zstrn(ji,jj)152 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj)153 !154 zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * EXP( -znanotot ) ) &155 & * trb(ji,jj,jk,jpnch) /( trb(ji,jj,jk,jpphy) * 12. + rtrn)156 !157 zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn ) &158 & * trb(ji,jj,jk,jpdch) /( trb(ji,jj,jk,jpdia) * 12. + rtrn)159 160 165 ! Computation of production function for Carbon 161 166 ! --------------------------------------------- 162 zpislopen = zpislopead (ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) * rday + rtrn) 163 zpislope2n = zpislopead2(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) * rday + rtrn) 164 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * znanotot ) ) 165 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot ) ) 166 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) ) ) 167 173 ! Computation of production function for Chlorophyll 168 174 !-------------------------------------------------- 169 zmaxday = 1._wp / ( prmax(ji,jj,jk) * rday + rtrn ) 170 zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead (ji,jj,jk) * zmaxday * znanotot ) ) 171 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) ) ) 172 179 ENDIF 173 180 END DO … … 178 185 DO jj = 1, jpj 179 186 DO ji = 1, jpi 180 181 ! Computation of the P-I slope for nanos and diatoms182 187 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 183 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )184 zadap = ztn / ( 2.+ ztn )185 zconctemp = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia )186 zconctemp2 = trb(ji,jj,jk,jpdia) - zconctemp187 znanotot = enano(ji,jj,jk) * zstrn(ji,jj)188 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj)189 !190 zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * EXP( -znanotot ) )191 zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn )192 193 zpislopen = zpislopead(ji,jj,jk) * trb(ji,jj,jk,jpnch) &194 & / ( trb(ji,jj,jk,jpphy) * 12. + rtrn ) &195 & / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn )196 197 zpislope2n = zpislopead2(ji,jj,jk) * trb(ji,jj,jk,jpdch) &198 & / ( trb(ji,jj,jk,jpdia) * 12. + rtrn ) &199 & / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn )200 201 188 ! Computation of production function for Carbon 202 189 ! --------------------------------------------- 203 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * znanotot ) ) 204 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot ) ) 205 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) ) ) 206 194 ! Computation of production function for Chlorophyll 207 195 !-------------------------------------------------- 208 zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 209 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) ) ) 210 200 ENDIF 211 201 END DO … … 213 203 END DO 214 204 ENDIF 215 216 205 217 206 ! Computation of a proxy of the N/C ratio … … 256 245 END DO 257 246 258 ! Computation of the limitation term due to a mixed layer deeper than the euphotic depth 259 DO jj = 1, jpj 260 DO ji = 1, jpi 261 zmxltst = MAX( 0.e0, hmld(ji,jj) - heup(ji,jj) ) 262 zmxlday = zmxltst * zmxltst * r1_rday 263 zmixnano(ji,jj) = 1. - zmxlday / ( 2. + zmxlday ) 264 zmixdiat(ji,jj) = 1. - zmxlday / ( 4. + zmxlday ) 265 END DO 266 END DO 267 268 ! Mixed-layer effect on production 269 DO jk = 1, jpkm1 270 DO jj = 1, jpj 271 DO ji = 1, jpi 272 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 273 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * zmixnano(ji,jj) 274 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * zmixdiat(ji,jj) 275 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 276 253 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 277 254 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) … … 285 262 DO ji = 1, jpi 286 263 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 287 ! production terms for nanophyto. 288 zprorca (ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2289 zpronew (ji,jj,jk) = zprorca(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn )264 ! production terms for nanophyto. (C) 265 zprorcan(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2 266 zpronewn(ji,jj,jk) = zprorcan(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 290 267 ! 291 zratio = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn ) 292 zratio = zratio / fecnm 268 zratio = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) * fecnm + rtrn ) 293 269 zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 294 zprofen(ji,jj,jk) = fecnm * prmax(ji,jj,jk) &270 zprofen(ji,jj,jk) = fecnm * prmax(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) ) & 295 271 & * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) ) & 296 272 & * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) ) & 297 273 & * zmax * trb(ji,jj,jk,jpphy) * rfact2 298 ! production terms for diatom ees274 ! production terms for diatoms (C) 299 275 zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trb(ji,jj,jk,jpdia) * rfact2 300 276 zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 301 277 ! 302 zratio = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn ) 303 zratio = zratio / fecdm 278 zratio = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) * fecdm + rtrn ) 304 279 zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 305 zprofed(ji,jj,jk) = fecdm * prmax(ji,jj,jk) &280 zprofed(ji,jj,jk) = fecdm * prmax(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) ) & 306 281 & * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) ) & 307 282 & * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) ) & … … 312 287 END DO 313 288 314 DO jk = 1, jpkm1 315 DO jj = 1, jpj 316 DO ji = 1, jpi 317 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 318 zprnch(ji,jj,jk) = zprnch(ji,jj,jk) * zmixnano(ji,jj) 319 zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj) 320 ENDIF 289 ! Computation of the chlorophyll production terms 290 DO jk = 1, jpkm1 291 DO jj = 1, jpj 292 DO ji = 1, jpi 321 293 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 322 294 ! production terms for nanophyto. ( chlorophyll ) 323 znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 324 zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 325 zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk) 326 zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + (chlcnm-chlcmin) * 12. * zprod / & 327 & ( zpislopead(ji,jj,jk) * znanotot +rtrn) 328 ! production terms for diatomees ( chlorophyll ) 329 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 330 zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 331 zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk) 332 zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + (chlcdm-chlcmin) * 12. * zprod / & 333 & ( zpislopead2(ji,jj,jk) * zdiattot +rtrn ) 295 znanotot = enano(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 296 zprod = rday * zprorcan(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 297 zprochln = chlcmin * 12. * zprorcan (ji,jj,jk) 298 chlcnm_n = MIN ( chlcnm, ( chlcnm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem))) * (1. - 1.14 / 43.4 * 20.)) 299 zprochln = zprochln + (chlcnm_n-chlcmin) * 12. * zprod / & 300 & ( zpislopeadn(ji,jj,jk) * znanotot +rtrn) 301 ! production terms for diatoms ( chlorophyll ) 302 zdiattot = ediat(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 303 zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 304 zprochld = chlcmin * 12. * zprorcad(ji,jj,jk) 305 chlcdm_n = MIN ( chlcdm, ( chlcdm / (1. - 1.14 / 43.4 * tsn(ji,jj,jk,jp_tem))) * (1. - 1.14 / 43.4 * 20.)) 306 zprochld = zprochld + (chlcdm_n-chlcmin) * 12. * zprod / & 307 & ( zpislopeadd(ji,jj,jk) * zdiattot +rtrn ) 308 ! Update the arrays TRA which contain the Chla sources and sinks 309 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln * texcretn 310 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld * texcretd 334 311 ENDIF 335 312 END DO … … 341 318 DO jj = 1, jpj 342 319 DO ji =1 ,jpi 343 zproreg = zprorca(ji,jj,jk) - zpronew(ji,jj,jk) 344 zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk) 345 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zprorca(ji,jj,jk) - zprorcad(ji,jj,jk) 346 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronew(ji,jj,jk) - zpronewd(ji,jj,jk) 347 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproreg - zproreg2 348 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorca(ji,jj,jk) * texcret 349 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln(ji,jj,jk) * texcret 350 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcret 351 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcret2 352 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld(ji,jj,jk) * texcret2 353 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcret2 354 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcret2 355 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + excret2 * zprorcad(ji,jj,jk) + excret * zprorca(ji,jj,jk) 356 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) & 357 & + ( o2ut + o2nit ) * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) 358 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - texcret * zprofen(ji,jj,jk) - texcret2 * zprofed(ji,jj,jk) 359 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcret2 * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 360 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorca(ji,jj,jk) - zprorcad(ji,jj,jk) 361 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 362 & - rno3 * ( zproreg + zproreg2 ) 363 END DO 320 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 321 zproreg = zprorcan(ji,jj,jk) - zpronewn(ji,jj,jk) 322 zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk) 323 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 324 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 325 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk) 326 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproreg - zproreg2 327 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorcan(ji,jj,jk) * texcretn 328 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcretn 329 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcretd 330 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcretd 331 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 332 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zdocprod 333 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) & 334 & + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) 335 ! 336 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 337 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zfeup 338 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 339 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 340 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 341 & - rno3 * ( zproreg + zproreg2 ) 342 ENDIF 343 END DO 364 344 END DO 365 345 END DO 346 ! 347 IF( ln_ligand ) THEN 348 DO jk = 1, jpkm1 349 DO jj = 1, jpj 350 DO ji =1 ,jpi 351 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 352 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 353 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 354 tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 355 ENDIF 356 END DO 357 END DO 358 END DO 359 ENDIF 366 360 367 361 368 362 ! Total primary production per year 369 363 IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc ) ) & 370 & tpp = glob_sum( ( zprorca (:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) )364 & tpp = glob_sum( ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) ) 371 365 372 366 IF( lk_iomput ) THEN … … 376 370 zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s 377 371 ! 378 IF( iom_use( "PPPHY " ) .OR. iom_use( "PPPHY2" ) ) THEN379 zw3d(:,:,:) = zprorca 380 CALL iom_put( "PPPHY " , zw3d )372 IF( iom_use( "PPPHYN" ) .OR. iom_use( "PPPHYD" ) ) THEN 373 zw3d(:,:,:) = zprorcan(:,:,:) * zfact * tmask(:,:,:) ! primary production by nanophyto 374 CALL iom_put( "PPPHYN" , zw3d ) 381 375 ! 382 376 zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:) ! primary production by diatomes 383 CALL iom_put( "PPPHY 2" , zw3d )377 CALL iom_put( "PPPHYD" , zw3d ) 384 378 ENDIF 385 379 IF( iom_use( "PPNEWN" ) .OR. iom_use( "PPNEWD" ) ) THEN 386 zw3d(:,:,:) = zpronew 380 zw3d(:,:,:) = zpronewn(:,:,:) * zfact * tmask(:,:,:) ! new primary production by nanophyto 387 381 CALL iom_put( "PPNEWN" , zw3d ) 388 382 ! … … 420 414 ENDIF 421 415 IF( iom_use( "TPP" ) ) THEN 422 zw3d(:,:,:) = ( zprorca (:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:) ! total primary production416 zw3d(:,:,:) = ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:) ! total primary production 423 417 CALL iom_put( "TPP" , zw3d ) 424 418 ENDIF 425 419 IF( iom_use( "TPNEW" ) ) THEN 426 zw3d(:,:,:) = ( zpronew (:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:) ! total new production420 zw3d(:,:,:) = ( zpronewn(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:) ! total new production 427 421 CALL iom_put( "TPNEW" , zw3d ) 428 422 ENDIF … … 431 425 CALL iom_put( "TPBFE" , zw3d ) 432 426 ENDIF 433 IF( iom_use( "INTPPPHY " ) .OR. iom_use( "INTPPPHY2" ) ) THEN427 IF( iom_use( "INTPPPHYN" ) .OR. iom_use( "INTPPPHYD" ) ) THEN 434 428 zw2d(:,:) = 0. 435 429 DO jk = 1, jpkm1 436 zw2d(:,:) = zw2d(:,:) + zprorca 430 zw2d(:,:) = zw2d(:,:) + zprorcan(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by nano 437 431 ENDDO 438 CALL iom_put( "INTPPPHY " , zw2d )432 CALL iom_put( "INTPPPHYN" , zw2d ) 439 433 ! 440 434 zw2d(:,:) = 0. … … 442 436 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by diatom 443 437 ENDDO 444 CALL iom_put( "INTPPPHY 2" , zw2d )438 CALL iom_put( "INTPPPHYD" , zw2d ) 445 439 ENDIF 446 440 IF( iom_use( "INTPP" ) ) THEN 447 441 zw2d(:,:) = 0. 448 442 DO jk = 1, jpkm1 449 zw2d(:,:) = zw2d(:,:) + ( zprorca (:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp443 zw2d(:,:) = zw2d(:,:) + ( zprorcan(:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp 450 444 ENDDO 451 445 CALL iom_put( "INTPP" , zw2d ) … … 454 448 zw2d(:,:) = 0. 455 449 DO jk = 1, jpkm1 456 zw2d(:,:) = zw2d(:,:) + ( zpronew (:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated new prod450 zw2d(:,:) = zw2d(:,:) + ( zpronewn(:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated new prod 457 451 ENDDO 458 452 CALL iom_put( "INTPNEW" , zw2d ) … … 485 479 ENDIF 486 480 ! 487 CALL wrk_dealloc( jpi, jpj, zmixnano, zmixdiat, zstrn ) 488 CALL wrk_dealloc( jpi, jpj, jpk, zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt ) 489 CALL wrk_dealloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd ) 481 CALL wrk_dealloc( jpi, jpj, zmixnano, zmixdiat, zstrn ) 482 CALL wrk_dealloc( jpi, jpj, jpk, zpislopeadn, zpislopeadd, zprdia, zprbio, zprdch, zprnch, zysopt ) 483 CALL wrk_dealloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl ) 484 CALL wrk_dealloc( jpi, jpj, jpk, zprorcan, zprorcad, zprofed, zprofen, zpronewn, zpronewd ) 490 485 ! 491 486 IF( nn_timing == 1 ) CALL timing_stop('p4z_prod') … … 506 501 !!---------------------------------------------------------------------- 507 502 ! 508 NAMELIST/namp isprod/ pislope, pislope2, xadap, ln_newprod, bresp, excret, excret2, &503 NAMELIST/namp4zprod/ pislopen, pisloped, xadap, ln_newprod, bresp, excretn, excretd, & 509 504 & chlcnm, chlcdm, chlcmin, fecnm, fecdm, grosip 510 505 INTEGER :: ios ! Local integer output status for namelist read … … 512 507 513 508 REWIND( numnatp_ref ) ! Namelist nampisprod in reference namelist : Pisces phytoplankton production 514 READ ( numnatp_ref, namp isprod, IOSTAT = ios, ERR = 901)515 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp isprod in reference namelist', lwp )509 READ ( numnatp_ref, namp4zprod, IOSTAT = ios, ERR = 901) 510 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zprod in reference namelist', lwp ) 516 511 517 512 REWIND( numnatp_cfg ) ! Namelist nampisprod in configuration namelist : Pisces phytoplankton production 518 READ ( numnatp_cfg, namp isprod, IOSTAT = ios, ERR = 902 )519 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp isprod in configuration namelist', lwp )520 IF(lwm) WRITE ( numonp, namp isprod )513 READ ( numnatp_cfg, namp4zprod, IOSTAT = ios, ERR = 902 ) 514 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zprod in configuration namelist', lwp ) 515 IF(lwm) WRITE ( numonp, namp4zprod ) 521 516 522 517 IF(lwp) THEN ! control print 523 518 WRITE(numout,*) ' ' 524 WRITE(numout,*) ' Namelist parameters for phytoplankton growth, namp isprod'519 WRITE(numout,*) ' Namelist parameters for phytoplankton growth, namp4zprod' 525 520 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 526 WRITE(numout,*) ' Enable new parame. of production (T/F) ln_newprod =', ln_newprod521 WRITE(numout,*) ' Enable new parame. of production (T/F) ln_newprod =', ln_newprod 527 522 WRITE(numout,*) ' mean Si/C ratio grosip =', grosip 528 WRITE(numout,*) ' P-I slope pislope =', pislope529 WRITE(numout,*) ' Acclimation factor to low light xadap =', xadap530 WRITE(numout,*) ' excretion ratio of nanophytoplankton excret =', excret531 WRITE(numout,*) ' excretion ratio of diatoms excret 2 =', excret2523 WRITE(numout,*) ' P-I slope pislopen =', pislopen 524 WRITE(numout,*) ' Acclimation factor to low light xadap =', xadap 525 WRITE(numout,*) ' excretion ratio of nanophytoplankton excretn =', excretn 526 WRITE(numout,*) ' excretion ratio of diatoms excretd =', excretd 532 527 IF( ln_newprod ) THEN 533 528 WRITE(numout,*) ' basal respiration in phytoplankton bresp =', bresp 534 529 WRITE(numout,*) ' Maximum Chl/C in phytoplankton chlcmin =', chlcmin 535 530 ENDIF 536 WRITE(numout,*) ' P-I slope for diatoms pislope 2 =', pislope2531 WRITE(numout,*) ' P-I slope for diatoms pisloped =', pisloped 537 532 WRITE(numout,*) ' Minimum Chl/C in nanophytoplankton chlcnm =', chlcnm 538 533 WRITE(numout,*) ' Minimum Chl/C in diatoms chlcdm =', chlcdm … … 542 537 ! 543 538 r1_rday = 1._wp / rday 544 texcret = 1._wp - excret545 texcret 2 = 1._wp - excret2539 texcretn = 1._wp - excretn 540 texcretd = 1._wp - excretd 546 541 tpp = 0._wp 547 542 ! … … 558 553 ! 559 554 END FUNCTION p4z_prod_alloc 560 561 555 !!====================================================================== 562 556 END MODULE p4zprod
Note: See TracChangeset
for help on using the changeset viewer.
