- Timestamp:
- 2016-09-30T16:56:23+02:00 (8 years ago)
- Location:
- branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES
- Files:
-
- 13 edited
-
P4Z/p4zbio.F90 (modified) (2 diffs)
-
P4Z/p4zche.F90 (modified) (10 diffs)
-
P4Z/p4zfechem.F90 (modified) (1 diff)
-
P4Z/p4zflx.F90 (modified) (4 diffs)
-
P4Z/p4zlys.F90 (modified) (6 diffs)
-
P4Z/p4zopt.F90 (modified) (7 diffs)
-
P4Z/p4zpoc.F90 (modified) (4 diffs)
-
P4Z/p4zprod.F90 (modified) (26 diffs)
-
P4Z/p4zsms.F90 (modified) (2 diffs)
-
P5Z/p5zbio.F90 (modified) (2 diffs)
-
P5Z/p5zpoc.F90 (modified) (4 diffs)
-
P5Z/p5zprod.F90 (modified) (22 diffs)
-
P5Z/p5zsms.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90
r6453 r6966 27 27 USE p4zpoc ! Remineralization of organic particles 28 28 USE p4zagg ! Aggregation of particles 29 USE p4zlys ! Dissolution of calcite30 29 USE p4zfechem ! Iron chemistry 31 30 USE p4zligand … … 82 81 CALL p4z_opt ( kt, knt ) ! Optic: PAR in the water column 83 82 CALL p4z_sink ( kt, knt ) ! vertical flux of particulate organic matter 84 CALL p4z_lys (kt, knt ) ! Dissolution of calcite85 83 CALL p4z_fechem(kt, knt ) ! Iron chemistry/scavenging 86 84 CALL p4z_lim ( kt, knt ) ! co-limitations by the various nutrients -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
r6931 r6966 23 23 USE sms_pisces ! PISCES Source Minus Sink variables 24 24 USE lib_mpp ! MPP library 25 USE eosbn2, ONLY : nn_eos 25 26 26 27 IMPLICIT NONE … … 37 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: chemo2 ! Solubilities of O2 and CO2 38 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: fesol ! solubility of Fe 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tempis ! In situ temperature 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: salinprac ! Practical salinity 39 42 40 43 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: akb3 !: ??? … … 154 157 REAL(wp) :: zpres, ztc , zcl , zcpexp, zoxy , zcpexp2 155 158 REAL(wp) :: zsqrt, ztr , zlogt , zcek1, zc1, zplat 156 REAL(wp) :: zis , zis2 , zsal15, zisqrt 159 REAL(wp) :: zis , zis2 , zsal15, zisqrt, za1, za2 157 160 REAL(wp) :: zckb , zck1 , zck2 , zckw , zak1 , zak2 , zakb , zaksp0, zakw 158 161 REAL(wp) :: zck1p, zck2p, zck3p, zcksi, zak1p, zak2p, zak3p, zaksi … … 163 166 ! 164 167 IF( nn_timing == 1 ) CALL timing_start('p4z_che') 168 ! 169 ! Computation of chemical constants require practical salinity 170 ! Thus, when TEOS08 is used, absolute salinity is converted to 171 ! practical salinity 172 ! ------------------------------------------------------------- 173 IF (nn_eos == -1) THEN 174 salinprac(:,:,:) = tsn(:,:,:,jp_sal) * 35.0 / 35.16504 175 ELSE 176 salinprac(:,:,:) = tsn(:,:,:,jp_sal) 177 ENDIF 178 179 ! 180 ! Computations of chemical constants require in situ temperature 181 ! Here a quite simple formulation is used to convert 182 ! potential temperature to in situ temperature. The errors is less than 183 ! 0.04°C relative to an exact computation 184 ! --------------------------------------------------------------------- 185 DO jk = 1, jpk 186 DO jj = 1, jpj 187 DO ji = 1, jpi 188 zpres = fsdept(ji,jj,jk) / 1000. 189 za1 = 0.04 * ( 1.0 + 0.185 * tsn(ji,jj,jk,jp_tem) + 0.035 * (salinprac(ji,jj,jk) - 35.0) ) 190 za2 = 0.0075 * ( 1.0 - tsn(ji,jj,jk,jp_tem) / 30.0 ) 191 tempis(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) - za1 * zpres + za2 * zpres**2 192 END DO 193 END DO 194 END DO 165 195 ! 166 196 ! CHEMICAL CONSTANTS - SURFACE LAYER … … 171 201 DO ji = 1, jpi 172 202 ! ! SET ABSOLUTE TEMPERATURE 173 ztkel = t sn(ji,jj,1,jp_tem) + 273.15203 ztkel = tempis(ji,jj,1) + 273.15 174 204 zt = ztkel * 0.01 175 zsal = tsn(ji,jj,1,jp_sal) + ( 1.- tmask(ji,jj,1) ) * 35.205 zsal = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35. 176 206 ! ! LN(K0) OF SOLUBILITY OF CO2 (EQ. 12, WEISS, 1980) 177 207 ! ! AND FOR THE ATMOSPHERE FOR NON IDEAL GAS … … 193 223 !CDIR NOVERRCHK 194 224 DO ji = 1, jpi 195 ztkel = t sn(ji,jj,jk,jp_tem) + 273.15196 zsal = tsn(ji,jj,jk,jp_sal) + ( 1.- tmask(ji,jj,jk) ) * 35.225 ztkel = tempis(ji,jj,jk) + 273.15 226 zsal = salinprac(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 35. 197 227 zsal2 = zsal * zsal 198 ztgg = LOG( ( 298.15 - t sn(ji,jj,jk,jp_tem) ) / ztkel ) ! Set the GORDON & GARCIA scaled temperature228 ztgg = LOG( ( 298.15 - tempis(ji,jj,jk) ) / ztkel ) ! Set the GORDON & GARCIA scaled temperature 199 229 ztgg2 = ztgg * ztgg 200 230 ztgg3 = ztgg2 * ztgg … … 229 259 230 260 ! SET ABSOLUTE TEMPERATURE 231 ztkel = t sn(ji,jj,jk,jp_tem) + 273.15232 zsal = tsn(ji,jj,jk,jp_sal) + ( 1.-tmask(ji,jj,jk) ) * 35.261 ztkel = tempis(ji,jj,jk) + 273.15 262 zsal = salinprac(ji,jj,jk) + ( 1.-tmask(ji,jj,jk) ) * 35. 233 263 zsqrt = SQRT( zsal ) 234 264 zsal15 = zsqrt * zsal … … 238 268 zis2 = zis * zis 239 269 zisqrt = SQRT( zis ) 240 ztc = t sn(ji,jj,jk,jp_tem) + ( 1.- tmask(ji,jj,jk) ) * 20.270 ztc = tempis(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 20. 241 271 242 272 ! CHLORINITY (WOOSTER ET AL., 1969) … … 414 444 415 445 ! Liu and Millero (1999) only valid 5 - 50 degC 416 ztkel1 = MAX( 5. , t sn(ji,jj,jk,jp_tem) ) + 273.16417 fesol(ji,jj,jk,1) = 10**((-13.486) - (0.1856* (zis**0.5)) + (0.3073*zis) + (5254 /ztkel1))418 fesol(ji,jj,jk,2) = 10**(2.517 - (0.885*(zis**0.5)) + (0.2139 * zis) - (1320 /ztkel1) )419 fesol(ji,jj,jk,3) = 10**(0.4511 - (0.3305*( ZIS**0.5)) - (1996/ztkel1) )420 fesol(ji,jj,jk,4) = 10**(-0.2965 - (0.7881*(zis**0.5)) - (4086 /ztkel1) )421 fesol(ji,jj,jk,5) = 10**(4.4466 - (0.8505*(zis**0.5)) - (7980 /ztkel1) )446 ztkel1 = MAX( 5. , tempis(ji,jj,jk) ) + 273.16 447 fesol(ji,jj,jk,1) = 10**((-13.486) - (0.1856* (zis**0.5)) + (0.3073*zis) + (5254.0/ztkel1)) 448 fesol(ji,jj,jk,2) = 10**(2.517 - (0.885*(zis**0.5)) + (0.2139 * zis) - (1320.0/ztkel1) ) 449 fesol(ji,jj,jk,3) = 10**(0.4511 - (0.3305*(zis**0.5)) - (1996.0/ztkel1) ) 450 fesol(ji,jj,jk,4) = 10**(-0.2965 - (0.7881*(zis**0.5)) - (4086.0/ztkel1) ) 451 fesol(ji,jj,jk,5) = 10**(4.4466 - (0.8505*(zis**0.5)) - (7980.0/ztkel1) ) 422 452 END DO 423 453 END DO … … 794 824 ALLOCATE( sio3eq(jpi,jpj,jpk), fekeq(jpi,jpj,jpk), chemc(jpi,jpj,3), chemo2(jpi,jpj,jpk), STAT=ierr(1) ) 795 825 796 ALLOCATE( akb3(jpi,jpj,jpk) , & 797 & akw3(jpi,jpj,jpk) , borat (jpi,jpj,jpk) , & 798 & aks3(jpi,jpj,jpk) , akf3(jpi,jpj,jpk) , & 799 & ak1p3(jpi,jpj,jpk) , ak2p3(jpi,jpj,jpk) , & 800 & ak3p3(jpi,jpj,jpk) , aksi3(jpi,jpj,jpk) , & 801 & fluorid(jpi,jpj,jpk) , sulfat(jpi,jpj,jpk) , STAT=ierr(2) ) 826 ALLOCATE( akb3(jpi,jpj,jpk) , tempis(jpi, jpj, jpk), & 827 & akw3(jpi,jpj,jpk) , borat (jpi,jpj,jpk) , & 828 & aks3(jpi,jpj,jpk) , akf3(jpi,jpj,jpk) , & 829 & ak1p3(jpi,jpj,jpk) , ak2p3(jpi,jpj,jpk) , & 830 & ak3p3(jpi,jpj,jpk) , aksi3(jpi,jpj,jpk) , & 831 & fluorid(jpi,jpj,jpk) , sulfat(jpi,jpj,jpk) , & 832 & salinprac(jpi,jpj,jpk), STAT=ierr(2) ) 802 833 803 834 ALLOCATE( fesol(jpi,jpj,jpk,5), STAT=ierr(3) ) -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90
r6841 r6966 163 163 zTL2(ji,jj,jk) = ligand * 1E9 - 0.000001 + 0.33 * ztligand 164 164 ! ionic strength from Millero et al. 1987 165 zionic = 19.9201 * tsn(ji,jj,jk,jp_sal) / ( 1000. - 1.00488 * tsn(ji,jj,jk,jp_sal) + rtrn )166 165 zph = -LOG10( MAX( hi(ji,jj,jk), rtrn) ) 167 zoxy = trb(ji,jj,jk,jpoxy) * ( rhop(ji,jj,jk) / 1.e3 )166 zoxy = trb(ji,jj,jk,jpoxy) 168 167 ! Fe2+ oxydation rate from Santana-Casiano et al. (2005) 169 zkox = 35.407 - 6.7109 * zph + 0.5342 * zph * zph - 5362.6 / ( t sn(ji,jj,jk,jp_tem) + 273.15 ) &170 & - 0.04406 * SQRT( tsn(ji,jj,jk,jp_sal) ) - 0.002847 * tsn(ji,jj,jk,jp_sal)168 zkox = 35.407 - 6.7109 * zph + 0.5342 * zph * zph - 5362.6 / ( tempis(ji,jj,jk) + 273.15 ) & 169 & - 0.04406 * SQRT( salinprac(ji,jj,jk) ) - 0.002847 * salinprac(ji,jj,jk) 171 170 zkox = ( 10.** zkox ) * spd 172 171 zkox = zkox * MAX( 1.e-6, zoxy) / ( chemo2(ji,jj,jk) + rtrn ) -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90
r6931 r6966 128 128 ! DUMMY VARIABLES FOR DIC, H+, AND BORATE 129 129 zfact = rhop(ji,jj,1) / 1000. + rtrn 130 zdic = trb(ji,jj,1,jpdic) / zfact130 zdic = trb(ji,jj,1,jpdic) 131 131 zph = MAX( hi(ji,jj,1), 1.e-10 ) / zfact 132 132 ! CALCULATE [H2CO3] 133 zh2co3(ji,jj) = zdic/(1. + ak13(ji,jj,1)/zph + ak13(ji,jj,1)*ak23(ji,jj,1)/zph**2) *zfact133 zh2co3(ji,jj) = zdic/(1. + ak13(ji,jj,1)/zph + ak13(ji,jj,1)*ak23(ji,jj,1)/zph**2) 134 134 END DO 135 135 END DO … … 146 146 !CDIR NOVERRCHK 147 147 DO ji = 1, jpi 148 ztc = MIN( 35., t sn(ji,jj,1,jp_tem) )148 ztc = MIN( 35., tempis(ji,jj,1) ) 149 149 ztc2 = ztc * ztc 150 150 ztc3 = ztc * ztc2 … … 169 169 DO jj = 1, jpj 170 170 DO ji = 1, jpi 171 ztkel = t sn(ji,jj,1,jp_tem) + 273.15172 zsal = tsn(ji,jj,1,jp_sal) + ( 1.- tmask(ji,jj,1) ) * 35.171 ztkel = tempis(ji,jj,1) + 273.15 172 zsal = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35. 173 173 zvapsw = exp(24.4543 - 67.4509*(100.0/ztkel) - 4.8489*log(ztkel/100) - 0.000544*zsal) 174 174 zpco2atm(ji,jj) = satmco2(ji,jj) * ( patm(ji,jj) - zvapsw ) … … 232 232 trc2d(:,:,jp_pcs0_2d + 1) = zoflx(:,:) * 1000 * tmask(:,:,1) 233 233 trc2d(:,:,jp_pcs0_2d + 2) = zkgco2(:,:) * tmask(:,:,1) 234 trc2d(:,:,jp_pcs0_2d + 3) = ( satmco2(:,:) * patm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1)234 trc2d(:,:,jp_pcs0_2d + 3) = ( zpco2atm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) 235 235 ENDIF 236 236 ENDIF -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90
r6841 r6966 66 66 REAL(wp) :: zomegaca, zexcess, zexcess0 67 67 CHARACTER (len=25) :: charout 68 REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zcaldiss, zhinit, zhi 68 REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zcaldiss, zhinit, zhi, zco3sat 69 69 !!--------------------------------------------------------------------- 70 70 ! 71 71 IF( nn_timing == 1 ) CALL timing_start('p4z_lys') 72 72 ! 73 CALL wrk_alloc( jpi, jpj, jpk, zco3, zcaldiss, zhinit, zhi )73 CALL wrk_alloc( jpi, jpj, jpk, zco3, zcaldiss, zhinit, zhi, zco3sat ) 74 74 ! 75 75 zco3 (:,:,:) = 0. … … 85 85 DO jj = 1, jpj 86 86 DO ji = 1, jpi 87 zfact = rhop(ji,jj,jk) / 1000. + rtrn88 87 zco3(ji,jj,jk) = trb(ji,jj,jk,jpdic) * ak13(ji,jj,jk) * ak23(ji,jj,jk) / (zhi(ji,jj,jk)**2 & 89 88 & + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn ) 90 hi(ji,jj,jk) = zhi(ji,jj,jk) * zfact89 hi(ji,jj,jk) = zhi(ji,jj,jk) * rhop(ji,jj,jk) / 1000. 91 90 END DO 92 91 END DO … … 105 104 ! DEVIATION OF [CO3--] FROM SATURATION VALUE 106 105 ! Salinity dependance in zomegaca and divide by rhop/1000 to have good units 107 zcalcon = calcon * ( tsn(ji,jj,jk,jp_sal) / 35._wp )106 zcalcon = calcon * ( salinprac(ji,jj,jk) / 35._wp ) 108 107 zfact = rhop(ji,jj,jk) / 1000._wp 109 zomegaca = ( zcalcon * zco3(ji,jj,jk) * zfact ) / aksp(ji,jj,jk) 108 zomegaca = ( zcalcon * zco3(ji,jj,jk) ) / ( aksp(ji,jj,jk) * zfact + rtrn ) 109 zco3sat(ji,jj,jk) = aksp(ji,jj,jk) * zfact / ( zcalcon + rtrn ) 110 110 111 111 ! SET DEGREE OF UNDER-/SUPERSATURATION … … 135 135 IF( iom_use( "PH" ) ) CALL iom_put( "PH" , -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:) ) 136 136 IF( iom_use( "CO3" ) ) CALL iom_put( "CO3" , zco3(:,:,:) * 1.e+3 * tmask(:,:,:) ) 137 IF( iom_use( "CO3sat" ) ) CALL iom_put( "CO3sat", aksp(:,:,:) * 1.e+3 / calcon* tmask(:,:,:) )138 IF( iom_use( "DCAL" ) ) CALL iom_put( "DCAL" , zcaldiss(:,:,:) * 1.e+3 * rfact2r 137 IF( iom_use( "CO3sat" ) ) CALL iom_put( "CO3sat", zco3sat(:,:,:) * 1.e+3 * tmask(:,:,:) ) 138 IF( iom_use( "DCAL" ) ) CALL iom_put( "DCAL" , zcaldiss(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) 139 139 140 140 ELSE … … 142 142 trc3d(:,:,:,jp_pcs0_3d ) = -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:) 143 143 trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:) * tmask(:,:,:) 144 trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon* tmask(:,:,:)144 trc3d(:,:,:,jp_pcs0_3d + 2) = zco3sat(:,:,:) * tmask(:,:,:) 145 145 ENDIF 146 146 ENDIF … … 153 153 ENDIF 154 154 ! 155 CALL wrk_dealloc( jpi, jpj, jpk, zco3, zcaldiss, zhinit, zhi )155 CALL wrk_dealloc( jpi, jpj, jpk, zco3, zcaldiss, zhinit, zhi, zco3sat ) 156 156 ! 157 157 IF( nn_timing == 1 ) CALL timing_stop('p4z_lys') -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
r6841 r6966 125 125 ! ! -------------------------------------- 126 126 IF( l_trcdm2dc ) THEN ! diurnal cycle 127 ! 1% of qsr to compute euphotic layer128 zqsr100(:,:) = 0.01 * qsr_mean(:,:) ! daily mean qsr129 127 ! 130 128 zqsr_corr(:,:) = qsr_mean(:,:) / ( 1. - fr_i(:,:) + rtrn ) 131 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 )129 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pe100 = zqsr100 ) 132 130 ! 133 131 DO jk = 1, nksrp … … 148 146 ! 149 147 ELSE 150 ! 1% of qsr to compute euphotic layer151 zqsr100(:,:) = 0.01 * qsr(:,:)152 148 ! 153 149 zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn ) 154 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 )150 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pe100 = zqsr100 ) 155 151 ! 156 152 DO jk = 1, nksrp … … 184 180 DO jj = 1, jpj 185 181 DO ji = 1, jpi 186 IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.43 *zqsr100(ji,jj) ) THEN182 IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= zqsr100(ji,jj) ) THEN 187 183 neln(ji,jj) = jk+1 ! Euphotic level : 1rst T-level strictly below Euphotic layer 188 184 ! ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint … … 190 186 ENDIF 191 187 IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.50 ) THEN 192 ! ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint 193 heup_01(ji,jj) = fsdepw(ji,jj,jk+1) ! Euphotic layer depth 188 heup_01(ji,jj) = fsdepw(ji,jj,jk+1) ! Euphotic layer depth (light level definition) 194 189 ENDIF 195 190 END DO … … 273 268 END SUBROUTINE p4z_opt 274 269 275 SUBROUTINE p4z_opt_par( kt, pqsr, pe1, pe2, pe3, pe0 )270 SUBROUTINE p4z_opt_par( kt, pqsr, pe1, pe2, pe3, pe0, pe100 ) 276 271 !!---------------------------------------------------------------------- 277 272 !! *** routine p4z_opt_par *** … … 285 280 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: pqsr ! shortwave 286 281 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe1 , pe2 , pe3 ! PAR ( R-G-B) 287 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL :: pe0 282 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL :: pe0 283 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout), OPTIONAL :: pe100 288 284 !! * local variables 289 285 INTEGER :: ji, jj, jk ! dummy loop indices … … 294 290 IF( ln_varpar ) THEN ; zqsr(:,:) = par_varsw(:,:) * pqsr(:,:) 295 291 ELSE ; zqsr(:,:) = xparsw * pqsr(:,:) 292 ENDIF 293 ! 294 IF( PRESENT( pe100 ) ) THEN 295 pe100(:,:) = 3. * 0.01 * zqsr(:,:) 296 296 ENDIF 297 297 ! -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zpoc.F90
r6931 r6966 63 63 ! 64 64 INTEGER :: ji, jj, jk, jn 65 REAL(wp) :: zremip, zremig, zdep, zorem 2, zofer65 REAL(wp) :: zremip, zremig, zdep, zorem, zorem2, zofer 66 66 REAL(wp) :: zsizek, zsizek1, alphat, remint 67 67 REAL(wp) :: solgoc, zpoc … … 220 220 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zofer2 - zofer3 221 221 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem2 222 orem(ji,jj,jk) = zorem2 222 223 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer2 223 224 END DO … … 389 390 ! -------------------------------------------------------- 390 391 zremip = zremipoc(ji,jj,jk) * zstep * tgfunc(ji,jj,jk) 391 orem(ji,jj,jk)= zremip * trb(ji,jj,jk,jppoc)392 zorem = zremip * trb(ji,jj,jk,jppoc) 392 393 zofer = zremip * trb(ji,jj,jk,jpsfe) 393 394 #if defined key_kriest … … 398 399 ! ------------------------------------- 399 400 400 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + orem(ji,jj,jk) 401 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem 402 orem(ji,jj,jk) = orem(ji,jj,jk) + zorem 401 403 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer 402 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - orem(ji,jj,jk)404 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zorem 403 405 #if defined key_kriest 404 406 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zorem2 -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
r6848 r6966 33 33 !! * Shared module variables 34 34 LOGICAL , PUBLIC :: ln_newprod !: 35 REAL(wp), PUBLIC :: pislope !:36 REAL(wp), PUBLIC :: pislope 2!:35 REAL(wp), PUBLIC :: pislopen !: 36 REAL(wp), PUBLIC :: pisloped !: 37 37 REAL(wp), PUBLIC :: xadap !: 38 REAL(wp), PUBLIC :: excret !:39 REAL(wp), PUBLIC :: excret 2!:38 REAL(wp), PUBLIC :: excretn !: 39 REAL(wp), PUBLIC :: excretd !: 40 40 REAL(wp), PUBLIC :: bresp !: 41 41 REAL(wp), PUBLIC :: chlcnm !: … … 51 51 52 52 REAL(wp) :: r1_rday !: 1 / rday 53 REAL(wp) :: texcret !: 1 - excret54 REAL(wp) :: texcret 2 !: 1 - excret253 REAL(wp) :: texcretn !: 1 - excretn 54 REAL(wp) :: texcretd !: 1 - excretd 55 55 56 56 … … 78 78 INTEGER :: ji, jj, jk 79 79 REAL(wp) :: zsilfac, 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, zdocprod 83 REAL(wp) :: zpislopen , zpislope2n 80 REAL(wp) :: zratio, zmax, zsilim, ztn, zadap, zlim, zsilfac2, zsiborn 81 REAL(wp) :: zprod, zproreg, zproreg2, zprochln, zprochld 82 REAL(wp) :: zmaxday, zdocprod, zpislopen, zpisloped 84 83 REAL(wp) :: zrum, zcodel, zargu, zval, zfeup 85 84 REAL(wp) :: zfact 86 85 CHARACTER (len=25) :: charout 87 86 REAL(wp), POINTER, DIMENSION(:,: ) :: zstrn, zw2d 88 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopead , zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt, zw3d89 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorca , zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd87 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopeadn, zpislopeadd, zprdia, zprbio, zprdch, zprnch, zysopt, zw3d 88 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorcan, zprorcad, zprofed, zprofen, zpronewn, zpronewd 90 89 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmxl_fac, zmxl_chl 91 90 !!--------------------------------------------------------------------- … … 95 94 ! Allocate temporary workspace 96 95 CALL wrk_alloc( jpi, jpj, zstrn ) 97 CALL wrk_alloc( jpi, jpj, jpk, zpislopead , zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt )96 CALL wrk_alloc( jpi, jpj, jpk, zpislopeadn, zpislopeadd, zprdia, zprbio, zprdch, zprnch, zysopt ) 98 97 CALL wrk_alloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl ) 99 CALL wrk_alloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd ) 100 ! 101 zprorca (:,:,:) = 0._wp 102 zprorcad(:,:,:) = 0._wp 103 zprofed (:,:,:) = 0._wp 104 zprofen (:,:,:) = 0._wp 105 zprochln(:,:,:) = 0._wp 106 zprochld(:,:,:) = 0._wp 107 zpronew (:,:,:) = 0._wp 108 zpronewd(:,:,:) = 0._wp 109 zprdia (:,:,:) = 0._wp 110 zprbio (:,:,:) = 0._wp 111 zprdch (:,:,:) = 0._wp 112 zprnch (:,:,:) = 0._wp 113 zysopt (:,:,:) = 0._wp 98 CALL wrk_alloc( jpi, jpj, jpk, zprorcan, zprorcad, zprofed, zprofen, zpronewn, zpronewd ) 99 ! 100 zprorcan(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp ; zprofed (:,:,:) = 0._wp 101 zprofen (:,:,:) = 0._wp ; zysopt (:,:,:) = 0._wp 102 zpronewn(:,:,:) = 0._wp ; zpronewd(:,:,:) = 0._wp ; zprdia (:,:,:) = 0._wp 103 zprbio (:,:,:) = 0._wp ; zprdch (:,:,:) = 0._wp ; zprnch (:,:,:) = 0._wp 114 104 115 105 ! Computation of the optimal production … … 144 134 zmxl_chl(ji,jj,jk) = zmxl_chl(ji,jj,jk) * zval 145 135 ENDIF 146 zmxl_fac(ji,jj,jk) = ( 1. - exp( -0.2 * zmxl_fac(ji,jj,jk) ) ) * ( 1. - fr_i(ji,jj) )147 zmxl_chl(ji,jj,jk) = zmxl_chl(ji,jj,jk) * ( 1. - fr_i(ji,jj) )136 zmxl_fac(ji,jj,jk) = ( 1. - exp( -0.2 * zmxl_fac(ji,jj,jk) ) ) 137 zmxl_chl(ji,jj,jk) = zmxl_chl(ji,jj,jk) 148 138 ENDIF 149 139 END DO … … 166 156 zconctemp2 = trb(ji,jj,jk,jpdia) - zconctemp 167 157 ! 168 zpislopead (ji,jj,jk) = pislope* ( 1.+ zadap * EXP( -0.25 * enano(ji,jj,jk) ) ) &158 zpislopeadn(ji,jj,jk) = pislopen * ( 1.+ zadap * EXP( -0.25 * enano(ji,jj,jk) ) ) & 169 159 & * trb(ji,jj,jk,jpnch) /( trb(ji,jj,jk,jpphy) * 12. + rtrn) 170 160 ! 171 zpislopead 2(ji,jj,jk) = (pislope * zconctemp2 + pislope2* zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn ) &161 zpislopeadd(ji,jj,jk) = (pislopen * zconctemp2 + pisloped * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn ) & 172 162 & * trb(ji,jj,jk,jpdch) /( trb(ji,jj,jk,jpdia) * 12. + rtrn) 173 163 ENDIF … … 183 173 ! Computation of production function for Carbon 184 174 ! --------------------------------------------- 185 zpislopen = zpislopead(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) &175 zpislopen = zpislopeadn(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 186 176 & * zmxl_fac(ji,jj,jk) * rday + rtrn) 187 zpislope 2n = zpislopead2(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) &177 zpisloped = zpislopeadd(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 188 178 & * zmxl_fac(ji,jj,jk) * rday + rtrn) 189 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen 190 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope 2n* ediat(ji,jj,jk) ) )179 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 180 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 191 181 ! Computation of production function for Chlorophyll 192 182 !-------------------------------------------------- 193 zpislopen = zpislopead(ji,jj,jk) / ( prmax(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn )194 zpislope 2n = zpislopead2(ji,jj,jk) / ( prmax(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn )195 zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen 196 zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope 2n* ediat(ji,jj,jk) ) )183 zpislopen = zpislopeadn(ji,jj,jk) / ( prmax(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 184 zpisloped = zpislopeadd(ji,jj,jk) / ( prmax(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 185 zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 186 zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 197 187 ENDIF 198 188 END DO … … 206 196 ! Computation of production function for Carbon 207 197 ! --------------------------------------------- 208 zpislopen = zpislopead(ji,jj,jk) / ( zprbio(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn )209 zpislope 2n = zpislopead2(ji,jj,jk) / ( zprdia(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn )210 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen 211 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope 2n* ediat(ji,jj,jk) ) )198 zpislopen = zpislopeadn(ji,jj,jk) / ( zprbio(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 199 zpisloped = zpislopeadd(ji,jj,jk) / ( zprdia(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 200 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 201 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 212 202 ! Computation of production function for Chlorophyll 213 203 !-------------------------------------------------- 214 zpislopen = zpislopen 215 zpislope 2n = zpislope2n* zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )216 zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen 217 zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope 2n* ediat(ji,jj,jk) ) )204 zpislopen = zpislopen * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 205 zpisloped = zpisloped * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 206 zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 207 zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 218 208 ENDIF 219 209 END DO … … 221 211 END DO 222 212 ENDIF 223 224 213 225 214 ! Computation of a proxy of the N/C ratio … … 264 253 END DO 265 254 255 ! Sea-ice effect on production 256 257 DO jk = 1, jpkm1 258 zprbio(:,:,jk) = zprbio(:,:,jk) * ( 1. - fr_i(:,:) ) 259 zprdia(:,:,jk) = zprdia(:,:,jk) * ( 1. - fr_i(:,:) ) 260 END DO 261 262 266 263 ! Computation of the various production terms 267 264 !CDIR NOVERRCHK … … 272 269 DO ji = 1, jpi 273 270 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 274 ! production terms for nanophyto. 275 zprorca (ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2276 zpronew (ji,jj,jk) = zprorca(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn )271 ! production terms for nanophyto. (C) 272 zprorcan(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2 273 zpronewn(ji,jj,jk) = zprorcan(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 277 274 ! 278 zratio = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn ) 279 zratio = zratio / fecnm 275 zratio = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) * fecnm + rtrn ) 280 276 zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 281 zprofen(ji,jj,jk) = fecnm * prmax(ji,jj,jk) &277 zprofen(ji,jj,jk) = fecnm * prmax(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) ) & 282 278 & * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) ) & 283 279 & * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) ) & 284 280 & * zmax * trb(ji,jj,jk,jpphy) * rfact2 285 ! production terms for diatom ees281 ! production terms for diatoms (C) 286 282 zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trb(ji,jj,jk,jpdia) * rfact2 287 283 zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 288 284 ! 289 zratio = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn ) 290 zratio = zratio / fecdm 285 zratio = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) * fecdm + rtrn ) 291 286 zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 292 zprofed(ji,jj,jk) = fecdm * prmax(ji,jj,jk) &287 zprofed(ji,jj,jk) = fecdm * prmax(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) ) & 293 288 & * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) ) & 294 289 & * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) ) & … … 299 294 END DO 300 295 296 ! Computation of the chlorophyll production terms 301 297 DO jk = 1, jpkm1 302 298 DO jj = 1, jpj … … 305 301 ! production terms for nanophyto. ( chlorophyll ) 306 302 znanotot = enano(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 307 zprod = rday * zprorca (ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk)308 zprochln (ji,jj,jk) = chlcmin * 12. * zprorca(ji,jj,jk)309 zprochln (ji,jj,jk) = zprochln(ji,jj,jk)+ (chlcnm-chlcmin) * 12. * zprod / &310 & ( zpislopead (ji,jj,jk) * znanotot +rtrn)311 ! production terms for diatom ees ( chlorophyll )303 zprod = rday * zprorcan(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 304 zprochln = chlcmin * 12. * zprorcan (ji,jj,jk) 305 zprochln = zprochln + (chlcnm-chlcmin) * 12. * zprod / & 306 & ( zpislopeadn(ji,jj,jk) * znanotot +rtrn) 307 ! production terms for diatoms ( chlorophyll ) 312 308 zdiattot = ediat(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 313 309 zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 314 zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk) 315 zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + (chlcdm-chlcmin) * 12. * zprod / & 316 & ( zpislopead2(ji,jj,jk) * zdiattot +rtrn ) 310 zprochld = chlcmin * 12. * zprorcad(ji,jj,jk) 311 zprochld = zprochld + (chlcdm-chlcmin) * 12. * zprod / & 312 & ( zpislopeadd(ji,jj,jk) * zdiattot +rtrn ) 313 ! Update the arrays TRA which contain the Chla sources and sinks 314 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln * texcretn 315 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld * texcretd 317 316 ENDIF 318 317 END DO … … 324 323 DO jj = 1, jpj 325 324 DO ji =1 ,jpi 326 zproreg = zprorca(ji,jj,jk) - zpronew(ji,jj,jk) 327 zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk) 328 zdocprod = excret2 * zprorcad(ji,jj,jk) + excret * zprorca(ji,jj,jk) 329 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zprorca(ji,jj,jk) - zprorcad(ji,jj,jk) 330 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronew(ji,jj,jk) - zpronewd(ji,jj,jk) 331 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproreg - zproreg2 332 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorca(ji,jj,jk) * texcret 333 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln(ji,jj,jk) * texcret 334 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcret 335 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcret2 336 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld(ji,jj,jk) * texcret2 337 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcret2 338 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcret2 339 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zdocprod 340 zfeup = texcret * zprofen(ji,jj,jk) + texcret2 * zprofed(ji,jj,jk) 325 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 326 zproreg = zprorcan(ji,jj,jk) - zpronewn(ji,jj,jk) 327 zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk) 328 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 329 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 330 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk) 331 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproreg - zproreg2 332 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorcan(ji,jj,jk) * texcretn 333 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcretn 334 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcretd 335 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcretd 336 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 337 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zdocprod 338 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 341 339 #if defined key_ligand 342 tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet340 tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 343 341 #endif 344 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) & 345 & + ( o2ut + o2nit ) * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) 346 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zfeup 347 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcret2 * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 348 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorca(ji,jj,jk) - zprorcad(ji,jj,jk) 349 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 350 & - rno3 * ( zproreg + zproreg2 ) 351 END DO 342 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) & 343 & + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) 344 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zfeup 345 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 346 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 347 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 348 & - rno3 * ( zproreg + zproreg2 ) 349 ENDIF 350 END DO 352 351 END DO 353 352 END DO … … 356 355 ! Total primary production per year 357 356 IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc ) ) & 358 & tpp = glob_sum( ( zprorca (:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) )357 & tpp = glob_sum( ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) ) 359 358 360 359 IF( lk_iomput ) THEN … … 365 364 ! 366 365 IF( iom_use( "PPPHY" ) .OR. iom_use( "PPPHY2" ) ) THEN 367 zw3d(:,:,:) = zprorca 366 zw3d(:,:,:) = zprorcan(:,:,:) * zfact * tmask(:,:,:) ! primary production by nanophyto 368 367 CALL iom_put( "PPPHY" , zw3d ) 369 368 ! … … 372 371 ENDIF 373 372 IF( iom_use( "PPNEWN" ) .OR. iom_use( "PPNEWD" ) ) THEN 374 zw3d(:,:,:) = zpronew 373 zw3d(:,:,:) = zpronewn(:,:,:) * zfact * tmask(:,:,:) ! new primary production by nanophyto 375 374 CALL iom_put( "PPNEWN" , zw3d ) 376 375 ! … … 408 407 ENDIF 409 408 IF( iom_use( "TPP" ) ) THEN 410 zw3d(:,:,:) = ( zprorca (:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:) ! total primary production409 zw3d(:,:,:) = ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:) ! total primary production 411 410 CALL iom_put( "TPP" , zw3d ) 412 411 ENDIF 413 412 IF( iom_use( "TPNEW" ) ) THEN 414 zw3d(:,:,:) = ( zpronew (:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:) ! total new production413 zw3d(:,:,:) = ( zpronewn(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:) ! total new production 415 414 CALL iom_put( "TPNEW" , zw3d ) 416 415 ENDIF … … 422 421 zw2d(:,:) = 0. 423 422 DO jk = 1, jpkm1 424 zw2d(:,:) = zw2d(:,:) + zprorca 423 zw2d(:,:) = zw2d(:,:) + zprorcan(:,:,jk) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by nano 425 424 ENDDO 426 425 CALL iom_put( "INTPPPHY" , zw2d ) … … 435 434 zw2d(:,:) = 0. 436 435 DO jk = 1, jpkm1 437 zw2d(:,:) = zw2d(:,:) + ( zprorca (:,:,jk) + zprorcad(:,:,jk) ) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp436 zw2d(:,:) = zw2d(:,:) + ( zprorcan(:,:,jk) + zprorcad(:,:,jk) ) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp 438 437 ENDDO 439 438 CALL iom_put( "INTPP" , zw2d ) … … 442 441 zw2d(:,:) = 0. 443 442 DO jk = 1, jpkm1 444 zw2d(:,:) = zw2d(:,:) + ( zpronew (:,:,jk) + zpronewd(:,:,jk) ) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated new prod443 zw2d(:,:) = zw2d(:,:) + ( zpronewn(:,:,jk) + zpronewd(:,:,jk) ) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated new prod 445 444 ENDDO 446 445 CALL iom_put( "INTPNEW" , zw2d ) … … 468 467 IF( ln_diatrc ) THEN 469 468 zfact = 1.e+3 * rfact2r 470 trc3d(:,:,:,jp_pcs0_3d + 4) = zprorca 469 trc3d(:,:,:,jp_pcs0_3d + 4) = zprorcan(:,:,:) * zfact * tmask(:,:,:) 471 470 trc3d(:,:,:,jp_pcs0_3d + 5) = zprorcad(:,:,:) * zfact * tmask(:,:,:) 472 trc3d(:,:,:,jp_pcs0_3d + 6) = zpronew 471 trc3d(:,:,:,jp_pcs0_3d + 6) = zpronewn(:,:,:) * zfact * tmask(:,:,:) 473 472 trc3d(:,:,:,jp_pcs0_3d + 7) = zpronewd(:,:,:) * zfact * tmask(:,:,:) 474 473 trc3d(:,:,:,jp_pcs0_3d + 8) = zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:) … … 487 486 ! 488 487 CALL wrk_dealloc( jpi, jpj, zstrn ) 489 CALL wrk_dealloc( jpi, jpj, jpk, zpislopead , zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt )488 CALL wrk_dealloc( jpi, jpj, jpk, zpislopeadn, zpislopeadd, zprdia, zprbio, zprdch, zprnch, zysopt ) 490 489 CALL wrk_dealloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl ) 491 CALL wrk_dealloc( jpi, jpj, jpk, zprorca , zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd )490 CALL wrk_dealloc( jpi, jpj, jpk, zprorcan, zprorcad, zprofed, zprofen, zpronewn, zpronewd ) 492 491 ! 493 492 IF( nn_timing == 1 ) CALL timing_stop('p4z_prod') … … 508 507 !!---------------------------------------------------------------------- 509 508 ! 510 NAMELIST/nampisprod/ pislope , pislope2, xadap, ln_newprod, bresp, excret, excret2, &509 NAMELIST/nampisprod/ pislopen, pisloped, xadap, ln_newprod, bresp, excretn, excretd, & 511 510 & chlcnm, chlcdm, chlcmin, fecnm, fecdm, grosip 512 511 INTEGER :: ios ! Local integer output status for namelist read … … 526 525 WRITE(numout,*) ' Namelist parameters for phytoplankton growth, nampisprod' 527 526 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 528 WRITE(numout,*) ' Enable new parame. of production (T/F) ln_newprod =', ln_newprod527 WRITE(numout,*) ' Enable new parame. of production (T/F) ln_newprod =', ln_newprod 529 528 WRITE(numout,*) ' mean Si/C ratio grosip =', grosip 530 WRITE(numout,*) ' P-I slope pislope =', pislope531 WRITE(numout,*) ' Acclimation factor to low light xadap =', xadap532 WRITE(numout,*) ' excretion ratio of nanophytoplankton excret =', excret533 WRITE(numout,*) ' excretion ratio of diatoms excret 2 =', excret2529 WRITE(numout,*) ' P-I slope pislopen =', pislopen 530 WRITE(numout,*) ' Acclimation factor to low light xadap =', xadap 531 WRITE(numout,*) ' excretion ratio of nanophytoplankton excretn =', excretn 532 WRITE(numout,*) ' excretion ratio of diatoms excretd =', excretd 534 533 IF( ln_newprod ) THEN 535 534 WRITE(numout,*) ' basal respiration in phytoplankton bresp =', bresp 536 535 WRITE(numout,*) ' Maximum Chl/C in phytoplankton chlcmin =', chlcmin 537 536 ENDIF 538 WRITE(numout,*) ' P-I slope for diatoms pislope 2 =', pislope2537 WRITE(numout,*) ' P-I slope for diatoms pisloped =', pisloped 539 538 WRITE(numout,*) ' Minimum Chl/C in nanophytoplankton chlcnm =', chlcnm 540 539 WRITE(numout,*) ' Minimum Chl/C in diatoms chlcdm =', chlcdm … … 544 543 ! 545 544 r1_rday = 1._wp / rday 546 texcret = 1._wp - excret547 texcret 2 = 1._wp - excret2545 texcretn = 1._wp - excretn 546 texcretd = 1._wp - excretd 548 547 tpp = 0._wp 549 548 ! -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90
r6841 r6966 19 19 USE p4zbio ! Biological model 20 20 USE p4zche ! Chemical model 21 USE p4zlys ! Calcite saturation 21 22 USE p4zflx ! Gas exchange 22 23 USE p4zsbc ! External source of nutrients … … 132 133 ! 133 134 CALL p4z_bio( kt, jnt ) ! Biology 135 CALL p4z_lys( kt, jnt ) ! Compute CaCO3 saturation 134 136 CALL p4z_flx( kt, jnt ) ! Compute surface fluxes 135 137 CALL p4z_sed( kt, jnt ) ! Sedimentation -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P5Z/p5zbio.F90
r6453 r6966 28 28 USE p5zpoc ! Remineralisation of organic particles 29 29 USE p5zagg ! Aggregation of particles 30 USE p4zlys ! Dissolution of calcite31 USE p4zfechem ! Iron chemistry32 30 USE p4zligand ! Remineralization of ligands 33 31 USE prtctl_trc ! print control for debugging … … 82 80 CALL p4z_opt ( kt, knt ) ! Optic: PAR in the water column 83 81 CALL p5z_sink ( kt, knt ) ! vertical flux of particulate organic matter 84 CALL p4z_lys (kt, knt ) ! Dissolution of calcite85 82 CALL p4z_fechem(kt, knt ) ! Iron chemistry/scavenging 86 83 CALL p5z_lim ( kt, knt ) ! co-limitations by the various nutrients -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P5Z/p5zpoc.F90
r6841 r6966 67 67 INTEGER :: ji, jj, jk, jn 68 68 REAL(wp) :: zremip, zremig, zdep, zstep 69 REAL(wp) :: zopon, zopop, zopoc 2, zopon2, zopop2, zofer69 REAL(wp) :: zopon, zopop, zopoc, zopoc2, zopon2, zopop2, zofer 70 70 REAL(wp) :: zsizek, zsizek1, alphat, remint 71 71 REAL(wp) :: solgoc, zpoc … … 211 211 zremig = zremigoc(ji,jj,jk) * zstep * tgfunc(ji,jj,jk) 212 212 zopoc2 = zremig * trb(ji,jj,jk,jpgoc) 213 orem(ji,jj,jk) = zopoc2 213 214 zopon2 = xremipn / xremipc * zremig * trb(ji,jj,jk,jpgon) 214 215 zopop2 = xremipp / xremipc * zremig * trb(ji,jj,jk,jpgop) … … 396 397 ! -------------------------------------------------------- 397 398 zremip = zremipoc(ji,jj,jk) * zstep * tgfunc(ji,jj,jk) 398 399 orem(ji,jj,jk) = zremip * trb(ji,jj,jk,jppoc)399 zopoc = zremip * trb(ji,jj,jk,jppoc) 400 orem(ji,jj,jk) = orem(ji,jj,jk) + zopoc 400 401 zopon = xremipn / xremipc * zremip * trb(ji,jj,jk,jppon) 401 402 zopop = xremipp / xremipc * zremip * trb(ji,jj,jk,jppop) … … 407 408 ! Update the appropriate tracers trends 408 409 ! ------------------------------------- 409 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - orem(ji,jj,jk)410 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zopoc 410 411 tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) - zopon 411 412 tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) - zopop 412 413 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zofer 413 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + orem(ji,jj,jk)414 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zopoc 414 415 tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zopon 415 416 tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zopop -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P5Z/p5zprod.F90
r6841 r6966 33 33 34 34 !! * Shared module variables 35 REAL(wp), PUBLIC :: pislope 35 REAL(wp), PUBLIC :: pislopen !: 36 36 REAL(wp), PUBLIC :: pislopep !: 37 REAL(wp), PUBLIC :: pislope 2!:37 REAL(wp), PUBLIC :: pisloped !: 38 38 REAL(wp), PUBLIC :: xadap !: 39 REAL(wp), PUBLIC :: excret 39 REAL(wp), PUBLIC :: excretn !: 40 40 REAL(wp), PUBLIC :: excretp !: 41 REAL(wp), PUBLIC :: excret 2!:41 REAL(wp), PUBLIC :: excretd !: 42 42 REAL(wp), PUBLIC :: bresp !: 43 43 REAL(wp), PUBLIC :: thetanpm !: … … 56 56 57 57 REAL(wp) :: r1_rday !: 1 / rday 58 REAL(wp) :: texcret 58 REAL(wp) :: texcretn !: 1 - excret 59 59 REAL(wp) :: texcretp !: 1 - excretp 60 REAL(wp) :: texcret 2!: 1 - excret260 REAL(wp) :: texcretd !: 1 - excret2 61 61 62 62 … … 87 87 REAL(wp) :: zpronmax, zpropmax, zprofmax, zrat 88 88 REAL(wp) :: zlim, zsilfac2, zsiborn, zprod, zprontot, zproptot, zprodtot 89 REAL(wp) :: z mxltst, zmxlday, zprnutmax, zdocprod90 REAL(wp) :: zpislopen, zpislopep, zpislope 2n89 REAL(wp) :: zprnutmax, zdocprod, zprochln, zprochld, zprochlp 90 REAL(wp) :: zpislopen, zpislopep, zpisloped 91 91 REAL(wp) :: zrum, zcodel, zargu, zval, zfeup 92 92 REAL(wp) :: zrfact2 93 93 CHARACTER (len=25) :: charout 94 94 REAL(wp), POINTER, DIMENSION(:,: ) :: zmixnano, zmixpico, zmixdiat, zstrn 95 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopead , zpislopeadp, zpislopead295 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopeadn, zpislopeadp, zpislopead 96 96 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprbio, zprpic, zprdia, zysopt 97 97 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprchln, zprchlp, zprchld 98 98 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorcan, zprorcap, zprorcad 99 99 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprofed, zprofep, zprofen 100 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprochln, zprochlp, zprochld101 100 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpronewn, zpronewp, zpronewd 102 101 REAL(wp), POINTER, DIMENSION(:,:,:) :: zproregn, zproregp, zproregd … … 105 104 REAL(wp), POINTER, DIMENSION(:,:,:) :: zrespn, zrespp, zrespd, zprnut 106 105 REAL(wp), POINTER, DIMENSION(:,:,:) :: zcroissn, zcroissp, zcroissd 106 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmxl_fac, zmxl_chl 107 107 !!--------------------------------------------------------------------- 108 108 ! … … 111 111 ! Allocate temporary workspace 112 112 CALL wrk_alloc( jpi, jpj, zmixnano, zmixpico, zmixdiat, zstrn ) 113 CALL wrk_alloc( jpi, jpj, jpk, zpislopead, zpislopeadp, zpislopead2, zysopt ) 113 CALL wrk_alloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl ) 114 CALL wrk_alloc( jpi, jpj, jpk, zpislopeadn, zpislopeadp, zpislopead, zysopt ) 114 115 CALL wrk_alloc( jpi, jpj, jpk, zprdia, zprpic, zprbio, zprorcan, zprorcap, zprorcad ) 115 CALL wrk_alloc( jpi, jpj, jpk, zprofed, zprofep, zprofen , zprochln, zprochlp, zprochld)116 CALL wrk_alloc( jpi, jpj, jpk, zprofed, zprofep, zprofen ) 116 117 CALL wrk_alloc( jpi, jpj, jpk, zpronewn, zpronewp, zpronewd, zproregn, zproregp, zproregd ) 117 118 CALL wrk_alloc( jpi, jpj, jpk, zpropo4n, zpropo4p, zpropo4d, zrespn, zrespp, zrespd, zprnut ) … … 121 122 zprorcan(:,:,:) = 0._wp ; zprorcap(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp 122 123 zprofed (:,:,:) = 0._wp ; zprofep (:,:,:) = 0._wp ; zprofen (:,:,:) = 0._wp 123 zprochln(:,:,:) = 0._wp ; zprochlp(:,:,:) = 0._wp ; zprochld(:,:,:) = 0._wp124 124 zpronewn(:,:,:) = 0._wp ; zpronewp(:,:,:) = 0._wp ; zpronewd(:,:,:) = 0._wp 125 125 zproregn(:,:,:) = 0._wp ; zproregp(:,:,:) = 0._wp ; zproregd(:,:,:) = 0._wp … … 159 159 DO jj = 1 ,jpj 160 160 DO ji = 1, jpi 161 IF( etot (ji,jj,jk) > 1.E-3 ) THEN161 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 162 162 zval = MAX( 1., zstrn(ji,jj) ) 163 zval = 1.5 * zval / (12. + zval) * (1. - fr_i(ji,jj)) 164 zprbio(ji,jj,jk) = prmaxn(ji,jj,jk) * zval 165 zprpic(ji,jj,jk) = prmaxp(ji,jj,jk) * zval 166 zprdia(ji,jj,jk) = prmaxd(ji,jj,jk) * zval 163 zmxl_fac(ji,jj,jk) = zval 164 zmxl_chl(ji,jj,jk) = zval / 24. 165 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 166 zval = MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 167 zmxl_fac(ji,jj,jk) = zmxl_fac(ji,jj,jk) * zval 168 zmxl_chl(ji,jj,jk) = zmxl_chl(ji,jj,jk) * zval 169 ENDIF 170 zmxl_fac(ji,jj,jk) = ( 1. - exp( -0.2 * zmxl_fac(ji,jj,jk) ) ) 171 zmxl_chl(ji,jj,jk) = zmxl_chl(ji,jj,jk) 167 172 ENDIF 168 173 END DO 169 174 END DO 170 175 END DO 176 177 zprbio(:,:,:) = prmaxn(:,:,:) * zmxl_fac(:,:,:) 178 zprdia(:,:,:) = prmaxd(:,:,:) * zmxl_fac(:,:,:) 179 zprpic(:,:,:) = prmaxp(:,:,:) * zmxl_fac(:,:,:) 180 171 181 172 182 ! Maximum light intensity … … 180 190 !CDIR NOVERRCHK 181 191 DO ji = 1, jpi 192 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 182 193 ! Computation of the P-I slope for nanos and diatoms 183 IF( etot(ji,jj,jk) > 1.E-3 ) THEN184 194 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 185 195 zadap = xadap * ztn / ( 2.+ ztn ) 186 znanotot = enano(ji,jj,jk) * zstrn(ji,jj)187 zpicotot = epico(ji,jj,jk) * zstrn(ji,jj)188 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj)189 196 ! 190 zpislopead (ji,jj,jk) = pislope* trb(ji,jj,jk,jpnch) &197 zpislopeadn(ji,jj,jk) = pislopen * trb(ji,jj,jk,jpnch) & 191 198 & /( trb(ji,jj,jk,jpphy) * 12. + rtrn) 192 zpislopeadp(ji,jj,jk) = pislopep * ( 1. + zadap * EXP( -0. 5 * zpicotot) ) &199 zpislopeadp(ji,jj,jk) = pislopep * ( 1. + zadap * EXP( -0.25 * epico(ji,jj,jk) ) ) & 193 200 & * trb(ji,jj,jk,jppch) /( trb(ji,jj,jk,jppic) * 12. + rtrn) 194 zpislopead 2(ji,jj,jk) = pislope2* trb(ji,jj,jk,jpdch) &201 zpislopeadd(ji,jj,jk) = pisloped * trb(ji,jj,jk,jpdch) & 195 202 & /( trb(ji,jj,jk,jpdia) * 12. + rtrn) 196 zpislopen = zpislopead (ji,jj,jk) / ( prmaxn(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 197 zpislopep = zpislopeadp(ji,jj,jk) / ( prmaxp(ji,jj,jk) * rday * xlimpic(ji,jj,jk) + rtrn ) 198 zpislope2n = zpislopead2(ji,jj,jk) / ( prmaxd(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 203 ! 204 zpislopen = zpislopeadn(ji,jj,jk) / ( prmaxn(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 205 zpislopep = zpislopeadp(ji,jj,jk) / ( prmaxp(ji,jj,jk) * rday * xlimpic(ji,jj,jk) + rtrn ) 206 zpisloped = zpislopeadd(ji,jj,jk) / ( prmaxd(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 199 207 200 208 ! Computation of production function for Carbon 201 209 ! --------------------------------------------- 202 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * znanotot) )203 zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1.- EXP( -zpislopep * zpicotot) )204 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope 2n * zdiattot) )210 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 211 zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1.- EXP( -zpislopep * epico(ji,jj,jk) ) ) 212 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 205 213 206 214 ! Computation of production function for Chlorophyll 207 215 ! ------------------------------------------------- 208 zprchln(ji,jj,jk) = prmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 209 zprchlp(ji,jj,jk) = prmaxp(ji,jj,jk) * ( 1.- EXP( -zpislopep * epico(ji,jj,jk) ) ) 210 zprchld(ji,jj,jk) = prmaxd(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) ) 216 zpislopen = zpislopen * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 217 zpisloped = zpisloped * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 218 zpislopep = zpislopep * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 219 zprchln(ji,jj,jk) = prmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 220 zprchlp(ji,jj,jk) = prmaxp(ji,jj,jk) * ( 1.- EXP( -zpislopep * epico(ji,jj,jk) ) ) 221 zprchld(ji,jj,jk) = prmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 211 222 ENDIF 212 223 END DO … … 217 228 DO jj = 1, jpj 218 229 DO ji = 1, jpi 219 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 230 231 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 220 232 ! Si/C of diatoms 221 233 ! ------------------------ … … 238 250 END DO 239 251 240 ! Computation of the limitation term due to a mixed layer deeper than the euphotic depth 241 DO jj = 1, jpj 242 DO ji = 1, jpi 243 zmxltst = MAX( 0.e0, hmld(ji,jj) - heup_01(ji,jj) ) 244 zmxlday = zmxltst * zmxltst * r1_rday 245 zmixnano(ji,jj) = 1. - zmxlday / ( zlimmxln + zmxlday ) 246 zmixpico(ji,jj) = 1. - zmxlday / ( zlimmxlp + zmxlday ) 247 zmixdiat(ji,jj) = 1. - zmxlday / ( zlimmxld + zmxlday ) 248 END DO 249 END DO 250 251 ! Mixed-layer effect on production 252 DO jk = 1, jpkm1 253 DO jj = 1, jpj 254 DO ji = 1, jpi 255 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 256 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * zmixnano(ji,jj) 257 zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * zmixpico(ji,jj) 258 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * zmixdiat(ji,jj) 259 zprchln(ji,jj,jk) = zprchln(ji,jj,jk) * zmixnano(ji,jj) 260 zprchlp(ji,jj,jk) = zprchlp(ji,jj,jk) * zmixpico(ji,jj) 261 zprchld(ji,jj,jk) = zprchld(ji,jj,jk) * zmixdiat(ji,jj) 262 ENDIF 252 ! Sea-ice effect on production 253 DO jk = 1, jpkm1 254 DO jj = 1, jpj 255 DO ji = 1, jpi 256 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 257 zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 258 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 259 zprnut(ji,jj,jk) = zprnut(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 263 260 END DO 264 261 END DO … … 269 266 DO jj = 1, jpj 270 267 DO ji = 1, jpi 271 IF( etot (ji,jj,jk) > 1.E-3 ) THEN268 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 272 269 ! production terms for nanophyto. 273 270 zprorcan(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2 … … 306 303 DO jj = 1, jpj 307 304 DO ji = 1, jpi 308 IF( etot (ji,jj,jk) > 1.E-3 ) THEN305 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 309 306 ! production terms for picophyto. 310 307 zprorcap(ji,jj,jk) = zprpic(ji,jj,jk) * xlimpic(ji,jj,jk) * trb(ji,jj,jk,jppic) * rfact2 … … 343 340 DO jj = 1, jpj 344 341 DO ji = 1, jpi 345 IF( etot (ji,jj,jk) > 1.E-3 ) THEN342 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 346 343 ! production terms for diatomees 347 344 zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trb(ji,jj,jk,jpdia) * rfact2 … … 381 378 DO jj = 1, jpj 382 379 DO ji = 1, jpi 383 IF( etot (ji,jj,jk) > 1.E-3 ) THEN380 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 384 381 ! production terms for nanophyto. ( chlorophyll ) 382 znanotot = enano(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 385 383 zprod = rday * (zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)) * zprchln(ji,jj,jk) * xlimphy(ji,jj,jk) 386 zprochln (ji,jj,jk) = thetannm * zprod / ( zpislopead(ji,jj,jk) * enano(ji,jj,jk) +rtrn )387 zprochln (ji,jj,jk) = MAX(zprochln(ji,jj,jk), chlcmin * 12. * zprorcan (ji,jj,jk) )384 zprochln = thetannm * zprod / ( zpislopeadn(ji,jj,jk) * znanotot + rtrn ) 385 zprochln = MAX(zprochln, chlcmin * 12. * zprorcan (ji,jj,jk) ) 388 386 ! production terms for picophyto. ( chlorophyll ) 387 zpicotot = epico(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 389 388 zprod = rday * (zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)) * zprchlp(ji,jj,jk) * xlimpic(ji,jj,jk) 390 zprochlp (ji,jj,jk) = thetanpm * zprod / ( zpislopeadp(ji,jj,jk) * epico(ji,jj,jk) +rtrn )391 zprochlp (ji,jj,jk) = MAX(zprochlp(ji,jj,jk), chlcmin * 12. * zprorcap(ji,jj,jk) )389 zprochlp = thetanpm * zprod / ( zpislopeadp(ji,jj,jk) * zpicotot + rtrn ) 390 zprochlp = MAX(zprochlp, chlcmin * 12. * zprorcap(ji,jj,jk) ) 392 391 ! production terms for diatomees ( chlorophyll ) 392 zdiattot = ediat(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 393 393 zprod = rday * (zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)) * zprchld(ji,jj,jk) * xlimdia(ji,jj,jk) 394 zprochld(ji,jj,jk) = thetandm * zprod / ( zpislopead2(ji,jj,jk) * ediat(ji,jj,jk) +rtrn ) 395 zprochld(ji,jj,jk) = MAX(zprochld(ji,jj,jk), chlcmin * 12. * zprorcad(ji,jj,jk) ) 394 zprochld = thetandm * zprod / ( zpislopeadd(ji,jj,jk) * zdiattot + rtrn ) 395 zprochld = MAX(zprochld, chlcmin * 12. * zprorcad(ji,jj,jk) ) 396 ! Update the arrays TRA which contain the Chla sources and sinks 397 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln * texcretn 398 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld * texcretd 399 tra(ji,jj,jk,jppch) = tra(ji,jj,jk,jppch) + zprochlp * texcretp 396 400 ENDIF 397 401 END DO … … 406 410 zproptot = zpronewp(ji,jj,jk) + zproregp(ji,jj,jk) 407 411 zprodtot = zpronewd(ji,jj,jk) + zproregd(ji,jj,jk) 408 zdocprod = excret 2 * zprorcad(ji,jj,jk) + excret* zprorcan(ji,jj,jk) &412 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) & 409 413 & + excretp * zprorcap(ji,jj,jk) 410 414 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zpropo4n(ji,jj,jk) - zpropo4d(ji,jj,jk) & … … 414 418 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproregn(ji,jj,jk) - zproregd(ji,jj,jk) & 415 419 & - zproregp(ji,jj,jk) 416 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorcan(ji,jj,jk) * texcret 420 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorcan(ji,jj,jk) * texcretn & 417 421 & - zpsino3 * zpronewn(ji,jj,jk) - zpsinh4 * zproregn(ji,jj,jk) & 418 422 & - zrespn(ji,jj,jk) 419 423 zcroissn(ji,jj,jk) = tra(ji,jj,jk,jpphy) / rfact2/ (trb(ji,jj,jk,jpphy) + rtrn) 420 tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) + zprontot * texcret 421 tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) + zpropo4n(ji,jj,jk) * texcret & 422 & + zprodopn(ji,jj,jk) * texcret 423 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln(ji,jj,jk) * texcret 424 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcret 424 tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) + zprontot * texcretn 425 tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) + zpropo4n(ji,jj,jk) * texcretn & 426 & + zprodopn(ji,jj,jk) * texcretn 427 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcretn 425 428 tra(ji,jj,jk,jppic) = tra(ji,jj,jk,jppic) + zprorcap(ji,jj,jk) * texcretp & 426 429 & - zpsino3 * zpronewp(ji,jj,jk) - zpsinh4 * zproregp(ji,jj,jk) & … … 430 433 tra(ji,jj,jk,jpppi) = tra(ji,jj,jk,jpppi) + zpropo4p(ji,jj,jk) * texcretp & 431 434 & + zprodopp(ji,jj,jk) * texcretp 432 tra(ji,jj,jk,jppch) = tra(ji,jj,jk,jppch) + zprochlp(ji,jj,jk) * texcretp433 435 tra(ji,jj,jk,jppfe) = tra(ji,jj,jk,jppfe) + zprofep(ji,jj,jk) * texcretp 434 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcret 2&436 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcretd & 435 437 & - zpsino3 * zpronewd(ji,jj,jk) - zpsinh4 * zproregd(ji,jj,jk) & 436 438 & - zrespd(ji,jj,jk) 437 439 zcroissd(ji,jj,jk) = tra(ji,jj,jk,jpdia) / rfact2 / (trb(ji,jj,jk,jpdia) + rtrn) 438 tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) + zprodtot * texcret2 439 tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) + zpropo4d(ji,jj,jk) * texcret2 & 440 & + zprodopd(ji,jj,jk) * texcret2 441 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld(ji,jj,jk) * texcret2 442 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcret2 443 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcret2 444 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + excret2 * zprorcad(ji,jj,jk) + excret * zprorcan(ji,jj,jk) & 440 tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) + zprodtot * texcretd 441 tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) + zpropo4d(ji,jj,jk) * texcretd & 442 & + zprodopd(ji,jj,jk) * texcretd 443 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcretd 444 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 445 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) & 445 446 & + excretp * zprorcap(ji,jj,jk) 446 tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + excret 2 * zprodtot + excret* zprontot &447 tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + excretd * zprodtot + excretn * zprontot & 447 448 & + excretp * zproptot 448 tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + excret 2 * zpropo4d(ji,jj,jk) + excret* zpropo4n(ji,jj,jk) &449 & - texcret * zprodopn(ji,jj,jk) - texcret2* zprodopd(ji,jj,jk) + excretp * zpropo4p(ji,jj,jk) &449 tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + excretd * zpropo4d(ji,jj,jk) + excretn * zpropo4n(ji,jj,jk) & 450 & - texcretn * zprodopn(ji,jj,jk) - texcretd * zprodopd(ji,jj,jk) + excretp * zpropo4p(ji,jj,jk) & 450 451 & - texcretp * zprodopp(ji,jj,jk) 451 452 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk) & … … 453 454 & + zpronewd(ji,jj,jk) + zpronewp(ji,jj,jk) ) & 454 455 & - o2ut * ( zrespn(ji,jj,jk) + zrespp(ji,jj,jk) + zrespd(ji,jj,jk) ) 455 zfeup = texcret * zprofen(ji,jj,jk) + texcret2* zprofed(ji,jj,jk) &456 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) & 456 457 & + texcretp * zprofep(ji,jj,jk) 457 458 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zfeup 458 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcret 2* zprorcad(ji,jj,jk) * zysopt(ji,jj,jk)459 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 459 460 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) - zprorcap(ji,jj,jk) & 460 461 & + zpsino3 * zpronewn(ji,jj,jk) + zpsinh4 * zproregn(ji,jj,jk) & … … 522 523 ! 523 524 CALL wrk_dealloc( jpi, jpj, zmixnano, zmixpico, zmixdiat, zstrn ) 524 CALL wrk_dealloc( jpi, jpj, jpk, zpislopead, zpislopeadp, zpislopead2, zysopt ) 525 CALL wrk_dealloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl ) 526 CALL wrk_dealloc( jpi, jpj, jpk, zpislopeadn, zpislopeadp, zpislopeadd, zysopt ) 525 527 CALL wrk_dealloc( jpi, jpj, jpk, zprdia, zprpic, zprbio, zprorcan, zprorcap, zprorcad ) 526 CALL wrk_dealloc( jpi, jpj, jpk, zprofed, zprofep, zprofen , zprochln, zprochlp, zprochld)528 CALL wrk_dealloc( jpi, jpj, jpk, zprofed, zprofep, zprofen ) 527 529 CALL wrk_dealloc( jpi, jpj, jpk, zpronewn, zpronewp, zpronewd, zproregn, zproregp, zproregd ) 528 530 CALL wrk_dealloc( jpi, jpj, jpk, zpropo4n, zpropo4p, zpropo4d, zrespn, zrespp, zrespd, zprnut ) … … 547 549 !!---------------------------------------------------------------------- 548 550 ! 549 NAMELIST/nampisprod/ pislope , pislopep, pislope2, xadap, bresp, excret, excretp, excret2, &551 NAMELIST/nampisprod/ pislopen, pislopep, pisloped, xadap, bresp, excretn, excretp, excretd, & 550 552 & thetannm, thetanpm, thetandm, chlcmin, grosip, zlimmxln, & 551 553 & zlimmxlp, zlimmxld … … 568 570 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 569 571 WRITE(numout,*) ' mean Si/C ratio grosip =', grosip 570 WRITE(numout,*) ' P-I slope pislope =', pislope571 WRITE(numout,*) ' Acclimation factor to low light xadap =', xadap572 WRITE(numout,*) ' excretion ratio of nanophytoplankton excret =', excret572 WRITE(numout,*) ' P-I slope pislopen =', pislopen 573 WRITE(numout,*) ' Acclimation factor to low light xadap =', xadap 574 WRITE(numout,*) ' excretion ratio of nanophytoplankton excretn =', excretn 573 575 WRITE(numout,*) ' excretion ratio of picophytoplankton excretp =', excretp 574 WRITE(numout,*) ' excretion ratio of diatoms excret 2 =', excret2576 WRITE(numout,*) ' excretion ratio of diatoms excretd =', excretd 575 577 WRITE(numout,*) ' basal respiration in phytoplankton bresp =', bresp 576 578 WRITE(numout,*) ' Maximum Chl/C in phytoplankton chlcmin =', chlcmin 577 WRITE(numout,*) ' P-I slope for diatoms pislope 2 =', pislope2579 WRITE(numout,*) ' P-I slope for diatoms pisloped =', pisloped 578 580 WRITE(numout,*) ' P-I slope for picophytoplankton pislopep =', pislopep 579 581 WRITE(numout,*) ' Minimum Chl/N in nanophytoplankton thetannm =', thetannm … … 586 588 ! 587 589 r1_rday = 1._wp / rday 588 texcret = 1._wp - excret590 texcretn = 1._wp - excretn 589 591 texcretp = 1._wp - excretp 590 texcret 2 = 1._wp - excret2592 texcretd = 1._wp - excretd 591 593 tpp = 0._wp 592 594 ! -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P5Z/p5zsms.F90
r6841 r6966 20 20 USE p5zbio ! Biological model 21 21 USE p4zche ! Chemical model 22 USE p4zlys ! Calcite saturation 22 23 USE p4zflx ! Gas exchange 23 24 USE p4zsbc ! External source of nutrients … … 132 133 ! 133 134 CALL p5z_bio (kt, knt) ! Biology 135 CALL p4z_lys( kt, jnt ) ! Compute CaCO3 saturation 134 136 CALL p4z_flx( kt, knt ) ! Compute surface fluxes 135 137 CALL p5z_sed (kt, knt) ! Sedimentation
Note: See TracChangeset
for help on using the changeset viewer.
