New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 2957 for branches/2011/dev_r2787_PISCES_improvment/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90 – NEMO

Ignore:
Timestamp:
2011-10-19T10:47:02+02:00 (13 years ago)
Author:
cetlod
Message:

dev_r2787_PISCES_improvment:keep the possiblity to switch between old and new parameterisation of production

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2011/dev_r2787_PISCES_improvment/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90

    r2823 r2957  
    3333 
    3434   !! * Shared module variables 
    35    REAL(wp), PUBLIC ::  pislope   = 3.0_wp            !: 
    36    REAL(wp), PUBLIC ::  pislope2  = 3.0_wp            !: 
    37    REAL(wp), PUBLIC ::  excret    = 10.e-5_wp         !: 
    38    REAL(wp), PUBLIC ::  excret2   = 0.05_wp           !: 
    39    REAL(wp), PUBLIC ::  bresp     = 0.00333_wp        !: 
    40    REAL(wp), PUBLIC ::  chlcnm    = 0.033_wp          !: 
    41    REAL(wp), PUBLIC ::  chlcdm    = 0.05_wp           !: 
    42    REAL(wp), PUBLIC ::  chlcmin   = 0.00333_wp        !: 
    43    REAL(wp), PUBLIC ::  fecnm     = 10.E-6_wp         !: 
    44    REAL(wp), PUBLIC ::  fecdm     = 15.E-6_wp         !: 
    45    REAL(wp), PUBLIC ::  grosip    = 0.151_wp          !: 
    46  
    47    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prmax     !: optimal prduction = f(temperature) 
     35   LOGICAL , PUBLIC ::  ln_newprod = .FALSE. 
     36   REAL(wp), PUBLIC ::  pislope    = 3.0_wp            !: 
     37   REAL(wp), PUBLIC ::  pislope2   = 3.0_wp            !: 
     38   REAL(wp), PUBLIC ::  excret     = 10.e-5_wp         !: 
     39   REAL(wp), PUBLIC ::  excret2    = 0.05_wp           !: 
     40   REAL(wp), PUBLIC ::  bresp      = 0.00333_wp        !: 
     41   REAL(wp), PUBLIC ::  chlcnm     = 0.033_wp          !: 
     42   REAL(wp), PUBLIC ::  chlcdm     = 0.05_wp           !: 
     43   REAL(wp), PUBLIC ::  chlcmin    = 0.00333_wp        !: 
     44   REAL(wp), PUBLIC ::  fecnm      = 10.E-6_wp         !: 
     45   REAL(wp), PUBLIC ::  fecdm      = 15.E-6_wp         !: 
     46   REAL(wp), PUBLIC ::  grosip     = 0.151_wp          !: 
     47 
     48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prmax    !: optimal production = f(temperature) 
    4849   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   quotan   !: proxy of N quota in Nanophyto 
    4950   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   quotad   !: proxy of N quota in diatomee 
    5051    
    5152   REAL(wp) :: r1_rday                !: 1 / rday 
    52    REAL(wp) :: r1_bresp               !: 1 / bresp  
    5353   REAL(wp) :: texcret                !: 1 - excret  
    5454   REAL(wp) :: texcret2               !: 1 - excret2         
     
    139139      END DO 
    140140 
    141      ! Impact of the day duration on phytoplankton growth 
    142       DO jk = 1, jpkm1 
    143          DO jj = 1 ,jpj 
    144             DO ji = 1, jpi 
    145                zval = MAX( 1., zstrn(ji,jj) ) 
    146                zval = 1.5 * zval / ( 12. + zval ) 
    147                zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval 
    148                zprdia(ji,jj,jk) = zprbio(ji,jj,jk) 
    149             END DO 
    150          END DO 
    151       END DO 
    152  
     141      IF( ln_newprod ) THEN 
     142         ! Impact of the day duration on phytoplankton growth 
     143         DO jk = 1, jpkm1 
     144            DO jj = 1 ,jpj 
     145               DO ji = 1, jpi 
     146                  zval = MAX( 1., zstrn(ji,jj) ) 
     147                  zval = 1.5 * zval / ( 12. + zval ) 
     148                  zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval 
     149                  zprdia(ji,jj,jk) = zprbio(ji,jj,jk) 
     150               END DO 
     151            END DO 
     152         END DO 
     153      ENDIF 
     154 
     155      ! Maximum light intensity 
    153156      WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 
    154157      zstrn(:,:) = 24. / zstrn(:,:) 
    155158 
    156 !CDIR NOVERRCHK 
    157       DO jk = 1, jpkm1 
    158 !CDIR NOVERRCHK 
    159          DO jj = 1, jpj 
    160 !CDIR NOVERRCHK 
    161             DO ji = 1, jpi 
    162  
    163                ! Computation of the P-I slope for nanos and diatoms 
    164                IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
    165                    ztn    = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
    166                    zadap  = ztn / ( 2.+ ztn ) 
    167  
    168                    zconctemp   = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - 5e-7 ) 
    169                    zconctemp2  = trn(ji,jj,jk,jpdia) - zconctemp 
    170  
    171                    znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 
    172                    zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 
    173                    zfact  = EXP( -0.21 * znanotot ) 
    174  
    175                    zpislopead (ji,jj,jk) = pislope  * ( 1.+ zadap  * zfact )  & 
    176                    &                       * trn(ji,jj,jk,jpnch) /( trn(ji,jj,jk,jpphy) * 12. + rtrn) 
    177  
    178                    zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp)   & 
    179                      &                     / ( trn(ji,jj,jk,jpdia) + rtrn )   & 
    180                      &                     * trn(ji,jj,jk,jpdch) /( trn(ji,jj,jk,jpdia) * 12. + rtrn) 
    181  
    182                   !  Computation of production function for Chlorophyll 
    183                   !-------------------------------------------------- 
    184                    zpislopen  = zpislopead (ji,jj,jk) / ( prmax(ji,jj,jk) * rday + rtrn ) 
    185                    zpislope2n = zpislopead2(ji,jj,jk) / ( prmax(ji,jj,jk) * rday + rtrn ) 
    186                    zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * znanotot ) ) 
    187                    zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot ) ) 
    188  
    189                    ! Computation of production function for Carbon 
    190                    !  --------------------------------------------- 
    191                    zpislopen  = zpislopead (ji,jj,jk) / ( ( r1_rday + r1_bresp / chlcnm ) * rday + rtrn) 
    192                    zpislope2n = zpislopead2(ji,jj,jk) / ( ( r1_rday + r1_bresp / chlcdm ) * rday + rtrn) 
    193                    zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen  * znanotot )  ) 
    194                    zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot )  ) 
    195                ENDIF 
    196             END DO 
    197          END DO 
    198       END DO 
     159      IF( ln_newprod ) THEN 
     160!CDIR NOVERRCHK 
     161         DO jk = 1, jpkm1 
     162!CDIR NOVERRCHK 
     163            DO jj = 1, jpj 
     164!CDIR NOVERRCHK 
     165               DO ji = 1, jpi 
     166 
     167                  ! Computation of the P-I slope for nanos and diatoms 
     168                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
     169                      ztn    = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
     170                      zadap  = ztn / ( 2.+ ztn ) 
     171 
     172                      zconctemp   = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - 5e-7 ) 
     173                      zconctemp2  = trn(ji,jj,jk,jpdia) - zconctemp 
     174 
     175                      znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 
     176                      zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 
     177 
     178                      zfact  = EXP( -0.21 * znanotot ) 
     179                      zpislopead (ji,jj,jk) = pislope  * ( 1.+ zadap  * zfact )  & 
     180                         &                   * trn(ji,jj,jk,jpnch) /( trn(ji,jj,jk,jpphy) * 12. + rtrn) 
     181 
     182                      zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trn(ji,jj,jk,jpdia) + rtrn )   & 
     183                         &                   * trn(ji,jj,jk,jpdch) /( trn(ji,jj,jk,jpdia) * 12. + rtrn) 
     184 
     185                      ! Computation of production function for Carbon 
     186                      !  --------------------------------------------- 
     187                      zpislopen  = zpislopead (ji,jj,jk) / ( ( r1_rday + bresp * r1_day / chlcnm ) * rday + rtrn) 
     188                      zpislope2n = zpislopead2(ji,jj,jk) / ( ( r1_rday + bresp * r1_day / chlcdm ) * rday + rtrn) 
     189                      zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen  * znanotot )  ) 
     190                      zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot )  ) 
     191 
     192                      !  Computation of production function for Chlorophyll 
     193                      !-------------------------------------------------- 
     194                      zmaxday  = 1._wp / ( prmax(ji,jj,jk) * rday + rtrn ) 
     195                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead (ji,jj,jk) * zmaxday * znanotot ) ) 
     196                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead2(ji,jj,jk) * zmaxday * zdiattot ) ) 
     197                  ENDIF 
     198               END DO 
     199            END DO 
     200         END DO 
     201      ELSE 
     202!CDIR NOVERRCHK 
     203         DO jk = 1, jpkm1 
     204!CDIR NOVERRCHK 
     205            DO jj = 1, jpj 
     206!CDIR NOVERRCHK 
     207               DO ji = 1, jpi 
     208 
     209                  ! Computation of the P-I slope for nanos and diatoms 
     210                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
     211                      ztn    = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
     212                      zadap  = ztn / ( 2.+ ztn ) 
     213 
     214                      zfact  = EXP( -0.21 * enano(ji,jj,jk) ) 
     215                      zpislopead (ji,jj,jk) = pislope  * ( 1.+ zadap  * zfact ) 
     216                      zpislopead2(ji,jj,jk) = pislope2 
     217 
     218                      zpislopen =  zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch)                & 
     219                        &          / ( trn(ji,jj,jk,jpphy) * 12.                  + rtrn )   & 
     220                        &          / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 
     221 
     222                      zpislope2n = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch)                & 
     223                        &          / ( trn(ji,jj,jk,jpdia) * 12.                  + rtrn )   & 
     224                        &          / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 
     225 
     226                      ! Computation of production function for Carbon 
     227                      !  --------------------------------------------- 
     228                      zprbio(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen  * enano(ji,jj,jk) ) ) 
     229                      zprdia(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) ) 
     230 
     231                      !  Computation of production function for Chlorophyll 
     232                      !-------------------------------------------------- 
     233                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen  * enano(ji,jj,jk) * zstrn(ji,jj) ) ) 
     234                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) * zstrn(ji,jj) ) ) 
     235                  ENDIF 
     236               END DO 
     237            END DO 
     238         END DO 
     239      ENDIF 
    199240 
    200241      !  Computation of a proxy of the N/C ratio 
     
    237278      END DO 
    238279 
    239       !  Computation of the limitation term due to 
    240       !  A mixed layer deeper than the euphotic depth 
     280      !  Computation of the limitation term due to a mixed layer deeper than the euphotic depth 
    241281      DO jj = 1, jpj 
    242282         DO ji = 1, jpi 
     
    262302      END DO 
    263303 
     304     IF( ln_newprod ) THEN 
     305        zprochln(:,:,:) = chlcmin * 12. * zprorca (:,:,:) 
     306        zprochld(:,:,:) = chlcmin * 12. * zprorcad(:,:,:) 
     307     ELSE 
     308        zprochln(:,:,:) = 0._wp 
     309        zprochld(:,:,:) = 0._wp 
     310     ENDIF 
     311 
    264312!CDIR NOVERRCHK 
    265313      DO jk = 1, jpkm1 
     
    276324                  ! 
    277325                  zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 
    278                   zprochln(ji,jj,jk) = chlcmin * 12. * zprorca(ji,jj,jk) 
    279326                  zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + chlcnm * 12. * zprod / (  zpislopead(ji,jj,jk) * zetot2 +rtrn) 
    280327                  ! 
     
    304351                  ! 
    305352                  zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 
    306                   zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk) 
    307353                  zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + chlcdm * 12. * zprod / ( zpislopead2(ji,jj,jk) * zetot2 +rtrn ) 
    308354                  ! 
     
    348394 
    349395     ! Total primary production per year 
    350      IF( lk_degrad )  THEN 
    351         tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) * facvol(:,:,:) ) 
    352      ELSE 
    353         tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) ) 
    354      ENDIF 
     396#if defined key_degrad 
     397     tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * e1e2t(:,:) * fse3t(:,:,:) * tmask(:,:,:) * facvol(:,:,:) ) 
     398#else 
     399     tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * e1e2t(:,:) * fse3t(:,:,:) * tmask(:,:,:) ) 
     400#endif 
    355401 
    356402     IF( kt == nitend .AND. jnt == nrdttrc .AND. lwp ) THEN 
     
    411457      !!---------------------------------------------------------------------- 
    412458      ! 
    413       NAMELIST/nampisprod/ pislope, pislope2, bresp, excret, excret2,  & 
     459      NAMELIST/nampisprod/ pislope, pislope2, ln_newprod, bresp, excret, excret2,  & 
    414460         &                 chlcnm, chlcdm, chlcmin, fecnm, fecdm, grosip 
    415461      !!---------------------------------------------------------------------- 
     
    422468         WRITE(numout,*) ' Namelist parameters for phytoplankton growth, nampisprod' 
    423469         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    424          WRITE(numout,*) '    mean Si/C ratio                           grosip    =', grosip 
    425          WRITE(numout,*) '    P-I slope                                 pislope   =', pislope 
    426          WRITE(numout,*) '    excretion ratio of nanophytoplankton      excret    =', excret 
    427          WRITE(numout,*) '    excretion ratio of diatoms                excret2   =', excret2 
    428          WRITE(numout,*) '    basal respiration in phytoplankton        bresp     =', bresp 
    429          WRITE(numout,*) '    P-I slope  for diatoms                    pislope2  =', pislope2 
    430          WRITE(numout,*) '    Minimum Chl/C in nanophytoplankton        chlcnm    =', chlcnm 
    431          WRITE(numout,*) '    Minimum Chl/C in diatoms                  chlcdm    =', chlcdm 
    432          WRITE(numout,*) '    Maximum Chl/C in phytoplankton            chlcmin   =', chlcmin 
    433          WRITE(numout,*) '    Maximum Fe/C in nanophytoplankton         fecnm     =', fecnm 
    434          WRITE(numout,*) '    Minimum Fe/C in diatoms                   fecdm     =', fecdm 
     470         WRITE(numout,*) '    Enable new parame. of production (T/F)   ln_newprod   =', ln_newprod 
     471         WRITE(numout,*) '    mean Si/C ratio                           grosip       =', grosip 
     472         WRITE(numout,*) '    P-I slope                                 pislope      =', pislope 
     473         WRITE(numout,*) '    excretion ratio of nanophytoplankton      excret       =', excret 
     474         WRITE(numout,*) '    excretion ratio of diatoms                excret2      =', excret2 
     475         IF( ln_newprod ) 
     476            WRITE(numout,*) '    basal respiration in phytoplankton        bresp        =', bresp 
     477            WRITE(numout,*) '    Maximum Chl/C in phytoplankton            chlcmin      =', chlcmin 
     478         ENDIF 
     479         WRITE(numout,*) '    P-I slope  for diatoms                    pislope2     =', pislope2 
     480         WRITE(numout,*) '    Minimum Chl/C in nanophytoplankton        chlcnm       =', chlcnm 
     481         WRITE(numout,*) '    Minimum Chl/C in diatoms                  chlcdm       =', chlcdm 
     482         WRITE(numout,*) '    Maximum Fe/C in nanophytoplankton         fecnm        =', fecnm 
     483         WRITE(numout,*) '    Minimum Fe/C in diatoms                   fecdm        =', fecdm 
    435484      ENDIF 
    436485      ! 
    437486      r1_rday   = 1._wp / rday  
    438       r1_bresp  = bresp * r1_rday 
    439487      texcret   = 1._wp - excret 
    440488      texcret2  = 1._wp - excret2 
Note: See TracChangeset for help on using the changeset viewer.