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 12377 for NEMO/trunk/src/TOP/PISCES/P4Z/p4zprod.F90 – NEMO

Ignore:
Timestamp:
2020-02-12T15:39:06+01:00 (4 years ago)
Author:
acc
Message:

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Location:
NEMO/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk

    • Property svn:externals
      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zprod.F90

    r12280 r12377  
    4646   REAL(wp) ::   texcretd   ! 1 - excretd         
    4747 
     48   !! * Substitutions 
     49#  include "do_loop_substitute.h90" 
    4850   !!---------------------------------------------------------------------- 
    4951   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
     
    5355CONTAINS 
    5456 
    55    SUBROUTINE p4z_prod( kt , knt ) 
     57   SUBROUTINE p4z_prod( kt , knt, Kbb, Kmm, Krhs ) 
    5658      !!--------------------------------------------------------------------- 
    5759      !!                     ***  ROUTINE p4z_prod  *** 
     
    6365      !!--------------------------------------------------------------------- 
    6466      INTEGER, INTENT(in) ::   kt, knt   ! 
     67      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices 
    6568      ! 
    6669      INTEGER  ::   ji, jj, jk 
     
    8992      !  Allocate temporary workspace 
    9093      ! 
    91       zprorcan(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp ; zprofed (:,:,:) = 0._wp 
    92       zprofen (:,:,:) = 0._wp ; zysopt  (:,:,:) = 0._wp 
    93       zpronewn(:,:,:) = 0._wp ; zpronewd(:,:,:) = 0._wp ; zprdia  (:,:,:) = 0._wp 
    94       zprbio  (:,:,:) = 0._wp ; zprdch  (:,:,:) = 0._wp ; zprnch  (:,:,:) = 0._wp  
    95       zmxl_fac(:,:,:) = 0._wp ; zmxl_chl(:,:,:) = 0._wp  
     94      zprorcan  (:,:,:) = 0._wp ; zprorcad  (:,:,:) = 0._wp ; zprofed (:,:,:) = 0._wp 
     95      zprofen   (:,:,:) = 0._wp ; zysopt    (:,:,:) = 0._wp 
     96      zpronewn  (:,:,:) = 0._wp ; zpronewd  (:,:,:) = 0._wp ; zprdia  (:,:,:) = 0._wp 
     97      zprbio    (:,:,:) = 0._wp ; zprdch    (:,:,:) = 0._wp ; zprnch  (:,:,:) = 0._wp  
     98      zmxl_fac  (:,:,:) = 0._wp ; zmxl_chl  (:,:,:) = 0._wp  
     99      zpligprod1(:,:,:) = 0._wp ; zpligprod2(:,:,:) = 0._wp  
    96100 
    97101      ! Computation of the optimal production 
     
    105109      ! day length in hours 
    106110      zstrn(:,:) = 0. 
    107       DO jj = 1, jpj 
    108          DO ji = 1, jpi 
    109             zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 
    110             zargu = MAX( -1., MIN(  1., zargu ) ) 
    111             zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 
    112          END DO 
    113       END DO 
     111      DO_2D_11_11 
     112         zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 
     113         zargu = MAX( -1., MIN(  1., zargu ) ) 
     114         zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 
     115      END_2D 
    114116 
    115117      ! Impact of the day duration and light intermittency on phytoplankton growth 
    116       DO jk = 1, jpkm1 
    117          DO jj = 1 ,jpj 
    118             DO ji = 1, jpi 
    119                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    120                   zval = MAX( 1., zstrn(ji,jj) ) 
    121                   IF( gdept_n(ji,jj,jk) <= hmld(ji,jj) ) THEN 
    122                      zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 
    123                   ENDIF 
    124                   zmxl_chl(ji,jj,jk) = zval / 24. 
    125                   zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval ) 
    126                ENDIF 
    127             END DO 
    128          END DO 
    129       END DO 
     118      DO_3D_11_11( 1, jpkm1 ) 
     119         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     120            zval = MAX( 1., zstrn(ji,jj) ) 
     121            IF( gdept(ji,jj,jk,Kmm) <= hmld(ji,jj) ) THEN 
     122               zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 
     123            ENDIF 
     124            zmxl_chl(ji,jj,jk) = zval / 24. 
     125            zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval ) 
     126         ENDIF 
     127      END_3D 
    130128 
    131129      zprbio(:,:,:) = zprmaxn(:,:,:) * zmxl_fac(:,:,:) 
     
    136134 
    137135      ! Computation of the P-I slope for nanos and diatoms 
    138       DO jk = 1, jpkm1 
    139          DO jj = 1, jpj 
    140             DO ji = 1, jpi 
    141                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    142                   ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
    143                   zadap       = xadap * ztn / ( 2.+ ztn ) 
    144                   zconctemp   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia ) 
    145                   zconctemp2  = trb(ji,jj,jk,jpdia) - zconctemp 
    146                   ! 
    147                   zpislopeadn(ji,jj,jk) = pislopen * ( 1.+ zadap  * EXP( -0.25 * enano(ji,jj,jk) ) )  & 
    148                   &                   * trb(ji,jj,jk,jpnch) /( trb(ji,jj,jk,jpphy) * 12. + rtrn) 
    149                   ! 
    150                   zpislopeadd(ji,jj,jk) = (pislopen * zconctemp2 + pisloped * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn )   & 
    151                   &                   * trb(ji,jj,jk,jpdch) /( trb(ji,jj,jk,jpdia) * 12. + rtrn) 
    152                ENDIF 
    153             END DO 
    154          END DO 
    155       END DO 
    156  
    157       DO jk = 1, jpkm1 
    158          DO jj = 1, jpj 
    159             DO ji = 1, jpi 
    160                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    161                    ! Computation of production function for Carbon 
    162                    !  --------------------------------------------- 
    163                    zpislopen = zpislopeadn(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 
    164                    &            * zmxl_fac(ji,jj,jk) * rday + rtrn) 
    165                    zpisloped = zpislopeadd(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 
    166                    &            * zmxl_fac(ji,jj,jk) * rday + rtrn) 
    167                    zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) )  ) 
    168                    zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) )  ) 
    169                    !  Computation of production function for Chlorophyll 
    170                    !-------------------------------------------------- 
    171                    zpislopen = zpislopeadn(ji,jj,jk) / ( zprmaxn(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 
    172                    zpisloped = zpislopeadd(ji,jj,jk) / ( zprmaxd(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 
    173                    zprnch(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) ) ) 
    174                    zprdch(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) ) ) 
    175                ENDIF 
    176             END DO 
    177          END DO 
    178       END DO 
     136      DO_3D_11_11( 1, jpkm1 ) 
     137         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     138            ztn         = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. ) 
     139            zadap       = xadap * ztn / ( 2.+ ztn ) 
     140            zconctemp   = MAX( 0.e0 , tr(ji,jj,jk,jpdia,Kbb) - xsizedia ) 
     141            zconctemp2  = tr(ji,jj,jk,jpdia,Kbb) - zconctemp 
     142            ! 
     143            zpislopeadn(ji,jj,jk) = pislopen * ( 1.+ zadap  * EXP( -0.25 * enano(ji,jj,jk) ) )  & 
     144            &                   * tr(ji,jj,jk,jpnch,Kbb) /( tr(ji,jj,jk,jpphy,Kbb) * 12. + rtrn) 
     145            ! 
     146            zpislopeadd(ji,jj,jk) = (pislopen * zconctemp2 + pisloped * zconctemp) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )   & 
     147            &                   * tr(ji,jj,jk,jpdch,Kbb) /( tr(ji,jj,jk,jpdia,Kbb) * 12. + rtrn) 
     148         ENDIF 
     149      END_3D 
     150 
     151      DO_3D_11_11( 1, jpkm1 ) 
     152         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     153             ! Computation of production function for Carbon 
     154             !  --------------------------------------------- 
     155             zpislopen = zpislopeadn(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 
     156             &            * zmxl_fac(ji,jj,jk) * rday + rtrn) 
     157             zpisloped = zpislopeadd(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 
     158             &            * zmxl_fac(ji,jj,jk) * rday + rtrn) 
     159             zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) )  ) 
     160             zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) )  ) 
     161             !  Computation of production function for Chlorophyll 
     162             !-------------------------------------------------- 
     163             zpislopen = zpislopeadn(ji,jj,jk) / ( zprmaxn(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 
     164             zpisloped = zpislopeadd(ji,jj,jk) / ( zprmaxd(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 
     165             zprnch(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) ) ) 
     166             zprdch(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) ) ) 
     167         ENDIF 
     168      END_3D 
    179169 
    180170      !  Computation of a proxy of the N/C ratio 
    181171      !  --------------------------------------- 
    182       DO jk = 1, jpkm1 
    183          DO jj = 1, jpj 
    184             DO ji = 1, jpi 
    185                 zval = MIN( xnanopo4(ji,jj,jk), ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) )   & 
    186                 &      * zprmaxn(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn ) 
    187                 quotan(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval ) 
    188                 zval = MIN( xdiatpo4(ji,jj,jk), ( xdiatnh4(ji,jj,jk) + xdiatno3(ji,jj,jk) ) )   & 
    189                 &      * zprmaxd(ji,jj,jk) / ( zprdia(ji,jj,jk) + rtrn ) 
    190                 quotad(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval ) 
    191             END DO 
    192          END DO 
    193       END DO 
    194  
    195  
    196       DO jk = 1, jpkm1 
    197          DO jj = 1, jpj 
    198             DO ji = 1, jpi 
    199  
    200                 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    201                    !    Si/C of diatoms 
    202                    !    ------------------------ 
    203                    !    Si/C increases with iron stress and silicate availability 
    204                    !    Si/C is arbitrariliy increased for very high Si concentrations 
    205                    !    to mimic the very high ratios observed in the Southern Ocean (silpot2) 
    206                   zlim  = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi1 ) 
    207                   zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 
    208                   zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0 
    209                   zsiborn = trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) 
    210                   IF (gphit(ji,jj) < -30 ) THEN 
    211                     zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 ) 
    212                   ELSE 
    213                     zsilfac2 = 1. +      zsiborn / ( zsiborn + xksi2**3 ) 
    214                   ENDIF 
    215                   zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2 
    216               ENDIF 
    217             END DO 
    218          END DO 
    219       END DO 
     172      DO_3D_11_11( 1, jpkm1 ) 
     173          zval = MIN( xnanopo4(ji,jj,jk), ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) )   & 
     174          &      * zprmaxn(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn ) 
     175          quotan(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval ) 
     176          zval = MIN( xdiatpo4(ji,jj,jk), ( xdiatnh4(ji,jj,jk) + xdiatno3(ji,jj,jk) ) )   & 
     177          &      * zprmaxd(ji,jj,jk) / ( zprdia(ji,jj,jk) + rtrn ) 
     178          quotad(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval ) 
     179      END_3D 
     180 
     181 
     182      DO_3D_11_11( 1, jpkm1 ) 
     183 
     184          IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     185             !    Si/C of diatoms 
     186             !    ------------------------ 
     187             !    Si/C increases with iron stress and silicate availability 
     188             !    Si/C is arbitrariliy increased for very high Si concentrations 
     189             !    to mimic the very high ratios observed in the Southern Ocean (silpot2) 
     190            zlim  = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi1 ) 
     191            zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 
     192            zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0 
     193            zsiborn = tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) 
     194            IF (gphit(ji,jj) < -30 ) THEN 
     195              zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 ) 
     196            ELSE 
     197              zsilfac2 = 1. +      zsiborn / ( zsiborn + xksi2**3 ) 
     198            ENDIF 
     199            zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2 
     200        ENDIF 
     201      END_3D 
    220202 
    221203      !  Mixed-layer effect on production  
    222204      !  Sea-ice effect on production 
    223205 
    224       DO jk = 1, jpkm1 
    225          DO jj = 1, jpj 
    226             DO ji = 1, jpi 
    227                zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
    228                zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
    229             END DO 
    230          END DO 
    231       END DO 
     206      DO_3D_11_11( 1, jpkm1 ) 
     207         zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
     208         zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
     209      END_3D 
    232210 
    233211      ! Computation of the various production terms  
    234       DO jk = 1, jpkm1 
    235          DO jj = 1, jpj 
    236             DO ji = 1, jpi 
    237                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    238                   !  production terms for nanophyto. (C) 
    239                   zprorcan(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2 
    240                   zpronewn(ji,jj,jk)  = zprorcan(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 
    241                   ! 
    242                   zratio = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) * fecnm + rtrn ) 
    243                   zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )  
    244                   zprofen(ji,jj,jk) = fecnm * zprmaxn(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) )  & 
    245                   &             * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) )    & 
    246                   &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) )  & 
    247                   &             * zmax * trb(ji,jj,jk,jpphy) * rfact2 
    248                   !  production terms for diatoms (C) 
    249                   zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trb(ji,jj,jk,jpdia) * rfact2 
    250                   zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 
    251                   ! 
    252                   zratio = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) * fecdm + rtrn ) 
    253                   zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )  
    254                   zprofed(ji,jj,jk) = fecdm * zprmaxd(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) )  & 
    255                   &             * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) )    & 
    256                   &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) )  & 
    257                   &             * zmax * trb(ji,jj,jk,jpdia) * rfact2 
    258                ENDIF 
    259             END DO 
    260          END DO 
    261       END DO 
     212      DO_3D_11_11( 1, jpkm1 ) 
     213         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     214            !  production terms for nanophyto. (C) 
     215            zprorcan(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * tr(ji,jj,jk,jpphy,Kbb) * rfact2 
     216            zpronewn(ji,jj,jk)  = zprorcan(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 
     217            ! 
     218            zratio = tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) * fecnm + rtrn ) 
     219            zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )  
     220            zprofen(ji,jj,jk) = fecnm * zprmaxn(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) )  & 
     221            &             * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) )    & 
     222            &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) )  & 
     223            &             * zmax * tr(ji,jj,jk,jpphy,Kbb) * rfact2 
     224            !  production terms for diatoms (C) 
     225            zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr(ji,jj,jk,jpdia,Kbb) * rfact2 
     226            zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 
     227            ! 
     228            zratio = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) * fecdm + rtrn ) 
     229            zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )  
     230            zprofed(ji,jj,jk) = fecdm * zprmaxd(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) )  & 
     231            &             * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) )    & 
     232            &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) )  & 
     233            &             * zmax * tr(ji,jj,jk,jpdia,Kbb) * rfact2 
     234         ENDIF 
     235      END_3D 
    262236 
    263237      ! Computation of the chlorophyll production terms 
    264       DO jk = 1, jpkm1 
    265          DO jj = 1, jpj 
    266             DO ji = 1, jpi 
    267                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    268                   !  production terms for nanophyto. ( chlorophyll ) 
    269                   znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
    270                   zprod    = rday * zprorcan(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 
    271                   zprochln = chlcmin * 12. * zprorcan (ji,jj,jk) 
    272                   chlcnm_n   = MIN ( chlcnm, ( chlcnm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem))) * (1. - 1.14 / 43.4 * 20.)) 
    273                   zprochln = zprochln + (chlcnm_n-chlcmin) * 12. * zprod / & 
    274                                         & (  zpislopeadn(ji,jj,jk) * znanotot +rtrn) 
    275                   !  production terms for diatoms ( chlorophyll ) 
    276                   zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
    277                   zprod    = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 
    278                   zprochld = chlcmin * 12. * zprorcad(ji,jj,jk) 
    279                   chlcdm_n   = MIN ( chlcdm, ( chlcdm / (1. - 1.14 / 43.4 * tsn(ji,jj,jk,jp_tem))) * (1. - 1.14 / 43.4 * 20.)) 
    280                   zprochld = zprochld + (chlcdm_n-chlcmin) * 12. * zprod / & 
    281                                         & ( zpislopeadd(ji,jj,jk) * zdiattot +rtrn ) 
    282                   !   Update the arrays TRA which contain the Chla sources and sinks 
    283                   tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln * texcretn 
    284                   tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld * texcretd 
    285                ENDIF 
    286             END DO 
    287          END DO 
    288       END DO 
     238      DO_3D_11_11( 1, jpkm1 ) 
     239         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     240            !  production terms for nanophyto. ( chlorophyll ) 
     241            znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     242            zprod    = rday * zprorcan(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 
     243            zprochln = chlcmin * 12. * zprorcan (ji,jj,jk) 
     244            chlcnm_n   = MIN ( chlcnm, ( chlcnm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm))) * (1. - 1.14 / 43.4 * 20.)) 
     245            zprochln = zprochln + (chlcnm_n-chlcmin) * 12. * zprod / & 
     246                                  & (  zpislopeadn(ji,jj,jk) * znanotot +rtrn) 
     247            !  production terms for diatoms ( chlorophyll ) 
     248            zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     249            zprod    = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 
     250            zprochld = chlcmin * 12. * zprorcad(ji,jj,jk) 
     251            chlcdm_n   = MIN ( chlcdm, ( chlcdm / (1. - 1.14 / 43.4 * ts(ji,jj,jk,jp_tem,Kmm))) * (1. - 1.14 / 43.4 * 20.)) 
     252            zprochld = zprochld + (chlcdm_n-chlcmin) * 12. * zprod / & 
     253                                  & ( zpislopeadd(ji,jj,jk) * zdiattot +rtrn ) 
     254            !   Update the arrays TRA which contain the Chla sources and sinks 
     255            tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) + zprochln * texcretn 
     256            tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) + zprochld * texcretd 
     257         ENDIF 
     258      END_3D 
    289259 
    290260      !   Update the arrays TRA which contain the biological sources and sinks 
    291       DO jk = 1, jpkm1 
    292          DO jj = 1, jpj 
    293            DO ji =1 ,jpi 
    294               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    295                  zproreg  = zprorcan(ji,jj,jk) - zpronewn(ji,jj,jk) 
    296                  zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk) 
    297                  zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 
    298                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 
    299                  tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk) 
    300                  tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproreg - zproreg2 
    301                  tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorcan(ji,jj,jk) * texcretn 
    302                  tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcretn 
    303                  tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcretd 
    304                  tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcretd 
    305                  tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 
    306                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zdocprod 
    307                  tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) & 
    308                  &                   + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) 
    309                  ! 
    310                  zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 
    311                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zfeup 
    312                  tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 
    313                  tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 
    314                  tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 
    315                  &                                         - rno3 * ( zproreg + zproreg2 ) 
    316               ENDIF 
    317            END DO 
    318         END DO 
    319      END DO 
     261      DO_3D_11_11( 1, jpkm1 ) 
     262        IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     263           zproreg  = zprorcan(ji,jj,jk) - zpronewn(ji,jj,jk) 
     264           zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk) 
     265           zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 
     266           tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 
     267           tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk) 
     268           tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zproreg - zproreg2 
     269           tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zprorcan(ji,jj,jk) * texcretn 
     270           tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) + zprofen(ji,jj,jk) * texcretn 
     271           tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) + zprorcad(ji,jj,jk) * texcretd 
     272           tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) + zprofed(ji,jj,jk) * texcretd 
     273           tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 
     274           tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zdocprod 
     275           tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + o2ut * ( zproreg + zproreg2) & 
     276           &                   + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) 
     277           ! 
     278           zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 
     279           tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zfeup 
     280           tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 
     281           tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 
     282           tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 
     283           &                                         - rno3 * ( zproreg + zproreg2 ) 
     284        ENDIF 
     285      END_3D 
    320286     ! 
    321287     IF( ln_ligand ) THEN 
    322288         zpligprod1(:,:,:) = 0._wp    ;    zpligprod2(:,:,:) = 0._wp 
    323          DO jk = 1, jpkm1 
    324             DO jj = 1, jpj 
    325               DO ji =1 ,jpi 
    326                  IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    327                     zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 
    328                     zfeup    = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 
    329                     tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 
    330                     zpligprod1(ji,jj,jk) = zdocprod * ldocp 
    331                     zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet 
    332                  ENDIF 
    333               END DO 
    334            END DO 
    335         END DO 
     289         DO_3D_11_11( 1, jpkm1 ) 
     290           IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     291              zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 
     292              zfeup    = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 
     293              tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 
     294              zpligprod1(ji,jj,jk) = zdocprod * ldocp 
     295              zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet 
     296           ENDIF 
     297         END_3D 
    336298     ENDIF 
    337299 
     
    366328     ENDIF 
    367329 
    368      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     330     IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    369331         WRITE(charout, FMT="('prod')") 
    370332         CALL prt_ctl_trc_info(charout) 
    371          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     333         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    372334     ENDIF 
    373335      ! 
     
    400362      ENDIF 
    401363      ! 
    402       REWIND( numnatp_ref ) 
    403364      READ  ( numnatp_ref, namp4zprod, IOSTAT = ios, ERR = 901) 
    404365901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zprod in reference namelist' ) 
    405  
    406       REWIND( numnatp_cfg ) 
    407366      READ  ( numnatp_cfg, namp4zprod, IOSTAT = ios, ERR = 902 ) 
    408367902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zprod in configuration namelist' ) 
Note: See TracChangeset for help on using the changeset viewer.