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 – NEMO

Changeset 12377 for NEMO/trunk/src/TOP


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:
3 deleted
87 edited
2 copied

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/AGE/trcini_age.F90

    r10070 r12377  
    2525CONTAINS 
    2626 
    27    SUBROUTINE trc_ini_age 
     27   SUBROUTINE trc_ini_age( Kmm ) 
    2828      !!---------------------------------------------------------------------- 
    2929      !!                     ***  trc_ini_age  ***   
    … …  
    3232      !! 
    3333      !!---------------------------------------------------------------------- 
     34      INTEGER, INTENT(in) ::   Kmm ! time level indices 
    3435      INTEGER    ::  jn 
    3536      CHARACTER(len = 20)  ::  cltra 
    … …  
    5758 
    5859       
    59       IF( .NOT. ln_rsttr ) trn(:,:,:,jp_age) = 0. 
     60      IF( .NOT. ln_rsttr ) tr(:,:,:,jp_age,Kmm) = 0. 
    6061      ! 
    6162   END SUBROUTINE trc_ini_age 

  • NEMO/trunk/src/TOP/AGE/trcnam_age.F90

    r11536 r12377  
    5454      ln_trc_obc(jp_age) = .false. 
    5555      ! 
    56       REWIND( numnat_ref )              ! Namelist namagedate in reference namelist : AGE parameters 
    5756      READ  ( numnat_ref, namage, IOSTAT = ios, ERR = 901) 
    5857901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namage in reference namelist' ) 
    59       REWIND( numnat_cfg )              ! Namelist namagedate in configuration namelist : AGE parameters 
    6058      READ  ( numnat_cfg, namage, IOSTAT = ios, ERR = 902 ) 
    6159902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namage in configuration namelist' ) 

  • NEMO/trunk/src/TOP/AGE/trcsms_age.F90

    r10070 r12377  
    3737CONTAINS 
    3838 
    39    SUBROUTINE trc_sms_age( kt ) 
     39   SUBROUTINE trc_sms_age( kt, Kbb, Kmm, Krhs ) 
    4040      !!---------------------------------------------------------------------- 
    4141      !!                     ***  trc_sms_age  *** 
    … …  
    4545      !! ** Method  : - 
    4646      !!---------------------------------------------------------------------- 
    47       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     47      INTEGER, INTENT(in) ::   kt              ! ocean time-step index 
     48      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! ocean time level 
    4849      INTEGER ::   jn, jk   ! dummy loop index 
    4950      !!---------------------------------------------------------------------- 
    … …  
    5758 
    5859      DO jk = 1, nla_age 
    59          tra(:,:,jk,jp_age) = rn_age_kill_rate * trb(:,:,jk,jp_age) 
     60         tr(:,:,jk,jp_age,Krhs) = rn_age_kill_rate * tr(:,:,jk,jp_age,Kbb) 
    6061      END DO 
    6162      ! 
    62       tra(:,:,nl_age,jp_age) = frac_kill_age * rn_age_kill_rate * trb(:,:,nl_age,jp_age)  & 
     63      tr(:,:,nl_age,jp_age,Krhs) = frac_kill_age * rn_age_kill_rate * tr(:,:,nl_age,jp_age,Kbb)  & 
    6364          &                   + frac_add_age  * rryear * tmask(:,:,nl_age) 
    6465      ! 
    6566      DO jk = nlb_age, jpk 
    66          tra(:,:,jk,jp_age) = tmask(:,:,jk) * rryear 
     67         tr(:,:,jk,jp_age,Krhs) = tmask(:,:,jk) * rryear 
    6768      END DO 
    6869      ! 
    69       IF( l_trdtrc ) CALL trd_trc( tra(:,:,:,jp_age), jn, jptra_sms, kt )   ! save trends 
     70      IF( l_trdtrc ) CALL trd_trc( tr(:,:,:,jp_age,Krhs), jn, jptra_sms, kt, Kmm )   ! save trends 
    7071      ! 
    7172      IF( ln_timing )   CALL timing_stop('trc_sms_age') 

  • NEMO/trunk/src/TOP/AGE/trcwri_age.F90

    r10070 r12377  
    2121CONTAINS 
    2222 
    23    SUBROUTINE trc_wri_age 
     23   SUBROUTINE trc_wri_age( Kmm ) 
    2424      !!--------------------------------------------------------------------- 
    2525      !!                     ***  ROUTINE trc_wri_trc  *** 
    … …  
    2727      !! ** Purpose :   output passive tracers fields  
    2828      !!--------------------------------------------------------------------- 
     29      INTEGER, INTENT(in)  :: Kmm  ! time level indices 
    2930      CHARACTER (len=20)   :: cltra 
    3031      INTEGER              :: jn 
    … …  
    3435 
    3536      cltra = TRIM( ctrcnm(jp_age) )                  ! short title for tracer 
    36       CALL iom_put( cltra, trn(:,:,:,jp_age) ) 
     37      CALL iom_put( cltra, tr(:,:,:,jp_age,Kmm) ) 
    3738 
    3839      ! 

  • NEMO/trunk/src/TOP/C14/trcatm_c14.F90

    r10069 r12377  
    2121   PUBLIC   trc_atm_c14_ini     ! called in trcini_c14.F90 
    2222   ! 
     23   !! * Substitutions 
     24#  include "do_loop_substitute.h90" 
    2325   !!---------------------------------------------------------------------- 
    2426   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    118120            IF( ierr3 /= 0 )   CALL ctl_stop( 'STOP', 'trc_atm_c14_ini: unable to allocate fareaz' ) 
    119121      ! 
    120             DO jj = 1 , jpj                       ! from C14b package 
    121               DO ji = 1 , jpi 
    122                  IF( gphit(ji,jj) >= yn40 ) THEN 
    123                     fareaz(ji,jj,1) = 0. 
    124                     fareaz(ji,jj,2) = 0. 
    125                     fareaz(ji,jj,3) = 1. 
    126                  ELSE IF( gphit(ji,jj ) <= ys40) THEN 
    127                     fareaz(ji,jj,1) = 1. 
    128                     fareaz(ji,jj,2) = 0. 
    129                     fareaz(ji,jj,3) = 0. 
    130                  ELSE IF( gphit(ji,jj) >= yn20 ) THEN 
    131                     fareaz(ji,jj,1) = 0. 
    132                     fareaz(ji,jj,2) = 2. * ( 1. - gphit(ji,jj) / yn40 ) 
    133                     fareaz(ji,jj,3) = 2. * gphit(ji,jj) / yn40 - 1. 
    134                  ELSE IF( gphit(ji,jj) <= ys20 ) THEN 
    135                     fareaz(ji,jj,1) = 2. * gphit(ji,jj) / ys40 - 1. 
    136                     fareaz(ji,jj,2) = 2. * ( 1. - gphit(ji,jj) / ys40 ) 
    137                     fareaz(ji,jj,3) = 0. 
    138                  ELSE 
    139                     fareaz(ji,jj,1) = 0. 
    140                     fareaz(ji,jj,2) = 1. 
    141                     fareaz(ji,jj,3) = 0. 
    142                  ENDIF 
    143               END DO 
    144            END DO 
     122            DO_2D_11_11 
     123              IF( gphit(ji,jj) >= yn40 ) THEN 
     124                 fareaz(ji,jj,1) = 0. 
     125                 fareaz(ji,jj,2) = 0. 
     126                 fareaz(ji,jj,3) = 1. 
     127              ELSE IF( gphit(ji,jj ) <= ys40) THEN 
     128                 fareaz(ji,jj,1) = 1. 
     129                 fareaz(ji,jj,2) = 0. 
     130                 fareaz(ji,jj,3) = 0. 
     131              ELSE IF( gphit(ji,jj) >= yn20 ) THEN 
     132                 fareaz(ji,jj,1) = 0. 
     133                 fareaz(ji,jj,2) = 2. * ( 1. - gphit(ji,jj) / yn40 ) 
     134                 fareaz(ji,jj,3) = 2. * gphit(ji,jj) / yn40 - 1. 
     135              ELSE IF( gphit(ji,jj) <= ys20 ) THEN 
     136                 fareaz(ji,jj,1) = 2. * gphit(ji,jj) / ys40 - 1. 
     137                 fareaz(ji,jj,2) = 2. * ( 1. - gphit(ji,jj) / ys40 ) 
     138                 fareaz(ji,jj,3) = 0. 
     139              ELSE 
     140                 fareaz(ji,jj,1) = 0. 
     141                 fareaz(ji,jj,2) = 1. 
     142                 fareaz(ji,jj,3) = 0. 
     143              ENDIF 
     144            END_2D 
    145145      ! 
    146146         ENDIF 

  • NEMO/trunk/src/TOP/C14/trcini_c14.F90

    r10069 r12377  
    3131CONTAINS 
    3232 
    33    SUBROUTINE trc_ini_c14 
     33   SUBROUTINE trc_ini_c14( Kmm ) 
    3434      !!---------------------------------------------------------------------- 
    3535      !!                     ***  trc_ini_c14  ***   
    … …  
    4040      !!---------------------------------------------------------------------- 
    4141      ! 
     42      INTEGER, INTENT(in)  ::  Kmm  ! time level indices 
    4243      REAL(wp) :: ztrai 
    4344      INTEGER  :: jn 
    … …  
    5758         IF(lwp) WRITE(numout,*) '                      ==>    Ocean C14/C :', rc14init  
    5859         ! 
    59          trn(:,:,:,jp_c14) = rc14init * tmask(:,:,:) 
     60         tr(:,:,:,jp_c14,Kmm) = rc14init * tmask(:,:,:) 
    6061         ! 
    6162         qtr_c14(:,:) = 0._wp           ! Init of air-sea BC 

  • NEMO/trunk/src/TOP/C14/trcnam_c14.F90

    r11536 r12377  
    6161      ln_trc_obc(jp_c14) = .false. 
    6262      ! 
    63       REWIND( numtrc_ref )              ! Namelist namc14_typ in reference namelist : 
    6463      READ  ( numtrc_ref, namc14_typ, IOSTAT = ios, ERR = 901) 
    6564901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc14_typ in reference namelist' ) 
    66       REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist  
    6765      READ  ( numtrc_cfg, namc14_typ, IOSTAT = ios, ERR = 902) 
    6866902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc14_typ in configuration namelist' ) 
    … …  
    7876      ENDIF 
    7977 
    80       REWIND( numtrc_ref )              ! Namelist namc14_typ in reference namelist : 
    8178      READ  ( numtrc_ref, namc14_sbc, IOSTAT = ios, ERR = 903) 
    8279903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc14_sbc in reference namelist' ) 
    83       REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist  
    8480      READ  ( numtrc_cfg, namc14_sbc, IOSTAT = ios, ERR = 904) 
    8581904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc14_sbc in configuration namelist' ) 
    … …  
    9490      ENDIF 
    9591 
    96       REWIND( numtrc_ref )              ! Namelist namc14_typ in reference namelist : 
    9792      READ  ( numtrc_ref, namc14_fcg, IOSTAT = ios, ERR = 905) 
    9893905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc14_fcg in reference namelist' ) 
    99       REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist  
    10094      READ  ( numtrc_cfg, namc14_fcg, IOSTAT = ios, ERR = 906) 
    10195906   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc14_fcg in configuration namelist' ) 

  • NEMO/trunk/src/TOP/C14/trcsms_c14.F90

    r10069 r12377  
    2626   PUBLIC   trc_sms_c14       ! called in trcsms.F90 
    2727 
     28   !! * Substitutions 
     29#  include "do_loop_substitute.h90" 
    2830   !!---------------------------------------------------------------------- 
    2931   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    3335CONTAINS 
    3436 
    35    SUBROUTINE trc_sms_c14( kt ) 
     37   SUBROUTINE trc_sms_c14( kt, Kbb, Kmm, Krhs ) 
    3638      !!---------------------------------------------------------------------- 
    3739      !!                  ***  ROUTINE trc_sms_c14  *** 
    … …  
    4648      !            freshwater fluxes which should not impact the C14/C ratio 
    4749      ! 
    48       !        =>   Delta-C14= ( trn(...jp_c14) -1)*1000. 
     50      !        =>   Delta-C14= ( tr(...jp_c14,Kmm) -1)*1000. 
    4951      !! 
    5052      !!---------------------------------------------------------------------- 
    5153      ! 
    52       INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     54      INTEGER, INTENT(in) ::   kt               ! ocean time-step index 
     55      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs   ! ocean time level 
    5356      ! 
    54       INTEGER  :: ji, jj, jk         ! dummy loop indices  
     57      INTEGER  :: ji, jj, jk        ! dummy loop indices  
    5558      REAL(wp) :: zt, ztp, zsk      ! dummy variables 
    5659      REAL(wp) :: zsol              ! solubility 
    … …  
    7780      ! ------------------------------------------------------------------- 
    7881 
    79       DO jj = 1, jpj 
    80          DO ji = 1, jpi   
    81             IF( tmask(ji,jj,1) >  0. ) THEN 
    82                ! 
    83                zt   = MIN( 40. , tsn(ji,jj,1,jp_tem) ) 
    84                ! 
    85                !  Computation of solubility zsol in [mol/(L * atm)] 
    86                !   after Wanninkhof (2014) referencing Weiss (1974) 
    87                ztp  = ( zt + 273.16 ) * 0.01 
    88                zsk  = 0.027766 + ztp * ( -0.025888 + 0.0050578 * ztp )   ! [mol/(L * atm)] 
    89                zsol = EXP( -58.0931 + 90.5069 / ztp  + 22.2940 * LOG( ztp ) + zsk * tsn(ji,jj,1,jp_sal) ) 
    90                ! convert solubilities [mol/(L * atm)] -> [mol/(m^3 * ppm)] 
    91                zsol = zsol * 1.e-03 
     82      DO_2D_11_11 
     83         IF( tmask(ji,jj,1) >  0. ) THEN 
     84            ! 
     85            zt   = MIN( 40. , ts(ji,jj,1,jp_tem,Kmm) ) 
     86            ! 
     87            !  Computation of solubility zsol in [mol/(L * atm)] 
     88            !   after Wanninkhof (2014) referencing Weiss (1974) 
     89            ztp  = ( zt + 273.16 ) * 0.01 
     90            zsk  = 0.027766 + ztp * ( -0.025888 + 0.0050578 * ztp )   ! [mol/(L * atm)] 
     91            zsol = EXP( -58.0931 + 90.5069 / ztp  + 22.2940 * LOG( ztp ) + zsk * ts(ji,jj,1,jp_sal,Kmm) ) 
     92            ! convert solubilities [mol/(L * atm)] -> [mol/(m^3 * ppm)] 
     93            zsol = zsol * 1.e-03 
    9294 
    93                ! Computes the Schmidt number of CO2 in seawater 
    94                !               Wanninkhof-2014 
    95                zsch = 2116.8 + zt * ( -136.25 + zt * (4.7353 + zt * (-0.092307 + 0.0007555 * zt ) ) ) 
     95            ! Computes the Schmidt number of CO2 in seawater 
     96            !               Wanninkhof-2014 
     97            zsch = 2116.8 + zt * ( -136.25 + zt * (4.7353 + zt * (-0.092307 + 0.0007555 * zt ) ) ) 
    9698 
    97                ! Wanninkhof Piston velocity: zpv in units [m/s] 
    98                zv2 = xkwind * (wndm(ji,jj) * wndm(ji,jj))              ! wind speed module at T points 
    99                ! chemical enhancement (Wanninkhof & Knox, 1996) 
    100                IF( ln_chemh ) zv2 = zv2 + 2.5 * ( 0.5246 + zt * (0.016256 + 0.00049946  * zt ) ) 
    101                zv2 = zv2/360000._wp                                    ! conversion cm/h -> m/s 
    102                ! 
    103                zpv  = ( zv2 * SQRT( 660./ zsch ) ) * ( 1. - fr_i(ji,jj) ) * tmask(ji,jj,1) 
     99            ! Wanninkhof Piston velocity: zpv in units [m/s] 
     100            zv2 = xkwind * (wndm(ji,jj) * wndm(ji,jj))              ! wind speed module at T points 
     101            ! chemical enhancement (Wanninkhof & Knox, 1996) 
     102            IF( ln_chemh ) zv2 = zv2 + 2.5 * ( 0.5246 + zt * (0.016256 + 0.00049946  * zt ) ) 
     103            zv2 = zv2/360000._wp                                    ! conversion cm/h -> m/s 
     104            ! 
     105            zpv  = ( zv2 * SQRT( 660./ zsch ) ) * ( 1. - fr_i(ji,jj) ) * tmask(ji,jj,1) 
    104106 
    105                ! CO2 piston velocity (m/s) 
    106                exch_co2(ji,jj)= zpv 
    107                ! CO2 invasion rate (mol/ppm/m2/s) = 1st part of 14C/C exchange velocity 
    108                exch_c14(ji,jj)= zpv * zsol 
    109             ELSE 
    110                exch_co2(ji,jj) = 0._wp 
    111                exch_c14(ji,jj) = 0._wp 
    112             ENDIF 
    113          END DO 
    114       END DO 
     107            ! CO2 piston velocity (m/s) 
     108            exch_co2(ji,jj)= zpv 
     109            ! CO2 invasion rate (mol/ppm/m2/s) = 1st part of 14C/C exchange velocity 
     110            exch_c14(ji,jj)= zpv * zsol 
     111         ELSE 
     112            exch_co2(ji,jj) = 0._wp 
     113            exch_c14(ji,jj) = 0._wp 
     114         ENDIF 
     115      END_2D 
    115116 
    116117      ! Exchange velocity for 14C/C ratio (m/s) 
    … …  
    120121      ! Flux of C-14 from air-to-sea; units: (C14/C ratio) x m/s 
    121122      !                               already masked 
    122       qtr_c14(:,:) = exch_c14(:,:) * ( c14sbc(:,:) - trb(:,:,1,jp_c14) ) 
     123      qtr_c14(:,:) = exch_c14(:,:) * ( c14sbc(:,:) - tr(:,:,1,jp_c14,Kbb) ) 
    123124             
    124125      ! cumulation of air-to-sea flux at each time step 
    … …  
    126127      ! 
    127128      ! Add the surface flux to the trend of jp_c14 
    128       DO jj = 1, jpj 
    129          DO ji = 1, jpi 
    130             tra(ji,jj,1,jp_c14) = tra(ji,jj,1,jp_c14) + qtr_c14(ji,jj) / e3t_n(ji,jj,1)  
    131          END DO 
    132       END DO 
     129      DO_2D_11_11 
     130         tr(ji,jj,1,jp_c14,Krhs) = tr(ji,jj,1,jp_c14,Krhs) + qtr_c14(ji,jj) / e3t(ji,jj,1,Kmm)  
     131      END_2D 
    133132      ! 
    134133      ! Computation of decay effects on jp_c14 
    135       DO jk = 1, jpk 
    136          DO jj = 1, jpj 
    137             DO ji = 1, jpi 
    138                ! 
    139                tra(ji,jj,jk,jp_c14) = tra(ji,jj,jk,jp_c14) - rlam14 * trb(ji,jj,jk,jp_c14) * tmask(ji,jj,jk)  
    140                ! 
    141             END DO 
    142          END DO 
    143       END DO 
     134      DO_3D_11_11( 1, jpk ) 
     135         ! 
     136         tr(ji,jj,jk,jp_c14,Krhs) = tr(ji,jj,jk,jp_c14,Krhs) - rlam14 * tr(ji,jj,jk,jp_c14,Kbb) * tmask(ji,jj,jk)  
     137         ! 
     138      END_3D 
    144139      ! 
    145140      IF( lrst_trc ) THEN 
    … …  
    157152      ENDIF 
    158153 
    159       IF( l_trdtrc )  CALL trd_trc( tra(:,:,:,jp_c14), 1, jptra_sms, kt )   ! save trends 
     154      IF( l_trdtrc )  CALL trd_trc( tr(:,:,:,jp_c14,Krhs), 1, jptra_sms, kt, Kmm )   ! save trends 
    160155      ! 
    161156      IF( ln_timing )   CALL timing_stop('trc_sms_c14') 

  • NEMO/trunk/src/TOP/C14/trcwri_c14.F90

    r10425 r12377  
    2323   !   Standard ratio: 1.176E-12 ; Avogadro's nbr = 6.022E+23 at/mol ; bomb C14 traditionally reported as 1.E+26 atoms 
    2424   REAL(wp), PARAMETER  :: atomc14 = 1.176 * 6.022E-15   ! conversion factor  
     25   !! * Substitutions 
     26#  include "do_loop_substitute.h90" 
    2527 
    2628 
    2729CONTAINS 
    2830 
    29    SUBROUTINE trc_wri_c14 
     31   SUBROUTINE trc_wri_c14( Kmm ) 
    3032      !!--------------------------------------------------------------------- 
    3133      !!                     ***  ROUTINE trc_wri_c14  *** 
    … …  
    3335      !! ** Purpose :   output additional C14 tracers fields  
    3436      !!--------------------------------------------------------------------- 
     37      INTEGER, INTENT(in)  :: Kmm           ! time level indices 
    3538      CHARACTER (len=20)   :: cltra         ! short title for tracer 
    3639      INTEGER              :: ji,jj,jk,jn   ! dummy loop indexes 
    … …  
    4346      ! --------------------------------------- 
    4447      cltra = TRIM( ctrcnm(jp_c14) )                  ! short title for tracer 
    45       CALL iom_put( cltra, trn(:,:,:,jp_c14) ) 
     48      CALL iom_put( cltra, tr(:,:,:,jp_c14,Kmm) ) 
    4649 
    4750      ! compute and write the tracer diagnostic in the file 
    … …  
    5760         zz3d(:,:,:) = 0._wp 
    5861         ! 
    59          DO jk = 1, jpkm1 
    60             DO jj = 1, jpj 
    61                DO ji = 1, jpi 
    62                   IF( tmask(ji,jj,jk) > 0._wp) THEN 
    63                      z3d (ji,jj,jk) = trn(ji,jj,jk,jp_c14) 
    64                      zz3d(ji,jj,jk) = LOG( z3d(ji,jj,jk) ) 
    65                   ENDIF 
    66                ENDDO 
    67             ENDDO 
    68          ENDDO 
     62         DO_3D_11_11( 1, jpkm1 ) 
     63            IF( tmask(ji,jj,jk) > 0._wp) THEN 
     64               z3d (ji,jj,jk) = tr(ji,jj,jk,jp_c14,Kmm) 
     65               zz3d(ji,jj,jk) = LOG( z3d(ji,jj,jk) ) 
     66            ENDIF 
     67         END_3D 
    6968         zres(:,:) = z3d(:,:,1) 
    7069 
    … …  
    7271         z2d(:,:) =0._wp 
    7372         jk = 1 
    74          DO jj = 1, jpj 
    75             DO ji = 1, jpi 
    76                ztemp = zres(ji,jj) / c14sbc(ji,jj) 
    77                IF( ztemp > 0._wp .AND. tmask(ji,jj,jk) > 0._wp ) z2d(ji,jj) = LOG( ztemp ) 
    78             ENDDO 
    79          ENDDO 
     73         DO_2D_11_11 
     74            ztemp = zres(ji,jj) / c14sbc(ji,jj) 
     75            IF( ztemp > 0._wp .AND. tmask(ji,jj,jk) > 0._wp ) z2d(ji,jj) = LOG( ztemp ) 
     76         END_2D 
    8077         ! 
    8178         z3d(:,:,:) = 1.d03 * ( z3d(:,:,:) - 1._wp ) 
    … …  
    113110      ENDIF 
    114111      IF( iom_use("C14Inv") ) THEN 
    115          ztemp = glob_sum( 'trcwri_c14', trn(:,:,:,jp_c14) * cvol(:,:,:) ) 
     112         ztemp = glob_sum( 'trcwri_c14', tr(:,:,:,jp_c14,Kmm) * cvol(:,:,:) ) 
    116113         ztemp = atomc14 * xdicsur * ztemp 
    117114         CALL iom_put( "C14Inv", ztemp )  !  Radiocarbon ocean inventory [10^26 atoms] 
    … …  
    130127#endif 
    131128 
     129   !! * Substitutions 
     130#  include "do_loop_substitute.h90" 
    132131   !!---------------------------------------------------------------------- 
    133132   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 

  • NEMO/trunk/src/TOP/CFC/trcini_cfc.F90

    r10068 r12377  
    2424   REAL(wp) ::   ylatn =  10.           ! 10 degrees north 
    2525 
     26   !! * Substitutions 
     27#  include "do_loop_substitute.h90" 
    2628   !!---------------------------------------------------------------------- 
    2729   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    3133CONTAINS 
    3234 
    33    SUBROUTINE trc_ini_cfc 
     35   SUBROUTINE trc_ini_cfc( Kmm ) 
    3436      !!---------------------------------------------------------------------- 
    3537      !!                     ***  trc_ini_cfc  ***   
    … …  
    3941      !! ** Method  : - Read the namcfc namelist and check the parameter values 
    4042      !!---------------------------------------------------------------------- 
     43      INTEGER, INTENT(in)  ::  Kmm  ! time level indices 
    4144      INTEGER  ::  ji, jj, jn, jl, jm, js, io, ierr 
    42       INTEGER  ::  iskip = 6   ! number of 1st descriptor lines 
     45      INTEGER  ::  iskip = 6        ! number of 1st descriptor lines 
    4346      REAL(wp) ::  zyy, zyd 
    4447      CHARACTER(len = 20)  ::  cltra 
    … …  
    9093         DO jl = 1, jp_cfc 
    9194            jn = jp_cfc0 + jl - 1 
    92             trn(:,:,:,jn) = 0._wp 
     95            tr(:,:,:,jn,Kmm) = 0._wp 
    9396         END DO 
    9497      ENDIF 
    … …  
    129132      !--------------------------------------------------------------------------------------- 
    130133      zyd = ylatn - ylats       
    131       DO jj = 1 , jpj 
    132          DO ji = 1 , jpi 
    133             IF(     gphit(ji,jj) >= ylatn ) THEN   ;   xphem(ji,jj) = 1.e0 
    134             ELSEIF( gphit(ji,jj) <= ylats ) THEN   ;   xphem(ji,jj) = 0.e0 
    135             ELSE                                   ;   xphem(ji,jj) = ( gphit(ji,jj) - ylats) / zyd 
    136             ENDIF 
    137          END DO 
    138       END DO 
     134      DO_2D_11_11 
     135         IF(     gphit(ji,jj) >= ylatn ) THEN   ;   xphem(ji,jj) = 1.e0 
     136         ELSEIF( gphit(ji,jj) <= ylats ) THEN   ;   xphem(ji,jj) = 0.e0 
     137         ELSE                                   ;   xphem(ji,jj) = ( gphit(ji,jj) - ylats) / zyd 
     138         ENDIF 
     139      END_2D 
    139140      ! 
    140141      IF(lwp) WRITE(numout,*) 'Initialization of CFC tracers done' 

  • NEMO/trunk/src/TOP/CFC/trcnam_cfc.F90

    r11536 r12377  
    5151      ENDIF 
    5252      ! 
    53       REWIND( numtrc_ref )              ! Namelist namcfcdate in reference namelist : CFC parameters 
    5453      READ  ( numtrc_ref, namcfc, IOSTAT = ios, ERR = 901) 
    5554901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfc in reference namelist' ) 
    56       REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist : CFC parameters 
    5755      READ  ( numtrc_cfg, namcfc, IOSTAT = ios, ERR = 902 ) 
    5856902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfc in configuration namelist' ) 

  • NEMO/trunk/src/TOP/CFC/trcsms_cfc.F90

    r12300 r12377  
    4747   REAL(wp) ::   xconv4 = 1.0e-12      ! conversion from mol/m3/atm to mol/m3/pptv  
    4848 
     49   !! * Substitutions 
     50#  include "do_loop_substitute.h90" 
    4951   !!---------------------------------------------------------------------- 
    5052   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    5456CONTAINS 
    5557 
    56    SUBROUTINE trc_sms_cfc( kt ) 
     58   SUBROUTINE trc_sms_cfc( kt, Kbb, Kmm, Krhs ) 
    5759      !!---------------------------------------------------------------------- 
    5860      !!                     ***  ROUTINE trc_sms_cfc  *** 
    … …  
    7072      !!                CFC concentration in pico-mol/m3 
    7173      !!---------------------------------------------------------------------- 
    72       INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     74      INTEGER, INTENT(in) ::   kt               ! ocean time-step index 
     75      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs   ! ocean time level 
    7376      ! 
    7477      INTEGER  ::   ji, jj, jn, jl, jm 
    … …  
    122125          
    123126         !                                                         !------------! 
    124          DO jj = 1, jpj                                            !  i-j loop  ! 
    125             DO ji = 1, jpi                                         !------------! 
     127         DO_2D_11_11 
    126128  
    127                ! space interpolation 
    128                zpp_cfc  =       xphem(ji,jj)   * zpatm(1,jl)   & 
    129                   &     + ( 1.- xphem(ji,jj) ) * zpatm(2,jl) 
    130  
    131                ! Computation of concentration at equilibrium : in picomol/l 
    132                ! coefficient for solubility for CFC-11/12 in  mol/l/atm 
    133                IF( tmask(ji,jj,1) .GE. 0.5 ) THEN 
    134                   ztap  = ( tsn(ji,jj,1,jp_tem) + 273.16 ) * 0.01 
    135                   zdtap = sob(1,jl) + ztap * ( sob(2,jl) + ztap * sob(3,jl) )  
    136                   zsol  =  EXP( soa(1,jl) + soa(2,jl) / ztap + soa(3,jl) * LOG( ztap )   & 
    137                      &                    + soa(4,jl) * ztap * ztap + tsn(ji,jj,1,jp_sal) * zdtap )  
    138                ELSE 
    139                   zsol  = 0.e0 
    140                ENDIF 
    141                ! conversion from mol/l/atm to mol/m3/atm and from mol/m3/atm to mol/m3/pptv     
    142                zsol = xconv4 * xconv3 * zsol * tmask(ji,jj,1)   
    143                ! concentration at equilibrium 
    144                zca_cfc = xconv1 * zpp_cfc * zsol * tmask(ji,jj,1)              
    145    
    146                ! Computation of speed transfert 
    147                !    Schmidt number revised in Wanninkhof (2014) 
    148                zt1  = tsn(ji,jj,1,jp_tem) 
    149                zt2  = zt1 * zt1  
    150                zt3  = zt1 * zt2 
    151                zt4  = zt2 * zt2 
    152                zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 + sca(5,jl) * zt4 
    153  
    154                !    speed transfert : formulae revised in Wanninkhof (2014) 
    155                zv2     = wndm(ji,jj) * wndm(ji,jj) 
    156                zsch    = zsch / 660. 
    157                zak_cfc = ( 0.251 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 
    158  
    159                ! Input function  : speed *( conc. at equil - concen at surface ) 
    160                ! trn in pico-mol/l idem qtr; ak in en m/a 
    161                qtr_cfc(ji,jj,jl) = -zak_cfc * ( trb(ji,jj,1,jn) - zca_cfc )   & 
    162                   &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) 
    163                ! Add the surface flux to the trend 
    164                tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / e3t_n(ji,jj,1)  
    165  
    166                ! cumulation of surface flux at each time step 
    167                qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * rdt 
    168                !                                               !----------------! 
    169             END DO                                             !  end i-j loop  ! 
    170          END DO                                                !----------------! 
     129            ! space interpolation 
     130            zpp_cfc  =       xphem(ji,jj)   * zpatm(1,jl)   & 
     131               &     + ( 1.- xphem(ji,jj) ) * zpatm(2,jl) 
     132 
     133            ! Computation of concentration at equilibrium : in picomol/l 
     134            ! coefficient for solubility for CFC-11/12 in  mol/l/atm 
     135            IF( tmask(ji,jj,1) .GE. 0.5 ) THEN 
     136               ztap  = ( ts(ji,jj,1,jp_tem,Kmm) + 273.16 ) * 0.01 
     137               zdtap = sob(1,jl) + ztap * ( sob(2,jl) + ztap * sob(3,jl) )  
     138               zsol  =  EXP( soa(1,jl) + soa(2,jl) / ztap + soa(3,jl) * LOG( ztap )   & 
     139                  &                    + soa(4,jl) * ztap * ztap + ts(ji,jj,1,jp_sal,Kmm) * zdtap )  
     140            ELSE 
     141               zsol  = 0.e0 
     142            ENDIF 
     143            ! conversion from mol/l/atm to mol/m3/atm and from mol/m3/atm to mol/m3/pptv     
     144            zsol = xconv4 * xconv3 * zsol * tmask(ji,jj,1)   
     145            ! concentration at equilibrium 
     146            zca_cfc = xconv1 * zpp_cfc * zsol * tmask(ji,jj,1)              
     147            ! Computation of speed transfert 
     148            !    Schmidt number revised in Wanninkhof (2014) 
     149            zt1  = ts(ji,jj,1,jp_tem,Kmm) 
     150            zt2  = zt1 * zt1  
     151            zt3  = zt1 * zt2 
     152            zt4  = zt2 * zt2 
     153            zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 + sca(5,jl) * zt4 
     154 
     155            !    speed transfert : formulae revised in Wanninkhof (2014) 
     156            zv2     = wndm(ji,jj) * wndm(ji,jj) 
     157            zsch    = zsch / 660. 
     158            zak_cfc = ( 0.251 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 
     159 
     160            ! Input function  : speed *( conc. at equil - concen at surface ) 
     161            ! tr(:,:,:,:,Kmm) in pico-mol/l idem qtr; ak in en m/a 
     162            qtr_cfc(ji,jj,jl) = -zak_cfc * ( tr(ji,jj,1,jn,Kbb) - zca_cfc )   & 
     163               &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) 
     164            ! Add the surface flux to the trend 
     165            tr(ji,jj,1,jn,Krhs) = tr(ji,jj,1,jn,Krhs) + qtr_cfc(ji,jj,jl) / e3t(ji,jj,1,Kmm)  
     166 
     167            ! cumulation of surface flux at each time step 
     168            qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * rdt 
     169            !                                               !----------------! 
     170         END_2D 
    171171         !                                                  !----------------! 
    172172      END DO                                                !  end CFC loop  ! 
    … …  
    195195      IF( l_trdtrc ) THEN 
    196196          DO jn = jp_cfc0, jp_cfc1 
    197             CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends 
     197            CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm )   ! save trends 
    198198          END DO 
    199199      END IF 

  • NEMO/trunk/src/TOP/CFC/trcwri_cfc.F90

    r10069 r12377  
    2020CONTAINS 
    2121 
    22    SUBROUTINE trc_wri_cfc 
     22   SUBROUTINE trc_wri_cfc( Kmm ) 
    2323      !!--------------------------------------------------------------------- 
    2424      !!                     ***  ROUTINE trc_wri_trc  *** 
    … …  
    2626      !! ** Purpose :   output passive tracers fields  
    2727      !!--------------------------------------------------------------------- 
     28      INTEGER, INTENT(in)  :: Kmm   ! time level indices 
    2829      CHARACTER (len=20)   :: cltra 
    2930      INTEGER              :: jn 
    … …  
    3435      DO jn = jp_cfc0, jp_cfc1 
    3536         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
    36          CALL iom_put( cltra, trn(:,:,:,jn) ) 
     37         CALL iom_put( cltra, tr(:,:,:,jn,Kmm) ) 
    3738      END DO 
    3839      ! 

  • NEMO/trunk/src/TOP/MY_TRC/trcini_my_trc.F90

    r10068 r12377  
    2828CONTAINS 
    2929 
    30    SUBROUTINE trc_ini_my_trc 
     30   SUBROUTINE trc_ini_my_trc( Kmm ) 
    3131      !!---------------------------------------------------------------------- 
    3232      !!                     ***  trc_ini_my_trc  ***   
    … …  
    3636      !! ** Method  : - Read the namcfc namelist and check the parameter values 
    3737      !!---------------------------------------------------------------------- 
     38      INTEGER, INTENT(in) ::   Kmm  ! time level indices 
    3839      ! 
    3940      CALL trc_nam_my_trc 
    … …  
    5051      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    5152       
    52       IF( .NOT. ln_rsttr ) trn(:,:,:,jp_myt0:jp_myt1) = 1. 
     53      IF( .NOT. ln_rsttr ) tr(:,:,:,jp_myt0:jp_myt1,Kmm) = 1. 
    5354      ! 
    5455   END SUBROUTINE trc_ini_my_trc 

  • NEMO/trunk/src/TOP/MY_TRC/trcsms_my_trc.F90

    r10425 r12377  
    1515   USE trd_oce 
    1616   USE trdtrc 
    17    USE trcbc, only : trc_bc 
    1817 
    1918   IMPLICIT NONE 
    … …  
    3231CONTAINS 
    3332 
    34    SUBROUTINE trc_sms_my_trc( kt ) 
     33   SUBROUTINE trc_sms_my_trc( kt, Kbb, Kmm, Krhs ) 
    3534      !!---------------------------------------------------------------------- 
    3635      !!                     ***  trc_sms_my_trc  *** 
    … …  
    4241      ! 
    4342      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     43      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices 
    4444      INTEGER ::   jn   ! dummy loop index 
    4545      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrmyt 
    … …  
    5454      IF( l_trdtrc )  ALLOCATE( ztrmyt(jpi,jpj,jpk) ) 
    5555 
    56       CALL trc_bc ( kt )       ! tracers: surface and lateral Boundary Conditions 
    57  
    5856      ! add here the call to BGC model 
    5957 
    … …  
    6159      IF( l_trdtrc ) THEN 
    6260          DO jn = jp_myt0, jp_myt1 
    63             ztrmyt(:,:,:) = tra(:,:,:,jn) 
    64             CALL trd_trc( ztrmyt, jn, jptra_sms, kt )   ! save trends 
     61            ztrmyt(:,:,:) = tr(:,:,:,jn,Krhs) 
     62            CALL trd_trc( ztrmyt, jn, jptra_sms, kt, Kmm )   ! save trends 
    6563          END DO 
    6664          DEALLOCATE( ztrmyt ) 

  • NEMO/trunk/src/TOP/MY_TRC/trcwri_my_trc.F90

    r10069 r12377  
    2525CONTAINS 
    2626 
    27    SUBROUTINE trc_wri_my_trc 
     27   SUBROUTINE trc_wri_my_trc( Kmm ) 
    2828      !!--------------------------------------------------------------------- 
    2929      !!                     ***  ROUTINE trc_wri_trc  *** 
    … …  
    3131      !! ** Purpose :   output passive tracers fields  
    3232      !!--------------------------------------------------------------------- 
     33      INTEGER, INTENT(in)  :: Kmm   ! time level indices 
    3334      CHARACTER (len=20)   :: cltra 
    3435      INTEGER              :: jn 
    … …  
    3940      DO jn = jp_myt0, jp_myt1 
    4041         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
    41          CALL iom_put( cltra, trn(:,:,:,jn) ) 
     42         CALL iom_put( cltra, tr(:,:,:,jn,Kmm) ) 
    4243      END DO 
    4344      ! 

  • NEMO/trunk/src/TOP/PISCES/P2Z/p2zbio.F90

    r11536 r12377  
    5757 
    5858   !! * Substitutions 
    59 #  include "vectopt_loop_substitute.h90" 
     59#  include "do_loop_substitute.h90" 
    6060   !!---------------------------------------------------------------------- 
    6161   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    6565CONTAINS 
    6666 
    67    SUBROUTINE p2z_bio( kt ) 
     67   SUBROUTINE p2z_bio( kt, Kmm, Krhs ) 
    6868      !!--------------------------------------------------------------------- 
    6969      !!                     ***  ROUTINE p2z_bio  *** 
    … …  
    7878      !!              is added to the general trend. 
    7979      !!         
    80       !!                      tra = tra + zf...tra - zftra... 
     80      !!                      tr(Krhs) = tr(Krhs) + zf...tr(Krhs) - zftra... 
    8181      !!                                     |         | 
    8282      !!                                     |         | 
    … …  
    8484      !!         
    8585      !!--------------------------------------------------------------------- 
    86       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     86      INTEGER, INTENT( in ) ::   kt             ! ocean time-step index       
     87      INTEGER, INTENT( in ) ::   Kmm, Krhs      ! time level indices 
    8788      ! 
    8889      INTEGER  ::   ji, jj, jk, jl 
    … …  
    120121      DO jk = 1, jpkbm1                      !  Upper ocean (bio-layers)  ! 
    121122         !                                   ! -------------------------- ! 
    122          DO jj = 2, jpjm1 
    123             DO ji = fs_2, fs_jpim1  
    124                ! trophic variables( det, zoo, phy, no3, nh4, dom) 
    125                ! ------------------------------------------------ 
    126  
    127                ! negative trophic variables DO not contribute to the fluxes 
    128                zdet = MAX( 0.e0, trn(ji,jj,jk,jpdet) ) 
    129                zzoo = MAX( 0.e0, trn(ji,jj,jk,jpzoo) ) 
    130                zphy = MAX( 0.e0, trn(ji,jj,jk,jpphy) ) 
    131                zno3 = MAX( 0.e0, trn(ji,jj,jk,jpno3) ) 
    132                znh4 = MAX( 0.e0, trn(ji,jj,jk,jpnh4) ) 
    133                zdom = MAX( 0.e0, trn(ji,jj,jk,jpdom) ) 
    134  
    135                ! Limitations 
    136                zlt   = 1. 
    137                zle   = 1. - EXP( -etot(ji,jj,jk) / aki / zlt ) 
    138                ! psinut,akno3,aknh4 added by asklod AS Kremeur 2005-03 
    139                zlno3 = zno3 * EXP( -psinut * znh4 ) / ( akno3 + zno3 ) 
    140                zlnh4 = znh4 / (znh4+aknh4)   
    141  
    142                ! sinks and sources 
    143                !    phytoplankton production and exsudation 
    144                zno3phy = tmumax * zle * zlt * zlno3 * zphy 
    145                znh4phy = tmumax * zle * zlt * zlnh4 * zphy 
    146  
    147                !    fphylab added by asklod AS Kremeur 2005-03 
    148                zphydom = rgamma * (1 - fphylab) * (zno3phy + znh4phy) 
    149                zphynh4 = rgamma * fphylab * (zno3phy + znh4phy) 
    150                ! zooplankton production 
    151                !    preferences 
    152                zppz = rppz 
    153                zpdz = 1. - rppz 
    154                zpppz = ( zppz * zphy ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 ) 
    155                zppdz = ( zpdz * zdet ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 ) 
    156                zfood = zpppz * zphy + zppdz * zdet 
    157                !    filtration  
    158                zfilpz = taus * zpppz / (aks + zfood) 
    159                zfildz = taus * zppdz / (aks + zfood) 
    160                !    grazing 
    161                zphyzoo = zfilpz * zphy * zzoo 
    162                zdetzoo = zfildz * zdet * zzoo 
    163  
    164                ! fecal pellets production 
    165                zzoodet = rpnaz * zphyzoo + rdnaz * zdetzoo 
    166  
    167                ! zooplankton liquide excretion 
    168                zzoonh4 = tauzn * fzoolab * zzoo   
    169                zzoodom = tauzn * (1 - fzoolab) * zzoo 
    170  
    171                ! mortality 
    172                !    phytoplankton mortality 
    173                zphydet = tmminp * zphy 
    174  
    175                !    zooplankton mortality 
    176                !    closure : flux grazing is redistributed below level jpkbio 
    177                zzoobod = tmminz * zzoo * zzoo 
    178                xksi(ji,jj) = xksi(ji,jj) + (1-fdbod) * zzoobod * e3t_n(ji,jj,jk) 
    179                zboddet = fdbod * zzoobod 
    180  
    181                ! detritus and dom breakdown 
    182                zdetnh4 = taudn * fdetlab * zdet 
    183                zdetdom = taudn * (1 - fdetlab) * zdet 
    184  
    185                zdomnh4 = taudomn * zdom 
    186  
    187                ! flux added to express how the excess of nitrogen from  
    188                ! PHY, ZOO and DET to DOM goes directly to NH4 (flux of ajustment) 
    189                zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 
    190  
    191                ! Nitrification  
    192                znh4no3 = taunn * znh4 
    193  
    194                ! determination of trends 
    195                !    total trend for each biological tracer 
    196                zphya =   zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet 
    197                zzooa =   zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod 
    198                zno3a = - zno3phy + znh4no3 
    199                znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju 
    200                zdeta =   zphydet + zzoodet - zdetzoo - zdetnh4 - zdetdom + zboddet 
    201                zdoma =   zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju 
    202  
    203                ! tracer flux at totox-point added to the general trend 
    204                tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta 
    205                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa 
    206                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya 
    207                tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a 
    208                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a 
    209                tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 
    210  
    211                 IF( lk_iomput ) THEN 
    212                   ! convert fluxes in per day 
    213                   ze3t = e3t_n(ji,jj,jk) * 86400._wp 
    214                   zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t 
    215                   zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t 
    216                   zw2d(ji,jj,3)  = zw2d(ji,jj,3)  + zphydom * ze3t 
    217                   zw2d(ji,jj,4)  = zw2d(ji,jj,4)  + zphynh4 * ze3t 
    218                   zw2d(ji,jj,5)  = zw2d(ji,jj,5)  + zphyzoo * ze3t 
    219                   zw2d(ji,jj,6)  = zw2d(ji,jj,6)  + zphydet * ze3t 
    220                   zw2d(ji,jj,7)  = zw2d(ji,jj,7)  + zdetzoo * ze3t 
    221                   zw2d(ji,jj,8)  = zw2d(ji,jj,8)  + zzoodet * ze3t 
    222                   zw2d(ji,jj,9)  = zw2d(ji,jj,9)  + zzoobod * ze3t 
    223                   zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t 
    224                   zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t 
    225                   zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t 
    226                   zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t 
    227                   zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t 
    228                   zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t 
    229                   zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t 
    230                   zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 
    231                   !    
    232                   zw3d(ji,jj,jk,1) = zno3phy * 86400 
    233                   zw3d(ji,jj,jk,2) = znh4phy * 86400      
    234                   zw3d(ji,jj,jk,3) = znh4no3 * 86400    
    235                    !  
    236                 ENDIF 
    237             END DO 
    238          END DO 
     123         DO_2D_00_00 
     124            ! trophic variables( det, zoo, phy, no3, nh4, dom) 
     125            ! ------------------------------------------------ 
     126 
     127            ! negative trophic variables DO not contribute to the fluxes 
     128            zdet = MAX( 0.e0, tr(ji,jj,jk,jpdet,Kmm) ) 
     129            zzoo = MAX( 0.e0, tr(ji,jj,jk,jpzoo,Kmm) ) 
     130            zphy = MAX( 0.e0, tr(ji,jj,jk,jpphy,Kmm) ) 
     131            zno3 = MAX( 0.e0, tr(ji,jj,jk,jpno3,Kmm) ) 
     132            znh4 = MAX( 0.e0, tr(ji,jj,jk,jpnh4,Kmm) ) 
     133            zdom = MAX( 0.e0, tr(ji,jj,jk,jpdom,Kmm) ) 
     134 
     135            ! Limitations 
     136            zlt   = 1. 
     137            zle   = 1. - EXP( -etot(ji,jj,jk) / aki / zlt ) 
     138            ! psinut,akno3,aknh4 added by asklod AS Kremeur 2005-03 
     139            zlno3 = zno3 * EXP( -psinut * znh4 ) / ( akno3 + zno3 ) 
     140            zlnh4 = znh4 / (znh4+aknh4)   
     141 
     142            ! sinks and sources 
     143            !    phytoplankton production and exsudation 
     144            zno3phy = tmumax * zle * zlt * zlno3 * zphy 
     145            znh4phy = tmumax * zle * zlt * zlnh4 * zphy 
     146 
     147            !    fphylab added by asklod AS Kremeur 2005-03 
     148            zphydom = rgamma * (1 - fphylab) * (zno3phy + znh4phy) 
     149            zphynh4 = rgamma * fphylab * (zno3phy + znh4phy) 
     150            ! zooplankton production 
     151            !    preferences 
     152            zppz = rppz 
     153            zpdz = 1. - rppz 
     154            zpppz = ( zppz * zphy ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 ) 
     155            zppdz = ( zpdz * zdet ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 ) 
     156            zfood = zpppz * zphy + zppdz * zdet 
     157            !    filtration  
     158            zfilpz = taus * zpppz / (aks + zfood) 
     159            zfildz = taus * zppdz / (aks + zfood) 
     160            !    grazing 
     161            zphyzoo = zfilpz * zphy * zzoo 
     162            zdetzoo = zfildz * zdet * zzoo 
     163 
     164            ! fecal pellets production 
     165            zzoodet = rpnaz * zphyzoo + rdnaz * zdetzoo 
     166 
     167            ! zooplankton liquide excretion 
     168            zzoonh4 = tauzn * fzoolab * zzoo   
     169            zzoodom = tauzn * (1 - fzoolab) * zzoo 
     170 
     171            ! mortality 
     172            !    phytoplankton mortality 
     173            zphydet = tmminp * zphy 
     174 
     175            !    zooplankton mortality 
     176            !    closure : flux grazing is redistributed below level jpkbio 
     177            zzoobod = tmminz * zzoo * zzoo 
     178            xksi(ji,jj) = xksi(ji,jj) + (1-fdbod) * zzoobod * e3t(ji,jj,jk,Kmm) 
     179            zboddet = fdbod * zzoobod 
     180 
     181            ! detritus and dom breakdown 
     182            zdetnh4 = taudn * fdetlab * zdet 
     183            zdetdom = taudn * (1 - fdetlab) * zdet 
     184 
     185            zdomnh4 = taudomn * zdom 
     186 
     187            ! flux added to express how the excess of nitrogen from  
     188            ! PHY, ZOO and DET to DOM goes directly to NH4 (flux of ajustment) 
     189            zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 
     190 
     191            ! Nitrification  
     192            znh4no3 = taunn * znh4 
     193 
     194            ! determination of trends 
     195            !    total trend for each biological tracer 
     196            zphya =   zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet 
     197            zzooa =   zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod 
     198            zno3a = - zno3phy + znh4no3 
     199            znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju 
     200            zdeta =   zphydet + zzoodet - zdetzoo - zdetnh4 - zdetdom + zboddet 
     201            zdoma =   zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju 
     202 
     203            ! tracer flux at totox-point added to the general trend 
     204            tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + zdeta 
     205            tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) + zzooa 
     206            tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zphya 
     207            tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + zno3a 
     208            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + znh4a 
     209            tr(ji,jj,jk,jpdom,Krhs) = tr(ji,jj,jk,jpdom,Krhs) + zdoma 
     210 
     211             IF( lk_iomput ) THEN 
     212               ! convert fluxes in per day 
     213               ze3t = e3t(ji,jj,jk,Kmm) * 86400._wp 
     214               zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t 
     215               zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t 
     216               zw2d(ji,jj,3)  = zw2d(ji,jj,3)  + zphydom * ze3t 
     217               zw2d(ji,jj,4)  = zw2d(ji,jj,4)  + zphynh4 * ze3t 
     218               zw2d(ji,jj,5)  = zw2d(ji,jj,5)  + zphyzoo * ze3t 
     219               zw2d(ji,jj,6)  = zw2d(ji,jj,6)  + zphydet * ze3t 
     220               zw2d(ji,jj,7)  = zw2d(ji,jj,7)  + zdetzoo * ze3t 
     221               zw2d(ji,jj,8)  = zw2d(ji,jj,8)  + zzoodet * ze3t 
     222               zw2d(ji,jj,9)  = zw2d(ji,jj,9)  + zzoobod * ze3t 
     223               zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t 
     224               zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t 
     225               zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t 
     226               zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t 
     227               zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t 
     228               zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t 
     229               zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t 
     230               zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 
     231               !    
     232               zw3d(ji,jj,jk,1) = zno3phy * 86400 
     233               zw3d(ji,jj,jk,2) = znh4phy * 86400      
     234               zw3d(ji,jj,jk,3) = znh4no3 * 86400    
     235                !  
     236             ENDIF 
     237         END_2D 
    239238      END DO 
    240239 
    … …  
    242241      DO jk = jpkb, jpkm1                    !  Upper ocean (bio-layers)  ! 
    243242         !                                   ! -------------------------- ! 
    244          DO jj = 2, jpjm1 
    245             DO ji = fs_2, fs_jpim1  
    246                ! remineralisation of all quantities towards nitrate  
    247  
    248                !    trophic variables( det, zoo, phy, no3, nh4, dom) 
    249                !       negative trophic variables DO not contribute to the fluxes 
    250                zdet = MAX( 0.e0, trn(ji,jj,jk,jpdet) ) 
    251                zzoo = MAX( 0.e0, trn(ji,jj,jk,jpzoo) ) 
    252                zphy = MAX( 0.e0, trn(ji,jj,jk,jpphy) ) 
    253                zno3 = MAX( 0.e0, trn(ji,jj,jk,jpno3) ) 
    254                znh4 = MAX( 0.e0, trn(ji,jj,jk,jpnh4) ) 
    255                zdom = MAX( 0.e0, trn(ji,jj,jk,jpdom) ) 
    256  
    257                !    Limitations 
    258                zlt   = 0.e0 
    259                zle   = 0.e0 
    260                zlno3 = 0.e0 
    261                zlnh4 = 0.e0 
    262  
    263                !    sinks and sources 
    264                !       phytoplankton production and exsudation 
    265                zno3phy = 0.e0 
    266                znh4phy = 0.e0 
    267                zphydom = 0.e0 
    268                zphynh4 = 0.e0 
    269  
    270                !    zooplankton production 
    271                zphyzoo = 0.e0      ! grazing 
    272                zdetzoo = 0.e0 
    273  
    274                zzoodet = 0.e0      ! fecal pellets production 
    275  
    276                zzoonh4 = tauzn * fzoolab * zzoo         ! zooplankton liquide excretion 
    277                zzoodom = tauzn * (1 - fzoolab) * zzoo 
    278  
    279                !    mortality 
    280                zphydet = tmminp * zphy      ! phytoplankton mortality 
    281  
    282                zzoobod = 0.e0               ! zooplankton mortality 
    283                zboddet = 0.e0               ! closure : flux fbod is redistributed below level jpkbio 
    284  
    285                !    detritus and dom breakdown 
    286                zdetnh4 = taudn * fdetlab * zdet 
    287                zdetdom = taudn * (1 - fdetlab) * zdet 
    288  
    289                zdomnh4 = taudomn * zdom 
    290                zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 
    291  
    292                !    Nitrification 
    293                znh4no3 = taunn * znh4 
    294  
    295  
    296                ! determination of trends 
    297                !     total trend for each biological tracer 
    298                zphya =   zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet 
    299                zzooa =   zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod 
    300                zno3a = - zno3phy + znh4no3  
    301                znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju 
    302                zdeta = zphydet + zzoodet  - zdetzoo - zdetnh4 - zdetdom + zboddet 
    303                zdoma = zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju 
    304  
    305                ! tracer flux at totox-point added to the general trend 
    306                tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta 
    307                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa 
    308                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya 
    309                tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a 
    310                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a 
    311                tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 
     243         DO_2D_00_00 
     244            ! remineralisation of all quantities towards nitrate  
     245 
     246            !    trophic variables( det, zoo, phy, no3, nh4, dom) 
     247            !       negative trophic variables DO not contribute to the fluxes 
     248            zdet = MAX( 0.e0, tr(ji,jj,jk,jpdet,Kmm) ) 
     249            zzoo = MAX( 0.e0, tr(ji,jj,jk,jpzoo,Kmm) ) 
     250            zphy = MAX( 0.e0, tr(ji,jj,jk,jpphy,Kmm) ) 
     251            zno3 = MAX( 0.e0, tr(ji,jj,jk,jpno3,Kmm) ) 
     252            znh4 = MAX( 0.e0, tr(ji,jj,jk,jpnh4,Kmm) ) 
     253            zdom = MAX( 0.e0, tr(ji,jj,jk,jpdom,Kmm) ) 
     254 
     255            !    Limitations 
     256            zlt   = 0.e0 
     257            zle   = 0.e0 
     258            zlno3 = 0.e0 
     259            zlnh4 = 0.e0 
     260 
     261            !    sinks and sources 
     262            !       phytoplankton production and exsudation 
     263            zno3phy = 0.e0 
     264            znh4phy = 0.e0 
     265            zphydom = 0.e0 
     266            zphynh4 = 0.e0 
     267 
     268            !    zooplankton production 
     269            zphyzoo = 0.e0      ! grazing 
     270            zdetzoo = 0.e0 
     271 
     272            zzoodet = 0.e0      ! fecal pellets production 
     273 
     274            zzoonh4 = tauzn * fzoolab * zzoo         ! zooplankton liquide excretion 
     275            zzoodom = tauzn * (1 - fzoolab) * zzoo 
     276 
     277            !    mortality 
     278            zphydet = tmminp * zphy      ! phytoplankton mortality 
     279 
     280            zzoobod = 0.e0               ! zooplankton mortality 
     281            zboddet = 0.e0               ! closure : flux fbod is redistributed below level jpkbio 
     282 
     283            !    detritus and dom breakdown 
     284            zdetnh4 = taudn * fdetlab * zdet 
     285            zdetdom = taudn * (1 - fdetlab) * zdet 
     286 
     287            zdomnh4 = taudomn * zdom 
     288            zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 
     289 
     290            !    Nitrification 
     291            znh4no3 = taunn * znh4 
     292 
     293 
     294            ! determination of trends 
     295            !     total trend for each biological tracer 
     296            zphya =   zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet 
     297            zzooa =   zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod 
     298            zno3a = - zno3phy + znh4no3  
     299            znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju 
     300            zdeta = zphydet + zzoodet  - zdetzoo - zdetnh4 - zdetdom + zboddet 
     301            zdoma = zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju 
     302 
     303            ! tracer flux at totox-point added to the general trend 
     304            tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + zdeta 
     305            tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) + zzooa 
     306            tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zphya 
     307            tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + zno3a 
     308            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + znh4a 
     309            tr(ji,jj,jk,jpdom,Krhs) = tr(ji,jj,jk,jpdom,Krhs) + zdoma 
     310            ! 
     311             IF( lk_iomput ) THEN                  ! convert fluxes in per day 
     312               ze3t = e3t(ji,jj,jk,Kmm) * 86400._wp 
     313               zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t 
     314               zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t 
     315               zw2d(ji,jj,3)  = zw2d(ji,jj,3)  + zphydom * ze3t 
     316               zw2d(ji,jj,4)  = zw2d(ji,jj,4)  + zphynh4 * ze3t 
     317               zw2d(ji,jj,5)  = zw2d(ji,jj,5)  + zphyzoo * ze3t 
     318               zw2d(ji,jj,6)  = zw2d(ji,jj,6)  + zphydet * ze3t 
     319               zw2d(ji,jj,7)  = zw2d(ji,jj,7)  + zdetzoo * ze3t 
     320               zw2d(ji,jj,8)  = zw2d(ji,jj,8)  + zzoodet * ze3t 
     321               zw2d(ji,jj,9)  = zw2d(ji,jj,9)  + zzoobod * ze3t 
     322               zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t 
     323               zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t 
     324               zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t 
     325               zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t 
     326               zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t 
     327               zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t 
     328               zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t 
     329               zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 
     330               !    
     331               zw3d(ji,jj,jk,1) = zno3phy * 86400._wp 
     332               zw3d(ji,jj,jk,2) = znh4phy * 86400._wp 
     333               zw3d(ji,jj,jk,3) = znh4no3 * 86400._wp 
    312334               ! 
    313                 IF( lk_iomput ) THEN                  ! convert fluxes in per day 
    314                   ze3t = e3t_n(ji,jj,jk) * 86400._wp 
    315                   zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t 
    316                   zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t 
    317                   zw2d(ji,jj,3)  = zw2d(ji,jj,3)  + zphydom * ze3t 
    318                   zw2d(ji,jj,4)  = zw2d(ji,jj,4)  + zphynh4 * ze3t 
    319                   zw2d(ji,jj,5)  = zw2d(ji,jj,5)  + zphyzoo * ze3t 
    320                   zw2d(ji,jj,6)  = zw2d(ji,jj,6)  + zphydet * ze3t 
    321                   zw2d(ji,jj,7)  = zw2d(ji,jj,7)  + zdetzoo * ze3t 
    322                   zw2d(ji,jj,8)  = zw2d(ji,jj,8)  + zzoodet * ze3t 
    323                   zw2d(ji,jj,9)  = zw2d(ji,jj,9)  + zzoobod * ze3t 
    324                   zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t 
    325                   zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t 
    326                   zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t 
    327                   zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t 
    328                   zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t 
    329                   zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t 
    330                   zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t 
    331                   zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 
    332                   !    
    333                   zw3d(ji,jj,jk,1) = zno3phy * 86400._wp 
    334                   zw3d(ji,jj,jk,2) = znh4phy * 86400._wp 
    335                   zw3d(ji,jj,jk,3) = znh4no3 * 86400._wp 
    336                   ! 
    337                ENDIF 
    338             END DO 
    339          END DO 
     335            ENDIF 
     336         END_2D 
    340337      END DO 
    341338      ! 
    … …  
    367364      ENDIF 
    368365 
    369       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     366      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    370367         WRITE(charout, FMT="('bio')") 
    371368         CALL prt_ctl_trc_info(charout) 
    372          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     369         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    373370      ENDIF 
    374371      ! 
    … …  
    402399      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~' 
    403400      ! 
    404       REWIND( numnatp_ref )              ! Namelist namlobphy in reference namelist : Lobster biological parameters 
    405401      READ  ( numnatp_ref, namlobphy, IOSTAT = ios, ERR = 901) 
    406402901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlobphy in reference namelist' ) 
    407       REWIND( numnatp_cfg )              ! Namelist namlobphy in configuration namelist : Lobster biological parameters 
    408403      READ  ( numnatp_cfg, namlobphy, IOSTAT = ios, ERR = 902 ) 
    409404902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlobphy in configuration namelist' ) 
    … …  
    419414      ENDIF 
    420415 
    421       REWIND( numnatp_ref )              ! Namelist namlobnut in reference namelist : Lobster nutriments parameters 
    422416      READ  ( numnatp_ref, namlobnut, IOSTAT = ios, ERR = 903) 
    423417903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlobnut in reference namelist' ) 
    424       REWIND( numnatp_cfg )              ! Namelist namlobnut in configuration namelist : Lobster nutriments parameters 
    425418      READ  ( numnatp_cfg, namlobnut, IOSTAT = ios, ERR = 904 ) 
    426419904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlobnut in configuration namelist' ) 
    … …  
    436429      ENDIF 
    437430 
    438       REWIND( numnatp_ref )              ! Namelist namlobzoo in reference namelist : Lobster zooplankton parameters 
    439431      READ  ( numnatp_ref, namlobzoo, IOSTAT = ios, ERR = 905) 
    440432905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlobzoo in reference namelist' ) 
    441       REWIND( numnatp_cfg )              ! Namelist namlobzoo in configuration namelist : Lobster zooplankton parameters 
    442433      READ  ( numnatp_cfg, namlobzoo, IOSTAT = ios, ERR = 906 ) 
    443434906   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlobzoo in configuration namelist' ) 
    … …  
    458449      ENDIF 
    459450 
    460       REWIND( numnatp_ref )              ! Namelist namlobdet in reference namelist : Lobster detritus parameters 
    461451      READ  ( numnatp_ref, namlobdet, IOSTAT = ios, ERR = 907) 
    462452907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlobdet in reference namelist' ) 
    463       REWIND( numnatp_cfg )              ! Namelist namlobdet in configuration namelist : Lobster detritus parameters 
    464453      READ  ( numnatp_cfg, namlobdet, IOSTAT = ios, ERR = 908 ) 
    465454908   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlobdet in configuration namelist' ) 
    … …  
    473462      ENDIF 
    474463 
    475       REWIND( numnatp_ref )              ! Namelist namlobdom in reference namelist : Lobster DOM breakdown rate 
    476464      READ  ( numnatp_ref, namlobdom, IOSTAT = ios, ERR = 909) 
    477465909   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlobdom in reference namelist' ) 
    478       REWIND( numnatp_cfg )              ! Namelist namlobdom in configuration namelist : Lobster DOM breakdown rate 
    479466      READ  ( numnatp_cfg, namlobdom, IOSTAT = ios, ERR = 910 ) 
    480467910   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlobdom in configuration namelist' ) 

  • NEMO/trunk/src/TOP/PISCES/P2Z/p2zexp.F90

    r10425 r12377  
    3838 
    3939   !! * Substitutions 
    40 #  include "vectopt_loop_substitute.h90" 
     40#  include "do_loop_substitute.h90" 
    4141   !!---------------------------------------------------------------------- 
    4242   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4646CONTAINS 
    4747 
    48    SUBROUTINE p2z_exp( kt ) 
     48   SUBROUTINE p2z_exp( kt, Kmm, Krhs ) 
    4949      !!--------------------------------------------------------------------- 
    5050      !!                     ***  ROUTINE p2z_exp  *** 
    … …  
    6060      !!--------------------------------------------------------------------- 
    6161      !! 
    62       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     62      INTEGER, INTENT( in ) ::   kt             ! ocean time-step index       
     63      INTEGER, INTENT( in ) ::   Kmm, Krhs      ! time level indices 
    6364      !! 
    6465      INTEGER  ::   ji, jj, jk, jl, ikt 
    … …  
    7071      IF( ln_timing )   CALL timing_start('p2z_exp') 
    7172      ! 
    72       IF( kt == nittrc000 )   CALL p2z_exp_init 
     73      IF( kt == nittrc000 )   CALL p2z_exp_init( Kmm ) 
    7374 
    7475      zsedpoca(:,:) = 0. 
    … …  
    8081      ! LAYERS IS DETERMINED BY DMIN3 DEFINED IN sms_p2z.F90 
    8182      ! ---------------------------------------------------------------------- 
    82       DO jk = 1, jpkm1 
    83          DO jj = 2, jpjm1 
    84             DO ji = fs_2, fs_jpim1 
    85                ze3t = 1. / e3t_n(ji,jj,jk) 
    86                tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj) 
    87             END DO 
    88          END DO 
    89       END DO 
     83      DO_3D_00_00( 1, jpkm1 ) 
     84         ze3t = 1. / e3t(ji,jj,jk,Kmm) 
     85         tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj) 
     86      END_3D 
    9087 
    9188      ! Find the last level of the water column 
    … …  
    9592      zgeolpoc = 0.e0         !     Initialization 
    9693      ! Release of nutrients from the "simple" sediment 
    97       DO jj = 2, jpjm1 
    98          DO ji = fs_2, fs_jpim1 
    99             ikt = mbkt(ji,jj)  
    100             tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) + sedlam * sedpocn(ji,jj) / e3t_n(ji,jj,ikt)  
    101             ! Deposition of organic matter in the sediment 
    102             zwork = vsed * trn(ji,jj,ikt,jpdet) 
    103             zsedpoca(ji,jj) = ( zwork + dminl(ji,jj) * xksi(ji,jj)   & 
    104                &           - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rdt 
    105             zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1e2t(ji,jj) 
    106          END DO 
    107       END DO 
    108  
    109       DO jj = 2, jpjm1 
    110          DO ji = fs_2, fs_jpim1 
    111             tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc * cmask(ji,jj) / areacot / e3t_n(ji,jj,1) 
    112          END DO 
    113       END DO 
     94      DO_2D_00_00 
     95         ikt = mbkt(ji,jj)  
     96         tr(ji,jj,ikt,jpno3,Krhs) = tr(ji,jj,ikt,jpno3,Krhs) + sedlam * sedpocn(ji,jj) / e3t(ji,jj,ikt,Kmm)  
     97         ! Deposition of organic matter in the sediment 
     98         zwork = vsed * tr(ji,jj,ikt,jpdet,Kmm) 
     99         zsedpoca(ji,jj) = ( zwork + dminl(ji,jj) * xksi(ji,jj)   & 
     100            &           - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rdt 
     101         zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1e2t(ji,jj) 
     102      END_2D 
     103 
     104      DO_2D_00_00 
     105         tr(ji,jj,1,jpno3,Krhs) = tr(ji,jj,1,jpno3,Krhs) + zgeolpoc * cmask(ji,jj) / areacot / e3t(ji,jj,1,Kmm) 
     106      END_2D 
    114107 
    115108      CALL lbc_lnk( 'p2zexp', sedpocn, 'T', 1. ) 
    … …  
    127120      ELSE 
    128121        ! 
    129         DO jj = 1, jpj 
    130            DO ji = 1, jpi 
    131               zsedpocd = zsedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj)      ! time laplacian on tracers 
    132               sedpocb(ji,jj) = sedpocn(ji,jj) + atfp * zsedpocd                     ! sedpocb <-- filtered sedpocn 
    133               sedpocn(ji,jj) = zsedpoca(ji,jj)                                       ! sedpocn <-- sedpoca 
    134            END DO 
    135         END DO 
     122        DO_2D_11_11 
     123           zsedpocd = zsedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj)      ! time laplacian on tracers 
     124           sedpocb(ji,jj) = sedpocn(ji,jj) + atfp * zsedpocd                     ! sedpocb <-- filtered sedpocn 
     125           sedpocn(ji,jj) = zsedpoca(ji,jj)                                       ! sedpocn <-- sedpoca 
     126        END_2D 
    136127        !  
    137128      ENDIF 
    … …  
    146137      ENDIF 
    147138      ! 
    148       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     139      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    149140         WRITE(charout, FMT="('exp')") 
    150141         CALL prt_ctl_trc_info(charout) 
    151          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     142         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    152143      ENDIF 
    153144      ! 
    … …  
    157148 
    158149 
    159    SUBROUTINE p2z_exp_init 
     150   SUBROUTINE p2z_exp_init( Kmm ) 
    160151      !!---------------------------------------------------------------------- 
    161152      !!                    ***  ROUTINE p4z_exp_init  *** 
    162153      !! ** purpose :   specific initialisation for export 
    163154      !!---------------------------------------------------------------------- 
     155      INTEGER, INTENT(in)  ::  Kmm      ! time level index 
    164156      INTEGER  ::   ji, jj, jk 
    165157      REAL(wp) ::   zmaskt, zfluo, zfluu 
    … …  
    181173      zdm0 = 0._wp 
    182174      zrro = 1._wp 
    183       DO jk = jpkb, jpkm1 
    184          DO jj = 1, jpj 
    185             DO ji = 1, jpi 
    186                zfluo = ( gdepw_n(ji,jj,jk  ) / gdepw_n(ji,jj,jpkb) )**xhr 
    187                zfluu = ( gdepw_n(ji,jj,jk+1) / gdepw_n(ji,jj,jpkb) )**xhr 
    188                IF( zfluo.GT.1. )   zfluo = 1._wp 
    189                zdm0(ji,jj,jk) = zfluo - zfluu 
    190                IF( jk <= jpkb-1 )   zdm0(ji,jj,jk) = 0._wp 
    191                zrro(ji,jj) = zrro(ji,jj) - zdm0(ji,jj,jk) 
    192             END DO 
    193          END DO 
    194       END DO 
     175      DO_3D_11_11( jpkb, jpkm1 ) 
     176         zfluo = ( gdepw(ji,jj,jk  ,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr 
     177         zfluu = ( gdepw(ji,jj,jk+1,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr 
     178         IF( zfluo.GT.1. )   zfluo = 1._wp 
     179         zdm0(ji,jj,jk) = zfluo - zfluu 
     180         IF( jk <= jpkb-1 )   zdm0(ji,jj,jk) = 0._wp 
     181         zrro(ji,jj) = zrro(ji,jj) - zdm0(ji,jj,jk) 
     182      END_3D 
    195183      ! 
    196184      zdm0(:,:,jpk) = zrro(:,:) 
    … …  
    202190      dminl(:,:)   = 0._wp 
    203191      dmin3(:,:,:) = zdm0 
    204       DO jk = 1, jpk 
    205          DO jj = 1, jpj 
    206             DO ji = 1, jpi 
    207                IF( tmask(ji,jj,jk) == 0._wp ) THEN 
    208                   dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk) 
    209                   dmin3(ji,jj,jk) = 0._wp 
    210                ENDIF 
    211             END DO 
    212          END DO 
    213       END DO 
    214  
    215       DO jj = 1, jpj 
    216          DO ji = 1, jpi 
    217             IF( tmask(ji,jj,1) == 0 )   dmin3(ji,jj,1) = 0._wp 
    218          END DO 
    219       END DO 
     192      DO_3D_11_11( 1, jpk ) 
     193         IF( tmask(ji,jj,jk) == 0._wp ) THEN 
     194            dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk) 
     195            dmin3(ji,jj,jk) = 0._wp 
     196         ENDIF 
     197      END_3D 
     198 
     199      DO_2D_11_11 
     200         IF( tmask(ji,jj,1) == 0 )   dmin3(ji,jj,1) = 0._wp 
     201      END_2D 
    220202 
    221203      ! Coastal mask  
    222204      cmask(:,:) = 0._wp 
    223       DO jj = 2, jpjm1 
    224          DO ji = fs_2, fs_jpim1 
    225             IF( tmask(ji,jj,1) /= 0. ) THEN 
    226                zmaskt = tmask(ji+1,jj,1) * tmask(ji-1,jj,1) * tmask(ji,jj+1,1) * tmask(ji,jj-1,1)  
    227                IF( zmaskt == 0. )   cmask(ji,jj) = 1._wp 
    228             END IF 
    229          END DO 
    230       END DO 
     205      DO_2D_00_00 
     206         IF( tmask(ji,jj,1) /= 0. ) THEN 
     207            zmaskt = tmask(ji+1,jj,1) * tmask(ji-1,jj,1) * tmask(ji,jj+1,1) * tmask(ji,jj-1,1)  
     208            IF( zmaskt == 0. )   cmask(ji,jj) = 1._wp 
     209         END IF 
     210      END_2D 
    231211      CALL lbc_lnk( 'p2zexp', cmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged) 
    232212      areacot = glob_sum( 'p2zexp', e1e2t(:,:) * cmask(:,:) ) 

  • NEMO/trunk/src/TOP/PISCES/P2Z/p2zopt.F90

    r11536 r12377  
    3838   REAL(wp), PUBLIC ::  reddom    ! redfield ratio (C:N) for DOM 
    3939 
     40   !! * Substitutions 
     41#  include "do_loop_substitute.h90" 
    4042   !!---------------------------------------------------------------------- 
    4143   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4547CONTAINS 
    4648 
    47    SUBROUTINE p2z_opt( kt ) 
     49   SUBROUTINE p2z_opt( kt, Kmm ) 
    4850      !!--------------------------------------------------------------------- 
    4951      !!                     ***  ROUTINE p2z_opt  *** 
    … …  
    6163      !! 
    6264      INTEGER, INTENT( in ) ::   kt   ! index of the time stepping 
     65      INTEGER, INTENT( in ) ::   Kmm  ! time level index 
    6366      !! 
    6467      INTEGER  ::   ji, jj, jk          ! dummy loop indices 
    … …  
    9194      !                                          ! Photosynthetically Available Radiation (PAR) 
    9295      zcoef = 12 * redf / rcchl / rpig           ! -------------------------------------- 
    93       DO jk = 2, jpk                                  ! local par at w-levels 
    94          DO jj = 1, jpj 
    95             DO ji = 1, jpi 
    96                zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk-1,jpphy) ) * zcoef  ) 
    97                zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
    98                zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
    99                zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * e3t_n(ji,jj,jk-1) ) 
    100                zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t_n(ji,jj,jk-1) ) 
    101             END DO 
    102         END DO 
    103       END DO 
    104       DO jk = 1, jpkm1                                ! mean par at t-levels 
    105          DO jj = 1, jpj 
    106             DO ji = 1, jpi 
    107                zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk,jpphy) ) * zcoef  ) 
    108                zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
    109                zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
    110                zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * e3t_n(ji,jj,jk) ) * ( 1 - EXP( -zkr * e3t_n(ji,jj,jk) ) ) 
    111                zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * e3t_n(ji,jj,jk) ) * ( 1 - EXP( -zkg * e3t_n(ji,jj,jk) ) ) 
    112                etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 ) 
    113             END DO 
    114          END DO 
    115       END DO 
     96      DO_3D_11_11( 2, jpk ) 
     97         zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk-1,jpphy,Kmm) ) * zcoef  ) 
     98         zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
     99         zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
     100         zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * e3t(ji,jj,jk-1,Kmm) ) 
     101         zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t(ji,jj,jk-1,Kmm) ) 
     102      END_3D 
     103      DO_3D_11_11( 1, jpkm1 ) 
     104         zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk,jpphy,Kmm) ) * zcoef  ) 
     105         zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
     106         zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
     107         zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * e3t(ji,jj,jk,Kmm) ) * ( 1 - EXP( -zkr * e3t(ji,jj,jk,Kmm) ) ) 
     108         zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * e3t(ji,jj,jk,Kmm) ) * ( 1 - EXP( -zkg * e3t(ji,jj,jk,Kmm) ) ) 
     109         etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 ) 
     110      END_3D 
    116111 
    117112      !                                          ! Euphotic layer 
    118113      !                                          ! -------------- 
    119114      neln(:,:) = 1                                   ! euphotic layer level 
    120       DO jk = 1, jpkm1                                ! (i.e. 1rst T-level strictly below EL bottom) 
    121          DO jj = 1, jpj 
    122            DO ji = 1, jpi 
    123               IF( etot(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk + 1  
    124            END DO 
    125          END DO 
    126       END DO 
     115      DO_3D_11_11( 1, jpkm1 ) 
     116        IF( etot(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk + 1  
     117      END_3D 
    127118      !                                               ! Euphotic layer depth 
    128       DO jj = 1, jpj 
    129          DO ji = 1, jpi 
    130             heup(ji,jj) = gdepw_n(ji,jj,neln(ji,jj)) 
    131          END DO 
    132       END DO  
     119      DO_2D_11_11 
     120         heup(ji,jj) = gdepw(ji,jj,neln(ji,jj),Kmm) 
     121      END_2D 
    133122 
    134123 
    135       IF(ln_ctl) THEN      ! print mean trends (used for debugging) 
     124      IF(sn_cfctl%l_prttrc) THEN      ! print mean trends (used for debugging) 
    136125         WRITE(charout, FMT="('opt')") 
    137126         CALL prt_ctl_trc_info( charout ) 
    138          CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
     127         CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm ) 
    139128      ENDIF 
    140129      ! 
    … …  
    159148      !!---------------------------------------------------------------------- 
    160149 
    161       REWIND( numnatp_ref )              ! Namelist namlobopt in reference namelist : Lobster options 
    162150      READ  ( numnatp_ref, namlobopt, IOSTAT = ios, ERR = 901) 
    163151901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobopt in reference namelist' ) 
    164152 
    165       REWIND( numnatp_cfg )              ! Namelist namlobopt in configuration namelist : Lobster options 
    166153      READ  ( numnatp_cfg, namlobopt, IOSTAT = ios, ERR = 902 ) 
    167154902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namlobopt in configuration namelist' ) 
    … …  
    181168      ENDIF 
    182169      ! 
    183       REWIND( numnatp_ref )              ! Namelist namlobrat in reference namelist : Lobster ratios 
    184170      READ  ( numnatp_ref, namlobrat, IOSTAT = ios, ERR = 903) 
    185171903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobrat in reference namelist' ) 
    186172 
    187       REWIND( numnatp_cfg )              ! Namelist namlobrat in configuration namelist : Lobster ratios 
    188173      READ  ( numnatp_cfg, namlobrat, IOSTAT = ios, ERR = 904 ) 
    189174904   IF( ios >  0 ) CALL ctl_nam ( ios , 'namlobrat in configuration namelist' ) 

  • NEMO/trunk/src/TOP/PISCES/P2Z/p2zsed.F90

    r11536 r12377  
    3131   REAL(wp), PUBLIC ::   xhr         !: coeff for martin''s remineralisation profile 
    3232 
     33   !! * Substitutions 
     34#  include "do_loop_substitute.h90" 
    3335   !!---------------------------------------------------------------------- 
    3436   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    3840CONTAINS 
    3941 
    40    SUBROUTINE p2z_sed( kt ) 
     42   SUBROUTINE p2z_sed( kt, Kmm, Krhs ) 
    4143      !!--------------------------------------------------------------------- 
    4244      !!                     ***  ROUTINE p2z_sed  *** 
    … …  
    4951      !!              using an upstream scheme 
    5052      !!              the now vertical advection of tracers is given by: 
    51       !!                      dz(trn wn) = 1/bt dk+1( e1t e2t vsed (trn) ) 
    52       !!              add this trend now to the general trend of tracer (ta,sa,tra): 
    53       !!                             tra = tra + dz(trn wn) 
     53      !!                      dz(tr(:,:,:,:,Kmm) ww) = 1/bt dk+1( e1t e2t vsed (tr(:,:,:,:,Kmm)) ) 
     54      !!              add this trend now to the general trend of tracer (ta,sa,tr(:,:,:,:,Krhs)): 
     55      !!                             tr(:,:,:,:,Krhs) = tr(:,:,:,:,Krhs) + dz(tr(:,:,:,:,Kmm) ww) 
    5456      !!         
    5557      !!              IF 'key_diabio' is defined, the now vertical advection 
    5658      !!              trend of passive tracers is saved for futher diagnostics. 
    5759      !!--------------------------------------------------------------------- 
    58       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     60      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index       
     61      INTEGER, INTENT( in ) ::   Kmm, Krhs  ! time level indices 
    5962      ! 
    6063      INTEGER  ::   ji, jj, jk, jl, ierr 
    … …  
    8184      ! tracer flux at w-point: we use -vsed (downward flux)  with simplification : no e1*e2 
    8285      DO jk = 2, jpkm1 
    83          zwork(:,:,jk) = -vsed * trn(:,:,jk-1,jpdet) 
     86         zwork(:,:,jk) = -vsed * tr(:,:,jk-1,jpdet,Kmm) 
    8487      END DO 
    8588 
    8689      ! tracer flux divergence at t-point added to the general trend 
    87       DO jk = 1, jpkm1 
    88          DO jj = 1, jpj 
    89             DO ji = 1, jpi 
    90                ztra(ji,jj,jk)  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / e3t_n(ji,jj,jk) 
    91                tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra(ji,jj,jk)  
    92             END DO 
    93          END DO 
    94       END DO 
     90      DO_3D_11_11( 1, jpkm1 ) 
     91         ztra(ji,jj,jk)  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 
     92         tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + ztra(ji,jj,jk)  
     93      END_3D 
    9594 
    9695      IF( lk_iomput )  THEN 
    9796         IF( iom_use( "TDETSED" ) ) THEN 
    9897            ALLOCATE( zw2d(jpi,jpj) ) 
    99             zw2d(:,:) =  ztra(:,:,1) * e3t_n(:,:,1) * 86400._wp 
     98            zw2d(:,:) =  ztra(:,:,1) * e3t(:,:,1,Kmm) * 86400._wp 
    10099            DO jk = 2, jpkm1 
    101                zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400._wp 
     100               zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t(:,:,jk,Kmm) * 86400._wp 
    102101            END DO 
    103102            CALL iom_put( "TDETSED", zw2d ) 
    … …  
    107106      ! 
    108107 
    109       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     108      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    110109         WRITE(charout, FMT="('sed')") 
    111110         CALL prt_ctl_trc_info(charout) 
    112          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     111         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    113112      ENDIF 
    114113      ! 
    … …  
    132131      !!---------------------------------------------------------------------- 
    133132      ! 
    134       REWIND( numnatp_ref )              ! Namelist namlobsed in reference namelist : Lobster sediments 
    135133      READ  ( numnatp_ref, namlobsed, IOSTAT = ios, ERR = 901) 
    136134901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlosed in reference namelist' ) 
    137       REWIND( numnatp_cfg )              ! Namelist namlobsed in configuration namelist : Lobster sediments 
    138135      READ  ( numnatp_cfg, namlobsed, IOSTAT = ios, ERR = 902 ) 
    139136902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlobsed in configuration namelist' ) 

  • NEMO/trunk/src/TOP/PISCES/P2Z/p2zsms.F90

    r10068 r12377  
    3535CONTAINS 
    3636 
    37    SUBROUTINE p2z_sms( kt ) 
     37   SUBROUTINE p2z_sms( kt, Kmm, Krhs ) 
    3838      !!--------------------------------------------------------------------- 
    3939      !!                     ***  ROUTINE p2z_sms  *** 
    … …  
    4444      !! ** Method  : - ??? 
    4545      !! -------------------------------------------------------------------- 
    46       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     46      INTEGER, INTENT( in ) ::   kt            ! ocean time-step index       
     47      INTEGER, INTENT( in ) ::   Kmm, Krhs     ! ocean time level index       
    4748      ! 
    4849      INTEGER ::   jn   ! dummy loop index 
    … …  
    5152      IF( ln_timing )   CALL timing_start('p2z_sms') 
    5253      ! 
    53       CALL p2z_opt( kt )      ! optical model 
    54       CALL p2z_bio( kt )      ! biological model 
    55       CALL p2z_sed( kt )      ! sedimentation model 
    56       CALL p2z_exp( kt )      ! export 
     54      CALL p2z_opt( kt, Kmm      )      ! optical model 
     55      CALL p2z_bio( kt, Kmm, Krhs )      ! biological model 
     56      CALL p2z_sed( kt, Kmm, Krhs )      ! sedimentation model 
     57      CALL p2z_exp( kt, Kmm, Krhs )      ! export 
    5758      ! 
    5859      IF( l_trdtrc ) THEN 
    5960         DO jn = jp_pcs0, jp_pcs1 
    60            CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends 
     61           CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm )   ! save trends 
    6162         END DO 
    6263      END IF 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zagg.F90

    r10069 r12377  
    2424   PUBLIC   p4z_agg         ! called in p4zbio.F90 
    2525 
     26   !! * Substitutions 
     27#  include "do_loop_substitute.h90" 
    2628   !!---------------------------------------------------------------------- 
    2729   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    3133CONTAINS 
    3234 
    33    SUBROUTINE p4z_agg ( kt, knt ) 
     35   SUBROUTINE p4z_agg ( kt, knt, Kbb, Krhs ) 
    3436      !!--------------------------------------------------------------------- 
    3537      !!                     ***  ROUTINE p4z_agg  *** 
    … …  
    4042      !!--------------------------------------------------------------------- 
    4143      INTEGER, INTENT(in) ::   kt, knt   ! 
     44      INTEGER, INTENT(in) ::   Kbb, Krhs ! time level indices 
    4245      ! 
    4346      INTEGER  ::   ji, jj, jk 
    … …  
    5760      IF( ln_p4z ) THEN 
    5861         ! 
    59          DO jk = 1, jpkm1 
    60             DO jj = 1, jpj 
    61                DO ji = 1, jpi 
    62                   ! 
    63                   zfact = xstep * xdiss(ji,jj,jk) 
    64                   !  Part I : Coagulation dependent on turbulence 
    65                   zagg1 = 25.9  * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc) 
    66                   zagg2 = 4452. * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc) 
     62         DO_3D_11_11( 1, jpkm1 ) 
     63            ! 
     64            zfact = xstep * xdiss(ji,jj,jk) 
     65            !  Part I : Coagulation dependent on turbulence 
     66            zagg1 = 25.9  * zfact * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jppoc,Kbb) 
     67            zagg2 = 4452. * zfact * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpgoc,Kbb) 
    6768 
    68                   ! Part II : Differential settling 
     69            ! Part II : Differential settling 
    6970 
    70                   !  Aggregation of small into large particles 
    71                   zagg3 =  47.1 * xstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc) 
    72                   zagg4 =  3.3  * xstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc) 
     71            !  Aggregation of small into large particles 
     72            zagg3 =  47.1 * xstep * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpgoc,Kbb) 
     73            zagg4 =  3.3  * xstep * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jppoc,Kbb) 
    7374 
    74                   zagg   = zagg1 + zagg2 + zagg3 + zagg4 
    75                   zaggfe = zagg * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn ) 
     75            zagg   = zagg1 + zagg2 + zagg3 + zagg4 
     76            zaggfe = zagg * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 
    7677 
    77                   ! Aggregation of DOC to POC :  
    78                   ! 1st term is shear aggregation of DOC-DOC 
    79                   ! 2nd term is shear aggregation of DOC-POC 
    80                   ! 3rd term is differential settling of DOC-POC 
    81                   zaggdoc  = ( ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * zfact       & 
    82                   &            + 2.4 * xstep * trb(ji,jj,jk,jppoc) ) * 0.3 * trb(ji,jj,jk,jpdoc) 
    83                   ! transfer of DOC to GOC :  
    84                   ! 1st term is shear aggregation 
    85                   ! 2nd term is differential settling  
    86                   zaggdoc2 = ( 3.53E3 * zfact + 0.1 * xstep ) * trb(ji,jj,jk,jpgoc) * 0.3 * trb(ji,jj,jk,jpdoc) 
    87                   ! tranfer of DOC to POC due to brownian motion 
    88                   zaggdoc3 =  114. * 0.3 * trb(ji,jj,jk,jpdoc) *xstep * 0.3 * trb(ji,jj,jk,jpdoc) 
     78            ! Aggregation of DOC to POC :  
     79            ! 1st term is shear aggregation of DOC-DOC 
     80            ! 2nd term is shear aggregation of DOC-POC 
     81            ! 3rd term is differential settling of DOC-POC 
     82            zaggdoc  = ( ( 0.369 * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4 * tr(ji,jj,jk,jppoc,Kbb) ) * zfact       & 
     83            &            + 2.4 * xstep * tr(ji,jj,jk,jppoc,Kbb) ) * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 
     84            ! transfer of DOC to GOC :  
     85            ! 1st term is shear aggregation 
     86            ! 2nd term is differential settling  
     87            zaggdoc2 = ( 3.53E3 * zfact + 0.1 * xstep ) * tr(ji,jj,jk,jpgoc,Kbb) * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 
     88            ! tranfer of DOC to POC due to brownian motion 
     89            zaggdoc3 =  114. * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) *xstep * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 
    8990 
    90                   !  Update the trends 
    91                   tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc + zaggdoc3 
    92                   tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zagg + zaggdoc2 
    93                   tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe 
    94                   tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe 
    95                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 - zaggdoc3 
    96                   ! 
    97                   conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zagg + zaggdoc + zaggdoc3 
    98                   prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zagg + zaggdoc2 
    99                   ! 
    100                END DO 
    101             END DO 
    102          END DO 
     91            !  Update the trends 
     92            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zagg + zaggdoc + zaggdoc3 
     93            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zagg + zaggdoc2 
     94            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zaggfe 
     95            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zaggfe 
     96            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zaggdoc - zaggdoc2 - zaggdoc3 
     97            ! 
     98            conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zagg + zaggdoc + zaggdoc3 
     99            prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zagg + zaggdoc2 
     100            ! 
     101         END_3D 
    103102      ELSE    ! ln_p5z 
    104103        ! 
    105          DO jk = 1, jpkm1 
    106             DO jj = 1, jpj 
    107                DO ji = 1, jpi 
    108                   ! 
    109                   zfact = xstep * xdiss(ji,jj,jk) 
    110                   !  Part I : Coagulation dependent on turbulence 
    111                   zaggtmp = 25.9  * zfact * trb(ji,jj,jk,jppoc) 
    112                   zaggpoc1 = zaggtmp * trb(ji,jj,jk,jppoc) 
    113                   zaggtmp = 4452. * zfact * trb(ji,jj,jk,jpgoc) 
    114                   zaggpoc2 = zaggtmp * trb(ji,jj,jk,jppoc) 
     104         DO_3D_11_11( 1, jpkm1 ) 
     105            ! 
     106            zfact = xstep * xdiss(ji,jj,jk) 
     107            !  Part I : Coagulation dependent on turbulence 
     108            zaggtmp = 25.9  * zfact * tr(ji,jj,jk,jppoc,Kbb) 
     109            zaggpoc1 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 
     110            zaggtmp = 4452. * zfact * tr(ji,jj,jk,jpgoc,Kbb) 
     111            zaggpoc2 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 
    115112 
    116                   ! Part II : Differential settling 
    117     
    118                   !  Aggregation of small into large particles 
    119                   zaggtmp =  47.1 * xstep * trb(ji,jj,jk,jpgoc) 
    120                   zaggpoc3 = zaggtmp * trb(ji,jj,jk,jppoc) 
    121                   zaggtmp =  3.3  * xstep * trb(ji,jj,jk,jppoc) 
    122                   zaggpoc4 = zaggtmp * trb(ji,jj,jk,jppoc) 
     113            ! Part II : Differential settling 
    123114 
    124                   zaggpoc   = zaggpoc1 + zaggpoc2 + zaggpoc3 + zaggpoc4 
    125                   zaggpon = zaggpoc * trb(ji,jj,jk,jppon) / ( trb(ji,jj,jk,jppoc) + rtrn) 
    126                   zaggpop = zaggpoc * trb(ji,jj,jk,jppop) / ( trb(ji,jj,jk,jppoc) + rtrn) 
    127                   zaggfe = zaggpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc)  + rtrn ) 
     115            !  Aggregation of small into large particles 
     116            zaggtmp =  47.1 * xstep * tr(ji,jj,jk,jpgoc,Kbb) 
     117            zaggpoc3 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 
     118            zaggtmp =  3.3  * xstep * tr(ji,jj,jk,jppoc,Kbb) 
     119            zaggpoc4 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 
    128120 
    129                   ! Aggregation of DOC to POC :  
    130                   ! 1st term is shear aggregation of DOC-DOC 
    131                   ! 2nd term is shear aggregation of DOC-POC 
    132                   ! 3rd term is differential settling of DOC-POC 
    133                   zaggtmp = ( ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * zfact       & 
    134                   &            + 2.4 * xstep * trb(ji,jj,jk,jppoc) ) 
    135                   zaggdoc  = zaggtmp * 0.3 * trb(ji,jj,jk,jpdoc) 
    136                   zaggdon  = zaggtmp * 0.3 * trb(ji,jj,jk,jpdon) 
    137                   zaggdop  = zaggtmp * 0.3 * trb(ji,jj,jk,jpdop) 
     121            zaggpoc   = zaggpoc1 + zaggpoc2 + zaggpoc3 + zaggpoc4 
     122            zaggpon = zaggpoc * tr(ji,jj,jk,jppon,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
     123            zaggpop = zaggpoc * tr(ji,jj,jk,jppop,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
     124            zaggfe = zaggpoc * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb)  + rtrn ) 
    138125 
    139                   ! transfer of DOC to GOC :  
    140                   ! 1st term is shear aggregation 
    141                   ! 2nd term is differential settling  
    142                   zaggtmp = ( 3.53E3 * zfact + 0.1 * xstep ) * trb(ji,jj,jk,jpgoc) 
    143                   zaggdoc2 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdoc) 
    144                   zaggdon2 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdon) 
    145                   zaggdop2 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdop) 
     126            ! Aggregation of DOC to POC :  
     127            ! 1st term is shear aggregation of DOC-DOC 
     128            ! 2nd term is shear aggregation of DOC-POC 
     129            ! 3rd term is differential settling of DOC-POC 
     130            zaggtmp = ( ( 0.369 * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4 * tr(ji,jj,jk,jppoc,Kbb) ) * zfact       & 
     131            &            + 2.4 * xstep * tr(ji,jj,jk,jppoc,Kbb) ) 
     132            zaggdoc  = zaggtmp * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 
     133            zaggdon  = zaggtmp * 0.3 * tr(ji,jj,jk,jpdon,Kbb) 
     134            zaggdop  = zaggtmp * 0.3 * tr(ji,jj,jk,jpdop,Kbb) 
    146135 
    147                   ! tranfer of DOC to POC due to brownian motion 
    148                   zaggtmp = ( 114. * 0.3 * trb(ji,jj,jk,jpdoc) ) * xstep 
    149                   zaggdoc3 =  zaggtmp * 0.3 * trb(ji,jj,jk,jpdoc) 
    150                   zaggdon3 =  zaggtmp * 0.3 * trb(ji,jj,jk,jpdon) 
    151                   zaggdop3 =  zaggtmp * 0.3 * trb(ji,jj,jk,jpdop) 
     136            ! transfer of DOC to GOC :  
     137            ! 1st term is shear aggregation 
     138            ! 2nd term is differential settling  
     139            zaggtmp = ( 3.53E3 * zfact + 0.1 * xstep ) * tr(ji,jj,jk,jpgoc,Kbb) 
     140            zaggdoc2 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 
     141            zaggdon2 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdon,Kbb) 
     142            zaggdop2 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdop,Kbb) 
    152143 
    153                   !  Update the trends 
    154                   tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zaggpoc + zaggdoc + zaggdoc3 
    155                   tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) - zaggpon + zaggdon + zaggdon3 
    156                   tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) - zaggpop + zaggdop + zaggdop3 
    157                   tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zaggpoc + zaggdoc2 
    158                   tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zaggpon + zaggdon2 
    159                   tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + zaggpop + zaggdop2 
    160                   tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe 
    161                   tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe 
    162                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 - zaggdoc3 
    163                   tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) - zaggdon - zaggdon2 - zaggdon3 
    164                   tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) - zaggdop - zaggdop2 - zaggdop3 
    165                   ! 
    166                   conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zaggpoc + zaggdoc + zaggdoc3 
    167                   prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zaggpoc + zaggdoc2 
    168                   ! 
    169                END DO 
    170             END DO 
    171          END DO 
     144            ! tranfer of DOC to POC due to brownian motion 
     145            zaggtmp = ( 114. * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) ) * xstep 
     146            zaggdoc3 =  zaggtmp * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 
     147            zaggdon3 =  zaggtmp * 0.3 * tr(ji,jj,jk,jpdon,Kbb) 
     148            zaggdop3 =  zaggtmp * 0.3 * tr(ji,jj,jk,jpdop,Kbb) 
     149 
     150            !  Update the trends 
     151            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zaggpoc + zaggdoc + zaggdoc3 
     152            tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) - zaggpon + zaggdon + zaggdon3 
     153            tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) - zaggpop + zaggdop + zaggdop3 
     154            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zaggpoc + zaggdoc2 
     155            tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zaggpon + zaggdon2 
     156            tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + zaggpop + zaggdop2 
     157            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zaggfe 
     158            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zaggfe 
     159            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zaggdoc - zaggdoc2 - zaggdoc3 
     160            tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) - zaggdon - zaggdon2 - zaggdon3 
     161            tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) - zaggdop - zaggdop2 - zaggdop3 
     162            ! 
     163            conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zaggpoc + zaggdoc + zaggdoc3 
     164            prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zaggpoc + zaggdoc2 
     165            ! 
     166         END_3D 
    172167         ! 
    173168      ENDIF 
    174169      ! 
    175       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     170      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    176171         WRITE(charout, FMT="('agg')") 
    177172         CALL prt_ctl_trc_info(charout) 
    178          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     173         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    179174      ENDIF 
    180175      ! 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zbio.F90

    r10227 r12377  
    3838   PUBLIC  p4z_bio     
    3939 
     40   !! * Substitutions 
     41#  include "do_loop_substitute.h90" 
    4042   !!---------------------------------------------------------------------- 
    4143   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4547CONTAINS 
    4648 
    47    SUBROUTINE p4z_bio ( kt, knt ) 
     49   SUBROUTINE p4z_bio ( kt, knt, Kbb, Kmm, Krhs ) 
    4850      !!--------------------------------------------------------------------- 
    4951      !!                     ***  ROUTINE p4z_bio  *** 
    … …  
    5658      !!--------------------------------------------------------------------- 
    5759      INTEGER, INTENT(in) :: kt, knt 
     60      INTEGER, INTENT(in) :: Kbb, Kmm, Krhs  ! time level indices 
    5861      ! 
    5962      INTEGER             :: ji, jj, jk, jn 
    … …  
    6871      xdiss(:,:,:) = 1. 
    6972!!gm the use of nmld should be better here? 
    70       DO jk = 2, jpkm1 
    71          DO jj = 1, jpj 
    72             DO ji = 1, jpi 
     73      DO_3D_11_11( 2, jpkm1 ) 
    7374!!gm  :  use nmln  and test on jk ...  less memory acces 
    74                IF( gdepw_n(ji,jj,jk+1) > hmld(ji,jj) )   xdiss(ji,jj,jk) = 0.01 
    75             END DO  
    76          END DO 
    77       END DO 
     75         IF( gdepw(ji,jj,jk+1,Kmm) > hmld(ji,jj) )   xdiss(ji,jj,jk) = 0.01 
     76      END_3D 
    7877 
    79       CALL p4z_opt     ( kt, knt )     ! Optic: PAR in the water column 
    80       CALL p4z_sink    ( kt, knt )     ! vertical flux of particulate organic matter 
    81       CALL p4z_fechem  ( kt, knt )     ! Iron chemistry/scavenging 
     78      CALL p4z_opt     ( kt, knt, Kbb, Kmm      )     ! Optic: PAR in the water column 
     79      CALL p4z_sink    ( kt, knt, Kbb, Kmm, Krhs )     ! vertical flux of particulate organic matter 
     80      CALL p4z_fechem  ( kt, knt, Kbb, Kmm, Krhs )     ! Iron chemistry/scavenging 
    8281      ! 
    8382      IF( ln_p4z ) THEN 
    84          CALL p4z_lim  ( kt, knt )     ! co-limitations by the various nutrients 
    85          CALL p4z_prod ( kt, knt )     ! phytoplankton growth rate over the global ocean.  
    86          !                             ! (for each element : C, Si, Fe, Chl ) 
    87          CALL p4z_mort ( kt      )     ! phytoplankton mortality 
    88          !                             ! zooplankton sources/sinks routines  
    89          CALL p4z_micro( kt, knt )           ! microzooplankton 
    90          CALL p4z_meso ( kt, knt )           ! mesozooplankton 
     83         CALL p4z_lim  ( kt, knt, Kbb, Kmm      )     ! co-limitations by the various nutrients 
     84         CALL p4z_prod ( kt, knt, Kbb, Kmm, Krhs )     ! phytoplankton growth rate over the global ocean.  
     85         !                                          ! (for each element : C, Si, Fe, Chl ) 
     86         CALL p4z_mort ( kt,      Kbb,      Krhs )     ! phytoplankton mortality 
     87         !                                          ! zooplankton sources/sinks routines  
     88         CALL p4z_micro( kt, knt, Kbb,      Krhs )     ! microzooplankton 
     89         CALL p4z_meso ( kt, knt, Kbb,      Krhs )     ! mesozooplankton 
    9190      ELSE 
    92          CALL p5z_lim  ( kt, knt )     ! co-limitations by the various nutrients 
    93          CALL p5z_prod ( kt, knt )     ! phytoplankton growth rate over the global ocean.  
    94          !                             ! (for each element : C, Si, Fe, Chl ) 
    95          CALL p5z_mort ( kt      )     ! phytoplankton mortality 
    96          !                             ! zooplankton sources/sinks routines  
    97          CALL p5z_micro( kt, knt )           ! microzooplankton 
    98          CALL p5z_meso ( kt, knt )           ! mesozooplankton 
     91         CALL p5z_lim  ( kt, knt, Kbb, Kmm      )     ! co-limitations by the various nutrients 
     92         CALL p5z_prod ( kt, knt, Kbb, Kmm, Krhs )     ! phytoplankton growth rate over the global ocean.  
     93         !                                          ! (for each element : C, Si, Fe, Chl ) 
     94         CALL p5z_mort ( kt,      Kbb,      Krhs      )     ! phytoplankton mortality 
     95         !                                          ! zooplankton sources/sinks routines  
     96         CALL p5z_micro( kt, knt, Kbb,      Krhs )           ! microzooplankton 
     97         CALL p5z_meso ( kt, knt, Kbb,      Krhs )           ! mesozooplankton 
    9998      ENDIF 
    10099      ! 
    101       CALL p4z_agg     ( kt, knt )     ! Aggregation of particles 
    102       CALL p4z_rem     ( kt, knt )     ! remineralization terms of organic matter+scavenging of Fe 
    103       CALL p4z_poc     ( kt, knt )     ! Remineralization of organic particles 
     100      CALL p4z_agg     ( kt, knt, Kbb,      Krhs )     ! Aggregation of particles 
     101      CALL p4z_rem     ( kt, knt, Kbb, Kmm, Krhs )     ! remineralization terms of organic matter+scavenging of Fe 
     102      CALL p4z_poc     ( kt, knt, Kbb, Kmm, Krhs )     ! Remineralization of organic particles 
    104103      ! 
    105104      IF( ln_ligand )  & 
    106       & CALL p4z_ligand( kt, knt ) 
     105      & CALL p4z_ligand( kt, knt, Kbb,      Krhs ) 
    107106      !                                                             ! 
    108       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     107      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    109108         WRITE(charout, FMT="('bio ')") 
    110109         CALL prt_ctl_trc_info(charout) 
    111          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     110         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    112111      ENDIF 
    113112      ! 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zche.F90

    r10425 r12377  
    130130   INTEGER :: niter_atgen    = jp_maxniter_atgen 
    131131 
     132   !! * Substitutions 
     133#  include "do_loop_substitute.h90" 
    132134   !!---------------------------------------------------------------------- 
    133135   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    137139CONTAINS 
    138140 
    139    SUBROUTINE p4z_che 
     141   SUBROUTINE p4z_che( Kbb, Kmm ) 
    140142      !!--------------------------------------------------------------------- 
    141143      !!                     ***  ROUTINE p4z_che  *** 
    … …  
    145147      !! ** Method  : - ... 
    146148      !!--------------------------------------------------------------------- 
     149      INTEGER, INTENT(in) ::   Kbb, Kmm  ! time level indices 
    147150      INTEGER  ::   ji, jj, jk 
    148151      REAL(wp) ::   ztkel, ztkel1, zt , zsal  , zsal2 , zbuf1 , zbuf2 
    … …  
    164167      ! ------------------------------------------------------------- 
    165168      IF (neos == -1) THEN 
    166          salinprac(:,:,:) = tsn(:,:,:,jp_sal) * 35.0 / 35.16504 
     169         salinprac(:,:,:) = ts(:,:,:,jp_sal,Kmm) * 35.0 / 35.16504 
    167170      ELSE 
    168          salinprac(:,:,:) = tsn(:,:,:,jp_sal) 
     171         salinprac(:,:,:) = ts(:,:,:,jp_sal,Kmm) 
    169172      ENDIF 
    170173 
    … …  
    175178      ! 0.04°C relative to an exact computation 
    176179      ! --------------------------------------------------------------------- 
    177       DO jk = 1, jpk 
    178          DO jj = 1, jpj 
    179             DO ji = 1, jpi 
    180                zpres = gdept_n(ji,jj,jk) / 1000. 
    181                za1 = 0.04 * ( 1.0 + 0.185 * tsn(ji,jj,jk,jp_tem) + 0.035 * (salinprac(ji,jj,jk) - 35.0) ) 
    182                za2 = 0.0075 * ( 1.0 - tsn(ji,jj,jk,jp_tem) / 30.0 ) 
    183                tempis(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) - za1 * zpres + za2 * zpres**2 
    184             END DO 
    185          END DO 
    186       END DO 
     180      DO_3D_11_11( 1, jpk ) 
     181         zpres = gdept(ji,jj,jk,Kmm) / 1000. 
     182         za1 = 0.04 * ( 1.0 + 0.185 * ts(ji,jj,jk,jp_tem,Kmm) + 0.035 * (salinprac(ji,jj,jk) - 35.0) ) 
     183         za2 = 0.0075 * ( 1.0 - ts(ji,jj,jk,jp_tem,Kmm) / 30.0 ) 
     184         tempis(ji,jj,jk) = ts(ji,jj,jk,jp_tem,Kmm) - za1 * zpres + za2 * zpres**2 
     185      END_3D 
    187186      ! 
    188187      ! CHEMICAL CONSTANTS - SURFACE LAYER 
    … …  
    245244               zplat   = SIN ( ABS(gphit(ji,jj)*3.141592654/180.) ) 
    246245               zc1 = 5.92E-3 + zplat**2 * 5.25E-3 
    247                zpres = ((1-zc1)-SQRT(((1-zc1)**2)-(8.84E-6*gdept_n(ji,jj,jk)))) / 4.42E-6 
     246               zpres = ((1-zc1)-SQRT(((1-zc1)**2)-(8.84E-6*gdept(ji,jj,jk,Kmm)))) / 4.42E-6 
    248247               zpres = zpres / 10.0 
    249248 
    … …  
    448447   END SUBROUTINE p4z_che 
    449448 
    450    SUBROUTINE ahini_for_at(p_hini) 
     449   SUBROUTINE ahini_for_at(p_hini, Kbb ) 
    451450      !!--------------------------------------------------------------------- 
    452451      !!                     ***  ROUTINE ahini_for_at  *** 
    … …  
    462461      !!--------------------------------------------------------------------- 
    463462      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT)  ::  p_hini 
     463      INTEGER,                          INTENT(in)   ::  Kbb      ! time level indices 
    464464      INTEGER  ::   ji, jj, jk 
    465465      REAL(wp)  ::  zca1, zba1 
    … …  
    471471      IF( ln_timing )  CALL timing_start('ahini_for_at') 
    472472      ! 
    473       DO jk = 1, jpk 
    474         DO jj = 1, jpj 
    475           DO ji = 1, jpi 
    476             p_alkcb  = trb(ji,jj,jk,jptal) * 1000. / (rhop(ji,jj,jk) + rtrn) 
    477             p_dictot = trb(ji,jj,jk,jpdic) * 1000. / (rhop(ji,jj,jk) + rtrn) 
    478             p_bortot = borat(ji,jj,jk) 
    479             IF (p_alkcb <= 0.) THEN 
    480                 p_hini(ji,jj,jk) = 1.e-3 
    481             ELSEIF (p_alkcb >= (2.*p_dictot + p_bortot)) THEN 
    482                 p_hini(ji,jj,jk) = 1.e-10_wp 
     473      DO_3D_11_11( 1, jpk ) 
     474      p_alkcb  = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 
     475      p_dictot = tr(ji,jj,jk,jpdic,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 
     476      p_bortot = borat(ji,jj,jk) 
     477      IF (p_alkcb <= 0.) THEN 
     478          p_hini(ji,jj,jk) = 1.e-3 
     479      ELSEIF (p_alkcb >= (2.*p_dictot + p_bortot)) THEN 
     480          p_hini(ji,jj,jk) = 1.e-10_wp 
     481      ELSE 
     482          zca1 = p_dictot/( p_alkcb + rtrn ) 
     483          zba1 = p_bortot/ (p_alkcb + rtrn ) 
     484     ! Coefficients of the cubic polynomial 
     485          za2 = aKb3(ji,jj,jk)*(1. - zba1) + ak13(ji,jj,jk)*(1.-zca1) 
     486          za1 = ak13(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - zca1)    & 
     487          &     + ak13(ji,jj,jk)*ak23(ji,jj,jk)*(1. - (zca1+zca1)) 
     488          za0 = ak13(ji,jj,jk)*ak23(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - (zca1+zca1)) 
     489                                  ! Taylor expansion around the minimum 
     490          zd = za2*za2 - 3.*za1   ! Discriminant of the quadratic equation 
     491                                  ! for the minimum close to the root 
     492 
     493          IF(zd > 0.) THEN        ! If the discriminant is positive 
     494            zsqrtd = SQRT(zd) 
     495            IF(za2 < 0) THEN 
     496              zhmin = (-za2 + zsqrtd)/3. 
    483497            ELSE 
    484                 zca1 = p_dictot/( p_alkcb + rtrn ) 
    485                 zba1 = p_bortot/ (p_alkcb + rtrn ) 
    486            ! Coefficients of the cubic polynomial 
    487                 za2 = aKb3(ji,jj,jk)*(1. - zba1) + ak13(ji,jj,jk)*(1.-zca1) 
    488                 za1 = ak13(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - zca1)    & 
    489                 &     + ak13(ji,jj,jk)*ak23(ji,jj,jk)*(1. - (zca1+zca1)) 
    490                 za0 = ak13(ji,jj,jk)*ak23(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - (zca1+zca1)) 
    491                                         ! Taylor expansion around the minimum 
    492                 zd = za2*za2 - 3.*za1   ! Discriminant of the quadratic equation 
    493                                         ! for the minimum close to the root 
    494  
    495                 IF(zd > 0.) THEN        ! If the discriminant is positive 
    496                   zsqrtd = SQRT(zd) 
    497                   IF(za2 < 0) THEN 
    498                     zhmin = (-za2 + zsqrtd)/3. 
    499                   ELSE 
    500                     zhmin = -za1/(za2 + zsqrtd) 
    501                   ENDIF 
    502                   p_hini(ji,jj,jk) = zhmin + SQRT(-(za0 + zhmin*(za1 + zhmin*(za2 + zhmin)))/zsqrtd) 
    503                 ELSE 
    504                   p_hini(ji,jj,jk) = 1.e-7 
    505                 ENDIF 
    506              ! 
    507              ENDIF 
    508           END DO 
    509         END DO 
    510       END DO 
     498              zhmin = -za1/(za2 + zsqrtd) 
     499            ENDIF 
     500            p_hini(ji,jj,jk) = zhmin + SQRT(-(za0 + zhmin*(za1 + zhmin*(za2 + zhmin)))/zsqrtd) 
     501          ELSE 
     502            p_hini(ji,jj,jk) = 1.e-7 
     503          ENDIF 
     504       ! 
     505       ENDIF 
     506      END_3D 
    511507      ! 
    512508      IF( ln_timing )  CALL timing_stop('ahini_for_at') 
    … …  
    516512   !=============================================================================== 
    517513 
    518    SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup ) 
     514   SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup, Kbb ) 
    519515 
    520516   ! Subroutine returns the lower and upper bounds of "non-water-selfionization" 
    … …  
    525521   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_inf 
    526522   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_sup 
    527  
    528    p_alknw_inf(:,:,:) =  -trb(:,:,:,jppo4) * 1000. / (rhop(:,:,:) + rtrn) - sulfat(:,:,:)  & 
     523   INTEGER,                          INTENT(in)  ::  Kbb      ! time level indices 
     524 
     525   p_alknw_inf(:,:,:) =  -tr(:,:,:,jppo4,Kbb) * 1000. / (rhop(:,:,:) + rtrn) - sulfat(:,:,:)  & 
    529526   &              - fluorid(:,:,:) 
    530    p_alknw_sup(:,:,:) =   (2. * trb(:,:,:,jpdic) + 2. * trb(:,:,:,jppo4) + trb(:,:,:,jpsil) )    & 
     527   p_alknw_sup(:,:,:) =   (2. * tr(:,:,:,jpdic,Kbb) + 2. * tr(:,:,:,jppo4,Kbb) + tr(:,:,:,jpsil,Kbb) )    & 
    531528   &               * 1000. / (rhop(:,:,:) + rtrn) + borat(:,:,:)  
    532529 
    … …  
    534531 
    535532 
    536    SUBROUTINE solve_at_general( p_hini, zhi ) 
     533   SUBROUTINE solve_at_general( p_hini, zhi, Kbb ) 
    537534 
    538535   ! Universal pH solver that converges from any given initial value, 
    … …  
    543540   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN)   :: p_hini 
    544541   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT)  :: zhi 
     542   INTEGER,                          INTENT(in)   :: Kbb  ! time level indices 
    545543 
    546544   ! Local variables 
    … …  
    565563   IF( ln_timing )  CALL timing_start('solve_at_general') 
    566564 
    567    CALL anw_infsup( zalknw_inf, zalknw_sup ) 
     565   CALL anw_infsup( zalknw_inf, zalknw_sup, Kbb ) 
    568566 
    569567   rmask(:,:,:) = tmask(:,:,:) 
    … …  
    571569 
    572570   ! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree 
    573    DO jk = 1, jpk 
    574       DO jj = 1, jpj 
    575          DO ji = 1, jpi 
    576             IF (rmask(ji,jj,jk) == 1.) THEN 
    577                p_alktot = trb(ji,jj,jk,jptal) * 1000. / (rhop(ji,jj,jk) + rtrn) 
    578                aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 
    579                zh_ini = p_hini(ji,jj,jk) 
    580  
    581                zdelta = (p_alktot-zalknw_inf(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 
    582  
    583                IF(p_alktot >= zalknw_inf(ji,jj,jk)) THEN 
    584                  zh_min(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_inf(ji,jj,jk) + SQRT(zdelta) ) 
    585                ELSE 
    586                  zh_min(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_inf(ji,jj,jk)) + SQRT(zdelta) ) / 2. 
    587                ENDIF 
    588  
    589                zdelta = (p_alktot-zalknw_sup(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 
    590  
    591                IF(p_alktot <= zalknw_sup(ji,jj,jk)) THEN 
    592                  zh_max(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_sup(ji,jj,jk)) + SQRT(zdelta) ) / 2. 
    593                ELSE 
    594                  zh_max(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_sup(ji,jj,jk) + SQRT(zdelta) ) 
    595                ENDIF 
    596  
    597                zhi(ji,jj,jk) = MAX(MIN(zh_max(ji,jj,jk), zh_ini), zh_min(ji,jj,jk)) 
     571   DO_3D_11_11( 1, jpk ) 
     572      IF (rmask(ji,jj,jk) == 1.) THEN 
     573         p_alktot = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 
     574         aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 
     575         zh_ini = p_hini(ji,jj,jk) 
     576 
     577         zdelta = (p_alktot-zalknw_inf(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 
     578 
     579         IF(p_alktot >= zalknw_inf(ji,jj,jk)) THEN 
     580           zh_min(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_inf(ji,jj,jk) + SQRT(zdelta) ) 
     581         ELSE 
     582           zh_min(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_inf(ji,jj,jk)) + SQRT(zdelta) ) / 2. 
     583         ENDIF 
     584 
     585         zdelta = (p_alktot-zalknw_sup(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 
     586 
     587         IF(p_alktot <= zalknw_sup(ji,jj,jk)) THEN 
     588           zh_max(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_sup(ji,jj,jk)) + SQRT(zdelta) ) / 2. 
     589         ELSE 
     590           zh_max(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_sup(ji,jj,jk) + SQRT(zdelta) ) 
     591         ENDIF 
     592 
     593         zhi(ji,jj,jk) = MAX(MIN(zh_max(ji,jj,jk), zh_ini), zh_min(ji,jj,jk)) 
     594      ENDIF 
     595   END_3D 
     596 
     597   zeqn_absmin(:,:,:) = HUGE(1._wp) 
     598 
     599   DO jn = 1, jp_maxniter_atgen  
     600   DO_3D_11_11( 1, jpk ) 
     601      IF (rmask(ji,jj,jk) == 1.) THEN 
     602         zfact = rhop(ji,jj,jk) / 1000. + rtrn 
     603         p_alktot = tr(ji,jj,jk,jptal,Kbb) / zfact 
     604         zdic  = tr(ji,jj,jk,jpdic,Kbb) / zfact 
     605         zbot  = borat(ji,jj,jk) 
     606         zpt = tr(ji,jj,jk,jppo4,Kbb) / zfact * po4r 
     607         zsit = tr(ji,jj,jk,jpsil,Kbb) / zfact 
     608         zst = sulfat (ji,jj,jk) 
     609         zft = fluorid(ji,jj,jk) 
     610         aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 
     611         zh = zhi(ji,jj,jk) 
     612         zh_prev = zh 
     613 
     614         ! H2CO3 - HCO3 - CO3 : n=2, m=0 
     615         znumer_dic = 2.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk) 
     616         zdenom_dic = ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*(ak13(ji,jj,jk) + zh) 
     617         zalk_dic   = zdic * (znumer_dic/zdenom_dic) 
     618         zdnumer_dic = ak13(ji,jj,jk)*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh     & 
     619                       *(4.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk)) 
     620         zdalk_dic   = -zdic*(zdnumer_dic/zdenom_dic**2) 
     621 
     622 
     623         ! B(OH)3 - B(OH)4 : n=1, m=0 
     624         znumer_bor = akb3(ji,jj,jk) 
     625         zdenom_bor = akb3(ji,jj,jk) + zh 
     626         zalk_bor   = zbot * (znumer_bor/zdenom_bor) 
     627         zdnumer_bor = akb3(ji,jj,jk) 
     628         zdalk_bor   = -zbot*(zdnumer_bor/zdenom_bor**2) 
     629 
     630 
     631         ! H3PO4 - H2PO4 - HPO4 - PO4 : n=3, m=1 
     632         znumer_po4 = 3.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  & 
     633         &            + zh*(2.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh* ak1p3(ji,jj,jk)) 
     634         zdenom_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)     & 
     635         &            + zh*( ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh*(ak1p3(ji,jj,jk) + zh)) 
     636         zalk_po4   = zpt * (znumer_po4/zdenom_po4 - 1.) ! Zero level of H3PO4 = 1 
     637         zdnumer_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  & 
     638         &             + zh*(4.*ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)         & 
     639         &             + zh*(9.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)                         & 
     640         &             + ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)                                & 
     641         &             + zh*(4.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh * ak1p3(ji,jj,jk) ) ) ) 
     642         zdalk_po4   = -zpt * (zdnumer_po4/zdenom_po4**2) 
     643 
     644         ! H4SiO4 - H3SiO4 : n=1, m=0 
     645         znumer_sil = aksi3(ji,jj,jk) 
     646         zdenom_sil = aksi3(ji,jj,jk) + zh 
     647         zalk_sil   = zsit * (znumer_sil/zdenom_sil) 
     648         zdnumer_sil = aksi3(ji,jj,jk) 
     649         zdalk_sil   = -zsit * (zdnumer_sil/zdenom_sil**2) 
     650 
     651         ! HSO4 - SO4 : n=1, m=1 
     652         aphscale = 1.0 + zst/aks3(ji,jj,jk) 
     653         znumer_so4 = aks3(ji,jj,jk) * aphscale 
     654         zdenom_so4 = aks3(ji,jj,jk) * aphscale + zh 
     655         zalk_so4   = zst * (znumer_so4/zdenom_so4 - 1.) 
     656         zdnumer_so4 = aks3(ji,jj,jk) 
     657         zdalk_so4   = -zst * (zdnumer_so4/zdenom_so4**2) 
     658 
     659         ! HF - F : n=1, m=1 
     660         znumer_flu =  akf3(ji,jj,jk) 
     661         zdenom_flu =  akf3(ji,jj,jk) + zh 
     662         zalk_flu   =  zft * (znumer_flu/zdenom_flu - 1.) 
     663         zdnumer_flu = akf3(ji,jj,jk) 
     664         zdalk_flu   = -zft * (zdnumer_flu/zdenom_flu**2) 
     665 
     666         ! H2O - OH 
     667         aphscale = 1.0 + zst/aks3(ji,jj,jk) 
     668         zalk_wat   = akw3(ji,jj,jk)/zh - zh/aphscale 
     669         zdalk_wat  = -akw3(ji,jj,jk)/zh**2 - 1./aphscale 
     670 
     671         ! CALCULATE [ALK]([CO3--], [HCO3-]) 
     672         zeqn = zalk_dic + zalk_bor + zalk_po4 + zalk_sil   & 
     673         &      + zalk_so4 + zalk_flu                       & 
     674         &      + zalk_wat - p_alktot 
     675 
     676         zalka = p_alktot - (zalk_bor + zalk_po4 + zalk_sil   & 
     677         &       + zalk_so4 + zalk_flu + zalk_wat) 
     678 
     679         zdeqndh = zdalk_dic + zdalk_bor + zdalk_po4 + zdalk_sil & 
     680         &         + zdalk_so4 + zdalk_flu + zdalk_wat 
     681 
     682         ! Adapt bracketing interval 
     683         IF(zeqn > 0._wp) THEN 
     684           zh_min(ji,jj,jk) = zh_prev 
     685         ELSEIF(zeqn < 0._wp) THEN 
     686           zh_max(ji,jj,jk) = zh_prev 
     687         ENDIF 
     688 
     689         IF(ABS(zeqn) >= 0.5_wp*zeqn_absmin(ji,jj,jk)) THEN 
     690         ! if the function evaluation at the current point is 
     691         ! not decreasing faster than with a bisection step (at least linearly) 
     692         ! in absolute value take one bisection step on [ph_min, ph_max] 
     693         ! ph_new = (ph_min + ph_max)/2d0 
     694         ! 
     695         ! In terms of [H]_new: 
     696         ! [H]_new = 10**(-ph_new) 
     697         !         = 10**(-(ph_min + ph_max)/2d0) 
     698         !         = SQRT(10**(-(ph_min + phmax))) 
     699         !         = SQRT(zh_max * zh_min) 
     700            zh = SQRT(zh_max(ji,jj,jk) * zh_min(ji,jj,jk)) 
     701            zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 
     702         ELSE 
     703         ! dzeqn/dpH = dzeqn/d[H] * d[H]/dpH 
     704         !           = -zdeqndh * LOG(10) * [H] 
     705         ! \Delta pH = -zeqn/(zdeqndh*d[H]/dpH) = zeqn/(zdeqndh*[H]*LOG(10)) 
     706         ! 
     707         ! pH_new = pH_old + \deltapH 
     708         ! 
     709         ! [H]_new = 10**(-pH_new) 
     710         !         = 10**(-pH_old - \Delta pH) 
     711         !         = [H]_old * 10**(-zeqn/(zdeqndh*[H]_old*LOG(10))) 
     712         !         = [H]_old * EXP(-LOG(10)*zeqn/(zdeqndh*[H]_old*LOG(10))) 
     713         !         = [H]_old * EXP(-zeqn/(zdeqndh*[H]_old)) 
     714 
     715            zh_lnfactor = -zeqn/(zdeqndh*zh_prev) 
     716 
     717            IF(ABS(zh_lnfactor) > pz_exp_threshold) THEN 
     718               zh          = zh_prev*EXP(zh_lnfactor) 
     719            ELSE 
     720               zh_delta    = zh_lnfactor*zh_prev 
     721               zh          = zh_prev + zh_delta 
    598722            ENDIF 
    599          END DO 
    600       END DO 
    601    END DO 
    602  
    603    zeqn_absmin(:,:,:) = HUGE(1._wp) 
    604  
    605    DO jn = 1, jp_maxniter_atgen  
    606    DO jk = 1, jpk 
    607       DO jj = 1, jpj 
    608          DO ji = 1, jpi 
    609             IF (rmask(ji,jj,jk) == 1.) THEN 
    610                zfact = rhop(ji,jj,jk) / 1000. + rtrn 
    611                p_alktot = trb(ji,jj,jk,jptal) / zfact 
    612                zdic  = trb(ji,jj,jk,jpdic) / zfact 
    613                zbot  = borat(ji,jj,jk) 
    614                zpt = trb(ji,jj,jk,jppo4) / zfact * po4r 
    615                zsit = trb(ji,jj,jk,jpsil) / zfact 
    616                zst = sulfat (ji,jj,jk) 
    617                zft = fluorid(ji,jj,jk) 
    618                aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 
    619                zh = zhi(ji,jj,jk) 
    620                zh_prev = zh 
    621  
    622                ! H2CO3 - HCO3 - CO3 : n=2, m=0 
    623                znumer_dic = 2.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk) 
    624                zdenom_dic = ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*(ak13(ji,jj,jk) + zh) 
    625                zalk_dic   = zdic * (znumer_dic/zdenom_dic) 
    626                zdnumer_dic = ak13(ji,jj,jk)*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh     & 
    627                              *(4.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk)) 
    628                zdalk_dic   = -zdic*(zdnumer_dic/zdenom_dic**2) 
    629  
    630  
    631                ! B(OH)3 - B(OH)4 : n=1, m=0 
    632                znumer_bor = akb3(ji,jj,jk) 
    633                zdenom_bor = akb3(ji,jj,jk) + zh 
    634                zalk_bor   = zbot * (znumer_bor/zdenom_bor) 
    635                zdnumer_bor = akb3(ji,jj,jk) 
    636                zdalk_bor   = -zbot*(zdnumer_bor/zdenom_bor**2) 
    637  
    638  
    639                ! H3PO4 - H2PO4 - HPO4 - PO4 : n=3, m=1 
    640                znumer_po4 = 3.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  & 
    641                &            + zh*(2.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh* ak1p3(ji,jj,jk)) 
    642                zdenom_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)     & 
    643                &            + zh*( ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh*(ak1p3(ji,jj,jk) + zh)) 
    644                zalk_po4   = zpt * (znumer_po4/zdenom_po4 - 1.) ! Zero level of H3PO4 = 1 
    645                zdnumer_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  & 
    646                &             + zh*(4.*ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)         & 
    647                &             + zh*(9.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)                         & 
    648                &             + ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)                                & 
    649                &             + zh*(4.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh * ak1p3(ji,jj,jk) ) ) ) 
    650                zdalk_po4   = -zpt * (zdnumer_po4/zdenom_po4**2) 
    651  
    652                ! H4SiO4 - H3SiO4 : n=1, m=0 
    653                znumer_sil = aksi3(ji,jj,jk) 
    654                zdenom_sil = aksi3(ji,jj,jk) + zh 
    655                zalk_sil   = zsit * (znumer_sil/zdenom_sil) 
    656                zdnumer_sil = aksi3(ji,jj,jk) 
    657                zdalk_sil   = -zsit * (zdnumer_sil/zdenom_sil**2) 
    658  
    659                ! HSO4 - SO4 : n=1, m=1 
    660                aphscale = 1.0 + zst/aks3(ji,jj,jk) 
    661                znumer_so4 = aks3(ji,jj,jk) * aphscale 
    662                zdenom_so4 = aks3(ji,jj,jk) * aphscale + zh 
    663                zalk_so4   = zst * (znumer_so4/zdenom_so4 - 1.) 
    664                zdnumer_so4 = aks3(ji,jj,jk) 
    665                zdalk_so4   = -zst * (zdnumer_so4/zdenom_so4**2) 
    666  
    667                ! HF - F : n=1, m=1 
    668                znumer_flu =  akf3(ji,jj,jk) 
    669                zdenom_flu =  akf3(ji,jj,jk) + zh 
    670                zalk_flu   =  zft * (znumer_flu/zdenom_flu - 1.) 
    671                zdnumer_flu = akf3(ji,jj,jk) 
    672                zdalk_flu   = -zft * (zdnumer_flu/zdenom_flu**2) 
    673  
    674                ! H2O - OH 
    675                aphscale = 1.0 + zst/aks3(ji,jj,jk) 
    676                zalk_wat   = akw3(ji,jj,jk)/zh - zh/aphscale 
    677                zdalk_wat  = -akw3(ji,jj,jk)/zh**2 - 1./aphscale 
    678  
    679                ! CALCULATE [ALK]([CO3--], [HCO3-]) 
    680                zeqn = zalk_dic + zalk_bor + zalk_po4 + zalk_sil   & 
    681                &      + zalk_so4 + zalk_flu                       & 
    682                &      + zalk_wat - p_alktot 
    683  
    684                zalka = p_alktot - (zalk_bor + zalk_po4 + zalk_sil   & 
    685                &       + zalk_so4 + zalk_flu + zalk_wat) 
    686  
    687                zdeqndh = zdalk_dic + zdalk_bor + zdalk_po4 + zdalk_sil & 
    688                &         + zdalk_so4 + zdalk_flu + zdalk_wat 
    689  
    690                ! Adapt bracketing interval 
    691                IF(zeqn > 0._wp) THEN 
    692                  zh_min(ji,jj,jk) = zh_prev 
    693                ELSEIF(zeqn < 0._wp) THEN 
    694                  zh_max(ji,jj,jk) = zh_prev 
    695                ENDIF 
    696  
    697                IF(ABS(zeqn) >= 0.5_wp*zeqn_absmin(ji,jj,jk)) THEN 
    698                ! if the function evaluation at the current point is 
    699                ! not decreasing faster than with a bisection step (at least linearly) 
    700                ! in absolute value take one bisection step on [ph_min, ph_max] 
    701                ! ph_new = (ph_min + ph_max)/2d0 
    702                ! 
     723 
     724            IF( zh < zh_min(ji,jj,jk) ) THEN 
     725               ! if [H]_new < [H]_min 
     726               ! i.e., if ph_new > ph_max then 
     727               ! take one bisection step on [ph_prev, ph_max] 
     728               ! ph_new = (ph_prev + ph_max)/2d0 
    703729               ! In terms of [H]_new: 
    704730               ! [H]_new = 10**(-ph_new) 
    705                !         = 10**(-(ph_min + ph_max)/2d0) 
    706                !         = SQRT(10**(-(ph_min + phmax))) 
    707                !         = SQRT(zh_max * zh_min) 
    708                   zh = SQRT(zh_max(ji,jj,jk) * zh_min(ji,jj,jk)) 
    709                   zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 
    710                ELSE 
    711                ! dzeqn/dpH = dzeqn/d[H] * d[H]/dpH 
    712                !           = -zdeqndh * LOG(10) * [H] 
    713                ! \Delta pH = -zeqn/(zdeqndh*d[H]/dpH) = zeqn/(zdeqndh*[H]*LOG(10)) 
    714                ! 
    715                ! pH_new = pH_old + \deltapH 
    716                ! 
    717                ! [H]_new = 10**(-pH_new) 
    718                !         = 10**(-pH_old - \Delta pH) 
    719                !         = [H]_old * 10**(-zeqn/(zdeqndh*[H]_old*LOG(10))) 
    720                !         = [H]_old * EXP(-LOG(10)*zeqn/(zdeqndh*[H]_old*LOG(10))) 
    721                !         = [H]_old * EXP(-zeqn/(zdeqndh*[H]_old)) 
    722  
    723                   zh_lnfactor = -zeqn/(zdeqndh*zh_prev) 
    724  
    725                   IF(ABS(zh_lnfactor) > pz_exp_threshold) THEN 
    726                      zh          = zh_prev*EXP(zh_lnfactor) 
    727                   ELSE 
    728                      zh_delta    = zh_lnfactor*zh_prev 
    729                      zh          = zh_prev + zh_delta 
    730                   ENDIF 
    731  
    732                   IF( zh < zh_min(ji,jj,jk) ) THEN 
    733                      ! if [H]_new < [H]_min 
    734                      ! i.e., if ph_new > ph_max then 
    735                      ! take one bisection step on [ph_prev, ph_max] 
    736                      ! ph_new = (ph_prev + ph_max)/2d0 
    737                      ! In terms of [H]_new: 
    738                      ! [H]_new = 10**(-ph_new) 
    739                      !         = 10**(-(ph_prev + ph_max)/2d0) 
    740                      !         = SQRT(10**(-(ph_prev + phmax))) 
    741                      !         = SQRT([H]_old*10**(-ph_max)) 
    742                      !         = SQRT([H]_old * zh_min) 
    743                      zh                = SQRT(zh_prev * zh_min(ji,jj,jk)) 
    744                      zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below 
    745                   ENDIF 
    746  
    747                   IF( zh > zh_max(ji,jj,jk) ) THEN 
    748                      ! if [H]_new > [H]_max 
    749                      ! i.e., if ph_new < ph_min, then 
    750                      ! take one bisection step on [ph_min, ph_prev] 
    751                      ! ph_new = (ph_prev + ph_min)/2d0 
    752                      ! In terms of [H]_new: 
    753                      ! [H]_new = 10**(-ph_new) 
    754                      !         = 10**(-(ph_prev + ph_min)/2d0) 
    755                      !         = SQRT(10**(-(ph_prev + ph_min))) 
    756                      !         = SQRT([H]_old*10**(-ph_min)) 
    757                      !         = SQRT([H]_old * zhmax) 
    758                      zh                = SQRT(zh_prev * zh_max(ji,jj,jk)) 
    759                      zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below 
    760                   ENDIF 
    761                ENDIF 
    762  
    763                zeqn_absmin(ji,jj,jk) = MIN( ABS(zeqn), zeqn_absmin(ji,jj,jk)) 
    764  
    765                ! Stop iterations once |\delta{[H]}/[H]| < rdel 
    766                ! <=> |(zh - zh_prev)/zh_prev| = |EXP(-zeqn/(zdeqndh*zh_prev)) -1| < rdel 
    767                ! |EXP(-zeqn/(zdeqndh*zh_prev)) -1| ~ |zeqn/(zdeqndh*zh_prev)| 
    768  
    769                ! Alternatively: 
    770                ! |\Delta pH| = |zeqn/(zdeqndh*zh_prev*LOG(10))| 
    771                !             ~ 1/LOG(10) * |\Delta [H]|/[H] 
    772                !             < 1/LOG(10) * rdel 
    773  
    774                ! Hence |zeqn/(zdeqndh*zh)| < rdel 
    775  
    776                ! rdel <-- pp_rdel_ah_target 
    777                l_exitnow = (ABS(zh_lnfactor) < pp_rdel_ah_target) 
    778  
    779                IF(l_exitnow) THEN  
    780                   rmask(ji,jj,jk) = 0. 
    781                ENDIF 
    782  
    783                zhi(ji,jj,jk) =  zh 
    784  
    785                IF(jn >= jp_maxniter_atgen) THEN 
    786                   zhi(ji,jj,jk) = -1._wp 
    787                ENDIF 
    788  
     731               !         = 10**(-(ph_prev + ph_max)/2d0) 
     732               !         = SQRT(10**(-(ph_prev + phmax))) 
     733               !         = SQRT([H]_old*10**(-ph_max)) 
     734               !         = SQRT([H]_old * zh_min) 
     735               zh                = SQRT(zh_prev * zh_min(ji,jj,jk)) 
     736               zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below 
    789737            ENDIF 
    790          END DO 
    791       END DO 
    792    END DO 
     738 
     739            IF( zh > zh_max(ji,jj,jk) ) THEN 
     740               ! if [H]_new > [H]_max 
     741               ! i.e., if ph_new < ph_min, then 
     742               ! take one bisection step on [ph_min, ph_prev] 
     743               ! ph_new = (ph_prev + ph_min)/2d0 
     744               ! In terms of [H]_new: 
     745               ! [H]_new = 10**(-ph_new) 
     746               !         = 10**(-(ph_prev + ph_min)/2d0) 
     747               !         = SQRT(10**(-(ph_prev + ph_min))) 
     748               !         = SQRT([H]_old*10**(-ph_min)) 
     749               !         = SQRT([H]_old * zhmax) 
     750               zh                = SQRT(zh_prev * zh_max(ji,jj,jk)) 
     751               zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below 
     752            ENDIF 
     753         ENDIF 
     754 
     755         zeqn_absmin(ji,jj,jk) = MIN( ABS(zeqn), zeqn_absmin(ji,jj,jk)) 
     756 
     757         ! Stop iterations once |\delta{[H]}/[H]| < rdel 
     758         ! <=> |(zh - zh_prev)/zh_prev| = |EXP(-zeqn/(zdeqndh*zh_prev)) -1| < rdel 
     759         ! |EXP(-zeqn/(zdeqndh*zh_prev)) -1| ~ |zeqn/(zdeqndh*zh_prev)| 
     760 
     761         ! Alternatively: 
     762         ! |\Delta pH| = |zeqn/(zdeqndh*zh_prev*LOG(10))| 
     763         !             ~ 1/LOG(10) * |\Delta [H]|/[H] 
     764         !             < 1/LOG(10) * rdel 
     765 
     766         ! Hence |zeqn/(zdeqndh*zh)| < rdel 
     767 
     768         ! rdel <-- pp_rdel_ah_target 
     769         l_exitnow = (ABS(zh_lnfactor) < pp_rdel_ah_target) 
     770 
     771         IF(l_exitnow) THEN  
     772            rmask(ji,jj,jk) = 0. 
     773         ENDIF 
     774 
     775         zhi(ji,jj,jk) =  zh 
     776 
     777         IF(jn >= jp_maxniter_atgen) THEN 
     778            zhi(ji,jj,jk) = -1._wp 
     779         ENDIF 
     780 
     781      ENDIF 
     782   END_3D 
    793783   END DO 
    794784   ! 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zfechem.F90

    r12276 r12377  
    1515   USE sms_pisces      ! PISCES Source Minus Sink variables 
    1616   USE p4zche          ! chemical model 
    17    USE p4zsbc           ! Boundary conditions from sediments 
     17   USE p4zbc           ! Boundary conditions from sediments 
    1818   USE prtctl_trc      ! print control for debugging 
    1919   USE iom             ! I/O manager 
    … …  
    3131   REAL(wp), PUBLIC ::   kfep         !: rate constant for nanoparticle formation 
    3232 
     33   !! * Substitutions 
     34#  include "do_loop_substitute.h90" 
    3335   !!---------------------------------------------------------------------- 
    3436   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    3840CONTAINS 
    3941 
    40    SUBROUTINE p4z_fechem( kt, knt ) 
     42   SUBROUTINE p4z_fechem( kt, knt, Kbb, Kmm, Krhs ) 
    4143      !!--------------------------------------------------------------------- 
    4244      !!                     ***  ROUTINE p4z_fechem  *** 
    … …  
    4850      !!--------------------------------------------------------------------- 
    4951      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step 
     52      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices 
    5053      ! 
    5154      INTEGER  ::   ji, jj, jk, jic, jn 
    … …  
    7174      IF( ln_timing )   CALL timing_start('p4z_fechem') 
    7275      ! 
    73  
    7476      ! Total ligand concentration : Ligands can be chosen to be constant or variable 
    7577      ! Parameterization from Tagliabue and Voelker (2011) 
    7678      ! ------------------------------------------------- 
    7779      IF( ln_ligvar ) THEN 
    78          ztotlig(:,:,:) =  0.09 * trb(:,:,:,jpdoc) * 1E6 + ligand * 1E9 
     80         ztotlig(:,:,:) =  0.09 * tr(:,:,:,jpdoc,Kbb) * 1E6 + ligand * 1E9 
    7981         ztotlig(:,:,:) =  MIN( ztotlig(:,:,:), 10. ) 
    8082      ELSE 
    81         IF( ln_ligand ) THEN  ;   ztotlig(:,:,:) = trb(:,:,:,jplgw) * 1E9 
     83        IF( ln_ligand ) THEN  ;   ztotlig(:,:,:) = tr(:,:,:,jplgw,Kbb) * 1E9 
    8284        ELSE                  ;   ztotlig(:,:,:) = ligand * 1E9 
    8385        ENDIF 
    … …  
    8991      ! Chemistry is supposed to be fast enough to be at equilibrium 
    9092      ! ------------------------------------------------------------ 
    91       DO jk = 1, jpkm1 
    92          DO jj = 1, jpj 
    93             DO ji = 1, jpi 
    94                zTL1(ji,jj,jk)  = ztotlig(ji,jj,jk) 
    95                zkeq            = fekeq(ji,jj,jk) 
    96                zfesatur        = zTL1(ji,jj,jk) * 1E-9 
    97                ztfe            = trb(ji,jj,jk,jpfer)  
    98                ! Fe' is the root of a 2nd order polynom 
    99                zFe3 (ji,jj,jk) = ( -( 1. + zfesatur * zkeq - zkeq * ztfe )               & 
    100                   &              + SQRT( ( 1. + zfesatur * zkeq - zkeq * ztfe )**2       & 
    101                   &              + 4. * ztfe * zkeq) ) / ( 2. * zkeq ) 
    102                zFe3 (ji,jj,jk) = zFe3(ji,jj,jk) * 1E9 
    103                zFeL1(ji,jj,jk) = MAX( 0., trb(ji,jj,jk,jpfer) * 1E9 - zFe3(ji,jj,jk) ) 
    104            END DO 
    105          END DO 
    106       END DO 
     93      DO_3D_11_11( 1, jpkm1 ) 
     94         zTL1(ji,jj,jk)  = ztotlig(ji,jj,jk) 
     95         zkeq            = fekeq(ji,jj,jk) 
     96         zfesatur        = zTL1(ji,jj,jk) * 1E-9 
     97         ztfe            = tr(ji,jj,jk,jpfer,Kbb)  
     98         ! Fe' is the root of a 2nd order polynom 
     99         zFe3 (ji,jj,jk) = ( -( 1. + zfesatur * zkeq - zkeq * ztfe )               & 
     100            &              + SQRT( ( 1. + zfesatur * zkeq - zkeq * ztfe )**2       & 
     101            &              + 4. * ztfe * zkeq) ) / ( 2. * zkeq ) 
     102         zFe3 (ji,jj,jk) = zFe3(ji,jj,jk) * 1E9 
     103         zFeL1(ji,jj,jk) = MAX( 0., tr(ji,jj,jk,jpfer,Kbb) * 1E9 - zFe3(ji,jj,jk) ) 
     104      END_3D 
    107105         ! 
    108106 
    109107      zdust = 0.         ! if no dust available 
    110       DO jk = 1, jpkm1 
    111          DO jj = 1, jpj 
    112             DO ji = 1, jpi 
    113                ! Scavenging rate of iron. This scavenging rate depends on the load of particles of sea water.  
    114                ! This parameterization assumes a simple second order kinetics (k[Particles][Fe]). 
    115                ! Scavenging onto dust is also included as evidenced from the DUNE experiments. 
    116                ! -------------------------------------------------------------------------------------- 
    117                zhplus  = max( rtrn, hi(ji,jj,jk) ) 
    118                fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  & 
    119                &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     & 
    120                &         + fesol(ji,jj,jk,5) / zhplus ) 
    121                ! 
    122                zfeequi = zFe3(ji,jj,jk) * 1E-9 
    123                zhplus  = max( rtrn, hi(ji,jj,jk) ) 
    124                fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  & 
    125                   &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     & 
    126                   &         + fesol(ji,jj,jk,5) / zhplus ) 
    127                zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9 
    128                ! precipitation of Fe3+, creation of nanoparticles 
    129                precip(ji,jj,jk) = MAX( 0., ( zFe3(ji,jj,jk) * 1E-9 - fe3sol ) ) * kfep * xstep 
    130                ! 
    131                ztrc   = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6  
    132                IF( ln_dust )  zdust  = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) & 
    133                &  * EXP( -gdept_n(ji,jj,jk) / 540. ) 
    134                IF (ln_ligand) THEN 
    135                   zxlam  = xlam1 * MAX( 1.E-3, EXP(-2 * etot(ji,jj,jk) / 10. ) * (1. - EXP(-2 * trb(ji,jj,jk,jpoxy) / 100.E-6 ) )) 
    136                ELSE 
    137                   zxlam  = xlam1 * 1.0 
    138                ENDIF 
    139                zlam1b = 3.e-5 + xlamdust * zdust + zxlam * ztrc 
    140                zscave = zfeequi * zlam1b * xstep 
    141  
    142                ! Compute the different ratios for scavenging of iron 
    143                ! to later allocate scavenged iron to the different organic pools 
    144                ! --------------------------------------------------------- 
    145                zdenom1 = zxlam * trb(ji,jj,jk,jppoc) / zlam1b 
    146                zdenom2 = zxlam * trb(ji,jj,jk,jpgoc) / zlam1b 
    147  
    148                !  Increased scavenging for very high iron concentrations found near the coasts  
    149                !  due to increased lithogenic particles and let say it is unknown processes (precipitation, ...) 
    150                !  ----------------------------------------------------------- 
    151                zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 
    152                zlamfac = MIN( 1.  , zlamfac ) 
    153                zdep    = MIN( 1., 1000. / gdept_n(ji,jj,jk) ) 
    154                zcoag   = 1E-4 * ( 1. - zlamfac ) * zdep * xstep * trb(ji,jj,jk,jpfer) 
    155  
    156                !  Compute the coagulation of colloidal iron. This parameterization  
    157                !  could be thought as an equivalent of colloidal pumping. 
    158                !  It requires certainly some more work as it is very poorly constrained. 
    159                !  ---------------------------------------------------------------- 
    160                zlam1a   = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    & 
    161                    &      + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) ) 
    162                zaggdfea = zlam1a * xstep * zfecoll 
    163                ! 
    164                zlam1b   = 3.53E3 * trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk) 
    165                zaggdfeb = zlam1b * xstep * zfecoll 
    166                ! 
    167                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfea - zaggdfeb & 
    168                &                     - zcoag - precip(ji,jj,jk) 
    169                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea 
    170                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zscave * zdenom2 + zaggdfeb 
    171                zscav3d(ji,jj,jk)   = zscave 
    172                zcoll3d(ji,jj,jk)   = zaggdfea + zaggdfeb 
    173                ! 
    174             END DO 
    175          END DO 
    176       END DO 
     108      DO_3D_11_11( 1, jpkm1 ) 
     109         ! Scavenging rate of iron. This scavenging rate depends on the load of particles of sea water.  
     110         ! This parameterization assumes a simple second order kinetics (k[Particles][Fe]). 
     111         ! Scavenging onto dust is also included as evidenced from the DUNE experiments. 
     112         ! -------------------------------------------------------------------------------------- 
     113         zhplus  = max( rtrn, hi(ji,jj,jk) ) 
     114         fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  & 
     115         &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     & 
     116         &         + fesol(ji,jj,jk,5) / zhplus ) 
     117         ! 
     118         zfeequi = zFe3(ji,jj,jk) * 1E-9 
     119         zhplus  = max( rtrn, hi(ji,jj,jk) ) 
     120         fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  & 
     121            &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     & 
     122            &         + fesol(ji,jj,jk,5) / zhplus ) 
     123         zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9 
     124         ! precipitation of Fe3+, creation of nanoparticles 
     125         precip(ji,jj,jk) = MAX( 0., ( zFe3(ji,jj,jk) * 1E-9 - fe3sol ) ) * kfep * xstep 
     126         ! 
     127         ztrc   = ( tr(ji,jj,jk,jppoc,Kbb) + tr(ji,jj,jk,jpgoc,Kbb) + tr(ji,jj,jk,jpcal,Kbb) + tr(ji,jj,jk,jpgsi,Kbb) ) * 1.e6  
     128         IF( ll_dust )  zdust  = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) & 
     129         &  * EXP( -gdept(ji,jj,jk,Kmm) / 540. ) 
     130         IF (ln_ligand) THEN 
     131            zxlam  = xlam1 * MAX( 1.E-3, EXP(-2 * etot(ji,jj,jk) / 10. ) * (1. - EXP(-2 * tr(ji,jj,jk,jpoxy,Kbb) / 100.E-6 ) )) 
     132         ELSE 
     133            zxlam  = xlam1 * 1.0 
     134         ENDIF 
     135         zlam1b = 3.e-5 + xlamdust * zdust + zxlam * ztrc 
     136         zscave = zfeequi * zlam1b * xstep 
     137 
     138         ! Compute the different ratios for scavenging of iron 
     139         ! to later allocate scavenged iron to the different organic pools 
     140         ! --------------------------------------------------------- 
     141         zdenom1 = zxlam * tr(ji,jj,jk,jppoc,Kbb) / zlam1b 
     142         zdenom2 = zxlam * tr(ji,jj,jk,jpgoc,Kbb) / zlam1b 
     143 
     144         !  Increased scavenging for very high iron concentrations found near the coasts  
     145         !  due to increased lithogenic particles and let say it is unknown processes (precipitation, ...) 
     146         !  ----------------------------------------------------------- 
     147         zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 
     148         zlamfac = MIN( 1.  , zlamfac ) 
     149         zdep    = MIN( 1., 1000. / gdept(ji,jj,jk,Kmm) ) 
     150         zcoag   = 1E-4 * ( 1. - zlamfac ) * zdep * xstep * tr(ji,jj,jk,jpfer,Kbb) 
     151 
     152         !  Compute the coagulation of colloidal iron. This parameterization  
     153         !  could be thought as an equivalent of colloidal pumping. 
     154         !  It requires certainly some more work as it is very poorly constrained. 
     155         !  ---------------------------------------------------------------- 
     156         zlam1a   = ( 0.369  * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4  * tr(ji,jj,jk,jppoc,Kbb) ) * xdiss(ji,jj,jk)    & 
     157             &      + ( 114.   * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) ) 
     158         zaggdfea = zlam1a * xstep * zfecoll 
     159         ! 
     160         zlam1b   = 3.53E3 * tr(ji,jj,jk,jpgoc,Kbb) * xdiss(ji,jj,jk) 
     161         zaggdfeb = zlam1b * xstep * zfecoll 
     162         ! 
     163         tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zscave - zaggdfea - zaggdfeb & 
     164         &                     - zcoag - precip(ji,jj,jk) 
     165         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zscave * zdenom1 + zaggdfea 
     166         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zscave * zdenom2 + zaggdfeb 
     167         zscav3d(ji,jj,jk)   = zscave 
     168         zcoll3d(ji,jj,jk)   = zaggdfea + zaggdfeb 
     169         ! 
     170      END_3D 
    177171      ! 
    178172      !  Define the bioavailable fraction of iron 
    179173      !  ---------------------------------------- 
    180       biron(:,:,:) = trb(:,:,:,jpfer)  
     174      biron(:,:,:) = tr(:,:,:,jpfer,Kbb)  
    181175      ! 
    182176      IF( ln_ligand ) THEN 
    183177         ! 
    184          DO jk = 1, jpkm1 
    185             DO jj = 1, jpj 
    186                DO ji = 1, jpi 
    187                   zlam1a   = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    & 
    188                       &    + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) ) 
    189                   ! 
    190                   zlam1b   = 3.53E3 *   trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk) 
    191                   zligco   = 0.5 * trn(ji,jj,jk,jplgw) 
    192                   zaggliga = zlam1a * xstep * zligco 
    193                   zaggligb = zlam1b * xstep * zligco 
    194                   tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) - zaggliga - zaggligb 
    195                   zlcoll3d(ji,jj,jk)  = zaggliga + zaggligb 
    196                END DO 
    197             END DO 
    198          END DO 
    199          ! 
    200          plig(:,:,:) =  MAX( 0., ( ( zFeL1(:,:,:) * 1E-9 ) / ( trb(:,:,:,jpfer) +rtrn ) ) ) 
     178         DO_3D_11_11( 1, jpkm1 ) 
     179            zlam1a   = ( 0.369  * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4  * tr(ji,jj,jk,jppoc,Kbb) ) * xdiss(ji,jj,jk)    & 
     180                &    + ( 114.   * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) ) 
     181            ! 
     182            zlam1b   = 3.53E3 *   tr(ji,jj,jk,jpgoc,Kbb) * xdiss(ji,jj,jk) 
     183            zligco   = 0.5 * tr(ji,jj,jk,jplgw,Kmm) 
     184            zaggliga = zlam1a * xstep * zligco 
     185            zaggligb = zlam1b * xstep * zligco 
     186            tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) - zaggliga - zaggligb 
     187            zlcoll3d(ji,jj,jk)  = zaggliga + zaggligb 
     188         END_3D 
     189         ! 
     190         plig(:,:,:) =  MAX( 0., ( ( zFeL1(:,:,:) * 1E-9 ) / ( tr(:,:,:,jpfer,Kbb) +rtrn ) ) ) 
    201191         ! 
    202192      ENDIF 
    … …  
    215205              zTL1(:,:,jpk) = 0.   ;  CALL iom_put("TL1" , zTL1(:,:,:) * tmask(:,:,:) )   ! TL1 
    216206            ENDIF 
    217             CALL iom_put("Totlig" , ztotlig(:,:,:)       * tmask(:,:,:) )   ! TL 
    218             CALL iom_put("Biron"  , biron  (:,:,:)  * 1e9 * tmask(:,:,:) )   ! biron 
     207            IF( iom_use("Totlig") )  CALL iom_put("Totlig" , ztotlig(:,:,:)       * tmask(:,:,:) )   ! TL 
     208            IF( iom_use("Biron")  )  CALL iom_put("Biron"  , biron  (:,:,:)  * 1e9 * tmask(:,:,:) )   ! biron 
    219209            IF( iom_use("FESCAV") )  THEN 
    220210               zscav3d (:,:,jpk) = 0.  ;  CALL iom_put("FESCAV" , zscav3d(:,:,:)  * 1e9 * tmask(:,:,:) * zrfact2 ) 
    … …  
    226216               zlcoll3d(:,:,jpk) = 0.  ;  CALL iom_put("LGWCOLL", zlcoll3d(:,:,:) * 1e9 * tmask(:,:,:) * zrfact2 ) 
    227217            ENDIF 
    228          ENDIF 
    229       ENDIF 
    230  
    231       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     218          ENDIF 
     219      ENDIF 
     220 
     221      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    232222         WRITE(charout, FMT="('fechem')") 
    233223         CALL prt_ctl_trc_info(charout) 
    234          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     224         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    235225      ENDIF 
    236226      ! 
    … …  
    263253      ENDIF 
    264254      ! 
    265       REWIND( numnatp_ref ) 
    266255      READ  ( numnatp_ref, nampisfer, IOSTAT = ios, ERR = 901) 
    267256901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisfer in reference namelist' ) 
    268  
    269       REWIND( numnatp_cfg ) 
    270257      READ  ( numnatp_cfg, nampisfer, IOSTAT = ios, ERR = 902 ) 
    271258902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisfer in configuration namelist' ) 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zflx.F90

    r12277 r12377  
    5252   REAL(wp) ::   xconv  = 0.01_wp / 3600._wp   !: coefficients for conversion  
    5353 
     54   !! * Substitutions 
     55#  include "do_loop_substitute.h90" 
    5456   !!---------------------------------------------------------------------- 
    5557   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    5961CONTAINS 
    6062 
    61    SUBROUTINE p4z_flx ( kt, knt ) 
     63   SUBROUTINE p4z_flx ( kt, knt, Kbb, Kmm, Krhs ) 
    6264      !!--------------------------------------------------------------------- 
    6365      !!                     ***  ROUTINE p4z_flx  *** 
    … …  
    7173      !!--------------------------------------------------------------------- 
    7274      INTEGER, INTENT(in) ::   kt, knt   ! 
     75      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs      ! time level indices 
    7376      ! 
    7477      INTEGER  ::   ji, jj, jm, iind, iindm1 
    … …  
    106109      IF( l_co2cpl )   satmco2(:,:) = atm_co2(:,:) 
    107110 
    108       DO jj = 1, jpj 
    109          DO ji = 1, jpi 
    110             ! DUMMY VARIABLES FOR DIC, H+, AND BORATE 
    111             zfact = rhop(ji,jj,1) / 1000. + rtrn 
    112             zdic  = trb(ji,jj,1,jpdic) 
    113             zph   = MAX( hi(ji,jj,1), 1.e-10 ) / zfact 
    114             ! CALCULATE [H2CO3] 
    115             zh2co3(ji,jj) = zdic/(1. + ak13(ji,jj,1)/zph + ak13(ji,jj,1)*ak23(ji,jj,1)/zph**2) 
    116          END DO 
    117       END DO 
     111      DO_2D_11_11 
     112         ! DUMMY VARIABLES FOR DIC, H+, AND BORATE 
     113         zfact = rhop(ji,jj,1) / 1000. + rtrn 
     114         zdic  = tr(ji,jj,1,jpdic,Kbb) 
     115         zph   = MAX( hi(ji,jj,1), 1.e-10 ) / zfact 
     116         ! CALCULATE [H2CO3] 
     117         zh2co3(ji,jj) = zdic/(1. + ak13(ji,jj,1)/zph + ak13(ji,jj,1)*ak23(ji,jj,1)/zph**2) 
     118      END_2D 
    118119 
    119120      ! -------------- 
    … …  
    124125      ! ------------------------------------------- 
    125126 
    126       DO jj = 1, jpj 
    127          DO ji = 1, jpi 
    128             ztc  = MIN( 35., tsn(ji,jj,1,jp_tem) ) 
    129             ztc2 = ztc * ztc 
    130             ztc3 = ztc * ztc2  
    131             ztc4 = ztc2 * ztc2  
    132             ! Compute the schmidt Number both O2 and CO2 
    133             zsch_co2 = 2116.8 - 136.25 * ztc + 4.7353 * ztc2 - 0.092307 * ztc3 + 0.0007555 * ztc4 
    134             zsch_o2  = 1920.4 - 135.6  * ztc + 5.2122 * ztc2 - 0.109390 * ztc3 + 0.0009377 * ztc4 
    135             !  wind speed  
    136             zws  = wndm(ji,jj) * wndm(ji,jj) 
    137             ! Compute the piston velocity for O2 and CO2 
    138             zkgwan = 0.251 * zws 
    139             zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) 
    140             ! compute gas exchange for CO2 and O2 
    141             zkgco2(ji,jj) = zkgwan * SQRT( 660./ zsch_co2 ) 
    142             zkgo2 (ji,jj) = zkgwan * SQRT( 660./ zsch_o2 ) 
    143          END DO 
    144       END DO 
    145  
    146  
    147       DO jj = 1, jpj 
    148          DO ji = 1, jpi 
    149             ztkel = tempis(ji,jj,1) + 273.15 
    150             zsal  = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35. 
    151             zvapsw    = EXP(24.4543 - 67.4509*(100.0/ztkel) - 4.8489*LOG(ztkel/100) - 0.000544*zsal) 
    152             zpco2atm(ji,jj) = satmco2(ji,jj) * ( patm(ji,jj) - zvapsw ) 
    153             zxc2      = ( 1.0 - zpco2atm(ji,jj) * 1E-6 )**2 
    154             zfugcoeff = EXP( patm(ji,jj) * (chemc(ji,jj,2) + 2.0 * zxc2 * chemc(ji,jj,3) )   & 
    155             &           / ( 82.05736 * ztkel )) 
    156             zfco2 = zpco2atm(ji,jj) * zfugcoeff 
    157  
    158             ! Compute CO2 flux for the sea and air 
    159             zfld = zfco2 * chemc(ji,jj,1) * zkgco2(ji,jj)  ! (mol/L) * (m/s) 
    160             zflu = zh2co3(ji,jj) * zkgco2(ji,jj)                                   ! (mol/L) (m/s) ? 
    161             oce_co2(ji,jj) = ( zfld - zflu ) * tmask(ji,jj,1)  
    162             ! compute the trend 
    163             tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + oce_co2(ji,jj) * rfact2 / e3t_n(ji,jj,1) 
    164  
    165             ! Compute O2 flux  
    166             zfld16 = patm(ji,jj) * chemo2(ji,jj,1) * zkgo2(ji,jj)          ! (mol/L) * (m/s) 
    167             zflu16 = trb(ji,jj,1,jpoxy) * zkgo2(ji,jj) 
    168             zoflx(ji,jj) = ( zfld16 - zflu16 ) * tmask(ji,jj,1) 
    169             tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) * rfact2 / e3t_n(ji,jj,1) 
    170          END DO 
    171       END DO 
     127      DO_2D_11_11 
     128         ztc  = MIN( 35., ts(ji,jj,1,jp_tem,Kmm) ) 
     129         ztc2 = ztc * ztc 
     130         ztc3 = ztc * ztc2  
     131         ztc4 = ztc2 * ztc2  
     132         ! Compute the schmidt Number both O2 and CO2 
     133         zsch_co2 = 2116.8 - 136.25 * ztc + 4.7353 * ztc2 - 0.092307 * ztc3 + 0.0007555 * ztc4 
     134         zsch_o2  = 1920.4 - 135.6  * ztc + 5.2122 * ztc2 - 0.109390 * ztc3 + 0.0009377 * ztc4 
     135         !  wind speed  
     136         zws  = wndm(ji,jj) * wndm(ji,jj) 
     137         ! Compute the piston velocity for O2 and CO2 
     138         zkgwan = 0.251 * zws 
     139         zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) 
     140         ! compute gas exchange for CO2 and O2 
     141         zkgco2(ji,jj) = zkgwan * SQRT( 660./ zsch_co2 ) 
     142         zkgo2 (ji,jj) = zkgwan * SQRT( 660./ zsch_o2 ) 
     143      END_2D 
     144 
     145 
     146      DO_2D_11_11 
     147         ztkel = tempis(ji,jj,1) + 273.15 
     148         zsal  = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35. 
     149         zvapsw    = EXP(24.4543 - 67.4509*(100.0/ztkel) - 4.8489*LOG(ztkel/100) - 0.000544*zsal) 
     150         zpco2atm(ji,jj) = satmco2(ji,jj) * ( patm(ji,jj) - zvapsw ) 
     151         zxc2      = ( 1.0 - zpco2atm(ji,jj) * 1E-6 )**2 
     152         zfugcoeff = EXP( patm(ji,jj) * (chemc(ji,jj,2) + 2.0 * zxc2 * chemc(ji,jj,3) )   & 
     153         &           / ( 82.05736 * ztkel )) 
     154         zfco2 = zpco2atm(ji,jj) * zfugcoeff 
     155 
     156         ! Compute CO2 flux for the sea and air 
     157         zfld = zfco2 * chemc(ji,jj,1) * zkgco2(ji,jj)  ! (mol/L) * (m/s) 
     158         zflu = zh2co3(ji,jj) * zkgco2(ji,jj)                                   ! (mol/L) (m/s) ? 
     159         oce_co2(ji,jj) = ( zfld - zflu ) * tmask(ji,jj,1)  
     160         ! compute the trend 
     161         tr(ji,jj,1,jpdic,Krhs) = tr(ji,jj,1,jpdic,Krhs) + oce_co2(ji,jj) * rfact2 / e3t(ji,jj,1,Kmm) 
     162 
     163         ! Compute O2 flux  
     164         zfld16 = patm(ji,jj) * chemo2(ji,jj,1) * zkgo2(ji,jj)          ! (mol/L) * (m/s) 
     165         zflu16 = tr(ji,jj,1,jpoxy,Kbb) * zkgo2(ji,jj) 
     166         zoflx(ji,jj) = ( zfld16 - zflu16 ) * tmask(ji,jj,1) 
     167         tr(ji,jj,1,jpoxy,Krhs) = tr(ji,jj,1,jpoxy,Krhs) + zoflx(ji,jj) * rfact2 / e3t(ji,jj,1,Kmm) 
     168      END_2D 
    172169 
    173170      IF( iom_use("tcflx") .OR. iom_use("tcflxcum") .OR. kt == nitrst   & 
    … …  
    178175      t_atm_co2_flx     =  atcco2      ! Total atmospheric pCO2 
    179176  
    180       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     177      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    181178         WRITE(charout, FMT="('flx ')") 
    182179         CALL prt_ctl_trc_info(charout) 
    183          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     180         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    184181      ENDIF 
    185182 
    … …  
    191188         CALL iom_put( "Dpco2"   , ( zpco2atm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) ) 
    192189         CALL iom_put( "pCO2sea" , ( zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) ) 
    193          CALL iom_put( "Dpo2"    , ( atcox * patm(:,:) - atcox * trb(:,:,1,jpoxy) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1) ) 
     190         CALL iom_put( "Dpo2"    , ( atcox * patm(:,:) - atcox * tr(:,:,1,jpoxy,Kbb) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1) ) 
    194191         CALL iom_put( "tcflx"   , t_oce_co2_flx     )   ! molC/s 
    195192         CALL iom_put( "tcflxcum", t_oce_co2_flx_cum )   ! molC 
    … …  
    222219      ENDIF 
    223220      ! 
    224       REWIND( numnatp_ref ) 
    225221      READ  ( numnatp_ref, nampisext, IOSTAT = ios, ERR = 901) 
    226222901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisext in reference namelist' ) 
    227  
    228       REWIND( numnatp_cfg ) 
    229223      READ  ( numnatp_cfg, nampisext, IOSTAT = ios, ERR = 902 ) 
    230224902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisext in configuration namelist' ) 
    … …  
    304298         ENDIF 
    305299         ! 
    306          REWIND( numnatp_ref ) 
    307300         READ  ( numnatp_ref, nampisatm, IOSTAT = ios, ERR = 901) 
    308301901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisatm in reference namelist' ) 
    309  
    310          REWIND( numnatp_cfg ) 
    311302         READ  ( numnatp_cfg, nampisatm, IOSTAT = ios, ERR = 902 ) 
    312303902      IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisatm in configuration namelist' ) 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zint.F90

    r10068 r12377  
    2626CONTAINS 
    2727 
    28    SUBROUTINE p4z_int( kt ) 
     28   SUBROUTINE p4z_int( kt, Kbb, Kmm ) 
    2929      !!--------------------------------------------------------------------- 
    3030      !!                     ***  ROUTINE p4z_int  *** 
    … …  
    3333      !! 
    3434      !!--------------------------------------------------------------------- 
    35       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     35      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index 
     36      INTEGER, INTENT( in ) ::   Kbb, Kmm ! time level indices 
    3637      ! 
    3738      INTEGER  :: ji, jj                 ! dummy loop indices 
    … …  
    4344      ! Computation of phyto and zoo metabolic rate 
    4445      ! ------------------------------------------- 
    45       tgfunc (:,:,:) = EXP( 0.063913 * tsn(:,:,:,jp_tem) ) 
    46       tgfunc2(:,:,:) = EXP( 0.07608  * tsn(:,:,:,jp_tem) ) 
     46      tgfunc (:,:,:) = EXP( 0.063913 * ts(:,:,:,jp_tem,Kmm) ) 
     47      tgfunc2(:,:,:) = EXP( 0.07608  * ts(:,:,:,jp_tem,Kmm) ) 
    4748 
    4849      ! Computation of the silicon dependant half saturation  constant for silica uptake 
    … …  
    5051      DO ji = 1, jpi 
    5152         DO jj = 1, jpj 
    52             zvar = trb(ji,jj,1,jpsil) * trb(ji,jj,1,jpsil) 
     53            zvar = tr(ji,jj,1,jpsil,Kbb) * tr(ji,jj,1,jpsil,Kbb) 
    5354            xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zvar / ( xksilim * xksilim + zvar ) ) * 1e-6 ) 
    5455         END DO 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zligand.F90

    r12276 r12377  
    2626   REAL(wp), PUBLIC ::  prlgw    !: Photochemical of weak ligand 
    2727 
     28   !! * Substitutions 
     29#  include "do_loop_substitute.h90" 
    2830   !!---------------------------------------------------------------------- 
    2931   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    3335CONTAINS 
    3436 
    35    SUBROUTINE p4z_ligand( kt, knt ) 
     37   SUBROUTINE p4z_ligand( kt, knt, Kbb, Krhs ) 
    3638      !!--------------------------------------------------------------------- 
    3739      !!                     ***  ROUTINE p4z_ligand  *** 
    … …  
    3941      !! ** Purpose :   Compute remineralization/scavenging of organic ligands 
    4042      !!--------------------------------------------------------------------- 
    41       INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
     43      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step 
     44      INTEGER, INTENT(in)  ::  Kbb, Krhs ! time level indices 
    4245      ! 
    4346      INTEGER  ::   ji, jj, jk 
    … …  
    4952      IF( ln_timing )   CALL timing_start('p4z_ligand') 
    5053      ! 
    51       DO jk = 1, jpkm1 
    52          DO jj = 1, jpj 
    53             DO ji = 1, jpi 
    54                ! 
    55                ! ------------------------------------------------------------------ 
    56                ! Remineralization of iron ligands 
    57                ! ------------------------------------------------------------------ 
    58                ! production from remineralisation of organic matter 
    59                zlgwp = orem(ji,jj,jk) * rlig 
    60                ! decay of weak ligand 
    61                ! This is based on the idea that as LGW is lower 
    62                ! there is a larger fraction of refractory OM 
    63                zlgwr = max( rlgs , rlgw * exp( -2 * (trb(ji,jj,jk,jplgw)*1e9) ) ) ! years 
    64                zlgwr = 1. / zlgwr * tgfunc(ji,jj,jk) * ( xstep / nyear_len(1) ) * blim(ji,jj,jk) * trb(ji,jj,jk,jplgw) 
    65                ! photochem loss of weak ligand 
    66                zlgwpr = prlgw * xstep * etot(ji,jj,jk) * trb(ji,jj,jk,jplgw) * (1. - fr_i(ji,jj)) 
    67                tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zlgwp - zlgwr - zlgwpr 
    68                zligrem(ji,jj,jk)   = zlgwr 
    69                zligpr(ji,jj,jk)    = zlgwpr 
    70                zligprod(ji,jj,jk)  = zlgwp 
    71                ! 
    72             END DO 
    73          END DO 
    74       END DO 
     54      DO_3D_11_11( 1, jpkm1 ) 
     55         ! 
     56         ! ------------------------------------------------------------------ 
     57         ! Remineralization of iron ligands 
     58         ! ------------------------------------------------------------------ 
     59         ! production from remineralisation of organic matter 
     60         zlgwp = orem(ji,jj,jk) * rlig 
     61         ! decay of weak ligand 
     62         ! This is based on the idea that as LGW is lower 
     63         ! there is a larger fraction of refractory OM 
     64         zlgwr = max( rlgs , rlgw * exp( -2 * (tr(ji,jj,jk,jplgw,Kbb)*1e9) ) ) ! years 
     65         zlgwr = 1. / zlgwr * tgfunc(ji,jj,jk) * ( xstep / nyear_len(1) ) * blim(ji,jj,jk) * tr(ji,jj,jk,jplgw,Kbb) 
     66         ! photochem loss of weak ligand 
     67         zlgwpr = prlgw * xstep * etot(ji,jj,jk) * tr(ji,jj,jk,jplgw,Kbb) * (1. - fr_i(ji,jj)) 
     68         tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zlgwp - zlgwr - zlgwpr 
     69         zligrem(ji,jj,jk)   = zlgwr 
     70         zligpr(ji,jj,jk)    = zlgwpr 
     71         zligprod(ji,jj,jk) = zlgwp 
     72         ! 
     73      END_3D 
    7574      ! 
    7675      !  Output of some diagnostics variables 
    … …  
    8887      ENDIF 
    8988      ! 
    90       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     89      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    9190         WRITE(charout, FMT="('ligand1')") 
    9291         CALL prt_ctl_trc_info(charout) 
    93          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     92         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    9493      ENDIF 
    9594      ! 
    … …  
    119118         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    120119      ENDIF 
    121  
    122       REWIND( numnatp_ref ) 
    123120      READ  ( numnatp_ref, nampislig, IOSTAT = ios, ERR = 901) 
    124121901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampislig in reference namelist' ) 
    125  
    126       REWIND( numnatp_cfg ) 
    127122      READ  ( numnatp_cfg, nampislig, IOSTAT = ios, ERR = 902 ) 
    128123902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampislig in configuration namelist' ) 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zlim.F90

    r12276 r12377  
    6767   REAL(wp) ::  xcoef3   = 1.15E-4 * 14. / 55.85 / 7.625 * 0.5  
    6868 
     69   !! * Substitutions 
     70#  include "do_loop_substitute.h90" 
    6971   !!---------------------------------------------------------------------- 
    7072   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    7476CONTAINS 
    7577 
    76    SUBROUTINE p4z_lim( kt, knt ) 
     78   SUBROUTINE p4z_lim( kt, knt, Kbb, Kmm ) 
    7779      !!--------------------------------------------------------------------- 
    7880      !!                     ***  ROUTINE p4z_lim  *** 
    … …  
    8486      !!--------------------------------------------------------------------- 
    8587      INTEGER, INTENT(in)  :: kt, knt 
     88      INTEGER, INTENT(in)  :: Kbb, Kmm      ! time level indices 
    8689      ! 
    8790      INTEGER  ::   ji, jj, jk 
    … …  
    9598      IF( ln_timing )   CALL timing_start('p4z_lim') 
    9699      ! 
    97       DO jk = 1, jpkm1 
    98          DO jj = 1, jpj 
    99             DO ji = 1, jpi 
    100                 
    101                ! Tuning of the iron concentration to a minimum level that is set to the detection limit 
    102                !------------------------------------- 
    103                zno3    = trb(ji,jj,jk,jpno3) / 40.e-6 
    104                zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 ) 
    105                zferlim = MIN( zferlim, 7e-11 ) 
    106                trb(ji,jj,jk,jpfer) = MAX( trb(ji,jj,jk,jpfer), zferlim ) 
    107  
    108                ! Computation of a variable Ks for iron on diatoms taking into account 
    109                ! that increasing biomass is made of generally bigger cells 
    110                !------------------------------------------------ 
    111                zconcd   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia ) 
    112                zconcd2  = trb(ji,jj,jk,jpdia) - zconcd 
    113                zconcn   = MAX( 0.e0 , trb(ji,jj,jk,jpphy) - xsizephy ) 
    114                zconcn2  = trb(ji,jj,jk,jpphy) - zconcn 
    115                z1_trbphy   = 1. / ( trb(ji,jj,jk,jpphy) + rtrn ) 
    116                z1_trbdia   = 1. / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    117  
    118                concdfe(ji,jj,jk) = MAX( concdfer, ( zconcd2 * concdfer + concdfer * xsizerd * zconcd ) * z1_trbdia ) 
    119                zconc1d           = MAX( concdno3, ( zconcd2 * concdno3 + concdno3 * xsizerd * zconcd ) * z1_trbdia ) 
    120                zconc1dnh4        = MAX( concdnh4, ( zconcd2 * concdnh4 + concdnh4 * xsizerd * zconcd ) * z1_trbdia ) 
    121  
    122                concnfe(ji,jj,jk) = MAX( concnfer, ( zconcn2 * concnfer + concnfer * xsizern * zconcn ) * z1_trbphy ) 
    123                zconc0n           = MAX( concnno3, ( zconcn2 * concnno3 + concnno3 * xsizern * zconcn ) * z1_trbphy ) 
    124                zconc0nnh4        = MAX( concnnh4, ( zconcn2 * concnnh4 + concnnh4 * xsizern * zconcn ) * z1_trbphy ) 
    125  
    126                ! Michaelis-Menten Limitation term for nutrients Small bacteria 
    127                ! ------------------------------------------------------------- 
    128                zdenom = 1. /  ( concbno3 * concbnh4 + concbnh4 * trb(ji,jj,jk,jpno3) + concbno3 * trb(ji,jj,jk,jpnh4) ) 
    129                xnanono3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * concbnh4 * zdenom 
    130                xnanonh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * concbno3 * zdenom 
    131                ! 
    132                zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 
    133                zlim2    = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concbnh4 ) 
    134                zlim3    = trb(ji,jj,jk,jpfer) / ( concbfe + trb(ji,jj,jk,jpfer) ) 
    135                zlim4    = trb(ji,jj,jk,jpdoc) / ( xkdoc   + trb(ji,jj,jk,jpdoc) ) 
    136                xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 
    137                xlimbac (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4 
    138  
    139                ! Michaelis-Menten Limitation term for nutrients Small flagellates 
    140                ! ----------------------------------------------- 
    141                zdenom = 1. /  ( zconc0n * zconc0nnh4 + zconc0nnh4 * trb(ji,jj,jk,jpno3) + zconc0n * trb(ji,jj,jk,jpnh4) ) 
    142                xnanono3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * zconc0nnh4 * zdenom 
    143                xnanonh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * zconc0n    * zdenom 
    144                ! 
    145                zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 
    146                zlim2    = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zconc0nnh4 ) 
    147                zratio   = trb(ji,jj,jk,jpnfe) * z1_trbphy  
    148                zironmin = xcoef1 * trb(ji,jj,jk,jpnch) * z1_trbphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk) 
    149                zlim3    = MAX( 0.,( zratio - zironmin ) / qnfelim ) 
    150                xnanopo4(ji,jj,jk) = zlim2 
    151                xlimnfe (ji,jj,jk) = MIN( 1., zlim3 ) 
    152                xlimphy (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 
    153                ! 
    154                !   Michaelis-Menten Limitation term for nutrients Diatoms 
    155                !   ---------------------------------------------- 
    156                zdenom   = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * trb(ji,jj,jk,jpno3) + zconc1d * trb(ji,jj,jk,jpnh4) ) 
    157                xdiatno3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * zconc1dnh4 * zdenom 
    158                xdiatnh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * zconc1d    * zdenom 
    159                ! 
    160                zlim1    = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 
    161                zlim2    = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zconc1dnh4  ) 
    162                zlim3    = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi(ji,jj) ) 
    163                zratio   = trb(ji,jj,jk,jpdfe) * z1_trbdia 
    164                zironmin = xcoef1 * trb(ji,jj,jk,jpdch) * z1_trbdia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk) 
    165                zlim4    = MAX( 0., ( zratio - zironmin ) / qdfelim ) 
    166                xdiatpo4(ji,jj,jk) = zlim2 
    167                xlimdfe (ji,jj,jk) = MIN( 1., zlim4 ) 
    168                xlimdia (ji,jj,jk) = MIN( zlim1, zlim2, zlim3, zlim4 ) 
    169                xlimsi  (ji,jj,jk) = MIN( zlim1, zlim2, zlim4 ) 
    170            END DO 
    171          END DO 
    172       END DO 
     100      DO_3D_11_11( 1, jpkm1 ) 
     101          
     102         ! Tuning of the iron concentration to a minimum level that is set to the detection limit 
     103         !------------------------------------- 
     104         zno3    = tr(ji,jj,jk,jpno3,Kbb) / 40.e-6 
     105         zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 ) 
     106         zferlim = MIN( zferlim, 7e-11 ) 
     107         tr(ji,jj,jk,jpfer,Kbb) = MAX( tr(ji,jj,jk,jpfer,Kbb), zferlim ) 
     108 
     109         ! Computation of a variable Ks for iron on diatoms taking into account 
     110         ! that increasing biomass is made of generally bigger cells 
     111         !------------------------------------------------ 
     112         zconcd   = MAX( 0.e0 , tr(ji,jj,jk,jpdia,Kbb) - xsizedia ) 
     113         zconcd2  = tr(ji,jj,jk,jpdia,Kbb) - zconcd 
     114         zconcn   = MAX( 0.e0 , tr(ji,jj,jk,jpphy,Kbb) - xsizephy ) 
     115         zconcn2  = tr(ji,jj,jk,jpphy,Kbb) - zconcn 
     116         z1_trbphy   = 1. / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
     117         z1_trbdia   = 1. / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     118 
     119         concdfe(ji,jj,jk) = MAX( concdfer, ( zconcd2 * concdfer + concdfer * xsizerd * zconcd ) * z1_trbdia ) 
     120         zconc1d           = MAX( concdno3, ( zconcd2 * concdno3 + concdno3 * xsizerd * zconcd ) * z1_trbdia ) 
     121         zconc1dnh4        = MAX( concdnh4, ( zconcd2 * concdnh4 + concdnh4 * xsizerd * zconcd ) * z1_trbdia ) 
     122 
     123         concnfe(ji,jj,jk) = MAX( concnfer, ( zconcn2 * concnfer + concnfer * xsizern * zconcn ) * z1_trbphy ) 
     124         zconc0n           = MAX( concnno3, ( zconcn2 * concnno3 + concnno3 * xsizern * zconcn ) * z1_trbphy ) 
     125         zconc0nnh4        = MAX( concnnh4, ( zconcn2 * concnnh4 + concnnh4 * xsizern * zconcn ) * z1_trbphy ) 
     126 
     127         ! Michaelis-Menten Limitation term for nutrients Small bacteria 
     128         ! ------------------------------------------------------------- 
     129         zdenom = 1. /  ( concbno3 * concbnh4 + concbnh4 * tr(ji,jj,jk,jpno3,Kbb) + concbno3 * tr(ji,jj,jk,jpnh4,Kbb) ) 
     130         xnanono3(ji,jj,jk) = tr(ji,jj,jk,jpno3,Kbb) * concbnh4 * zdenom 
     131         xnanonh4(ji,jj,jk) = tr(ji,jj,jk,jpnh4,Kbb) * concbno3 * zdenom 
     132         ! 
     133         zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 
     134         zlim2    = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concbnh4 ) 
     135         zlim3    = tr(ji,jj,jk,jpfer,Kbb) / ( concbfe + tr(ji,jj,jk,jpfer,Kbb) ) 
     136         zlim4    = tr(ji,jj,jk,jpdoc,Kbb) / ( xkdoc   + tr(ji,jj,jk,jpdoc,Kbb) ) 
     137         xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 
     138         xlimbac (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4 
     139 
     140         ! Michaelis-Menten Limitation term for nutrients Small flagellates 
     141         ! ----------------------------------------------- 
     142         zdenom = 1. /  ( zconc0n * zconc0nnh4 + zconc0nnh4 * tr(ji,jj,jk,jpno3,Kbb) + zconc0n * tr(ji,jj,jk,jpnh4,Kbb) ) 
     143         xnanono3(ji,jj,jk) = tr(ji,jj,jk,jpno3,Kbb) * zconc0nnh4 * zdenom 
     144         xnanonh4(ji,jj,jk) = tr(ji,jj,jk,jpnh4,Kbb) * zconc0n    * zdenom 
     145         ! 
     146         zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 
     147         zlim2    = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zconc0nnh4 ) 
     148         zratio   = tr(ji,jj,jk,jpnfe,Kbb) * z1_trbphy  
     149         zironmin = xcoef1 * tr(ji,jj,jk,jpnch,Kbb) * z1_trbphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk) 
     150         zlim3    = MAX( 0.,( zratio - zironmin ) / qnfelim ) 
     151         xnanopo4(ji,jj,jk) = zlim2 
     152         xlimnfe (ji,jj,jk) = MIN( 1., zlim3 ) 
     153         xlimphy (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 
     154         ! 
     155         !   Michaelis-Menten Limitation term for nutrients Diatoms 
     156         !   ---------------------------------------------- 
     157         zdenom   = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * tr(ji,jj,jk,jpno3,Kbb) + zconc1d * tr(ji,jj,jk,jpnh4,Kbb) ) 
     158         xdiatno3(ji,jj,jk) = tr(ji,jj,jk,jpno3,Kbb) * zconc1dnh4 * zdenom 
     159         xdiatnh4(ji,jj,jk) = tr(ji,jj,jk,jpnh4,Kbb) * zconc1d    * zdenom 
     160         ! 
     161         zlim1    = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 
     162         zlim2    = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zconc1dnh4  ) 
     163         zlim3    = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi(ji,jj) ) 
     164         zratio   = tr(ji,jj,jk,jpdfe,Kbb) * z1_trbdia 
     165         zironmin = xcoef1 * tr(ji,jj,jk,jpdch,Kbb) * z1_trbdia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk) 
     166         zlim4    = MAX( 0., ( zratio - zironmin ) / qdfelim ) 
     167         xdiatpo4(ji,jj,jk) = zlim2 
     168         xlimdfe (ji,jj,jk) = MIN( 1., zlim4 ) 
     169         xlimdia (ji,jj,jk) = MIN( zlim1, zlim2, zlim3, zlim4 ) 
     170         xlimsi  (ji,jj,jk) = MIN( zlim1, zlim2, zlim4 ) 
     171      END_3D 
    173172 
    174173      ! Compute the fraction of nanophytoplankton that is made of calcifiers 
    175174      ! -------------------------------------------------------------------- 
    176       DO jk = 1, jpkm1 
    177          DO jj = 1, jpj 
    178             DO ji = 1, jpi 
    179                zlim1 =  ( trb(ji,jj,jk,jpno3) * concnnh4 + trb(ji,jj,jk,jpnh4) * concnno3 )    & 
    180                   &   / ( concnno3 * concnnh4 + concnnh4 * trb(ji,jj,jk,jpno3) + concnno3 * trb(ji,jj,jk,jpnh4) )  
    181                zlim2  = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concnnh4 ) 
    182                zlim3  = trb(ji,jj,jk,jpfer) / ( trb(ji,jj,jk,jpfer) +  5.E-11   ) 
    183                ztem1  = MAX( 0., tsn(ji,jj,jk,jp_tem) ) 
    184                ztem2  = tsn(ji,jj,jk,jp_tem) - 10. 
    185                zetot1 = MAX( 0., etot_ndcy(ji,jj,jk) - 1.) / ( 4. + etot_ndcy(ji,jj,jk) )  
    186                zetot2 = 30. / ( 30. + etot_ndcy(ji,jj,jk) )  
    187  
    188                xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 )                  & 
    189                   &                       * ztem1 / ( 0.1 + ztem1 )                     & 
    190                   &                       * MAX( 1., trb(ji,jj,jk,jpphy) * 1.e6 / 2. )  & 
    191                   &                       * zetot1 * zetot2               & 
    192                   &                       * ( 1. + EXP(-ztem2 * ztem2 / 25. ) )         & 
    193                   &                       * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) ) 
    194                xfracal(ji,jj,jk) = MIN( 0.8 , xfracal(ji,jj,jk) ) 
    195                xfracal(ji,jj,jk) = MAX( 0.02, xfracal(ji,jj,jk) ) 
    196             END DO 
    197          END DO 
    198       END DO 
    199       ! 
    200       DO jk = 1, jpkm1 
    201          DO jj = 1, jpj 
    202             DO ji = 1, jpi 
    203                ! denitrification factor computed from O2 levels 
    204                nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - trb(ji,jj,jk,jpoxy) )    & 
    205                   &                                / ( oxymin + trb(ji,jj,jk,jpoxy) )  ) 
    206                nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 
    207                ! 
    208                ! denitrification factor computed from NO3 levels 
    209                nitrfac2(ji,jj,jk) = MAX( 0.e0,       ( 1.E-6 - trb(ji,jj,jk,jpno3) )  & 
    210                   &                                / ( 1.E-6 + trb(ji,jj,jk,jpno3) ) ) 
    211                nitrfac2(ji,jj,jk) = MIN( 1., nitrfac2(ji,jj,jk) ) 
    212             END DO 
    213          END DO 
    214       END DO 
     175      DO_3D_11_11( 1, jpkm1 ) 
     176         zlim1 =  ( tr(ji,jj,jk,jpno3,Kbb) * concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) * concnno3 )    & 
     177            &   / ( concnno3 * concnnh4 + concnnh4 * tr(ji,jj,jk,jpno3,Kbb) + concnno3 * tr(ji,jj,jk,jpnh4,Kbb) )  
     178         zlim2  = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concnnh4 ) 
     179         zlim3  = tr(ji,jj,jk,jpfer,Kbb) / ( tr(ji,jj,jk,jpfer,Kbb) +  5.E-11   ) 
     180         ztem1  = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) ) 
     181         ztem2  = ts(ji,jj,jk,jp_tem,Kmm) - 10. 
     182         zetot1 = MAX( 0., etot_ndcy(ji,jj,jk) - 1.) / ( 4. + etot_ndcy(ji,jj,jk) )  
     183         zetot2 = 30. / ( 30. + etot_ndcy(ji,jj,jk) )  
     184 
     185         xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 )                  & 
     186            &                       * ztem1 / ( 0.1 + ztem1 )                     & 
     187            &                       * MAX( 1., tr(ji,jj,jk,jpphy,Kbb) * 1.e6 / 2. )  & 
     188            &                       * zetot1 * zetot2               & 
     189            &                       * ( 1. + EXP(-ztem2 * ztem2 / 25. ) )         & 
     190            &                       * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) ) 
     191         xfracal(ji,jj,jk) = MIN( 0.8 , xfracal(ji,jj,jk) ) 
     192         xfracal(ji,jj,jk) = MAX( 0.02, xfracal(ji,jj,jk) ) 
     193      END_3D 
     194      ! 
     195      DO_3D_11_11( 1, jpkm1 ) 
     196         ! denitrification factor computed from O2 levels 
     197         nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - tr(ji,jj,jk,jpoxy,Kbb) )    & 
     198            &                                / ( oxymin + tr(ji,jj,jk,jpoxy,Kbb) )  ) 
     199         nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 
     200         ! 
     201         ! denitrification factor computed from NO3 levels 
     202         nitrfac2(ji,jj,jk) = MAX( 0.e0,       ( 1.E-6 - tr(ji,jj,jk,jpno3,Kbb) )  & 
     203            &                                / ( 1.E-6 + tr(ji,jj,jk,jpno3,Kbb) ) ) 
     204         nitrfac2(ji,jj,jk) = MIN( 1., nitrfac2(ji,jj,jk) ) 
     205      END_3D 
    215206      ! 
    216207      IF( lk_iomput .AND. knt == nrdttrc ) THEN        ! save output diagnostics 
    … …  
    252243      ENDIF 
    253244      ! 
    254       REWIND( numnatp_ref ) 
    255245      READ  ( numnatp_ref, namp4zlim, IOSTAT = ios, ERR = 901) 
    256246901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zlim in reference namelist' ) 
    257  
    258       REWIND( numnatp_cfg ) 
    259247      READ  ( numnatp_cfg, namp4zlim, IOSTAT = ios, ERR = 902 ) 
    260248902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zlim in configuration namelist' ) 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zlys.F90

    r12276 r12377  
    3535   REAL(wp) ::   calcon = 1.03E-2   ! mean calcite concentration [Ca2+] in sea water [mole/kg solution] 
    3636  
     37   !! * Substitutions 
     38#  include "do_loop_substitute.h90" 
    3739   !!---------------------------------------------------------------------- 
    3840   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4345CONTAINS 
    4446 
    45    SUBROUTINE p4z_lys( kt, knt ) 
     47   SUBROUTINE p4z_lys( kt, knt, Kbb, Krhs ) 
    4648      !!--------------------------------------------------------------------- 
    4749      !!                     ***  ROUTINE p4z_lys  *** 
    … …  
    5456      !!--------------------------------------------------------------------- 
    5557      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step and ??? 
     58      INTEGER, INTENT(in)  ::  Kbb, Krhs ! time level indices 
    5659      ! 
    5760      INTEGER  ::   ji, jj, jk, jn 
    … …  
    7073      !     ------------------------------------------- 
    7174 
    72       CALL solve_at_general( zhinit, zhi ) 
     75      CALL solve_at_general( zhinit, zhi, Kbb ) 
    7376 
    74       DO jk = 1, jpkm1 
    75          DO jj = 1, jpj 
    76             DO ji = 1, jpi 
    77                zco3(ji,jj,jk) = trb(ji,jj,jk,jpdic) * ak13(ji,jj,jk) * ak23(ji,jj,jk) / (zhi(ji,jj,jk)**2   & 
    78                   &             + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn ) 
    79                hi  (ji,jj,jk) = zhi(ji,jj,jk) * rhop(ji,jj,jk) / 1000. 
    80             END DO 
    81          END DO 
    82       END DO 
     77      DO_3D_11_11( 1, jpkm1 ) 
     78         zco3(ji,jj,jk) = tr(ji,jj,jk,jpdic,Kbb) * ak13(ji,jj,jk) * ak23(ji,jj,jk) / (zhi(ji,jj,jk)**2   & 
     79            &             + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn ) 
     80         hi  (ji,jj,jk) = zhi(ji,jj,jk) * rhop(ji,jj,jk) / 1000. 
     81      END_3D 
    8382 
    8483      !     --------------------------------------------------------- 
    … …  
    8887      !     --------------------------------------------------------- 
    8988 
    90       DO jk = 1, jpkm1 
    91          DO jj = 1, jpj 
    92             DO ji = 1, jpi 
     89      DO_3D_11_11( 1, jpkm1 ) 
    9390 
    94                ! DEVIATION OF [CO3--] FROM SATURATION VALUE 
    95                ! Salinity dependance in zomegaca and divide by rhop/1000 to have good units 
    96                zcalcon  = calcon * ( salinprac(ji,jj,jk) / 35._wp ) 
    97                zfact    = rhop(ji,jj,jk) / 1000._wp 
    98                zomegaca = ( zcalcon * zco3(ji,jj,jk) ) / ( aksp(ji,jj,jk) * zfact + rtrn ) 
    99                zco3sat(ji,jj,jk) = aksp(ji,jj,jk) * zfact / ( zcalcon + rtrn ) 
     91         ! DEVIATION OF [CO3--] FROM SATURATION VALUE 
     92         ! Salinity dependance in zomegaca and divide by rhop/1000 to have good units 
     93         zcalcon  = calcon * ( salinprac(ji,jj,jk) / 35._wp ) 
     94         zfact    = rhop(ji,jj,jk) / 1000._wp 
     95         zomegaca = ( zcalcon * zco3(ji,jj,jk) ) / ( aksp(ji,jj,jk) * zfact + rtrn ) 
     96         zco3sat(ji,jj,jk) = aksp(ji,jj,jk) * zfact / ( zcalcon + rtrn ) 
    10097 
    101                ! SET DEGREE OF UNDER-/SUPERSATURATION 
    102                excess(ji,jj,jk) = 1._wp - zomegaca 
    103                zexcess0 = MAX( 0., excess(ji,jj,jk) ) 
    104                zexcess  = zexcess0**nca 
     98         ! SET DEGREE OF UNDER-/SUPERSATURATION 
     99         excess(ji,jj,jk) = 1._wp - zomegaca 
     100         zexcess0 = MAX( 0., excess(ji,jj,jk) ) 
     101         zexcess  = zexcess0**nca 
    105102 
    106                ! AMOUNT CACO3 (12C) THAT RE-ENTERS SOLUTION 
    107                !       (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE 
    108                !       CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION) 
    109                zdispot = kdca * zexcess * trb(ji,jj,jk,jpcal) 
    110               !  CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3], 
    111               !       AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION 
    112               zcaldiss(ji,jj,jk)  = zdispot * rfact2 / rmtss ! calcite dissolution 
    113               ! 
    114               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zcaldiss(ji,jj,jk) 
    115               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) -      zcaldiss(ji,jj,jk) 
    116               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +      zcaldiss(ji,jj,jk) 
    117             END DO 
    118          END DO 
    119       END DO 
     103         ! AMOUNT CACO3 (12C) THAT RE-ENTERS SOLUTION 
     104         !       (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE 
     105         !       CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION) 
     106         zdispot = kdca * zexcess * tr(ji,jj,jk,jpcal,Kbb) 
     107        !  CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3], 
     108        !       AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION 
     109        zcaldiss(ji,jj,jk)  = zdispot * rfact2 / rmtss ! calcite dissolution 
     110        ! 
     111        tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + 2. * zcaldiss(ji,jj,jk) 
     112        tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) -      zcaldiss(ji,jj,jk) 
     113        tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) +      zcaldiss(ji,jj,jk) 
     114      END_3D 
    120115      ! 
    121116 
    122117      IF( lk_iomput .AND. knt == nrdttrc ) THEN 
    123          CALL iom_put( "PH"  , -1. * LOG10( MAX( hi(:,:,:), rtrn ) ) * tmask(:,:,:) ) 
     118         CALL iom_put( "PH" , -1. * LOG10( MAX( hi(:,:,:), rtrn ) ) * tmask(:,:,:) ) 
    124119         IF( iom_use( "CO3" ) ) THEN 
    125120            zco3(:,:,jpk) = 0.    ; CALL iom_put( "CO3"   , zco3(:,:,:)     * 1.e+3           * tmask(:,:,:) ) 
    … …  
    130125         IF( iom_use( "DCAL" ) ) THEN 
    131126           zcaldiss(:,:,jpk) = 0. ; CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) 
    132          ENDIF 
     127         ENDIF               
    133128      ENDIF 
    134129      ! 
    135       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     130      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    136131        WRITE(charout, FMT="('lys ')") 
    137132        CALL prt_ctl_trc_info(charout) 
    138         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     133        CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    139134      ENDIF 
    140135      ! 
    … …  
    166161      ENDIF 
    167162      ! 
    168       REWIND( numnatp_ref ) 
    169163      READ  ( numnatp_ref, nampiscal, IOSTAT = ios, ERR = 901) 
    170164901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampiscal in reference namelist' ) 
    171  
    172       REWIND( numnatp_cfg ) 
    173165      READ  ( numnatp_cfg, nampiscal, IOSTAT = ios, ERR = 902 ) 
    174166902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampiscal in configuration namelist' ) 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zmeso.F90

    r12276 r12377  
    4444   REAL(wp), PUBLIC ::  grazflux     !: mesozoo flux feeding rate 
    4545 
     46   !! * Substitutions 
     47#  include "do_loop_substitute.h90" 
    4648   !!---------------------------------------------------------------------- 
    4749   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    5153CONTAINS 
    5254 
    53    SUBROUTINE p4z_meso( kt, knt ) 
     55   SUBROUTINE p4z_meso( kt, knt, Kbb, Krhs ) 
    5456      !!--------------------------------------------------------------------- 
    5557      !!                     ***  ROUTINE p4z_meso  *** 
    … …  
    6062      !!--------------------------------------------------------------------- 
    6163      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step and ??? 
     64      INTEGER, INTENT(in)  ::  Kbb, Krhs ! time level indices 
    6265      ! 
    6366      INTEGER  :: ji, jj, jk 
    … …  
    7780      IF( ln_timing )   CALL timing_start('p4z_meso') 
    7881      ! 
    79       DO jk = 1, jpkm1 
    80          DO jj = 1, jpj 
    81             DO ji = 1, jpi 
    82                zcompam   = MAX( ( trb(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 ) 
    83                zfact     = xstep * tgfunc2(ji,jj,jk) * zcompam 
    84  
    85                !  Respiration rates of both zooplankton 
    86                !  ------------------------------------- 
    87                zrespz    = resrat2 * zfact * ( trb(ji,jj,jk,jpmes) / ( xkmort + trb(ji,jj,jk,jpmes) )  & 
    88                &           + 3. * nitrfac(ji,jj,jk) ) 
    89  
    90                !  Zooplankton mortality. A square function has been selected with 
    91                !  no real reason except that it seems to be more stable and may mimic predation 
    92                !  --------------------------------------------------------------- 
    93                ztortz    = mzrat2 * 1.e6 * zfact * trb(ji,jj,jk,jpmes)  * (1. - nitrfac(ji,jj,jk) ) 
    94                ! 
    95                zcompadi  = MAX( ( trb(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 ) 
    96                zcompaz   = MAX( ( trb(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 ) 
    97                zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 ) 
    98                ! Size effect of nanophytoplankton on grazing : the smaller it is, the less prone 
    99                ! it is to predation by mesozooplankton 
    100                ! ------------------------------------------------------------------------------- 
    101                zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) & 
    102                   &      * MIN(1., MAX( 0., ( quotan(ji,jj,jk) - 0.2) / 0.3 ) ) 
    103  
    104                !   Mesozooplankton grazing 
    105                !   ------------------------ 
    106                zfood     = xpref2d * zcompadi + xpref2z * zcompaz + xpref2n * zcompaph + xpref2c * zcompapoc  
    107                zfoodlim  = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) ) 
    108                zdenom    = zfoodlim / ( xkgraz2 + zfoodlim ) 
    109                zdenom2   = zdenom / ( zfood + rtrn ) 
    110                zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes) * (1. - nitrfac(ji,jj,jk))  
    111  
    112                zgrazd    = zgraze2  * xpref2d  * zcompadi  * zdenom2  
    113                zgrazz    = zgraze2  * xpref2z  * zcompaz   * zdenom2  
    114                zgrazn    = zgraze2  * xpref2n  * zcompaph  * zdenom2  
    115                zgrazpoc  = zgraze2  * xpref2c  * zcompapoc * zdenom2  
    116  
    117                zgraznf   = zgrazn   * trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn) 
    118                zgrazf    = zgrazd   * trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn) 
    119                zgrazpof  = zgrazpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn) 
    120  
    121                !  Mesozooplankton flux feeding on GOC 
    122                !  ---------------------------------- 
    123                zgrazffeg = grazflux  * xstep * wsbio4(ji,jj,jk)      & 
    124                &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes) & 
    125                &           * (1. - nitrfac(ji,jj,jk)) 
    126                zgrazfffg = zgrazffeg * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn) 
    127                zgrazffep = grazflux  * xstep *  wsbio3(ji,jj,jk)     & 
    128                &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpmes) & 
    129                &           * (1. - nitrfac(ji,jj,jk)) 
    130                zgrazfffp = zgrazffep * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn) 
    131                ! 
    132                zgraztotc = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg 
    133                ! Compute the proportion of filter feeders 
    134                zproport  = (zgrazffep + zgrazffeg)/(rtrn + zgraztotc) 
    135                ! Compute fractionation of aggregates. It is assumed that  
    136                ! diatoms based aggregates are more prone to fractionation 
    137                ! since they are more porous (marine snow instead of fecal pellets) 
    138                zratio    = trb(ji,jj,jk,jpgsi) / ( trb(ji,jj,jk,jpgoc) + rtrn ) 
    139                zratio2   = zratio * zratio 
    140                zfrac     = zproport * grazflux  * xstep * wsbio4(ji,jj,jk)      & 
    141                &          * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)          & 
    142                &          * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) ) 
    143                zfracfe   = zfrac * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn) 
    144  
    145                zgrazffep = zproport * zgrazffep 
    146                zgrazffeg = zproport * zgrazffeg 
    147                zgrazfffp = zproport * zgrazfffp 
    148                zgrazfffg = zproport * zgrazfffg 
    149                zgraztotc = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg 
    150                zgraztotn = zgrazd * quotad(ji,jj,jk) + zgrazz + zgrazn * quotan(ji,jj,jk)   & 
    151                &   + zgrazpoc + zgrazffep + zgrazffeg 
    152                zgraztotf = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfffp + zgrazfffg 
    153  
    154                ! Total grazing ( grazing by microzoo is already computed in p4zmicro ) 
    155                zgrazing2(ji,jj,jk) = zgraztotc 
    156  
    157                !    Mesozooplankton efficiency 
    158                !    -------------------------- 
    159                zgrasrat  =  ( zgraztotf + rtrn )/ ( zgraztotc + rtrn ) 
    160                zgrasratn =  ( zgraztotn + rtrn )/ ( zgraztotc + rtrn ) 
    161                zepshert  = MIN( 1., zgrasratn, zgrasrat / ferat3) 
    162                zbeta     = MAX(0., (epsher2 - epsher2min) ) 
    163                zepsherf  = epsher2min + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta )  
    164                zepsherv  = zepsherf * zepshert  
    165  
    166                zgrarem2  = zgraztotc * ( 1. - zepsherv - unass2 ) & 
    167                &         + ( 1. - epsher2 - unass2 ) / ( 1. - epsher2 ) * ztortz 
    168                zgrafer2  = zgraztotc * MAX( 0. , ( 1. - unass2 ) * zgrasrat - ferat3 * zepsherv )    & 
    169                &         + ferat3 * ( ( 1. - epsher2 - unass2 ) /( 1. - epsher2 ) * ztortz ) 
    170                zgrapoc2  = zgraztotc * unass2 
    171  
    172                !   Update the arrays TRA which contain the biological sources and sinks 
    173                zgrarsig  = zgrarem2 * sigma2 
    174                tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig 
    175                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 
    176                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 - zgrarsig 
    177                ! 
    178                IF( ln_ligand ) THEN  
    179                   tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + (zgrarem2 - zgrarsig) * ldocz 
    180                   zz2ligprod(ji,jj,jk) = (zgrarem2 - zgrarsig) * ldocz 
    181                ENDIF 
    182                ! 
    183                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 
    184                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2 
    185                zfezoo2(ji,jj,jk)   = zgrafer2 
    186                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig 
    187                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig               
    188  
    189                zmortz = ztortz + zrespz 
    190                zmortzgoc = unass2 / ( 1. - epsher2 ) * ztortz + zrespz 
    191                tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz + zepsherv * zgraztotc  
    192                tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazd 
    193                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz 
    194                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazn 
    195                tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn * trb(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpphy) + rtrn ) 
    196                tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd * trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    197                tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    198                tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    199                tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf 
    200                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf 
    201  
    202                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc - zgrazffep + zfrac 
    203                prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfrac 
    204                conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep 
    205                tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortzgoc - zgrazffeg + zgrapoc2 - zfrac 
    206                prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zmortzgoc + zgrapoc2 
    207                consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfrac 
    208                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof - zgrazfffp + zfracfe 
    209                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortzgoc - zgrazfffg     & 
    210                  &                + zgraztotf * unass2 - zfracfe 
    211                zfracal = trb(ji,jj,jk,jpcal) / (trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + rtrn ) 
    212                zgrazcal = (zgrazffeg + zgrazpoc) * (1. - part2) * zfracal 
    213                ! calcite production 
    214                zprcaca = xfracal(ji,jj,jk) * zgrazn 
    215                prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    216                ! 
    217                zprcaca = part2 * zprcaca 
    218                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrazcal - zprcaca 
    219                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * ( zgrazcal + zprcaca ) 
    220                tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) - zgrazcal + zprcaca 
    221             END DO 
    222          END DO 
    223       END DO 
     82      DO_3D_11_11( 1, jpkm1 ) 
     83         zcompam   = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - 1.e-9 ), 0.e0 ) 
     84         zfact     = xstep * tgfunc2(ji,jj,jk) * zcompam 
     85 
     86         !  Respiration rates of both zooplankton 
     87         !  ------------------------------------- 
     88         zrespz    = resrat2 * zfact * ( tr(ji,jj,jk,jpmes,Kbb) / ( xkmort + tr(ji,jj,jk,jpmes,Kbb) )  & 
     89         &           + 3. * nitrfac(ji,jj,jk) ) 
     90 
     91         !  Zooplankton mortality. A square function has been selected with 
     92         !  no real reason except that it seems to be more stable and may mimic predation 
     93         !  --------------------------------------------------------------- 
     94         ztortz    = mzrat2 * 1.e6 * zfact * tr(ji,jj,jk,jpmes,Kbb)  * (1. - nitrfac(ji,jj,jk) ) 
     95         ! 
     96         zcompadi  = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthresh2dia ), 0.e0 ) 
     97         zcompaz   = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - xthresh2zoo ), 0.e0 ) 
     98         zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthresh2poc ), 0.e0 ) 
     99         ! Size effect of nanophytoplankton on grazing : the smaller it is, the less prone 
     100         ! it is to predation by mesozooplankton 
     101         ! ------------------------------------------------------------------------------- 
     102         zcompaph  = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthresh2phy ), 0.e0 ) & 
     103            &      * MIN(1., MAX( 0., ( quotan(ji,jj,jk) - 0.2) / 0.3 ) ) 
     104 
     105         !   Mesozooplankton grazing 
     106         !   ------------------------ 
     107         zfood     = xpref2d * zcompadi + xpref2z * zcompaz + xpref2n * zcompaph + xpref2c * zcompapoc  
     108         zfoodlim  = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) ) 
     109         zdenom    = zfoodlim / ( xkgraz2 + zfoodlim ) 
     110         zdenom2   = zdenom / ( zfood + rtrn ) 
     111         zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpmes,Kbb) * (1. - nitrfac(ji,jj,jk))  
     112 
     113         zgrazd    = zgraze2  * xpref2d  * zcompadi  * zdenom2  
     114         zgrazz    = zgraze2  * xpref2z  * zcompaz   * zdenom2  
     115         zgrazn    = zgraze2  * xpref2n  * zcompaph  * zdenom2  
     116         zgrazpoc  = zgraze2  * xpref2c  * zcompapoc * zdenom2  
     117 
     118         zgraznf   = zgrazn   * tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
     119         zgrazf    = zgrazd   * tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
     120         zgrazpof  = zgrazpoc * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
     121 
     122         !  Mesozooplankton flux feeding on GOC 
     123         !  ---------------------------------- 
     124         zgrazffeg = grazflux  * xstep * wsbio4(ji,jj,jk)      & 
     125         &           * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 
     126         &           * (1. - nitrfac(ji,jj,jk)) 
     127         zgrazfffg = zgrazffeg * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 
     128         zgrazffep = grazflux  * xstep *  wsbio3(ji,jj,jk)     & 
     129         &           * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 
     130         &           * (1. - nitrfac(ji,jj,jk)) 
     131         zgrazfffp = zgrazffep * tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
     132         ! 
     133         zgraztotc = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg 
     134         ! Compute the proportion of filter feeders 
     135         zproport  = (zgrazffep + zgrazffeg)/(rtrn + zgraztotc) 
     136         ! Compute fractionation of aggregates. It is assumed that  
     137         ! diatoms based aggregates are more prone to fractionation 
     138         ! since they are more porous (marine snow instead of fecal pellets) 
     139         zratio    = tr(ji,jj,jk,jpgsi,Kbb) / ( tr(ji,jj,jk,jpgoc,Kbb) + rtrn ) 
     140         zratio2   = zratio * zratio 
     141         zfrac     = zproport * grazflux  * xstep * wsbio4(ji,jj,jk)      & 
     142         &          * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb)          & 
     143         &          * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) ) 
     144         zfracfe   = zfrac * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 
     145 
     146         zgrazffep = zproport * zgrazffep 
     147         zgrazffeg = zproport * zgrazffeg 
     148         zgrazfffp = zproport * zgrazfffp 
     149         zgrazfffg = zproport * zgrazfffg 
     150         zgraztotc = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg 
     151         zgraztotn = zgrazd * quotad(ji,jj,jk) + zgrazz + zgrazn * quotan(ji,jj,jk)   & 
     152         &   + zgrazpoc + zgrazffep + zgrazffeg 
     153         zgraztotf = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfffp + zgrazfffg 
     154 
     155         ! Total grazing ( grazing by microzoo is already computed in p4zmicro ) 
     156         zgrazing2(ji,jj,jk) = zgraztotc 
     157 
     158         !    Mesozooplankton efficiency 
     159         !    -------------------------- 
     160         zgrasrat  =  ( zgraztotf + rtrn )/ ( zgraztotc + rtrn ) 
     161         zgrasratn =  ( zgraztotn + rtrn )/ ( zgraztotc + rtrn ) 
     162         zepshert  = MIN( 1., zgrasratn, zgrasrat / ferat3) 
     163         zbeta     = MAX(0., (epsher2 - epsher2min) ) 
     164         zepsherf  = epsher2min + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta )  
     165         zepsherv  = zepsherf * zepshert  
     166 
     167         zgrarem2  = zgraztotc * ( 1. - zepsherv - unass2 ) & 
     168         &         + ( 1. - epsher2 - unass2 ) / ( 1. - epsher2 ) * ztortz 
     169         zgrafer2  = zgraztotc * MAX( 0. , ( 1. - unass2 ) * zgrasrat - ferat3 * zepsherv )    & 
     170         &         + ferat3 * ( ( 1. - epsher2 - unass2 ) /( 1. - epsher2 ) * ztortz ) 
     171         zgrapoc2  = zgraztotc * unass2 
     172 
     173         !   Update the arrays TRA which contain the biological sources and sinks 
     174         zgrarsig  = zgrarem2 * sigma2 
     175         tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarsig 
     176         tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgrarsig 
     177         tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgrarem2 - zgrarsig 
     178         ! 
     179         IF( ln_ligand ) THEN  
     180            tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + (zgrarem2 - zgrarsig) * ldocz 
     181            zz2ligprod(ji,jj,jk) = (zgrarem2 - zgrarsig) * ldocz 
     182         ENDIF 
     183         ! 
     184         tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarsig 
     185         tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgrafer2 
     186         zfezoo2(ji,jj,jk)   = zgrafer2 
     187         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarsig 
     188         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zgrarsig               
     189 
     190         zmortz = ztortz + zrespz 
     191         zmortzgoc = unass2 / ( 1. - epsher2 ) * ztortz + zrespz 
     192         tr(ji,jj,jk,jpmes,Krhs) = tr(ji,jj,jk,jpmes,Krhs) - zmortz + zepsherv * zgraztotc  
     193         tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazd 
     194         tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) - zgrazz 
     195         tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgrazn 
     196         tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgrazn * tr(ji,jj,jk,jpnch,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
     197         tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazd * tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     198         tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazd * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     199         tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazd * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     200         tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgraznf 
     201         tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazf 
     202 
     203         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zgrazpoc - zgrazffep + zfrac 
     204         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfrac 
     205         conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep 
     206         tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zmortzgoc - zgrazffeg + zgrapoc2 - zfrac 
     207         prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zmortzgoc + zgrapoc2 
     208         consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfrac 
     209         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zgrazpof - zgrazfffp + zfracfe 
     210         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + ferat3 * zmortzgoc - zgrazfffg     & 
     211           &                + zgraztotf * unass2 - zfracfe 
     212         zfracal = tr(ji,jj,jk,jpcal,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + tr(ji,jj,jk,jpgoc,Kbb) + rtrn ) 
     213         zgrazcal = (zgrazffeg + zgrazpoc) * (1. - part2) * zfracal 
     214         ! calcite production 
     215         zprcaca = xfracal(ji,jj,jk) * zgrazn 
     216         prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
     217         ! 
     218         zprcaca = part2 * zprcaca 
     219         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrazcal - zprcaca 
     220         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * ( zgrazcal + zprcaca ) 
     221         tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) - zgrazcal + zprcaca 
     222      END_3D 
    224223      ! 
    225224      IF( lk_iomput .AND. knt == nrdttrc ) THEN 
    226          CALL iom_put( "PCAL"  , prodcal(:,:,:) * 1.e+3  * rfact2r * tmask(:,:,:) )  !  Calcite production  
    227          IF( iom_use("GRAZ2") ) THEN  !   Total grazing of phyto by zooplankton 
     225        CALL iom_put( "PCAL"  , prodcal(:,:,:) * 1.e+3  * rfact2r * tmask(:,:,:) )  !  Calcite production  
     226        IF( iom_use("GRAZ2") ) THEN  !   Total grazing of phyto by zooplankton 
    228227           zgrazing2(:,:,jpk) = 0._wp ;  CALL iom_put( "GRAZ2" , zgrazing2(:,:,:) * 1.e+3  * rfact2r * tmask(:,:,:) )  
    229228         ENDIF 
    … …  
    236235      ENDIF 
    237236      ! 
    238       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     237      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    239238        WRITE(charout, FMT="('meso')") 
    240239        CALL prt_ctl_trc_info(charout) 
    241         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     240        CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    242241      ENDIF 
    243242      ! 
    … …  
    271270      ENDIF 
    272271      ! 
    273       REWIND( numnatp_ref ) 
    274272      READ  ( numnatp_ref, namp4zmes, IOSTAT = ios, ERR = 901) 
    275273901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zmes in reference namelist' ) 
    276  
    277       REWIND( numnatp_cfg ) 
    278274      READ  ( numnatp_cfg, namp4zmes, IOSTAT = ios, ERR = 902 ) 
    279275902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zmes in configuration namelist' ) 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zmicro.F90

    r12276 r12377  
    4242   REAL(wp), PUBLIC ::   epshermin   !: minimum growth efficiency for grazing 1 
    4343 
     44   !! * Substitutions 
     45#  include "do_loop_substitute.h90" 
    4446   !!---------------------------------------------------------------------- 
    4547   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4951CONTAINS 
    5052 
    51    SUBROUTINE p4z_micro( kt, knt ) 
     53   SUBROUTINE p4z_micro( kt, knt, Kbb, Krhs ) 
    5254      !!--------------------------------------------------------------------- 
    5355      !!                     ***  ROUTINE p4z_micro  *** 
    … …  
    5961      INTEGER, INTENT(in) ::   kt    ! ocean time step 
    6062      INTEGER, INTENT(in) ::   knt   ! ???  
     63      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices 
    6164      ! 
    6265      INTEGER  :: ji, jj, jk 
    … …  
    7578      IF( ln_timing )   CALL timing_start('p4z_micro') 
    7679      ! 
    77       DO jk = 1, jpkm1 
    78          DO jj = 1, jpj 
    79             DO ji = 1, jpi 
    80                zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 ) 
    81                zfact   = xstep * tgfunc2(ji,jj,jk) * zcompaz 
    82  
    83                !  Respiration rates of both zooplankton 
    84                !  ------------------------------------- 
    85                zrespz = resrat * zfact * trb(ji,jj,jk,jpzoo) / ( xkmort + trb(ji,jj,jk,jpzoo) )  & 
    86                   &   + resrat * zfact * 3. * nitrfac(ji,jj,jk) 
    87  
    88                !  Zooplankton mortality. A square function has been selected with 
    89                !  no real reason except that it seems to be more stable and may mimic predation. 
    90                !  --------------------------------------------------------------- 
    91                ztortz = mzrat * 1.e6 * zfact * trb(ji,jj,jk,jpzoo) * (1. - nitrfac(ji,jj,jk)) 
    92  
    93                zcompadi  = MIN( MAX( ( trb(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia ) 
    94                zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 ) 
    95                zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 ) 
    96                 
    97                !     Microzooplankton grazing 
    98                !     ------------------------ 
    99                zfood     = xprefn * zcompaph + xprefc * zcompapoc + xprefd * zcompadi 
    100                zfoodlim  = MAX( 0. , zfood - min(xthresh,0.5*zfood) ) 
    101                zdenom    = zfoodlim / ( xkgraz + zfoodlim ) 
    102                zdenom2   = zdenom / ( zfood + rtrn ) 
    103                zgraze    = grazrat * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpzoo) * (1. - nitrfac(ji,jj,jk)) 
    104  
    105                zgrazp    = zgraze  * xprefn * zcompaph  * zdenom2  
    106                zgrazm    = zgraze  * xprefc * zcompapoc * zdenom2  
    107                zgrazsd   = zgraze  * xprefd * zcompadi  * zdenom2  
    108  
    109                zgrazpf   = zgrazp  * trb(ji,jj,jk,jpnfe) / (trb(ji,jj,jk,jpphy) + rtrn) 
    110                zgrazmf   = zgrazm  * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn) 
    111                zgrazsf   = zgrazsd * trb(ji,jj,jk,jpdfe) / (trb(ji,jj,jk,jpdia) + rtrn) 
    112                ! 
    113                zgraztotc = zgrazp  + zgrazm  + zgrazsd  
    114                zgraztotf = zgrazpf + zgrazsf + zgrazmf  
    115                zgraztotn = zgrazp * quotan(ji,jj,jk) + zgrazm + zgrazsd * quotad(ji,jj,jk) 
    116  
    117                ! Grazing by microzooplankton 
    118                zgrazing(ji,jj,jk) = zgraztotc 
    119  
    120                !    Various remineralization and excretion terms 
    121                !    -------------------------------------------- 
    122                zgrasrat  = ( zgraztotf + rtrn ) / ( zgraztotc + rtrn ) 
    123                zgrasratn = ( zgraztotn + rtrn ) / ( zgraztotc + rtrn ) 
    124                zepshert  =  MIN( 1., zgrasratn, zgrasrat / ferat3) 
    125                zbeta     = MAX(0., (epsher - epshermin) ) 
    126                zepsherf  = epshermin + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 
    127                zepsherv  = zepsherf * zepshert  
    128  
    129                zgrafer   = zgraztotc * MAX( 0. , ( 1. - unass ) * zgrasrat - ferat3 * zepsherv )  
    130                zgrarem   = zgraztotc * ( 1. - zepsherv - unass ) 
    131                zgrapoc   = zgraztotc * unass 
    132  
    133                !  Update of the TRA arrays 
    134                !  ------------------------ 
    135                zgrarsig  = zgrarem * sigma1 
    136                tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig 
    137                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 
    138                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem - zgrarsig 
    139                ! 
    140                IF( ln_ligand ) THEN 
    141                   tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + (zgrarem - zgrarsig) * ldocz 
    142                   zzligprod(ji,jj,jk) = (zgrarem - zgrarsig) * ldocz 
    143                ENDIF 
    144                ! 
    145                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 
    146                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer 
    147                zfezoo(ji,jj,jk)    = zgrafer 
    148                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc 
    149                prodpoc(ji,jj,jk)   = prodpoc(ji,jj,jk) + zgrapoc 
    150                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zgraztotf * unass 
    151                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig 
    152                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig 
    153                !   Update the arrays TRA which contain the biological sources and sinks 
    154                !   -------------------------------------------------------------------- 
    155                zmortz = ztortz + zrespz 
    156                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz + zepsherv * zgraztotc  
    157                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp 
    158                tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd 
    159                tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp  * trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn) 
    160                tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd * trb(ji,jj,jk,jpdch)/(trb(ji,jj,jk,jpdia)+rtrn) 
    161                tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazsd * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn) 
    162                tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazsd * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn) 
    163                tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgrazpf 
    164                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf 
    165                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm 
    166                prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortz 
    167                conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazm 
    168                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz - zgrazmf 
    169                ! 
    170                ! calcite production 
    171                zprcaca = xfracal(ji,jj,jk) * zgrazp 
    172                prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    173                ! 
    174                zprcaca = part * zprcaca 
    175                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 
    176                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 
    177                tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 
    178             END DO 
    179          END DO 
    180       END DO 
     80      DO_3D_11_11( 1, jpkm1 ) 
     81         zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - 1.e-9 ), 0.e0 ) 
     82         zfact   = xstep * tgfunc2(ji,jj,jk) * zcompaz 
     83 
     84         !  Respiration rates of both zooplankton 
     85         !  ------------------------------------- 
     86         zrespz = resrat * zfact * tr(ji,jj,jk,jpzoo,Kbb) / ( xkmort + tr(ji,jj,jk,jpzoo,Kbb) )  & 
     87            &   + resrat * zfact * 3. * nitrfac(ji,jj,jk) 
     88 
     89         !  Zooplankton mortality. A square function has been selected with 
     90         !  no real reason except that it seems to be more stable and may mimic predation. 
     91         !  --------------------------------------------------------------- 
     92         ztortz = mzrat * 1.e6 * zfact * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk)) 
     93 
     94         zcompadi  = MIN( MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthreshdia ), 0.e0 ), xsizedia ) 
     95         zcompaph  = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthreshphy ), 0.e0 ) 
     96         zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthreshpoc ), 0.e0 ) 
     97          
     98         !     Microzooplankton grazing 
     99         !     ------------------------ 
     100         zfood     = xprefn * zcompaph + xprefc * zcompapoc + xprefd * zcompadi 
     101         zfoodlim  = MAX( 0. , zfood - min(xthresh,0.5*zfood) ) 
     102         zdenom    = zfoodlim / ( xkgraz + zfoodlim ) 
     103         zdenom2   = zdenom / ( zfood + rtrn ) 
     104         zgraze    = grazrat * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk)) 
     105 
     106         zgrazp    = zgraze  * xprefn * zcompaph  * zdenom2  
     107         zgrazm    = zgraze  * xprefc * zcompapoc * zdenom2  
     108         zgrazsd   = zgraze  * xprefd * zcompadi  * zdenom2  
     109 
     110         zgrazpf   = zgrazp  * tr(ji,jj,jk,jpnfe,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
     111         zgrazmf   = zgrazm  * tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
     112         zgrazsf   = zgrazsd * tr(ji,jj,jk,jpdfe,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
     113         ! 
     114         zgraztotc = zgrazp  + zgrazm  + zgrazsd  
     115         zgraztotf = zgrazpf + zgrazsf + zgrazmf  
     116         zgraztotn = zgrazp * quotan(ji,jj,jk) + zgrazm + zgrazsd * quotad(ji,jj,jk) 
     117 
     118         ! Grazing by microzooplankton 
     119         zgrazing(ji,jj,jk) = zgraztotc 
     120 
     121         !    Various remineralization and excretion terms 
     122         !    -------------------------------------------- 
     123         zgrasrat  = ( zgraztotf + rtrn ) / ( zgraztotc + rtrn ) 
     124         zgrasratn = ( zgraztotn + rtrn ) / ( zgraztotc + rtrn ) 
     125         zepshert  =  MIN( 1., zgrasratn, zgrasrat / ferat3) 
     126         zbeta     = MAX(0., (epsher - epshermin) ) 
     127         zepsherf  = epshermin + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 
     128         zepsherv  = zepsherf * zepshert  
     129 
     130         zgrafer   = zgraztotc * MAX( 0. , ( 1. - unass ) * zgrasrat - ferat3 * zepsherv )  
     131         zgrarem   = zgraztotc * ( 1. - zepsherv - unass ) 
     132         zgrapoc   = zgraztotc * unass 
     133 
     134         !  Update of the TRA arrays 
     135         !  ------------------------ 
     136         zgrarsig  = zgrarem * sigma1 
     137         tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarsig 
     138         tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgrarsig 
     139         tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgrarem - zgrarsig 
     140         ! 
     141         IF( ln_ligand ) THEN 
     142            tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + (zgrarem - zgrarsig) * ldocz 
     143            zzligprod(ji,jj,jk) = (zgrarem - zgrarsig) * ldocz 
     144         ENDIF 
     145         ! 
     146         tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarsig 
     147         tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgrafer 
     148         zfezoo(ji,jj,jk)    = zgrafer 
     149         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zgrapoc 
     150         prodpoc(ji,jj,jk)   = prodpoc(ji,jj,jk) + zgrapoc 
     151         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zgraztotf * unass 
     152         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarsig 
     153         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zgrarsig 
     154         !   Update the arrays TRA which contain the biological sources and sinks 
     155         !   -------------------------------------------------------------------- 
     156         zmortz = ztortz + zrespz 
     157         tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) - zmortz + zepsherv * zgraztotc  
     158         tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgrazp 
     159         tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazsd 
     160         tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgrazp  * tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 
     161         tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazsd * tr(ji,jj,jk,jpdch,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 
     162         tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazsd * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 
     163         tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazsd * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 
     164         tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgrazpf 
     165         tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazsf 
     166         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortz - zgrazm 
     167         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortz 
     168         conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazm 
     169         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ferat3 * zmortz - zgrazmf 
     170         ! 
     171         ! calcite production 
     172         zprcaca = xfracal(ji,jj,jk) * zgrazp 
     173         prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
     174         ! 
     175         zprcaca = part * zprcaca 
     176         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprcaca 
     177         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca 
     178         tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca 
     179      END_3D 
    181180      ! 
    182181      IF( lk_iomput .AND. knt == nrdttrc ) THEN 
    183        IF( iom_use("GRAZ1") ) THEN  !   Total grazing of phyto by zooplankton 
     182        IF( iom_use("GRAZ1") ) THEN  !   Total grazing of phyto by zooplankton 
    184183           zgrazing(:,:,jpk) = 0._wp   ; CALL iom_put( "GRAZ1" , zgrazing(:,:,:) * 1.e+3  * rfact2r * tmask(:,:,:) )  
    185184         ENDIF 
    186185         IF( iom_use("FEZOO") ) THEN   
    187            zfezoo (:,:,jpk) = 0._wp    ; CALL iom_put( "FEZOO" , zfezoo(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) ) 
     186           zfezoo (:,:,jpk) = 0._wp    ; CALL iom_put( "FEZOO", zfezoo(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) ) 
    188187         ENDIF 
    189188         IF( ln_ligand ) THEN 
    … …  
    192191      ENDIF 
    193192      ! 
    194       IF(ln_ctl) THEN      ! print mean trends (used for debugging) 
     193      IF(sn_cfctl%l_prttrc) THEN      ! print mean trends (used for debugging) 
    195194         WRITE(charout, FMT="('micro')") 
    196195         CALL prt_ctl_trc_info(charout) 
    197          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     196         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    198197      ENDIF 
    199198      ! 
    … …  
    228227      ENDIF 
    229228      ! 
    230       REWIND( numnatp_ref ) 
    231229      READ  ( numnatp_ref, namp4zzoo, IOSTAT = ios, ERR = 901) 
    232230901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zzoo in reference namelist' ) 
    233  
    234       REWIND( numnatp_cfg ) 
    235231      READ  ( numnatp_cfg, namp4zzoo, IOSTAT = ios, ERR = 902 ) 
    236232902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zzoo in configuration namelist' ) 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zmort.F90

    r11536 r12377  
    2929   REAL(wp), PUBLIC ::   mprat2   !: 
    3030 
     31   !! * Substitutions 
     32#  include "do_loop_substitute.h90" 
    3133   !!---------------------------------------------------------------------- 
    3234   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    3638CONTAINS 
    3739 
    38    SUBROUTINE p4z_mort( kt ) 
     40   SUBROUTINE p4z_mort( kt, Kbb, Krhs ) 
    3941      !!--------------------------------------------------------------------- 
    4042      !!                     ***  ROUTINE p4z_mort  *** 
    … …  
    4648      !!--------------------------------------------------------------------- 
    4749      INTEGER, INTENT(in) ::   kt ! ocean time step 
    48       !!--------------------------------------------------------------------- 
    49       ! 
    50       CALL p4z_nano            ! nanophytoplankton 
    51       ! 
    52       CALL p4z_diat            ! diatoms 
     50      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices 
     51      !!--------------------------------------------------------------------- 
     52      ! 
     53      CALL p4z_nano( Kbb, Krhs )            ! nanophytoplankton 
     54      ! 
     55      CALL p4z_diat( Kbb, Krhs )            ! diatoms 
    5356      ! 
    5457   END SUBROUTINE p4z_mort 
    5558 
    5659 
    57    SUBROUTINE p4z_nano 
     60   SUBROUTINE p4z_nano( Kbb, Krhs ) 
    5861      !!--------------------------------------------------------------------- 
    5962      !!                     ***  ROUTINE p4z_nano  *** 
    … …  
    6366      !! ** Method  : - ??? 
    6467      !!--------------------------------------------------------------------- 
     68      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices 
    6569      INTEGER  ::   ji, jj, jk 
    6670      REAL(wp) ::   zsizerat, zcompaph 
    … …  
    7377      ! 
    7478      prodcal(:,:,:) = 0._wp   ! calcite production variable set to zero 
    75       DO jk = 1, jpkm1 
    76          DO jj = 1, jpj 
    77             DO ji = 1, jpi 
    78                zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 ) 
    79                !     When highly limited by macronutrients, very small cells  
    80                !     dominate the community. As a consequence, aggregation 
    81                !     due to turbulence is negligible. Mortality is also set 
    82                !     to 0 
    83                zsizerat = MIN(1., MAX( 0., (quotan(ji,jj,jk) - 0.2) / 0.3) ) * trb(ji,jj,jk,jpphy) 
    84                !     Squared mortality of Phyto similar to a sedimentation term during 
    85                !     blooms (Doney et al. 1996) 
    86                zrespp = wchl * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * zsizerat  
    87  
    88                !     Phytoplankton mortality. This mortality loss is slightly 
    89                !     increased when nutrients are limiting phytoplankton growth 
    90                !     as observed for instance in case of iron limitation. 
    91                ztortp = mprat * xstep * zcompaph / ( xkmort + trb(ji,jj,jk,jpphy) ) * zsizerat 
    92  
    93                zmortp = zrespp + ztortp 
    94  
    95                !   Update the arrays TRA which contains the biological sources and sinks 
    96  
    97                zfactfe = trb(ji,jj,jk,jpnfe)/(trb(ji,jj,jk,jpphy)+rtrn) 
    98                zfactch = trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn) 
    99                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zmortp 
    100                tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zmortp * zfactch 
    101                tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zmortp * zfactfe 
    102                zprcaca = xfracal(ji,jj,jk) * zmortp 
    103                ! 
    104                prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    105                ! 
    106                zfracal = 0.5 * xfracal(ji,jj,jk) 
    107                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 
    108                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 
    109                tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 
    110                tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfracal * zmortp 
    111                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ( 1. - zfracal ) * zmortp 
    112                prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ( 1. - zfracal ) * zmortp 
    113                prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zfracal * zmortp 
    114                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ( 1. - zfracal ) * zmortp * zfactfe 
    115                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zfracal * zmortp * zfactfe 
    116             END DO 
    117          END DO 
    118       END DO 
    119       ! 
    120        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     79      DO_3D_11_11( 1, jpkm1 ) 
     80         zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-8 ), 0.e0 ) 
     81         !     When highly limited by macronutrients, very small cells  
     82         !     dominate the community. As a consequence, aggregation 
     83         !     due to turbulence is negligible. Mortality is also set 
     84         !     to 0 
     85         zsizerat = MIN(1., MAX( 0., (quotan(ji,jj,jk) - 0.2) / 0.3) ) * tr(ji,jj,jk,jpphy,Kbb) 
     86         !     Squared mortality of Phyto similar to a sedimentation term during 
     87         !     blooms (Doney et al. 1996) 
     88         zrespp = wchl * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * zsizerat  
     89 
     90         !     Phytoplankton mortality. This mortality loss is slightly 
     91         !     increased when nutrients are limiting phytoplankton growth 
     92         !     as observed for instance in case of iron limitation. 
     93         ztortp = mprat * xstep * zcompaph / ( xkmort + tr(ji,jj,jk,jpphy,Kbb) ) * zsizerat 
     94 
     95         zmortp = zrespp + ztortp 
     96 
     97         !   Update the arrays TRA which contains the biological sources and sinks 
     98 
     99         zfactfe = tr(ji,jj,jk,jpnfe,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 
     100         zfactch = tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 
     101         tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zmortp 
     102         tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zmortp * zfactch 
     103         tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zmortp * zfactfe 
     104         zprcaca = xfracal(ji,jj,jk) * zmortp 
     105         ! 
     106         prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
     107         ! 
     108         zfracal = 0.5 * xfracal(ji,jj,jk) 
     109         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprcaca 
     110         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca 
     111         tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca 
     112         tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfracal * zmortp 
     113         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + ( 1. - zfracal ) * zmortp 
     114         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ( 1. - zfracal ) * zmortp 
     115         prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zfracal * zmortp 
     116         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ( 1. - zfracal ) * zmortp * zfactfe 
     117         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zfracal * zmortp * zfactfe 
     118      END_3D 
     119      ! 
     120       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    121121         WRITE(charout, FMT="('nano')") 
    122122         CALL prt_ctl_trc_info(charout) 
    123          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     123         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    124124       ENDIF 
    125125      ! 
    … …  
    129129 
    130130 
    131    SUBROUTINE p4z_diat 
     131   SUBROUTINE p4z_diat( Kbb, Krhs ) 
    132132      !!--------------------------------------------------------------------- 
    133133      !!                     ***  ROUTINE p4z_diat  *** 
    … …  
    137137      !! ** Method  : - ??? 
    138138      !!--------------------------------------------------------------------- 
     139      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices 
    139140      INTEGER  ::   ji, jj, jk 
    140141      REAL(wp) ::   zfactfe,zfactsi,zfactch, zcompadi 
    … …  
    151152      !     ------------------------------------------------------------ 
    152153 
    153       DO jk = 1, jpkm1 
    154          DO jj = 1, jpj 
    155             DO ji = 1, jpi 
    156  
    157                zcompadi = MAX( ( trb(ji,jj,jk,jpdia) - 1e-9), 0. ) 
    158  
    159                !    Aggregation term for diatoms is increased in case of nutrient 
    160                !    stress as observed in reality. The stressed cells become more 
    161                !    sticky and coagulate to sink quickly out of the euphotic zone 
    162                !     ------------------------------------------------------------ 
    163                !  Phytoplankton respiration  
    164                !     ------------------------ 
    165                zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk) 
    166                zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 )  
    167                zrespp2 = 1.e6 * xstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trb(ji,jj,jk,jpdia) 
    168  
    169                !     Phytoplankton mortality.  
    170                !     ------------------------ 
    171                ztortp2 = mprat2 * xstep * trb(ji,jj,jk,jpdia)  / ( xkmort + trb(ji,jj,jk,jpdia) ) * zcompadi  
    172  
    173                zmortp2 = zrespp2 + ztortp2 
    174  
    175                !   Update the arrays tra which contains the biological sources and sinks 
    176                !   --------------------------------------------------------------------- 
    177                zfactch = trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    178                zfactfe = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    179                zfactsi = trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    180                tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zmortp2  
    181                tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zmortp2 * zfactch 
    182                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zmortp2 * zfactfe 
    183                tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zmortp2 * zfactsi 
    184                tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zmortp2 * zfactsi 
    185                tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zrespp2 + 0.5 * ztortp2 
    186                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + 0.5 * ztortp2 
    187                prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + 0.5 * ztortp2 
    188                prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zrespp2 + 0.5 * ztortp2 
    189                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 0.5 * ztortp2 * zfactfe 
    190                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ( zrespp2 + 0.5 * ztortp2 ) * zfactfe 
    191             END DO 
    192          END DO 
    193       END DO 
    194       ! 
    195       IF(ln_ctl) THEN      ! print mean trends (used for debugging) 
     154      DO_3D_11_11( 1, jpkm1 ) 
     155 
     156         zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1e-9), 0. ) 
     157 
     158         !    Aggregation term for diatoms is increased in case of nutrient 
     159         !    stress as observed in reality. The stressed cells become more 
     160         !    sticky and coagulate to sink quickly out of the euphotic zone 
     161         !     ------------------------------------------------------------ 
     162         !  Phytoplankton respiration  
     163         !     ------------------------ 
     164         zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk) 
     165         zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 )  
     166         zrespp2 = 1.e6 * xstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * tr(ji,jj,jk,jpdia,Kbb) 
     167 
     168         !     Phytoplankton mortality.  
     169         !     ------------------------ 
     170         ztortp2 = mprat2 * xstep * tr(ji,jj,jk,jpdia,Kbb)  / ( xkmort + tr(ji,jj,jk,jpdia,Kbb) ) * zcompadi  
     171 
     172         zmortp2 = zrespp2 + ztortp2 
     173 
     174         !   Update the arrays tr(:,:,:,:,Krhs) which contains the biological sources and sinks 
     175         !   --------------------------------------------------------------------- 
     176         zfactch = tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     177         zfactfe = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     178         zfactsi = tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     179         tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zmortp2  
     180         tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zmortp2 * zfactch 
     181         tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zmortp2 * zfactfe 
     182         tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zmortp2 * zfactsi 
     183         tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zmortp2 * zfactsi 
     184         tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zrespp2 + 0.5 * ztortp2 
     185         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + 0.5 * ztortp2 
     186         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + 0.5 * ztortp2 
     187         prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zrespp2 + 0.5 * ztortp2 
     188         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 0.5 * ztortp2 * zfactfe 
     189         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + ( zrespp2 + 0.5 * ztortp2 ) * zfactfe 
     190      END_3D 
     191      ! 
     192      IF(sn_cfctl%l_prttrc) THEN      ! print mean trends (used for debugging) 
    196193         WRITE(charout, FMT="('diat')") 
    197194         CALL prt_ctl_trc_info(charout) 
    198          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     195         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    199196      ENDIF 
    200197      ! 
    … …  
    227224      ENDIF 
    228225      ! 
    229       REWIND( numnatp_ref )              ! Namelist nampismort in reference namelist : Pisces phytoplankton 
    230226      READ  ( numnatp_ref, namp4zmort, IOSTAT = ios, ERR = 901) 
    231227901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zmort in reference namelist' ) 
    232       REWIND( numnatp_cfg )              ! Namelist nampismort in configuration namelist : Pisces phytoplankton 
    233228      READ  ( numnatp_cfg, namp4zmort, IOSTAT = ios, ERR = 902 ) 
    234229902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zmort in configuration namelist' ) 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zopt.F90

    r12276 r12377  
    4242   REAL(wp), DIMENSION(3,61) ::   xkrgb   ! tabulated attenuation coefficients for RGB absorption 
    4343    
     44   !! * Substitutions 
     45#  include "do_loop_substitute.h90" 
    4446   !!---------------------------------------------------------------------- 
    4547   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4951CONTAINS 
    5052 
    51    SUBROUTINE p4z_opt( kt, knt ) 
     53   SUBROUTINE p4z_opt( kt, knt, Kbb, Kmm ) 
    5254      !!--------------------------------------------------------------------- 
    5355      !!                     ***  ROUTINE p4z_opt  *** 
    … …  
    5961      !!--------------------------------------------------------------------- 
    6062      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step 
     63      INTEGER, INTENT(in) ::   Kbb, Kmm  ! time level indices 
    6164      ! 
    6265      INTEGER  ::   ji, jj, jk 
    … …  
    8285      !                                        !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 
    8386      !                                        !  -------------------------------------------------------- 
    84                      zchl3d(:,:,:) = trb(:,:,:,jpnch) + trb(:,:,:,jpdch) 
    85       IF( ln_p5z )   zchl3d(:,:,:) = zchl3d(:,:,:)    + trb(:,:,:,jppch) 
    86       ! 
    87       DO jk = 1, jpkm1    
    88          DO jj = 1, jpj 
    89             DO ji = 1, jpi 
    90                zchl = ( zchl3d(ji,jj,jk) + rtrn ) * 1.e6 
    91                zchl = MIN(  10. , MAX( 0.05, zchl )  ) 
    92                irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 
    93                !                                                          
    94                ekb(ji,jj,jk) = xkrgb(1,irgb) * e3t_n(ji,jj,jk) 
    95                ekg(ji,jj,jk) = xkrgb(2,irgb) * e3t_n(ji,jj,jk) 
    96                ekr(ji,jj,jk) = xkrgb(3,irgb) * e3t_n(ji,jj,jk) 
    97             END DO 
    98          END DO 
    99       END DO 
     87                     zchl3d(:,:,:) = tr(:,:,:,jpnch,Kbb) + tr(:,:,:,jpdch,Kbb) 
     88      IF( ln_p5z )   zchl3d(:,:,:) = zchl3d(:,:,:)    + tr(:,:,:,jppch,Kbb) 
     89      ! 
     90      DO_3D_11_11( 1, jpkm1 ) 
     91         zchl = ( zchl3d(ji,jj,jk) + rtrn ) * 1.e6 
     92         zchl = MIN(  10. , MAX( 0.05, zchl )  ) 
     93         irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 
     94         !                                                          
     95         ekb(ji,jj,jk) = xkrgb(1,irgb) * e3t(ji,jj,jk,Kmm) 
     96         ekg(ji,jj,jk) = xkrgb(2,irgb) * e3t(ji,jj,jk,Kmm) 
     97         ekr(ji,jj,jk) = xkrgb(3,irgb) * e3t(ji,jj,jk,Kmm) 
     98      END_3D 
    10099      !                                        !* Photosynthetically Available Radiation (PAR) 
    101100      !                                        !  -------------------------------------- 
    … …  
    104103         zqsr_corr(:,:) = qsr_mean(:,:) / ( 1.-fr_i(:,:) + rtrn ) 
    105104         ! 
    106          CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 )  
     105         CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 )  
    107106         ! 
    108107         DO jk = 1, nksrp       
    … …  
    119118         zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn ) 
    120119         ! 
    121          CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 )  
     120         CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3 )  
    122121         ! 
    123122         DO jk = 1, nksrp       
    … …  
    129128         zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn ) 
    130129         ! 
    131          CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100  )  
     130         CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100  )  
    132131         ! 
    133132         DO jk = 1, nksrp       
    134             etot (:,:,jk) =         ze1(:,:,jk) +        ze2(:,:,jk) +       ze3(:,:,jk) 
     133            etot (:,:,jk) =        ze1(:,:,jk) +        ze2(:,:,jk) +       ze3(:,:,jk) 
    135134            enano(:,:,jk) =  1.85 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.46 * ze3(:,:,jk) 
    136135            ediat(:,:,jk) =  1.62 * ze1(:,:,jk) + 0.74 * ze2(:,:,jk) + 0.63 * ze3(:,:,jk) 
    … …  
    147146      IF( ln_qsr_bio ) THEN                    !* heat flux accros w-level (used in the dynamics) 
    148147         !                                     !  ------------------------ 
    149          CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3, pe0=ze0 ) 
     148         CALL p4z_opt_par( kt, Kmm, qsr, ze1, ze2, ze3, pe0=ze0 ) 
    150149         ! 
    151150         etot3(:,:,1) =  qsr(:,:) * tmask(:,:,1) 
    … …  
    157156      !                                        !* Euphotic depth and level 
    158157      neln   (:,:) = 1                            !  ------------------------ 
    159       heup   (:,:) = gdepw_n(:,:,2) 
    160       heup_01(:,:) = gdepw_n(:,:,2) 
    161  
    162       DO jk = 2, nksrp 
    163          DO jj = 1, jpj 
    164            DO ji = 1, jpi 
    165               IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >=  zqsr100(ji,jj) )  THEN 
    166                  neln(ji,jj) = jk+1                    ! Euphotic level : 1rst T-level strictly below Euphotic layer 
    167                  !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint 
    168                  heup(ji,jj) = gdepw_n(ji,jj,jk+1)     ! Euphotic layer depth 
    169               ENDIF 
    170               IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.50 )  THEN 
    171                  heup_01(ji,jj) = gdepw_n(ji,jj,jk+1)  ! Euphotic layer depth (light level definition) 
    172               ENDIF 
    173            END DO 
    174         END DO 
    175       END DO 
     158      heup   (:,:) = gdepw(:,:,2,Kmm) 
     159      heup_01(:,:) = gdepw(:,:,2,Kmm) 
     160 
     161      DO_3D_11_11( 2, nksrp ) 
     162        IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >=  zqsr100(ji,jj) )  THEN 
     163           neln(ji,jj) = jk+1                    ! Euphotic level : 1rst T-level strictly below Euphotic layer 
     164           !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint 
     165           heup(ji,jj) = gdepw(ji,jj,jk+1,Kmm)     ! Euphotic layer depth 
     166        ENDIF 
     167        IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.50 )  THEN 
     168           heup_01(ji,jj) = gdepw(ji,jj,jk+1,Kmm)  ! Euphotic layer depth (light level definition) 
     169        ENDIF 
     170      END_3D 
    176171      ! 
    177172      heup   (:,:) = MIN( 300., heup   (:,:) ) 
    … …  
    182177      zetmp2 (:,:)   = 0.e0 
    183178 
    184       DO jk = 1, nksrp 
    185          DO jj = 1, jpj 
    186             DO ji = 1, jpi 
    187                IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    188                   zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * e3t_n(ji,jj,jk) ! remineralisation 
    189                   zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t_n(ji,jj,jk) ! production 
    190                   zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t_n(ji,jj,jk) 
    191                ENDIF 
    192             END DO 
    193          END DO 
    194       END DO 
     179      DO_3D_11_11( 1, nksrp ) 
     180         IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
     181            zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! remineralisation 
     182            zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
     183            zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t(ji,jj,jk,Kmm) 
     184         ENDIF 
     185      END_3D 
    195186      ! 
    196187      emoy(:,:,:) = etot(:,:,:)       ! remineralisation 
    197188      zpar(:,:,:) = etot_ndcy(:,:,:)  ! diagnostic : PAR with no diurnal cycle  
    198189      ! 
    199       DO jk = 1, nksrp 
    200          DO jj = 1, jpj 
    201             DO ji = 1, jpi 
    202                IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    203                   z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
    204                   emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep 
    205                   zpar (ji,jj,jk) = zetmp2(ji,jj) * z1_dep 
    206                ENDIF 
    207             END DO 
    208          END DO 
    209       END DO 
     190      DO_3D_11_11( 1, nksrp ) 
     191         IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
     192            z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
     193            emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep 
     194            zpar (ji,jj,jk) = zetmp2(ji,jj) * z1_dep 
     195         ENDIF 
     196      END_3D 
    210197      ! 
    211198      zdepmoy(:,:)   = 0.e0 
    … …  
    213200      zetmp4 (:,:)   = 0.e0 
    214201      ! 
    215       DO jk = 1, nksrp 
    216          DO jj = 1, jpj 
    217             DO ji = 1, jpi 
    218                IF( gdepw_n(ji,jj,jk+1) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 
    219                   zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * e3t_n(ji,jj,jk) ! production 
    220                   zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat    (ji,jj,jk) * e3t_n(ji,jj,jk) ! production 
    221                   zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t_n(ji,jj,jk) 
    222                ENDIF 
    223             END DO 
    224          END DO 
    225       END DO 
     202      DO_3D_11_11( 1, nksrp ) 
     203         IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 
     204            zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
     205            zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat    (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
     206            zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t(ji,jj,jk,Kmm) 
     207         ENDIF 
     208      END_3D 
    226209      enanom(:,:,:) = enano(:,:,:) 
    227210      ediatm(:,:,:) = ediat(:,:,:) 
    228211      ! 
    229       DO jk = 1, nksrp 
    230          DO jj = 1, jpj 
    231             DO ji = 1, jpi 
    232                IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    233                   z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
    234                   enanom(ji,jj,jk) = zetmp3(ji,jj) * z1_dep 
    235                   ediatm(ji,jj,jk) = zetmp4(ji,jj) * z1_dep 
    236                ENDIF 
    237             END DO 
    238          END DO 
    239       END DO 
     212      DO_3D_11_11( 1, nksrp ) 
     213         IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
     214            z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
     215            enanom(ji,jj,jk) = zetmp3(ji,jj) * z1_dep 
     216            ediatm(ji,jj,jk) = zetmp4(ji,jj) * z1_dep 
     217         ENDIF 
     218      END_3D 
    240219      ! 
    241220      IF( ln_p5z ) THEN 
    242221         ALLOCATE( zetmp5(jpi,jpj) )  ;   zetmp5 (:,:) = 0.e0 
    243          DO jk = 1, nksrp 
    244             DO jj = 1, jpj 
    245                DO ji = 1, jpi 
    246                   IF( gdepw_n(ji,jj,jk+1) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 
    247                      zetmp5(ji,jj)  = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t_n(ji,jj,jk) ! production 
    248                   ENDIF 
    249                END DO 
    250             END DO 
    251          END DO 
     222         DO_3D_11_11( 1, nksrp ) 
     223            IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 
     224               zetmp5(ji,jj)  = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
     225            ENDIF 
     226         END_3D 
    252227         ! 
    253228         epicom(:,:,:) = epico(:,:,:) 
    254229         ! 
    255          DO jk = 1, nksrp 
    256             DO jj = 1, jpj 
    257                DO ji = 1, jpi 
    258                   IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    259                      z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
    260                      epicom(ji,jj,jk) = zetmp5(ji,jj) * z1_dep 
    261                   ENDIF 
    262                END DO 
    263             END DO 
    264          END DO 
     230         DO_3D_11_11( 1, nksrp ) 
     231            IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
     232               z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
     233               epicom(ji,jj,jk) = zetmp5(ji,jj) * z1_dep 
     234            ENDIF 
     235         END_3D 
    265236         DEALLOCATE( zetmp5 ) 
    266237      ENDIF 
    … …  
    277248 
    278249 
    279    SUBROUTINE p4z_opt_par( kt, pqsr, pe1, pe2, pe3, pe0, pqsr100 )  
     250   SUBROUTINE p4z_opt_par( kt, Kmm, pqsr, pe1, pe2, pe3, pe0, pqsr100 )  
    280251      !!---------------------------------------------------------------------- 
    281252      !!                  ***  routine p4z_opt_par  *** 
    … …  
    286257      !!---------------------------------------------------------------------- 
    287258      INTEGER                         , INTENT(in)              ::   kt                ! ocean time-step 
     259      INTEGER                         , INTENT(in)              ::   Kmm               ! ocean time-index 
    288260      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in   )           ::   pqsr              ! shortwave 
    289261      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pe1 , pe2 , pe3   ! PAR ( R-G-B) 
    … …  
    313285            DO jj = 1, jpj 
    314286               DO ji = 1, jpi 
    315                   pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t_n(ji,jj,jk-1) * xsi0r ) 
     287                  pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t(ji,jj,jk-1,Kmm) * xsi0r ) 
    316288                  pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb  (ji,jj,jk-1 )        ) 
    317289                  pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg  (ji,jj,jk-1 )        ) 
    … …  
    329301        pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) ) 
    330302        ! 
    331         DO jk = 2, nksrp       
    332            DO jj = 1, jpj 
    333               DO ji = 1, jpi 
    334                  pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) 
    335                  pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) ) 
    336                  pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) ) 
    337               END DO 
    338            END DO 
    339         END DO     
     303        DO_3D_11_11( 2, nksrp ) 
     304           pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) 
     305           pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) ) 
     306           pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) ) 
     307        END_3D 
    340308        ! 
    341309      ENDIF 
    … …  
    398366         WRITE(numout,*) '~~~~~~~~~~~~ ' 
    399367      ENDIF 
    400  
    401       REWIND( numnatp_ref ) 
    402368      READ  ( numnatp_ref, nampisopt, IOSTAT = ios, ERR = 901) 
    403369901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisopt in reference namelist' ) 
    404  
    405       REWIND( numnatp_cfg ) 
    406370      READ  ( numnatp_cfg, nampisopt, IOSTAT = ios, ERR = 902 ) 
    407371902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisopt in configuration namelist' ) 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zpoc.F90

    r11536 r12377  
    3737 
    3838 
     39   !! * Substitutions 
     40#  include "do_loop_substitute.h90" 
    3941   !!---------------------------------------------------------------------- 
    4042   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4446CONTAINS 
    4547 
    46    SUBROUTINE p4z_poc( kt, knt ) 
     48   SUBROUTINE p4z_poc( kt, knt, Kbb, Kmm, Krhs ) 
    4749      !!--------------------------------------------------------------------- 
    4850      !!                     ***  ROUTINE p4z_poc  *** 
    … …  
    5254      !! ** Method  : - ??? 
    5355      !!--------------------------------------------------------------------- 
    54       INTEGER, INTENT(in) ::   kt, knt   ! ocean time step and ??? 
     56      INTEGER, INTENT(in) ::   kt, knt         ! ocean time step and ??? 
     57      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices 
    5558      ! 
    5659      INTEGER  ::   ji, jj, jk, jn 
    … …  
    103106     ! ----------------------------------------------------------------------- 
    104107     ztremint(:,:,:) = zremigoc(:,:,:) 
    105      DO jk = 2, jpkm1 
    106         DO jj = 1, jpj 
    107            DO ji = 1, jpi 
    108               IF (tmask(ji,jj,jk) == 1.) THEN 
    109                 zdep = hmld(ji,jj) 
    110                 ! 
    111                 ! In the case of GOC, lability is constant in the mixed layer  
    112                 ! It is computed only below the mixed layer depth 
    113                 ! ------------------------------------------------------------ 
    114                 ! 
    115                 IF( gdept_n(ji,jj,jk) > zdep ) THEN 
    116                   alphat = 0. 
    117                   remint = 0. 
    118                   ! 
    119                   zsizek1  = e3t_n(ji,jj,jk-1) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 
    120                   zsizek = e3t_n(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 
    121                   ! 
    122                   IF ( gdept_n(ji,jj,jk-1) <= zdep ) THEN 
    123                     !  
    124                     ! The first level just below the mixed layer needs a  
    125                     ! specific treatment because lability is supposed constant 
    126                     ! everywhere within the mixed layer. This means that  
    127                     ! change in lability in the bottom part of the previous cell 
    128                     ! should not be computed 
    129                     ! ---------------------------------------------------------- 
    130                     ! 
    131                     ! POC concentration is computed using the lagrangian  
    132                     ! framework. It is only used for the lability param 
    133                     zpoc = trb(ji,jj,jk-1,jpgoc) + consgoc(ji,jj,jk) * rday / rfact2               & 
    134                     &   * e3t_n(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn) 
    135                     zpoc = MAX(0., zpoc) 
    136                     ! 
    137                     DO jn = 1, jcpoc 
    138                        ! 
    139                        ! Lagrangian based algorithm. The fraction of each  
    140                        ! lability class is computed starting from the previous 
    141                        ! level 
    142                        ! ----------------------------------------------------- 
    143                        ! 
    144                        ! the concentration of each lability class is calculated 
    145                        ! as the sum of the different sources and sinks 
    146                        ! Please note that production of new GOC experiences 
    147                        ! degradation  
    148                        alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc & 
    149                        &   + prodgoc(ji,jj,jk) * alphan(jn) / tgfunc(ji,jj,jk) / reminp(jn)             & 
    150                        &   * ( 1. - exp( -reminp(jn) * zsizek ) ) * rday / rfact2  
    151                        alphat = alphat + alphag(ji,jj,jk,jn) 
    152                        remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) 
    153                     END DO 
    154                   ELSE 
    155                     ! 
    156                     ! standard algorithm in the rest of the water column 
    157                     ! See the comments in the previous block. 
    158                     ! --------------------------------------------------- 
    159                     ! 
    160                     zpoc = trb(ji,jj,jk-1,jpgoc) + consgoc(ji,jj,jk-1) * rday / rfact2               & 
    161                     &   * e3t_n(ji,jj,jk-1) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) + consgoc(ji,jj,jk)   & 
    162                     &   * rday / rfact2 * e3t_n(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn) 
    163                     zpoc = max(0., zpoc) 
    164                     ! 
    165                     DO jn = 1, jcpoc 
    166                        alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * ( zsizek              & 
    167                        &   + zsizek1 ) ) * zpoc + ( prodgoc(ji,jj,jk-1) / tgfunc(ji,jj,jk-1) * ( 1.           & 
    168                        &   - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn) * zsizek ) + prodgoc(ji,jj,jk) & 
    169                        &   / tgfunc(ji,jj,jk) * ( 1. - exp( -reminp(jn) * zsizek ) ) ) * rday / rfact2 / reminp(jn) * alphan(jn)  
    170                        alphat = alphat + alphag(ji,jj,jk,jn) 
    171                        remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) 
    172                     END DO 
    173                   ENDIF 
    174                   ! 
    175                   DO jn = 1, jcpoc 
    176                      ! The contribution of each lability class at the current 
    177                      ! level is computed 
    178                      alphag(ji,jj,jk,jn) = alphag(ji,jj,jk,jn) / ( alphat + rtrn) 
    179                   END DO 
    180                   ! Computation of the mean remineralisation rate 
    181                   ztremint(ji,jj,jk) =  MAX(0., remint / ( alphat + rtrn) ) 
    182                   ! 
    183                 ENDIF 
    184               ENDIF 
     108     DO_3D_11_11( 2, jpkm1 ) 
     109        IF (tmask(ji,jj,jk) == 1.) THEN 
     110          zdep = hmld(ji,jj) 
     111          ! 
     112          ! In the case of GOC, lability is constant in the mixed layer  
     113          ! It is computed only below the mixed layer depth 
     114          ! ------------------------------------------------------------ 
     115          ! 
     116          IF( gdept(ji,jj,jk,Kmm) > zdep ) THEN 
     117            alphat = 0. 
     118            remint = 0. 
     119            ! 
     120            zsizek1  = e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 
     121            zsizek = e3t(ji,jj,jk,Kmm) / 2. / (wsbio4(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 
     122            ! 
     123            IF ( gdept(ji,jj,jk-1,Kmm) <= zdep ) THEN 
     124              !  
     125              ! The first level just below the mixed layer needs a  
     126              ! specific treatment because lability is supposed constant 
     127              ! everywhere within the mixed layer. This means that  
     128              ! change in lability in the bottom part of the previous cell 
     129              ! should not be computed 
     130              ! ---------------------------------------------------------- 
     131              ! 
     132              ! POC concentration is computed using the lagrangian  
     133              ! framework. It is only used for the lability param 
     134              zpoc = tr(ji,jj,jk-1,jpgoc,Kbb) + consgoc(ji,jj,jk) * rday / rfact2               & 
     135              &   * e3t(ji,jj,jk,Kmm) / 2. / (wsbio4(ji,jj,jk) + rtrn) 
     136              zpoc = MAX(0., zpoc) 
     137              ! 
     138              DO jn = 1, jcpoc 
     139                 ! 
     140                 ! Lagrangian based algorithm. The fraction of each  
     141                 ! lability class is computed starting from the previous 
     142                 ! level 
     143                 ! ----------------------------------------------------- 
     144                 ! 
     145                 ! the concentration of each lability class is calculated 
     146                 ! as the sum of the different sources and sinks 
     147                 ! Please note that production of new GOC experiences 
     148                 ! degradation  
     149                 alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc & 
     150                 &   + prodgoc(ji,jj,jk) * alphan(jn) / tgfunc(ji,jj,jk) / reminp(jn)             & 
     151                 &   * ( 1. - exp( -reminp(jn) * zsizek ) ) * rday / rfact2  
     152                 alphat = alphat + alphag(ji,jj,jk,jn) 
     153                 remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) 
     154              END DO 
     155            ELSE 
     156              ! 
     157              ! standard algorithm in the rest of the water column 
     158              ! See the comments in the previous block. 
     159              ! --------------------------------------------------- 
     160              ! 
     161              zpoc = tr(ji,jj,jk-1,jpgoc,Kbb) + consgoc(ji,jj,jk-1) * rday / rfact2               & 
     162              &   * e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) + consgoc(ji,jj,jk)   & 
     163              &   * rday / rfact2 * e3t(ji,jj,jk,Kmm) / 2. / (wsbio4(ji,jj,jk) + rtrn) 
     164              zpoc = max(0., zpoc) 
     165              ! 
     166              DO jn = 1, jcpoc 
     167                 alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * ( zsizek              & 
     168                 &   + zsizek1 ) ) * zpoc + ( prodgoc(ji,jj,jk-1) / tgfunc(ji,jj,jk-1) * ( 1.           & 
     169                 &   - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn) * zsizek ) + prodgoc(ji,jj,jk) & 
     170                 &   / tgfunc(ji,jj,jk) * ( 1. - exp( -reminp(jn) * zsizek ) ) ) * rday / rfact2 / reminp(jn) * alphan(jn)  
     171                 alphat = alphat + alphag(ji,jj,jk,jn) 
     172                 remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) 
     173              END DO 
     174            ENDIF 
     175            ! 
     176            DO jn = 1, jcpoc 
     177               ! The contribution of each lability class at the current 
     178               ! level is computed 
     179               alphag(ji,jj,jk,jn) = alphag(ji,jj,jk,jn) / ( alphat + rtrn) 
    185180            END DO 
    186          END DO 
    187       END DO 
     181            ! Computation of the mean remineralisation rate 
     182            ztremint(ji,jj,jk) =  MAX(0., remint / ( alphat + rtrn) ) 
     183            ! 
     184          ENDIF 
     185        ENDIF 
     186     END_3D 
    188187 
    189188      IF( ln_p4z ) THEN   ;   zremigoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 
    … …  
    192191 
    193192      IF( ln_p4z ) THEN 
    194          DO jk = 1, jpkm1 
    195             DO jj = 1, jpj 
    196                DO ji = 1, jpi 
    197                   ! POC disaggregation by turbulence and bacterial activity.  
    198                   ! -------------------------------------------------------- 
    199                   zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
    200                   zorem2  = zremig * trb(ji,jj,jk,jpgoc) 
    201                   orem(ji,jj,jk)      = zorem2 
    202                   zorem3(ji,jj,jk) = zremig * solgoc * trb(ji,jj,jk,jpgoc) 
    203                   zofer2 = zremig * trb(ji,jj,jk,jpbfe) 
    204                   zofer3 = zremig * solgoc * trb(ji,jj,jk,jpbfe) 
    205  
    206                   ! ------------------------------------- 
    207                   tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zorem3(ji,jj,jk) 
    208                   tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zorem2 - zorem3(ji,jj,jk) 
    209                   tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zofer3 
    210                   tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zofer2 - zofer3 
    211                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem2 
    212                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer2 
    213                   zfolimi(ji,jj,jk)   = zofer2 
    214                END DO 
    215             END DO 
    216          END DO 
     193         DO_3D_11_11( 1, jpkm1 ) 
     194            ! POC disaggregation by turbulence and bacterial activity.  
     195            ! -------------------------------------------------------- 
     196            zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
     197            zorem2  = zremig * tr(ji,jj,jk,jpgoc,Kbb) 
     198            orem(ji,jj,jk)      = zorem2 
     199            zorem3(ji,jj,jk) = zremig * solgoc * tr(ji,jj,jk,jpgoc,Kbb) 
     200            zofer2 = zremig * tr(ji,jj,jk,jpbfe,Kbb) 
     201            zofer3 = zremig * solgoc * tr(ji,jj,jk,jpbfe,Kbb) 
     202 
     203            ! ------------------------------------- 
     204            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zorem3(ji,jj,jk) 
     205            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) - zorem2 - zorem3(ji,jj,jk) 
     206            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zofer3 
     207            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zofer2 - zofer3 
     208            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zorem2 
     209            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer2 
     210            zfolimi(ji,jj,jk)   = zofer2 
     211         END_3D 
    217212      ELSE 
    218          DO jk = 1, jpkm1 
    219             DO jj = 1, jpj 
    220                DO ji = 1, jpi 
    221                    ! POC disaggregation by turbulence and bacterial activity.  
    222                   ! -------------------------------------------------------- 
    223                   zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
    224                   zopoc2 = zremig  * trb(ji,jj,jk,jpgoc) 
    225                   orem(ji,jj,jk) = zopoc2 
    226                   zorem3(ji,jj,jk) = zremig * solgoc * trb(ji,jj,jk,jpgoc) 
    227                   zopon2 = xremipn / xremipc * zremig * trb(ji,jj,jk,jpgon) 
    228                   zopop2 = xremipp / xremipc * zremig * trb(ji,jj,jk,jpgop) 
    229                   zofer2 = xremipn / xremipc * zremig * trb(ji,jj,jk,jpbfe) 
    230  
    231                   ! ------------------------------------- 
    232                   tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zorem3(ji,jj,jk) 
    233                   tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + solgoc * zopon2  
    234                   tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + solgoc * zopop2 
    235                   tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + solgoc * zofer2 
    236                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zopoc2 
    237                   tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zopon2 
    238                   tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zopop2 
    239                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer2 
    240                   tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zopoc2 - zorem3(ji,jj,jk) 
    241                   tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) - zopon2 * (1. + solgoc) 
    242                   tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) - zopop2 * (1. + solgoc) 
    243                   tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zofer2 * (1. + solgoc) 
    244                   zfolimi(ji,jj,jk)   = zofer2 
    245                END DO 
    246             END DO 
    247          END DO 
     213         DO_3D_11_11( 1, jpkm1 ) 
     214             ! POC disaggregation by turbulence and bacterial activity.  
     215            ! -------------------------------------------------------- 
     216            zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
     217            zopoc2 = zremig  * tr(ji,jj,jk,jpgoc,Kbb) 
     218            orem(ji,jj,jk) = zopoc2 
     219            zorem3(ji,jj,jk) = zremig * solgoc * tr(ji,jj,jk,jpgoc,Kbb) 
     220            zopon2 = xremipn / xremipc * zremig * tr(ji,jj,jk,jpgon,Kbb) 
     221            zopop2 = xremipp / xremipc * zremig * tr(ji,jj,jk,jpgop,Kbb) 
     222            zofer2 = xremipn / xremipc * zremig * tr(ji,jj,jk,jpbfe,Kbb) 
     223 
     224            ! ------------------------------------- 
     225            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zorem3(ji,jj,jk) 
     226            tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + solgoc * zopon2  
     227            tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + solgoc * zopop2 
     228            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + solgoc * zofer2 
     229            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zopoc2 
     230            tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zopon2 
     231            tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zopop2 
     232            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer2 
     233            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) - zopoc2 - zorem3(ji,jj,jk) 
     234            tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) - zopon2 * (1. + solgoc) 
     235            tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) - zopop2 * (1. + solgoc) 
     236            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zofer2 * (1. + solgoc) 
     237            zfolimi(ji,jj,jk)   = zofer2 
     238         END_3D 
    248239      ENDIF 
    249240 
    250      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     241     IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    251242        WRITE(charout, FMT="('poc1')") 
    252243        CALL prt_ctl_trc_info(charout) 
    253         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     244        CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    254245     ENDIF 
    255246 
    … …  
    268259     ! ---------------------------------------------------------------- 
    269260     !  
    270      DO jk = 1, jpkm1 
    271         DO jj = 1, jpj 
    272            DO ji = 1, jpi 
    273               zdep = hmld(ji,jj) 
    274               IF (tmask(ji,jj,jk) == 1. .AND. gdept_n(ji,jj,jk) <= zdep ) THEN 
    275                 totprod(ji,jj) = totprod(ji,jj) + prodpoc(ji,jj,jk) * e3t_n(ji,jj,jk) * rday/ rfact2 
    276                 ! The temperature effect is included here 
    277                 totthick(ji,jj) = totthick(ji,jj) + e3t_n(ji,jj,jk)* tgfunc(ji,jj,jk) 
    278                 totcons(ji,jj) = totcons(ji,jj) - conspoc(ji,jj,jk) * e3t_n(ji,jj,jk) * rday/ rfact2    & 
    279                 &                / ( trb(ji,jj,jk,jppoc) + rtrn ) 
    280               ENDIF 
    281            END DO 
    282         END DO 
    283      END DO 
     261     DO_3D_11_11( 1, jpkm1 ) 
     262        zdep = hmld(ji,jj) 
     263        IF (tmask(ji,jj,jk) == 1. .AND. gdept(ji,jj,jk,Kmm) <= zdep ) THEN 
     264          totprod(ji,jj) = totprod(ji,jj) + prodpoc(ji,jj,jk) * e3t(ji,jj,jk,Kmm) * rday/ rfact2 
     265          ! The temperature effect is included here 
     266          totthick(ji,jj) = totthick(ji,jj) + e3t(ji,jj,jk,Kmm)* tgfunc(ji,jj,jk) 
     267          totcons(ji,jj) = totcons(ji,jj) - conspoc(ji,jj,jk) * e3t(ji,jj,jk,Kmm) * rday/ rfact2    & 
     268          &                / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 
     269        ENDIF 
     270     END_3D 
    284271 
    285272     ! Computation of the lability spectrum in the mixed layer. In the mixed  
    … …  
    287274     ! --------------------------------------------------------------------- 
    288275     ztremint(:,:,:) = zremipoc(:,:,:) 
    289      DO jk = 1, jpkm1 
    290         DO jj = 1, jpj 
    291            DO ji = 1, jpi 
    292               IF (tmask(ji,jj,jk) == 1.) THEN 
    293                 zdep = hmld(ji,jj) 
    294                 alphat = 0.0 
    295                 remint = 0.0 
    296                 IF( gdept_n(ji,jj,jk) <= zdep ) THEN 
    297                    DO jn = 1, jcpoc 
    298                       ! For each lability class, the system is supposed to be  
    299                       ! at equilibrium: Prod - Sink - w alphap = 0. 
    300                       alphap(ji,jj,jk,jn) = totprod(ji,jj) * alphan(jn) / ( reminp(jn)    & 
    301                       &                     * totthick(ji,jj) + totcons(ji,jj) + wsbio + rtrn ) 
    302                       alphat = alphat + alphap(ji,jj,jk,jn) 
    303                    END DO 
    304                    DO jn = 1, jcpoc 
    305                       alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 
    306                       remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 
    307                    END DO 
    308                    ! Mean remineralization rate in the mixed layer 
    309                    ztremint(ji,jj,jk) =  MAX( 0., remint ) 
    310                 ENDIF 
    311               ENDIF 
    312            END DO 
    313         END DO 
    314      END DO 
     276     DO_3D_11_11( 1, jpkm1 ) 
     277        IF (tmask(ji,jj,jk) == 1.) THEN 
     278          zdep = hmld(ji,jj) 
     279          alphat = 0.0 
     280          remint = 0.0 
     281          IF( gdept(ji,jj,jk,Kmm) <= zdep ) THEN 
     282             DO jn = 1, jcpoc 
     283                ! For each lability class, the system is supposed to be  
     284                ! at equilibrium: Prod - Sink - w alphap = 0. 
     285                alphap(ji,jj,jk,jn) = totprod(ji,jj) * alphan(jn) / ( reminp(jn)    & 
     286                &                     * totthick(ji,jj) + totcons(ji,jj) + wsbio + rtrn ) 
     287                alphat = alphat + alphap(ji,jj,jk,jn) 
     288             END DO 
     289             DO jn = 1, jcpoc 
     290                alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 
     291                remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 
     292             END DO 
     293             ! Mean remineralization rate in the mixed layer 
     294             ztremint(ji,jj,jk) =  MAX( 0., remint ) 
     295          ENDIF 
     296        ENDIF 
     297     END_3D 
    315298     ! 
    316299     IF( ln_p4z ) THEN   ;  zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 
    … …  
    326309     ! ----------------------------------------------------------------------- 
    327310     ! 
    328      DO jk = 2, jpkm1 
    329         DO jj = 1, jpj 
    330            DO ji = 1, jpi 
    331               IF (tmask(ji,jj,jk) == 1.) THEN 
    332                 zdep = hmld(ji,jj) 
    333                 IF( gdept_n(ji,jj,jk) > zdep ) THEN 
    334                   alphat = 0. 
    335                   remint = 0. 
    336                   ! 
    337                   ! the scale factors are corrected with temperature 
    338                   zsizek1  = e3t_n(ji,jj,jk-1) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 
    339                   zsizek = e3t_n(ji,jj,jk) / 2. / (wsbio3(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 
    340                   ! 
    341                   ! Special treatment of the level just below the MXL 
    342                   ! See the comments in the GOC section 
    343                   ! --------------------------------------------------- 
    344                   ! 
    345                   IF ( gdept_n(ji,jj,jk-1) <= zdep ) THEN 
    346                     ! 
    347                     ! Computation of the POC concentration using the  
    348                     ! lagrangian algorithm 
    349                     zpoc = trb(ji,jj,jk-1,jppoc) + conspoc(ji,jj,jk) * rday / rfact2               & 
    350                     &   * e3t_n(ji,jj,jk) / 2. / (wsbio3(ji,jj,jk) + rtrn) 
    351                     zpoc = max(0., zpoc) 
    352                     !  
    353                     DO jn = 1, jcpoc 
    354                        ! computation of the lability spectrum applying the  
    355                        ! different sources and sinks 
    356                        alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc  & 
    357                        &   + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk) * alphag(ji,jj,jk,jn) ) & 
    358                        &   / tgfunc(ji,jj,jk) / reminp(jn) * rday / rfact2 * ( 1. - exp( -reminp(jn)     & 
    359                        &   * zsizek ) ) 
    360                        alphap(ji,jj,jk,jn) = MAX( 0., alphap(ji,jj,jk,jn) ) 
    361                        alphat = alphat + alphap(ji,jj,jk,jn) 
    362                     END DO 
    363                   ELSE 
    364                     ! 
    365                     ! Lability parameterization for the interior of the ocean 
    366                     ! This is very similar to what is done in the previous  
    367                     ! block 
    368                     ! -------------------------------------------------------- 
    369                     ! 
    370                     zpoc = trb(ji,jj,jk-1,jppoc) + conspoc(ji,jj,jk-1) * rday / rfact2               & 
    371                     &   * e3t_n(ji,jj,jk-1) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) + conspoc(ji,jj,jk)   & 
    372                     &   * rday / rfact2 * e3t_n(ji,jj,jk) / 2. / (wsbio3(ji,jj,jk) + rtrn) 
    373                     zpoc = max(0., zpoc) 
    374                     ! 
    375                     DO jn = 1, jcpoc 
    376                        alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn)                       & 
    377                        &   * ( zsizek + zsizek1 ) ) * zpoc + ( prodpoc(ji,jj,jk-1) * alphan(jn)             &  
    378                        &   + zorem3(ji,jj,jk-1) * alphag(ji,jj,jk-1,jn) ) * rday / rfact2 / reminp(jn)      & 
    379                        &   / tgfunc(ji,jj,jk-1) * ( 1. - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn)  & 
    380                        &   * zsizek ) + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk)                 & 
    381                        &   * alphag(ji,jj,jk,jn) ) * rday / rfact2 / reminp(jn) / tgfunc(ji,jj,jk) * ( 1.   & 
    382                        &   - exp( -reminp(jn) * zsizek ) ) 
    383                        alphap(ji,jj,jk,jn) = max(0., alphap(ji,jj,jk,jn) ) 
    384                        alphat = alphat + alphap(ji,jj,jk,jn) 
    385                     END DO 
    386                   ENDIF 
    387                   ! Normalization of the lability spectrum so that the  
    388                   ! integral is equal to 1 
    389                   DO jn = 1, jcpoc 
    390                      alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 
    391                      remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 
    392                   END DO 
    393                   ! Mean remineralization rate in the water column 
    394                   ztremint(ji,jj,jk) =  MAX( 0., remint ) 
    395                 ENDIF 
    396               ENDIF 
     311     DO_3D_11_11( 2, jpkm1 ) 
     312        IF (tmask(ji,jj,jk) == 1.) THEN 
     313          zdep = hmld(ji,jj) 
     314          IF( gdept(ji,jj,jk,Kmm) > zdep ) THEN 
     315            alphat = 0. 
     316            remint = 0. 
     317            ! 
     318            ! the scale factors are corrected with temperature 
     319            zsizek1  = e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 
     320            zsizek = e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 
     321            ! 
     322            ! Special treatment of the level just below the MXL 
     323            ! See the comments in the GOC section 
     324            ! --------------------------------------------------- 
     325            ! 
     326            IF ( gdept(ji,jj,jk-1,Kmm) <= zdep ) THEN 
     327              ! 
     328              ! Computation of the POC concentration using the  
     329              ! lagrangian algorithm 
     330              zpoc = tr(ji,jj,jk-1,jppoc,Kbb) + conspoc(ji,jj,jk) * rday / rfact2               & 
     331              &   * e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn) 
     332              zpoc = max(0., zpoc) 
     333              !  
     334              DO jn = 1, jcpoc 
     335                 ! computation of the lability spectrum applying the  
     336                 ! different sources and sinks 
     337                 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc  & 
     338                 &   + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk) * alphag(ji,jj,jk,jn) ) & 
     339                 &   / tgfunc(ji,jj,jk) / reminp(jn) * rday / rfact2 * ( 1. - exp( -reminp(jn)     & 
     340                 &   * zsizek ) ) 
     341                 alphap(ji,jj,jk,jn) = MAX( 0., alphap(ji,jj,jk,jn) ) 
     342                 alphat = alphat + alphap(ji,jj,jk,jn) 
     343              END DO 
     344            ELSE 
     345              ! 
     346              ! Lability parameterization for the interior of the ocean 
     347              ! This is very similar to what is done in the previous  
     348              ! block 
     349              ! -------------------------------------------------------- 
     350              ! 
     351              zpoc = tr(ji,jj,jk-1,jppoc,Kbb) + conspoc(ji,jj,jk-1) * rday / rfact2               & 
     352              &   * e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) + conspoc(ji,jj,jk)   & 
     353              &   * rday / rfact2 * e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn) 
     354              zpoc = max(0., zpoc) 
     355              ! 
     356              DO jn = 1, jcpoc 
     357                 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn)                       & 
     358                 &   * ( zsizek + zsizek1 ) ) * zpoc + ( prodpoc(ji,jj,jk-1) * alphan(jn)             &  
     359                 &   + zorem3(ji,jj,jk-1) * alphag(ji,jj,jk-1,jn) ) * rday / rfact2 / reminp(jn)      & 
     360                 &   / tgfunc(ji,jj,jk-1) * ( 1. - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn)  & 
     361                 &   * zsizek ) + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk)                 & 
     362                 &   * alphag(ji,jj,jk,jn) ) * rday / rfact2 / reminp(jn) / tgfunc(ji,jj,jk) * ( 1.   & 
     363                 &   - exp( -reminp(jn) * zsizek ) ) 
     364                 alphap(ji,jj,jk,jn) = max(0., alphap(ji,jj,jk,jn) ) 
     365                 alphat = alphat + alphap(ji,jj,jk,jn) 
     366              END DO 
     367            ENDIF 
     368            ! Normalization of the lability spectrum so that the  
     369            ! integral is equal to 1 
     370            DO jn = 1, jcpoc 
     371               alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 
     372               remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 
    397373            END DO 
    398          END DO 
    399       END DO 
     374            ! Mean remineralization rate in the water column 
     375            ztremint(ji,jj,jk) =  MAX( 0., remint ) 
     376          ENDIF 
     377        ENDIF 
     378     END_3D 
    400379 
    401380     IF( ln_p4z ) THEN   ;   zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 
    … …  
    404383 
    405384     IF( ln_p4z ) THEN 
    406          DO jk = 1, jpkm1 
    407             DO jj = 1, jpj 
    408                DO ji = 1, jpi 
    409                   IF (tmask(ji,jj,jk) == 1.) THEN 
    410                     ! POC disaggregation by turbulence and bacterial activity.  
    411                     ! -------------------------------------------------------- 
    412                     zremip          = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
    413                     zorem           = zremip * trb(ji,jj,jk,jppoc) 
    414                     zofer           = zremip * trb(ji,jj,jk,jpsfe) 
    415  
    416                     tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem 
    417                     orem(ji,jj,jk)      = orem(ji,jj,jk) + zorem 
    418                     tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer 
    419                     tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zorem 
    420                     tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zofer 
    421                     zfolimi(ji,jj,jk)   = zfolimi(ji,jj,jk) + zofer 
    422                   ENDIF 
    423                END DO 
    424             END DO 
    425          END DO 
     385         DO_3D_11_11( 1, jpkm1 ) 
     386            IF (tmask(ji,jj,jk) == 1.) THEN 
     387              ! POC disaggregation by turbulence and bacterial activity.  
     388              ! -------------------------------------------------------- 
     389              zremip          = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
     390              zorem           = zremip * tr(ji,jj,jk,jppoc,Kbb) 
     391              zofer           = zremip * tr(ji,jj,jk,jpsfe,Kbb) 
     392 
     393              tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zorem 
     394              orem(ji,jj,jk)      = orem(ji,jj,jk) + zorem 
     395              tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer 
     396              tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zorem 
     397              tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zofer 
     398              zfolimi(ji,jj,jk)   = zfolimi(ji,jj,jk) + zofer 
     399            ENDIF 
     400         END_3D 
    426401     ELSE 
    427        DO jk = 1, jpkm1 
    428           DO jj = 1, jpj 
    429              DO ji = 1, jpi 
    430                 ! POC disaggregation by turbulence and bacterial activity.  
    431                 ! -------------------------------------------------------- 
    432                 zremip = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
    433                 zopoc  = zremip * trb(ji,jj,jk,jppoc) 
    434                 orem(ji,jj,jk)  = orem(ji,jj,jk) + zopoc 
    435                 zopon  = xremipn / xremipc * zremip * trb(ji,jj,jk,jppon) 
    436                 zopop  = xremipp / xremipc * zremip * trb(ji,jj,jk,jppop) 
    437                 zofer  = xremipn / xremipc * zremip * trb(ji,jj,jk,jpsfe) 
    438  
    439                 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zopoc 
    440                 tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) - zopon 
    441                 tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) - zopop 
    442                 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zofer 
    443                 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zopoc 
    444                 tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zopon  
    445                 tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zopop  
    446                 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer  
    447                 zfolimi(ji,jj,jk)   = zfolimi(ji,jj,jk) + zofer 
    448              END DO 
    449            END DO 
    450         END DO 
     402       DO_3D_11_11( 1, jpkm1 ) 
     403          ! POC disaggregation by turbulence and bacterial activity.  
     404          ! -------------------------------------------------------- 
     405          zremip = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
     406          zopoc  = zremip * tr(ji,jj,jk,jppoc,Kbb) 
     407          orem(ji,jj,jk)  = orem(ji,jj,jk) + zopoc 
     408          zopon  = xremipn / xremipc * zremip * tr(ji,jj,jk,jppon,Kbb) 
     409          zopop  = xremipp / xremipc * zremip * tr(ji,jj,jk,jppop,Kbb) 
     410          zofer  = xremipn / xremipc * zremip * tr(ji,jj,jk,jpsfe,Kbb) 
     411 
     412          tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zopoc 
     413          tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) - zopon 
     414          tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) - zopop 
     415          tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zofer 
     416          tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zopoc 
     417          tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zopon  
     418          tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zopop  
     419          tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer  
     420          zfolimi(ji,jj,jk)   = zfolimi(ji,jj,jk) + zofer 
     421       END_3D 
    451422     ENDIF 
    452423 
    … …  
    460431     ENDIF 
    461432 
    462       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     433      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    463434         WRITE(charout, FMT="('poc2')") 
    464435         CALL prt_ctl_trc_info(charout) 
    465          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     436         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    466437      ENDIF 
    467438      ! 
    … …  
    497468      ENDIF 
    498469      ! 
    499       REWIND( numnatp_ref )              ! Namelist nampisrem in reference namelist : Pisces remineralization 
    500470      READ  ( numnatp_ref, nampispoc, IOSTAT = ios, ERR = 901) 
    501471901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampispoc in reference namelist' ) 
    502       REWIND( numnatp_cfg )              ! Namelist nampisrem in configuration namelist : Pisces remineralization 
    503472      READ  ( numnatp_cfg, nampispoc, IOSTAT = ios, ERR = 902 ) 
    504473902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampispoc in configuration namelist' ) 

  • 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' ) 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zrem.F90

    r12276 r12377  
    4242   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitr   !: denitrification array 
    4343 
     44   !! * Substitutions 
     45#  include "do_loop_substitute.h90" 
    4446   !!---------------------------------------------------------------------- 
    4547   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4951CONTAINS 
    5052 
    51    SUBROUTINE p4z_rem( kt, knt ) 
     53   SUBROUTINE p4z_rem( kt, knt, Kbb, Kmm, Krhs ) 
    5254      !!--------------------------------------------------------------------- 
    5355      !!                     ***  ROUTINE p4z_rem  *** 
    … …  
    5759      !! ** Method  : - ??? 
    5860      !!--------------------------------------------------------------------- 
    59       INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
     61      INTEGER, INTENT(in) ::   kt, knt         ! ocean time step 
     62      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices 
    6063      ! 
    6164      INTEGER  ::   ji, jj, jk 
    … …  
    8588      ! that was modeling explicitely bacteria 
    8689      ! ------------------------------------------------------- 
    87       DO jk = 1, jpkm1 
    88          DO jj = 1, jpj 
    89             DO ji = 1, jpi 
    90                zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 
    91                IF( gdept_n(ji,jj,jk) < zdep ) THEN 
    92                   zdepbac(ji,jj,jk) = MIN( 0.7 * ( trb(ji,jj,jk,jpzoo) + 2.* trb(ji,jj,jk,jpmes) ), 4.e-6 ) 
    93                   ztempbac(ji,jj)   = zdepbac(ji,jj,jk) 
    94                ELSE 
    95                   zdepmin = MIN( 1., zdep / gdept_n(ji,jj,jk) ) 
    96                   zdepbac (ji,jj,jk) = zdepmin**0.683 * ztempbac(ji,jj) 
    97                   zdepprod(ji,jj,jk) = zdepmin**0.273 
    98                   zdepeff (ji,jj,jk) = zdepeff(ji,jj,jk) * zdepmin**0.3 
    99                ENDIF 
    100             END DO 
    101          END DO 
    102       END DO 
     90      DO_3D_11_11( 1, jpkm1 ) 
     91         zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 
     92         IF( gdept(ji,jj,jk,Kmm) < zdep ) THEN 
     93            zdepbac(ji,jj,jk) = MIN( 0.7 * ( tr(ji,jj,jk,jpzoo,Kbb) + 2.* tr(ji,jj,jk,jpmes,Kbb) ), 4.e-6 ) 
     94            ztempbac(ji,jj)   = zdepbac(ji,jj,jk) 
     95         ELSE 
     96            zdepmin = MIN( 1., zdep / gdept(ji,jj,jk,Kmm) ) 
     97            zdepbac (ji,jj,jk) = zdepmin**0.683 * ztempbac(ji,jj) 
     98            zdepprod(ji,jj,jk) = zdepmin**0.273 
     99            zdepeff (ji,jj,jk) = zdepeff(ji,jj,jk) * zdepmin**0.3 
     100         ENDIF 
     101      END_3D 
    103102 
    104103      IF( ln_p4z ) THEN 
    105          DO jk = 1, jpkm1 
    106             DO jj = 1, jpj 
    107                DO ji = 1, jpi 
    108                   ! DOC ammonification. Depends on depth, phytoplankton biomass 
    109                   ! and a limitation term which is supposed to be a parameterization of the bacterial activity.  
    110                   zremik = xremik * xstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk)  
    111                   zremik = MAX( zremik, 2.74e-4 * xstep ) 
    112                   ! Ammonification in oxic waters with oxygen consumption 
    113                   ! ----------------------------------------------------- 
    114                   zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc)  
    115                   zolimi(ji,jj,jk) = MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit )  
    116                   ! Ammonification in suboxic waters with denitrification 
    117                   ! ------------------------------------------------------- 
    118                   zammonic = zremik * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc) 
    119                   denitr(ji,jj,jk)  = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 
    120                   denitr(ji,jj,jk)  = MIN( ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit, denitr(ji,jj,jk) ) 
    121                   zoxyremc          = zammonic - denitr(ji,jj,jk) 
    122                   ! 
    123                   zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) ) 
    124                   denitr (ji,jj,jk) = MAX( 0.e0, denitr (ji,jj,jk) ) 
    125                   zoxyremc          = MAX( 0.e0, zoxyremc ) 
    126  
    127                   ! 
    128                   tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 
    129                   tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 
    130                   tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - denitr (ji,jj,jk) * rdenit 
    131                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zolimi (ji,jj,jk) - denitr(ji,jj,jk) - zoxyremc 
    132                   tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - zolimi (ji,jj,jk) * o2ut 
    133                   tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 
    134                   tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zolimi(ji,jj,jk) + zoxyremc    & 
    135                   &                     + ( rdenit + 1.) * denitr(ji,jj,jk) ) 
    136                END DO 
    137             END DO 
    138          END DO 
     104         DO_3D_11_11( 1, jpkm1 ) 
     105            ! DOC ammonification. Depends on depth, phytoplankton biomass 
     106            ! and a limitation term which is supposed to be a parameterization of the bacterial activity.  
     107            zremik = xremik * xstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk)  
     108            zremik = MAX( zremik, 2.74e-4 * xstep ) 
     109            ! Ammonification in oxic waters with oxygen consumption 
     110            ! ----------------------------------------------------- 
     111            zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * tr(ji,jj,jk,jpdoc,Kbb)  
     112            zolimi(ji,jj,jk) = MIN( ( tr(ji,jj,jk,jpoxy,Kbb) - rtrn ) / o2ut, zolimit )  
     113            ! Ammonification in suboxic waters with denitrification 
     114            ! ------------------------------------------------------- 
     115            zammonic = zremik * nitrfac(ji,jj,jk) * tr(ji,jj,jk,jpdoc,Kbb) 
     116            denitr(ji,jj,jk)  = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 
     117            denitr(ji,jj,jk)  = MIN( ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenit, denitr(ji,jj,jk) ) 
     118            zoxyremc          = zammonic - denitr(ji,jj,jk) 
     119            ! 
     120            zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) ) 
     121            denitr (ji,jj,jk) = MAX( 0.e0, denitr (ji,jj,jk) ) 
     122            zoxyremc          = MAX( 0.e0, zoxyremc ) 
     123 
     124            ! 
     125            tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 
     126            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 
     127            tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - denitr (ji,jj,jk) * rdenit 
     128            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zolimi (ji,jj,jk) - denitr(ji,jj,jk) - zoxyremc 
     129            tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - zolimi (ji,jj,jk) * o2ut 
     130            tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 
     131            tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zolimi(ji,jj,jk) + zoxyremc    & 
     132            &                     + ( rdenit + 1.) * denitr(ji,jj,jk) ) 
     133         END_3D 
    139134      ELSE 
    140          DO jk = 1, jpkm1 
    141             DO jj = 1, jpj 
    142                DO ji = 1, jpi 
    143                   ! DOC ammonification. Depends on depth, phytoplankton biomass 
    144                   ! and a limitation term which is supposed to be a parameterization of the bacterial activity.  
    145                   ! ----------------------------------------------------------------- 
    146                   zremik = xstep / 1.e-6 * MAX(0.01, xlimbac(ji,jj,jk)) * zdepbac(ji,jj,jk)  
    147                   zremik = MAX( zremik, 2.74e-4 * xstep / xremikc ) 
    148  
    149                   zremikc = xremikc * zremik 
    150                   zremikn = xremikn / xremikc 
    151                   zremikp = xremikp / xremikc 
    152  
    153                   ! Ammonification in oxic waters with oxygen consumption 
    154                   ! ----------------------------------------------------- 
    155                   zolimit = zremikc * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc)  
    156                   zolimic = MAX( 0.e0, MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit ) )  
    157                   zolimi(ji,jj,jk) = zolimic 
    158                   zolimin = zremikn * zolimic * trb(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 
    159                   zolimip = zremikp * zolimic * trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn )  
    160  
    161                   ! Ammonification in suboxic waters with denitrification 
    162                   ! ------------------------------------------------------- 
    163                   zammonic = zremikc * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc) 
    164                   denitr(ji,jj,jk)  = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 
    165                   denitr(ji,jj,jk)  = MAX(0., MIN(  ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit, denitr(ji,jj,jk) ) ) 
    166                   zoxyremc          = MAX(0., zammonic - denitr(ji,jj,jk)) 
    167                   zdenitrn  = zremikn * denitr(ji,jj,jk) * trb(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 
    168                   zdenitrp  = zremikp * denitr(ji,jj,jk) * trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 
    169                   zoxyremn  = zremikn * zoxyremc * trb(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 
    170                   zoxyremp  = zremikp * zoxyremc * trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 
    171  
    172                   tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zolimip + zdenitrp + zoxyremp 
    173                   tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zolimin + zdenitrn + zoxyremn 
    174                   tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - denitr(ji,jj,jk) * rdenit 
    175                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zolimic - denitr(ji,jj,jk) - zoxyremc 
    176                   tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) - zolimin - zdenitrn - zoxyremn 
    177                   tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) - zolimip - zdenitrp - zoxyremp 
    178                   tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - zolimic * o2ut 
    179                   tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zolimic + denitr(ji,jj,jk) + zoxyremc 
    180                   tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zolimin + zoxyremn + ( rdenit + 1.) * zdenitrn ) 
    181                END DO 
    182             END DO 
    183          END DO 
     135         DO_3D_11_11( 1, jpkm1 ) 
     136            ! DOC ammonification. Depends on depth, phytoplankton biomass 
     137            ! and a limitation term which is supposed to be a parameterization of the bacterial activity.  
     138            ! ----------------------------------------------------------------- 
     139            zremik = xstep / 1.e-6 * MAX(0.01, xlimbac(ji,jj,jk)) * zdepbac(ji,jj,jk)  
     140            zremik = MAX( zremik, 2.74e-4 * xstep / xremikc ) 
     141 
     142            zremikc = xremikc * zremik 
     143            zremikn = xremikn / xremikc 
     144            zremikp = xremikp / xremikc 
     145 
     146            ! Ammonification in oxic waters with oxygen consumption 
     147            ! ----------------------------------------------------- 
     148            zolimit = zremikc * ( 1.- nitrfac(ji,jj,jk) ) * tr(ji,jj,jk,jpdoc,Kbb)  
     149            zolimic = MAX( 0.e0, MIN( ( tr(ji,jj,jk,jpoxy,Kbb) - rtrn ) / o2ut, zolimit ) )  
     150            zolimi(ji,jj,jk) = zolimic 
     151            zolimin = zremikn * zolimic * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
     152            zolimip = zremikp * zolimic * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn )  
     153 
     154            ! Ammonification in suboxic waters with denitrification 
     155            ! ------------------------------------------------------- 
     156            zammonic = zremikc * nitrfac(ji,jj,jk) * tr(ji,jj,jk,jpdoc,Kbb) 
     157            denitr(ji,jj,jk)  = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 
     158            denitr(ji,jj,jk)  = MAX(0., MIN(  ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenit, denitr(ji,jj,jk) ) ) 
     159            zoxyremc          = MAX(0., zammonic - denitr(ji,jj,jk)) 
     160            zdenitrn  = zremikn * denitr(ji,jj,jk) * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
     161            zdenitrp  = zremikp * denitr(ji,jj,jk) * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
     162            zoxyremn  = zremikn * zoxyremc * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
     163            zoxyremp  = zremikp * zoxyremc * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
     164 
     165            tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zolimip + zdenitrp + zoxyremp 
     166            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zolimin + zdenitrn + zoxyremn 
     167            tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - denitr(ji,jj,jk) * rdenit 
     168            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zolimic - denitr(ji,jj,jk) - zoxyremc 
     169            tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) - zolimin - zdenitrn - zoxyremn 
     170            tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) - zolimip - zdenitrp - zoxyremp 
     171            tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - zolimic * o2ut 
     172            tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zolimic + denitr(ji,jj,jk) + zoxyremc 
     173            tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zolimin + zoxyremn + ( rdenit + 1.) * zdenitrn ) 
     174         END_3D 
    184175         ! 
    185176      ENDIF 
    186177 
    187178 
    188       DO jk = 1, jpkm1 
    189          DO jj = 1, jpj 
    190             DO ji = 1, jpi 
    191                ! NH4 nitrification to NO3. Ceased for oxygen concentrations 
    192                ! below 2 umol/L. Inhibited at strong light  
    193                ! ---------------------------------------------------------- 
    194                zonitr  = nitrif * xstep * trb(ji,jj,jk,jpnh4) * ( 1.- nitrfac(ji,jj,jk) )  & 
    195                &         / ( 1.+ emoy(ji,jj,jk) ) * ( 1. + fr_i(ji,jj) * emoy(ji,jj,jk) )  
    196                zdenitnh4 = nitrif * xstep * trb(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk) 
    197                zdenitnh4 = MIN(  ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenita, zdenitnh4 )  
    198                ! Update of the tracers trends 
    199                ! ---------------------------- 
    200                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr - zdenitnh4 
    201                tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr - rdenita * zdenitnh4 
    202                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr 
    203                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * zdenitnh4 
    204             END DO 
    205          END DO 
    206       END DO 
    207  
    208        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     179      DO_3D_11_11( 1, jpkm1 ) 
     180         ! NH4 nitrification to NO3. Ceased for oxygen concentrations 
     181         ! below 2 umol/L. Inhibited at strong light  
     182         ! ---------------------------------------------------------- 
     183         zonitr  = nitrif * xstep * tr(ji,jj,jk,jpnh4,Kbb) * ( 1.- nitrfac(ji,jj,jk) )  & 
     184         &         / ( 1.+ emoy(ji,jj,jk) ) * ( 1. + fr_i(ji,jj) * emoy(ji,jj,jk) )  
     185         zdenitnh4 = nitrif * xstep * tr(ji,jj,jk,jpnh4,Kbb) * nitrfac(ji,jj,jk) 
     186         zdenitnh4 = MIN(  ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenita, zdenitnh4 )  
     187         ! Update of the tracers trends 
     188         ! ---------------------------- 
     189         tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zonitr - zdenitnh4 
     190         tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + zonitr - rdenita * zdenitnh4 
     191         tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2nit * zonitr 
     192         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * zdenitnh4 
     193      END_3D 
     194 
     195       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    209196         WRITE(charout, FMT="('rem1')") 
    210197         CALL prt_ctl_trc_info(charout) 
    211          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     198         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    212199       ENDIF 
    213200 
    214       DO jk = 1, jpkm1 
    215          DO jj = 1, jpj 
    216             DO ji = 1, jpi 
    217  
    218                ! Bacterial uptake of iron. No iron is available in DOC. So 
    219                ! Bacteries are obliged to take up iron from the water. Some 
    220                ! studies (especially at Papa) have shown this uptake to be significant 
    221                ! ---------------------------------------------------------- 
    222                zbactfer = feratb *  rfact2 * 0.6_wp / rday * tgfunc(ji,jj,jk) * xlimbacl(ji,jj,jk)     & 
    223                   &              * trb(ji,jj,jk,jpfer) / ( xkferb + trb(ji,jj,jk,jpfer) )    & 
    224                   &              * zdepprod(ji,jj,jk) * zdepeff(ji,jj,jk) * zdepbac(ji,jj,jk) 
    225                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zbactfer*0.33 
    226                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zbactfer*0.25 
    227                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zbactfer*0.08 
    228                zfebact(ji,jj,jk)   = zbactfer * 0.33 
    229                blim(ji,jj,jk)      = xlimbacl(ji,jj,jk)  * zdepbac(ji,jj,jk) / 1.e-6 * zdepprod(ji,jj,jk) 
    230             END DO 
    231          END DO 
    232       END DO 
    233  
    234        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     201      DO_3D_11_11( 1, jpkm1 ) 
     202 
     203         ! Bacterial uptake of iron. No iron is available in DOC. So 
     204         ! Bacteries are obliged to take up iron from the water. Some 
     205         ! studies (especially at Papa) have shown this uptake to be significant 
     206         ! ---------------------------------------------------------- 
     207         zbactfer = feratb *  rfact2 * 0.6_wp / rday * tgfunc(ji,jj,jk) * xlimbacl(ji,jj,jk)     & 
     208            &              * tr(ji,jj,jk,jpfer,Kbb) / ( xkferb + tr(ji,jj,jk,jpfer,Kbb) )    & 
     209            &              * zdepprod(ji,jj,jk) * zdepeff(ji,jj,jk) * zdepbac(ji,jj,jk) 
     210         tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zbactfer*0.33 
     211         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zbactfer*0.25 
     212         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zbactfer*0.08 
     213         zfebact(ji,jj,jk)   = zbactfer * 0.33 
     214         blim(ji,jj,jk)      = xlimbacl(ji,jj,jk)  * zdepbac(ji,jj,jk) / 1.e-6 * zdepprod(ji,jj,jk) 
     215      END_3D 
     216 
     217       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    235218         WRITE(charout, FMT="('rem2')") 
    236219         CALL prt_ctl_trc_info(charout) 
    237          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     220         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    238221       ENDIF 
    239222 
    … …  
    242225      ! --------------------------------------------------------------- 
    243226 
    244       DO jk = 1, jpkm1 
    245          DO jj = 1, jpj 
    246             DO ji = 1, jpi 
    247                zdep     = MAX( hmld(ji,jj), heup_01(ji,jj) ) 
    248                zsatur   = MAX( rtrn, ( sio3eq(ji,jj,jk) - trb(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) ) 
    249                zsatur2  = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**37 
    250                znusil   = 0.225  * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25 
    251                ! Remineralization rate of BSi depedant on T and saturation 
    252                ! --------------------------------------------------------- 
    253                IF ( gdept_n(ji,jj,jk) > zdep ) THEN 
    254                   zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk-1) * EXP( -0.5 * ( xsiremlab - xsirem )  & 
    255                   &                   * znusil * e3t_n(ji,jj,jk) / wsbio4(ji,jj,jk) ) 
    256                   zfacsi(ji,jj,jk)  = zfacsib(ji,jj,jk) / ( 1.0 + zfacsib(ji,jj,jk) ) 
    257                   zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk) * EXP( -0.5 * ( xsiremlab - xsirem )    & 
    258                   &                   * znusil * e3t_n(ji,jj,jk) / wsbio4(ji,jj,jk) ) 
    259                ENDIF 
    260                zsiremin = ( xsiremlab * zfacsi(ji,jj,jk) + xsirem * ( 1. - zfacsi(ji,jj,jk) ) ) * xstep * znusil 
    261                zosil    = zsiremin * trb(ji,jj,jk,jpgsi) 
    262                ! 
    263                tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) - zosil 
    264                tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + zosil 
    265             END DO 
    266          END DO 
    267       END DO 
    268  
    269       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     227      DO_3D_11_11( 1, jpkm1 ) 
     228         zdep     = MAX( hmld(ji,jj), heup_01(ji,jj) ) 
     229         zsatur   = MAX( rtrn, ( sio3eq(ji,jj,jk) - tr(ji,jj,jk,jpsil,Kbb) ) / ( sio3eq(ji,jj,jk) + rtrn ) ) 
     230         zsatur2  = ( 1. + ts(ji,jj,jk,jp_tem,Kmm) / 400.)**37 
     231         znusil   = 0.225  * ( 1. + ts(ji,jj,jk,jp_tem,Kmm) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25 
     232         ! Remineralization rate of BSi depedant on T and saturation 
     233         ! --------------------------------------------------------- 
     234         IF ( gdept(ji,jj,jk,Kmm) > zdep ) THEN 
     235            zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk-1) * EXP( -0.5 * ( xsiremlab - xsirem )  & 
     236            &                   * znusil * e3t(ji,jj,jk,Kmm) / wsbio4(ji,jj,jk) ) 
     237            zfacsi(ji,jj,jk)  = zfacsib(ji,jj,jk) / ( 1.0 + zfacsib(ji,jj,jk) ) 
     238            zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk) * EXP( -0.5 * ( xsiremlab - xsirem )    & 
     239            &                   * znusil * e3t(ji,jj,jk,Kmm) / wsbio4(ji,jj,jk) ) 
     240         ENDIF 
     241         zsiremin = ( xsiremlab * zfacsi(ji,jj,jk) + xsirem * ( 1. - zfacsi(ji,jj,jk) ) ) * xstep * znusil 
     242         zosil    = zsiremin * tr(ji,jj,jk,jpgsi,Kbb) 
     243         ! 
     244         tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) - zosil 
     245         tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) + zosil 
     246      END_3D 
     247 
     248      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    270249         WRITE(charout, FMT="('rem3')") 
    271250         CALL prt_ctl_trc_info(charout) 
    272          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     251         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    273252       ENDIF 
    274253 
    275       IF( lk_iomput .AND. knt == nrdttrc ) THEN 
     254      IF( knt == nrdttrc ) THEN 
    276255          zrfact2 = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s 
    277256          ! 
    … …  
    314293      ENDIF 
    315294      ! 
    316       REWIND( numnatp_ref ) 
    317295      READ  ( numnatp_ref, nampisrem, IOSTAT = ios, ERR = 901) 
    318296901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisrem in reference namelist' ) 
    319  
    320       REWIND( numnatp_cfg ) 
    321297      READ  ( numnatp_cfg, nampisrem, IOSTAT = ios, ERR = 902 ) 
    322298902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisrem in configuration namelist' ) 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zsed.F90

    r12276 r12377  
    1515   USE sms_pisces      !  PISCES Source Minus Sink variables 
    1616   USE p4zlim          !  Co-limitations of differents nutrients 
    17    USE p4zsbc          !  External source of nutrients  
    1817   USE p4zint          !  interpolation and computation of various fields 
    1918   USE sed             !  Sediment module 
    … …  
    2524 
    2625   PUBLIC   p4z_sed   
     26   PUBLIC   p4z_sed_init 
    2727   PUBLIC   p4z_sed_alloc 
    2828  
     29   REAL(wp), PUBLIC ::   nitrfix      !: Nitrogen fixation rate 
     30   REAL(wp), PUBLIC ::   diazolight   !: Nitrogen fixation sensitivty to light 
     31   REAL(wp), PUBLIC ::   concfediaz   !: Fe half-saturation Cste for diazotrophs 
     32 
    2933   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nitrpot    !: Nitrogen fixation  
    3034   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:  ) :: sdenit     !: Nitrate reduction in the sediments 
    31    REAL(wp) :: r1_rday                  !: inverse of rday 
    32    LOGICAL, SAVE :: lk_sed 
    33  
     35   ! 
     36   REAL(wp), SAVE :: r1_rday           
     37   REAL(wp), SAVE :: sedsilfrac, sedcalfrac 
     38 
     39   !! * Substitutions 
     40#  include "do_loop_substitute.h90" 
    3441   !!---------------------------------------------------------------------- 
    3542   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    3946CONTAINS 
    4047 
    41    SUBROUTINE p4z_sed( kt, knt ) 
     48   SUBROUTINE p4z_sed( kt, knt, Kbb, Kmm, Krhs ) 
    4249      !!--------------------------------------------------------------------- 
    4350      !!                     ***  ROUTINE p4z_sed  *** 
    … …  
    5158      ! 
    5259      INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
     60      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices 
    5361      INTEGER  ::  ji, jj, jk, ikt 
    5462      REAL(wp) ::  zrivalk, zrivsil, zrivno3 
    55       REAL(wp) ::  zwflux, zlim, zfact, zfactcal 
     63      REAL(wp) ::  zlim, zfact, zfactcal 
    5664      REAL(wp) ::  zo2, zno3, zflx, zpdenit, z1pdenit, zolimit 
    5765      REAL(wp) ::  zsiloss, zcaloss, zws3, zws4, zwsc, zdep 
    … …  
    6674      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zsoufer, zlight 
    6775      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrpo4, ztrdop, zirondep, zpdep 
    68       REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) :: zsidep, zironice 
    6976      !!--------------------------------------------------------------------- 
    7077      ! 
    7178      IF( ln_timing )  CALL timing_start('p4z_sed') 
    7279      ! 
    73       IF( kt == nittrc000 .AND. knt == 1 )   THEN 
    74           r1_rday  = 1. / rday 
    75           IF (ln_sediment .AND. ln_sed_2way) THEN 
    76              lk_sed = .TRUE. 
    77           ELSE 
    78              lk_sed = .FALSE. 
    79           ENDIF 
    80       ENDIF 
    81       ! 
    82       IF( kt == nittrc000 .AND. knt == 1 )   r1_rday  = 1. / rday 
    83       ! 
     80 
    8481      ! Allocate temporary workspace 
    8582      ALLOCATE( ztrpo4(jpi,jpj,jpk) ) 
    … …  
    9390      zsedc   (:,:) = 0.e0 
    9491 
    95       ! Iron input/uptake due to sea ice : Crude parameterization based on Lancelot et al. 
    96       ! ---------------------------------------------------- 
    97       IF( ln_ironice ) THEN   
    98          !                                               
    99          ALLOCATE( zironice(jpi,jpj) ) 
    100          !                                               
    101          DO jj = 1, jpj 
    102             DO ji = 1, jpi 
    103                zdep    = rfact2 / e3t_n(ji,jj,1) 
    104                zwflux  = fmmflx(ji,jj) / 1000._wp 
    105                zironice(ji,jj) =  MAX( -0.99 * trb(ji,jj,1,jpfer), -zwflux * icefeinput * zdep ) 
    106             END DO 
    107          END DO 
    108          ! 
    109          tra(:,:,1,jpfer) = tra(:,:,1,jpfer) + zironice(:,:)  
    110          !  
    111          IF( lk_iomput .AND. knt == nrdttrc )   & 
    112             &   CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! iron flux from ice 
    113          ! 
    114          DEALLOCATE( zironice ) 
    115          !                                               
    116       ENDIF 
    117  
    118       ! Add the external input of nutrients from dust deposition 
    119       ! ---------------------------------------------------------- 
    120       IF( ln_dust ) THEN 
    121          !                                               
    122          ALLOCATE( zsidep(jpi,jpj), zpdep(jpi,jpj,jpk), zirondep(jpi,jpj,jpk) ) 
    123          !                                              ! Iron and Si deposition at the surface 
    124          IF( ln_solub ) THEN 
    125             zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss  
    126          ELSE 
    127             zirondep(:,:,1) = dustsolub  * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss  
    128          ENDIF 
    129          zsidep(:,:)   = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 28.1  
    130          zpdep (:,:,1) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 31. / po4r  
    131          !                                              ! Iron solubilization of particles in the water column 
    132          !                                              ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ;  wdust in m/j 
    133          zwdust = 0.03 * rday / ( wdust * 55.85 ) / ( 270. * rday ) 
    134          DO jk = 2, jpkm1 
    135             zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -gdept_n(:,:,jk) / 540. ) 
    136             zpdep   (:,:,jk) = zirondep(:,:,jk) * 0.023 
    137          END DO 
    138          !                                              ! Iron solubilization of particles in the water column 
    139          tra(:,:,1,jpsil) = tra(:,:,1,jpsil) + zsidep  (:,:) 
    140          DO jk = 1, jpkm1 
    141             tra(:,:,jk,jppo4) = tra(:,:,jk,jppo4) + zpdep   (:,:,jk) 
    142             tra(:,:,jk,jpfer) = tra(:,:,jk,jpfer) + zirondep(:,:,jk)  
    143          ENDDO 
    144          !  
    145          IF( lk_iomput .AND. knt == nrdttrc ) THEN 
    146              CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron 
    147              CALL iom_put( "pdust"  , dust(:,:) / ( wdust * rday )  * tmask(:,:,1) ) ! dust concentration at surface 
    148          ENDIF 
    149          DEALLOCATE( zsidep, zpdep, zirondep ) 
    150          !                                               
    151       ENDIF 
    152       
    153       ! Add the external input of nutrients from river 
    154       ! ---------------------------------------------------------- 
    155       IF( ln_river ) THEN 
    156          DO jj = 1, jpj 
    157             DO ji = 1, jpi 
    158                DO jk = 1, nk_rnf(ji,jj) 
    159                   tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) +  rivdip(ji,jj) * rfact2 
    160                   tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) +  rivdin(ji,jj) * rfact2 
    161                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) +  rivdic(ji,jj) * 5.e-5 * rfact2 
    162                   tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) +  rivdsi(ji,jj) * rfact2 
    163                   tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +  rivdic(ji,jj) * rfact2 
    164                   tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) +  ( rivalk(ji,jj) - rno3 * rivdin(ji,jj) ) * rfact2 
    165                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) +  rivdoc(ji,jj) * rfact2 
    166                ENDDO 
    167             ENDDO 
    168          ENDDO 
    169          IF (ln_ligand) THEN 
    170             DO jj = 1, jpj 
    171                DO ji = 1, jpi 
    172                   DO jk = 1, nk_rnf(ji,jj) 
    173                      tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) +  rivdic(ji,jj) * 5.e-5 * rfact2 
    174                   ENDDO 
    175                ENDDO 
    176             ENDDO 
    177          ENDIF 
    178          IF( ln_p5z ) THEN 
    179             DO jj = 1, jpj 
    180                DO ji = 1, jpi 
    181                   DO jk = 1, nk_rnf(ji,jj) 
    182                      tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + rivdop(ji,jj) * rfact2 
    183                      tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + rivdon(ji,jj) * rfact2 
    184                   ENDDO 
    185                ENDDO 
    186             ENDDO 
    187          ENDIF 
    188       ENDIF 
    189        
    190       ! Add the external input of nutrients from nitrogen deposition 
    191       ! ---------------------------------------------------------- 
    192       IF( ln_ndepo ) THEN 
    193          tra(:,:,1,jpno3) = tra(:,:,1,jpno3) + nitdep(:,:) * rfact2 
    194          tra(:,:,1,jptal) = tra(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2 
    195       ENDIF 
    196  
    197       ! Add the external input of iron from hydrothermal vents 
    198       ! ------------------------------------------------------ 
    199       IF( ln_hydrofe ) THEN 
    200             tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2 
    201          IF( ln_ligand ) THEN 
    202             tra(:,:,:,jplgw) = tra(:,:,:,jplgw) + ( hydrofe(:,:,:) * lgw_rath ) * rfact2 
    203          ENDIF 
    204          ! 
    205          IF( lk_iomput .AND. knt == nrdttrc )   & 
    206             &   CALL iom_put( "HYDR", hydrofe(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! hydrothermal iron input 
    207       ENDIF 
    208  
    209       ! OA: Warning, the following part is necessary to avoid CFL problems above the sediments 
    210       ! -------------------------------------------------------------------- 
    211       DO jj = 1, jpj 
    212          DO ji = 1, jpi 
     92      IF( .NOT.lk_sed ) THEN 
     93         ! OA: Warning, the following part is necessary to avoid CFL problems above the sediments 
     94         ! -------------------------------------------------------------------- 
     95         DO_2D_11_11 
    21396            ikt  = mbkt(ji,jj) 
    214             zdep = e3t_n(ji,jj,ikt) / xstep 
     97            zdep = e3t(ji,jj,ikt,Kmm) / xstep 
    21598            zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) ) 
    21699            zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) ) 
    217          END DO 
    218       END DO 
    219       ! 
    220       IF( .NOT.lk_sed ) THEN 
    221 ! 
    222          ! Add the external input of iron from sediment mobilization 
    223          ! ------------------------------------------------------ 
    224          IF( ln_ironsed ) THEN 
    225                             tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2 
    226             ! 
    227             IF( lk_iomput .AND. knt == nrdttrc )   & 
    228                &   CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! iron inputs from sediments 
    229          ENDIF 
     100         END_2D 
    230101 
    231102         ! Computation of the sediment denitrification proportion: The metamodel from midlleburg (2006) is being used 
    232103         ! Computation of the fraction of organic matter that is permanently buried from Dunne's model 
    233104         ! ------------------------------------------------------- 
    234          DO jj = 1, jpj 
    235             DO ji = 1, jpi 
    236               IF( tmask(ji,jj,1) == 1 ) THEN 
    237                  ikt = mbkt(ji,jj) 
    238                  zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   & 
    239                    &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) )  * 1E3 * 1E6 / 1E4 
    240                  zflx  = LOG10( MAX( 1E-3, zflx ) ) 
    241                  zo2   = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) ) 
    242                  zno3  = LOG10( MAX( 1.  , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) ) 
    243                  zdep  = LOG10( gdepw_n(ji,jj,ikt+1) ) 
    244                  zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3    & 
    245                    &                + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2 
    246                  zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) ) 
    247                    ! 
    248                  zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   & 
    249                    &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6 
    250                  zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2 
    251               ENDIF 
    252             END DO 
    253          END DO  
     105         DO_2D_11_11 
     106           IF( tmask(ji,jj,1) == 1 ) THEN 
     107              ikt = mbkt(ji,jj) 
     108              zflx = (  tr(ji,jj,ikt,jpgoc,Kbb) * zwsbio4(ji,jj)   & 
     109                &     + tr(ji,jj,ikt,jppoc,Kbb) * zwsbio3(ji,jj) )  * 1E3 * 1E6 / 1E4 
     110              zflx  = LOG10( MAX( 1E-3, zflx ) ) 
     111              zo2   = LOG10( MAX( 10. , tr(ji,jj,ikt,jpoxy,Kbb) * 1E6 ) ) 
     112              zno3  = LOG10( MAX( 1.  , tr(ji,jj,ikt,jpno3,Kbb) * 1E6 * rno3 ) ) 
     113              zdep  = LOG10( gdepw(ji,jj,ikt+1,Kmm) ) 
     114              zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3    & 
     115                &                + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2 
     116              zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) ) 
     117                ! 
     118              zflx = (  tr(ji,jj,ikt,jpgoc,Kbb) * zwsbio4(ji,jj)   & 
     119                &     + tr(ji,jj,ikt,jppoc,Kbb) * zwsbio3(ji,jj) ) * 1E6 
     120              zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2 
     121           ENDIF 
     122         END_2D 
    254123         ! 
    255124      ENDIF 
    … …  
    260129      IF( .NOT.lk_sed )  zrivsil = 1._wp - sedsilfrac 
    261130 
    262       DO jj = 1, jpj 
    263          DO ji = 1, jpi 
     131      DO_2D_11_11 
     132         ikt  = mbkt(ji,jj) 
     133         zdep = xstep / e3t(ji,jj,ikt,Kmm)  
     134         zwsc = zwsbio4(ji,jj) * zdep 
     135         zsiloss = tr(ji,jj,ikt,jpgsi,Kbb) * zwsc 
     136         zcaloss = tr(ji,jj,ikt,jpcal,Kbb) * zwsc 
     137         ! 
     138         tr(ji,jj,ikt,jpgsi,Krhs) = tr(ji,jj,ikt,jpgsi,Krhs) - zsiloss 
     139         tr(ji,jj,ikt,jpcal,Krhs) = tr(ji,jj,ikt,jpcal,Krhs) - zcaloss 
     140      END_2D 
     141      ! 
     142      IF( .NOT.lk_sed ) THEN 
     143         DO_2D_11_11 
    264144            ikt  = mbkt(ji,jj) 
    265             zdep = xstep / e3t_n(ji,jj,ikt)  
     145            zdep = xstep / e3t(ji,jj,ikt,Kmm)  
    266146            zwsc = zwsbio4(ji,jj) * zdep 
    267             zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc 
    268             zcaloss = trb(ji,jj,ikt,jpcal) * zwsc 
     147            zsiloss = tr(ji,jj,ikt,jpgsi,Kbb) * zwsc 
     148            zcaloss = tr(ji,jj,ikt,jpcal,Kbb) * zwsc 
     149            tr(ji,jj,ikt,jpsil,Krhs) = tr(ji,jj,ikt,jpsil,Krhs) + zsiloss * zrivsil  
    269150            ! 
    270             tra(ji,jj,ikt,jpgsi) = tra(ji,jj,ikt,jpgsi) - zsiloss 
    271             tra(ji,jj,ikt,jpcal) = tra(ji,jj,ikt,jpcal) - zcaloss 
    272          END DO 
    273       END DO 
    274       ! 
    275       IF( .NOT.lk_sed ) THEN 
    276          DO jj = 1, jpj 
    277             DO ji = 1, jpi 
    278                ikt  = mbkt(ji,jj) 
    279                zdep = xstep / e3t_n(ji,jj,ikt)  
    280                zwsc = zwsbio4(ji,jj) * zdep 
    281                zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc 
    282                zcaloss = trb(ji,jj,ikt,jpcal) * zwsc 
    283                tra(ji,jj,ikt,jpsil) = tra(ji,jj,ikt,jpsil) + zsiloss * zrivsil  
    284                ! 
    285                zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 
    286                zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 
    287                zrivalk  = sedcalfrac * zfactcal 
    288                tra(ji,jj,ikt,jptal) =  tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0 
    289                tra(ji,jj,ikt,jpdic) =  tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk 
    290                zsedcal(ji,jj) = (1.0 - zrivalk) * zcaloss * e3t_n(ji,jj,ikt)  
    291                zsedsi (ji,jj) = (1.0 - zrivsil) * zsiloss * e3t_n(ji,jj,ikt)  
    292             END DO 
    293          END DO 
    294       ENDIF 
    295       ! 
    296       DO jj = 1, jpj 
    297          DO ji = 1, jpi 
     151            zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 
     152            zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 
     153            zrivalk  = sedcalfrac * zfactcal 
     154            tr(ji,jj,ikt,jptal,Krhs) =  tr(ji,jj,ikt,jptal,Krhs) + zcaloss * zrivalk * 2.0 
     155            tr(ji,jj,ikt,jpdic,Krhs) =  tr(ji,jj,ikt,jpdic,Krhs) + zcaloss * zrivalk 
     156            zsedcal(ji,jj) = (1.0 - zrivalk) * zcaloss * e3t(ji,jj,ikt,Kmm)  
     157            zsedsi (ji,jj) = (1.0 - zrivsil) * zsiloss * e3t(ji,jj,ikt,Kmm)  
     158         END_2D 
     159      ENDIF 
     160      ! 
     161      DO_2D_11_11 
     162         ikt  = mbkt(ji,jj) 
     163         zdep = xstep / e3t(ji,jj,ikt,Kmm)  
     164         zws4 = zwsbio4(ji,jj) * zdep 
     165         zws3 = zwsbio3(ji,jj) * zdep 
     166         tr(ji,jj,ikt,jpgoc,Krhs) = tr(ji,jj,ikt,jpgoc,Krhs) - tr(ji,jj,ikt,jpgoc,Kbb) * zws4  
     167         tr(ji,jj,ikt,jppoc,Krhs) = tr(ji,jj,ikt,jppoc,Krhs) - tr(ji,jj,ikt,jppoc,Kbb) * zws3 
     168         tr(ji,jj,ikt,jpbfe,Krhs) = tr(ji,jj,ikt,jpbfe,Krhs) - tr(ji,jj,ikt,jpbfe,Kbb) * zws4 
     169         tr(ji,jj,ikt,jpsfe,Krhs) = tr(ji,jj,ikt,jpsfe,Krhs) - tr(ji,jj,ikt,jpsfe,Kbb) * zws3 
     170      END_2D 
     171      ! 
     172      IF( ln_p5z ) THEN 
     173         DO_2D_11_11 
    298174            ikt  = mbkt(ji,jj) 
    299             zdep = xstep / e3t_n(ji,jj,ikt)  
     175            zdep = xstep / e3t(ji,jj,ikt,Kmm)  
    300176            zws4 = zwsbio4(ji,jj) * zdep 
    301177            zws3 = zwsbio3(ji,jj) * zdep 
    302             tra(ji,jj,ikt,jpgoc) = tra(ji,jj,ikt,jpgoc) - trb(ji,jj,ikt,jpgoc) * zws4  
    303             tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3 
    304             tra(ji,jj,ikt,jpbfe) = tra(ji,jj,ikt,jpbfe) - trb(ji,jj,ikt,jpbfe) * zws4 
    305             tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3 
    306          END DO 
    307       END DO 
    308       ! 
    309       IF( ln_p5z ) THEN 
    310          DO jj = 1, jpj 
    311             DO ji = 1, jpi 
    312                ikt  = mbkt(ji,jj) 
    313                zdep = xstep / e3t_n(ji,jj,ikt)  
    314                zws4 = zwsbio4(ji,jj) * zdep 
    315                zws3 = zwsbio3(ji,jj) * zdep 
    316                tra(ji,jj,ikt,jpgon) = tra(ji,jj,ikt,jpgon) - trb(ji,jj,ikt,jpgon) * zws4 
    317                tra(ji,jj,ikt,jppon) = tra(ji,jj,ikt,jppon) - trb(ji,jj,ikt,jppon) * zws3 
    318                tra(ji,jj,ikt,jpgop) = tra(ji,jj,ikt,jpgop) - trb(ji,jj,ikt,jpgop) * zws4 
    319                tra(ji,jj,ikt,jppop) = tra(ji,jj,ikt,jppop) - trb(ji,jj,ikt,jppop) * zws3 
    320             END DO 
    321          END DO 
     178            tr(ji,jj,ikt,jpgon,Krhs) = tr(ji,jj,ikt,jpgon,Krhs) - tr(ji,jj,ikt,jpgon,Kbb) * zws4 
     179            tr(ji,jj,ikt,jppon,Krhs) = tr(ji,jj,ikt,jppon,Krhs) - tr(ji,jj,ikt,jppon,Kbb) * zws3 
     180            tr(ji,jj,ikt,jpgop,Krhs) = tr(ji,jj,ikt,jpgop,Krhs) - tr(ji,jj,ikt,jpgop,Kbb) * zws4 
     181            tr(ji,jj,ikt,jppop,Krhs) = tr(ji,jj,ikt,jppop,Krhs) - tr(ji,jj,ikt,jppop,Kbb) * zws3 
     182         END_2D 
    322183      ENDIF 
    323184 
    … …  
    325186         ! The 0.5 factor in zpdenit is to avoid negative NO3 concentration after 
    326187         ! denitrification in the sediments. Not very clever, but simpliest option. 
    327          DO jj = 1, jpj 
    328             DO ji = 1, jpi 
    329                ikt  = mbkt(ji,jj) 
    330                zdep = xstep / e3t_n(ji,jj,ikt)  
    331                zws4 = zwsbio4(ji,jj) * zdep 
    332                zws3 = zwsbio3(ji,jj) * zdep 
    333                zrivno3 = 1. - zbureff(ji,jj) 
    334                zwstpoc = trb(ji,jj,ikt,jpgoc) * zws4 + trb(ji,jj,ikt,jppoc) * zws3 
    335                zpdenit  = MIN( 0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 ) 
    336                z1pdenit = zwstpoc * zrivno3 - zpdenit 
    337                zolimit = MIN( ( trb(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) ) 
    338                tra(ji,jj,ikt,jpdoc) = tra(ji,jj,ikt,jpdoc) + z1pdenit - zolimit 
    339                tra(ji,jj,ikt,jppo4) = tra(ji,jj,ikt,jppo4) + zpdenit + zolimit 
    340                tra(ji,jj,ikt,jpnh4) = tra(ji,jj,ikt,jpnh4) + zpdenit + zolimit 
    341                tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) - rdenit * zpdenit 
    342                tra(ji,jj,ikt,jpoxy) = tra(ji,jj,ikt,jpoxy) - zolimit * o2ut 
    343                tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * zpdenit ) 
    344                tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit  
    345                sdenit(ji,jj) = rdenit * zpdenit * e3t_n(ji,jj,ikt) 
    346                zsedc(ji,jj)   = (1. - zrivno3) * zwstpoc * e3t_n(ji,jj,ikt) 
    347                IF( ln_p5z ) THEN 
    348                   zwstpop              = trb(ji,jj,ikt,jpgop) * zws4 + trb(ji,jj,ikt,jppop) * zws3 
    349                   zwstpon              = trb(ji,jj,ikt,jpgon) * zws4 + trb(ji,jj,ikt,jppon) * zws3 
    350                   tra(ji,jj,ikt,jpdon) = tra(ji,jj,ikt,jpdon) + ( z1pdenit - zolimit ) * zwstpon / (zwstpoc + rtrn) 
    351                   tra(ji,jj,ikt,jpdop) = tra(ji,jj,ikt,jpdop) + ( z1pdenit - zolimit ) * zwstpop / (zwstpoc + rtrn) 
    352                ENDIF 
    353             END DO 
    354          END DO 
     188         DO_2D_11_11 
     189            ikt  = mbkt(ji,jj) 
     190            zdep = xstep / e3t(ji,jj,ikt,Kmm)  
     191            zws4 = zwsbio4(ji,jj) * zdep 
     192            zws3 = zwsbio3(ji,jj) * zdep 
     193            zrivno3 = 1. - zbureff(ji,jj) 
     194            zwstpoc = tr(ji,jj,ikt,jpgoc,Kbb) * zws4 + tr(ji,jj,ikt,jppoc,Kbb) * zws3 
     195            zpdenit  = MIN( 0.5 * ( tr(ji,jj,ikt,jpno3,Kbb) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 ) 
     196            z1pdenit = zwstpoc * zrivno3 - zpdenit 
     197            zolimit = MIN( ( tr(ji,jj,ikt,jpoxy,Kbb) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) ) 
     198            tr(ji,jj,ikt,jpdoc,Krhs) = tr(ji,jj,ikt,jpdoc,Krhs) + z1pdenit - zolimit 
     199            tr(ji,jj,ikt,jppo4,Krhs) = tr(ji,jj,ikt,jppo4,Krhs) + zpdenit + zolimit 
     200            tr(ji,jj,ikt,jpnh4,Krhs) = tr(ji,jj,ikt,jpnh4,Krhs) + zpdenit + zolimit 
     201            tr(ji,jj,ikt,jpno3,Krhs) = tr(ji,jj,ikt,jpno3,Krhs) - rdenit * zpdenit 
     202            tr(ji,jj,ikt,jpoxy,Krhs) = tr(ji,jj,ikt,jpoxy,Krhs) - zolimit * o2ut 
     203            tr(ji,jj,ikt,jptal,Krhs) = tr(ji,jj,ikt,jptal,Krhs) + rno3 * (zolimit + (1.+rdenit) * zpdenit ) 
     204            tr(ji,jj,ikt,jpdic,Krhs) = tr(ji,jj,ikt,jpdic,Krhs) + zpdenit + zolimit  
     205            sdenit(ji,jj) = rdenit * zpdenit * e3t(ji,jj,ikt,Kmm) 
     206            zsedc(ji,jj)   = (1. - zrivno3) * zwstpoc * e3t(ji,jj,ikt,Kmm) 
     207            IF( ln_p5z ) THEN 
     208               zwstpop              = tr(ji,jj,ikt,jpgop,Kbb) * zws4 + tr(ji,jj,ikt,jppop,Kbb) * zws3 
     209               zwstpon              = tr(ji,jj,ikt,jpgon,Kbb) * zws4 + tr(ji,jj,ikt,jppon,Kbb) * zws3 
     210               tr(ji,jj,ikt,jpdon,Krhs) = tr(ji,jj,ikt,jpdon,Krhs) + ( z1pdenit - zolimit ) * zwstpon / (zwstpoc + rtrn) 
     211               tr(ji,jj,ikt,jpdop,Krhs) = tr(ji,jj,ikt,jpdop,Krhs) + ( z1pdenit - zolimit ) * zwstpop / (zwstpoc + rtrn) 
     212            ENDIF 
     213         END_2D 
    355214       ENDIF 
    356215 
    … …  
    364223      ENDDO 
    365224      IF( ln_p4z ) THEN 
    366          DO jk = 1, jpkm1 
    367             DO jj = 1, jpj 
    368                DO ji = 1, jpi 
    369                   !                      ! Potential nitrogen fixation dependant on temperature and iron 
    370                   ztemp = tsn(ji,jj,jk,jp_tem) 
    371                   zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 
    372                   !       Potential nitrogen fixation dependant on temperature and iron 
    373                   xdianh4 = trb(ji,jj,jk,jpnh4) / ( concnnh4 + trb(ji,jj,jk,jpnh4) ) 
    374                   xdiano3 = trb(ji,jj,jk,jpno3) / ( concnno3 + trb(ji,jj,jk,jpno3) ) * (1. - xdianh4) 
    375                   zlim = ( 1.- xdiano3 - xdianh4 ) 
    376                   IF( zlim <= 0.1 )   zlim = 0.01 
    377                   zfact = zlim * rfact2 
    378                   ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 
    379                   ztrpo4(ji,jj,jk) = trb(ji,jj,jk,jppo4) / ( 1E-6 + trb(ji,jj,jk,jppo4) ) 
    380                   ztrdp = ztrpo4(ji,jj,jk) 
    381                   nitrpot(ji,jj,jk) =  zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 
    382                END DO 
    383             END DO 
    384          END DO 
     225         DO_3D_11_11( 1, jpkm1 ) 
     226            !                      ! Potential nitrogen fixation dependant on temperature and iron 
     227            ztemp = ts(ji,jj,jk,jp_tem,Kmm) 
     228            zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 
     229            !       Potential nitrogen fixation dependant on temperature and iron 
     230            xdianh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 
     231            xdiano3 = tr(ji,jj,jk,jpno3,Kbb) / ( concnno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - xdianh4) 
     232            zlim = ( 1.- xdiano3 - xdianh4 ) 
     233            IF( zlim <= 0.1 )   zlim = 0.01 
     234            zfact = zlim * rfact2 
     235            ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 
     236            ztrpo4(ji,jj,jk) = tr(ji,jj,jk,jppo4,Kbb) / ( 1E-6 + tr(ji,jj,jk,jppo4,Kbb) ) 
     237            ztrdp = ztrpo4(ji,jj,jk) 
     238            nitrpot(ji,jj,jk) =  zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 
     239         END_3D 
    385240      ELSE       ! p5z 
    386          DO jk = 1, jpkm1 
    387             DO jj = 1, jpj 
    388                DO ji = 1, jpi 
    389                   !                      ! Potential nitrogen fixation dependant on temperature and iron 
    390                   ztemp = tsn(ji,jj,jk,jp_tem) 
    391                   zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 
    392                   !       Potential nitrogen fixation dependant on temperature and iron 
    393                   xdianh4 = trb(ji,jj,jk,jpnh4) / ( concnnh4 + trb(ji,jj,jk,jpnh4) ) 
    394                   xdiano3 = trb(ji,jj,jk,jpno3) / ( concnno3 + trb(ji,jj,jk,jpno3) ) * (1. - xdianh4) 
    395                   zlim = ( 1.- xdiano3 - xdianh4 ) 
    396                   IF( zlim <= 0.1 )   zlim = 0.01 
    397                   zfact = zlim * rfact2 
    398                   ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 
    399                   ztrpo4(ji,jj,jk) = trb(ji,jj,jk,jppo4) / ( 1E-6 + trb(ji,jj,jk,jppo4) ) 
    400                   ztrdop(ji,jj,jk) = trb(ji,jj,jk,jpdop) / ( 1E-6 + trb(ji,jj,jk,jpdop) ) * (1. - ztrpo4(ji,jj,jk)) 
    401                   ztrdp = ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) 
    402                   nitrpot(ji,jj,jk) =  zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 
    403                END DO 
    404             END DO 
    405          END DO 
     241         DO_3D_11_11( 1, jpkm1 ) 
     242            !                      ! Potential nitrogen fixation dependant on temperature and iron 
     243            ztemp = ts(ji,jj,jk,jp_tem,Kmm) 
     244            zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 
     245            !       Potential nitrogen fixation dependant on temperature and iron 
     246            xdianh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 
     247            xdiano3 = tr(ji,jj,jk,jpno3,Kbb) / ( concnno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - xdianh4) 
     248            zlim = ( 1.- xdiano3 - xdianh4 ) 
     249            IF( zlim <= 0.1 )   zlim = 0.01 
     250            zfact = zlim * rfact2 
     251            ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 
     252            ztrpo4(ji,jj,jk) = tr(ji,jj,jk,jppo4,Kbb) / ( 1E-6 + tr(ji,jj,jk,jppo4,Kbb) ) 
     253            ztrdop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( 1E-6 + tr(ji,jj,jk,jpdop,Kbb) ) * (1. - ztrpo4(ji,jj,jk)) 
     254            ztrdp = ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) 
     255            nitrpot(ji,jj,jk) =  zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 
     256         END_3D 
    406257      ENDIF 
    407258 
    … …  
    409260      ! ---------------------------------------- 
    410261      IF( ln_p4z ) THEN 
    411          DO jk = 1, jpkm1 
    412             DO jj = 1, jpj 
    413                DO ji = 1, jpi 
    414                   zfact = nitrpot(ji,jj,jk) * nitrfix 
    415                   tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zfact / 3.0 
    416                   tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zfact / 3.0 
    417                   tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zfact * 2.0 / 3.0 
    418                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zfact * 1.0 / 3.0 
    419                   tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zfact * 1.0 / 3.0 * 2.0 / 3.0 
    420                   tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfact * 1.0 / 3.0 * 1.0 / 3.0 
    421                   tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 
    422                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - 30E-6 * zfact * 1.0 / 3.0 
    423                   tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 
    424                   tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 
    425                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 
    426                   tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trb(ji,jj,jk,jppo4) ) & 
    427                   &                     * 0.001 * trb(ji,jj,jk,jpdoc) * xstep 
    428               END DO 
    429             END DO  
    430          END DO 
     262         DO_3D_11_11( 1, jpkm1 ) 
     263            zfact = nitrpot(ji,jj,jk) * nitrfix 
     264            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0 
     265            tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zfact / 3.0 
     266            tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zfact * 2.0 / 3.0 
     267            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zfact * 1.0 / 3.0 
     268            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zfact * 1.0 / 3.0 * 2.0 / 3.0 
     269            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfact * 1.0 / 3.0 * 1.0 / 3.0 
     270            tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 
     271            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - 30E-6 * zfact * 1.0 / 3.0 
     272            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 
     273            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 
     274            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 
     275            tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + concdnh4 / ( concdnh4 + tr(ji,jj,jk,jppo4,Kbb) ) & 
     276            &                     * 0.001 * tr(ji,jj,jk,jpdoc,Kbb) * xstep 
     277         END_3D 
    431278      ELSE    ! p5z 
    432          DO jk = 1, jpkm1 
    433             DO jj = 1, jpj 
    434                DO ji = 1, jpi 
    435                   zfact = nitrpot(ji,jj,jk) * nitrfix 
    436                   tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zfact / 3.0 
    437                   tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zfact / 3.0 
    438                   tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - 16.0 / 46.0 * zfact * ( 1.0 - 1.0 / 3.0 ) & 
    439                   &                     * ztrpo4(ji,jj,jk) / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 
    440                   tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zfact * 1.0 / 3.0 
    441                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zfact * 1.0 / 3.0 
    442                   tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + 16.0 / 46.0 * zfact / 3.0  & 
    443                   &                     - 16.0 / 46.0 * zfact * ztrdop(ji,jj,jk)   & 
    444                   &                     / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 
    445                   tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zfact * 1.0 / 3.0 * 2.0 / 3.0 
    446                   tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zfact * 1.0 / 3.0 * 2.0 /3.0 
    447                   tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 2.0 /3.0 
    448                   tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfact * 1.0 / 3.0 * 1.0 / 3.0 
    449                   tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zfact * 1.0 / 3.0 * 1.0 /3.0 
    450                   tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 1.0 /3.0 
    451                   tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 
    452                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - 30E-6 * zfact * 1.0 / 3.0  
    453                   tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 
    454                   tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 
    455                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 
    456               END DO 
    457             END DO  
    458          END DO 
     279         DO_3D_11_11( 1, jpkm1 ) 
     280            zfact = nitrpot(ji,jj,jk) * nitrfix 
     281            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0 
     282            tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zfact / 3.0 
     283            tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - 16.0 / 46.0 * zfact * ( 1.0 - 1.0 / 3.0 ) & 
     284            &                     * ztrpo4(ji,jj,jk) / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 
     285            tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zfact * 1.0 / 3.0 
     286            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zfact * 1.0 / 3.0 
     287            tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + 16.0 / 46.0 * zfact / 3.0  & 
     288            &                     - 16.0 / 46.0 * zfact * ztrdop(ji,jj,jk)   & 
     289            &                     / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 
     290            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zfact * 1.0 / 3.0 * 2.0 / 3.0 
     291            tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zfact * 1.0 / 3.0 * 2.0 /3.0 
     292            tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 2.0 /3.0 
     293            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfact * 1.0 / 3.0 * 1.0 / 3.0 
     294            tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zfact * 1.0 / 3.0 * 1.0 /3.0 
     295            tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 1.0 /3.0 
     296            tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 
     297            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - 30E-6 * zfact * 1.0 / 3.0  
     298            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 
     299            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 
     300            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 
     301         END_3D 
    459302         ! 
    460303      ENDIF 
    461304 
    462       IF( lk_iomput ) THEN 
    463          IF( knt == nrdttrc ) THEN 
    464             zfact = 1.e+3 * rfact2r !  conversion from molC/l/kt  to molN/m3/s 
    465             CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * rno3 * zfact * tmask(:,:,:) )  ! nitrogen fixation  
    466             CALL iom_put( "SedCal", zsedcal(:,:) * zfact ) 
    467             CALL iom_put( "SedSi",  zsedsi (:,:) * zfact ) 
    468             CALL iom_put( "SedC",   zsedc  (:,:) * zfact ) 
    469             CALL iom_put( "Sdenit", sdenit (:,:) * zfact * rno3 ) 
    470          ENDIF 
    471       ENDIF 
    472       ! 
    473       IF(ln_ctl) THEN  ! print mean trends (USEd for debugging) 
     305      IF( lk_iomput .AND. knt == nrdttrc ) THEN 
     306         zfact = 1.e+3 * rfact2r !  conversion from molC/l/kt  to molN/m3/s 
     307         CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * rno3 * zfact * tmask(:,:,:) )  ! nitrogen fixation  
     308         CALL iom_put( "SedCal", zsedcal(:,:) * zfact ) 
     309         CALL iom_put( "SedSi" , zsedsi (:,:) * zfact ) 
     310         CALL iom_put( "SedC"  , zsedc  (:,:) * zfact ) 
     311         CALL iom_put( "Sdenit", sdenit (:,:) * zfact * rno3 ) 
     312      ENDIF 
     313      ! 
     314      IF(sn_cfctl%l_prttrc) THEN  ! print mean trends (USEd for debugging) 
    474315         WRITE(charout, fmt="('sed ')") 
    475316         CALL prt_ctl_trc_info(charout) 
    476          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     317         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    477318      ENDIF 
    478319      ! 
    … …  
    483324   END SUBROUTINE p4z_sed 
    484325 
     326   SUBROUTINE p4z_sed_init 
     327      !!---------------------------------------------------------------------- 
     328      !!                  ***  routine p4z_sed_init  *** 
     329      !! 
     330      !! ** purpose :   initialization of some parameters 
     331      !! 
     332      !!---------------------------------------------------------------------- 
     333      !!---------------------------------------------------------------------- 
     334      INTEGER  :: ji, jj, jk, jm 
     335      INTEGER  :: ios                 ! Local integer output status for namelist read 
     336      ! 
     337      !! 
     338      NAMELIST/nampissed/ nitrfix, diazolight, concfediaz 
     339      !!---------------------------------------------------------------------- 
     340      ! 
     341      IF(lwp) THEN 
     342         WRITE(numout,*) 
     343         WRITE(numout,*) 'p4z_sed_init : initialization of sediment mobilisation ' 
     344         WRITE(numout,*) '~~~~~~~~~~~~ ' 
     345      ENDIF 
     346      !                            !* set file information 
     347      READ  ( numnatp_ref, nampissed, IOSTAT = ios, ERR = 901) 
     348901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampissed in reference namelist' ) 
     349      READ  ( numnatp_cfg, nampissed, IOSTAT = ios, ERR = 902 ) 
     350902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampissed in configuration namelist' ) 
     351      IF(lwm) WRITE ( numonp, nampissed ) 
     352 
     353      IF(lwp) THEN 
     354         WRITE(numout,*) '   Namelist : nampissed ' 
     355         WRITE(numout,*) '      nitrogen fixation rate                       nitrfix = ', nitrfix 
     356         WRITE(numout,*) '      nitrogen fixation sensitivty to light    diazolight  = ', diazolight 
     357         WRITE(numout,*) '      Fe half-saturation cste for diazotrophs  concfediaz  = ', concfediaz 
     358      ENDIF 
     359      ! 
     360      r1_rday  = 1. / rday 
     361      ! 
     362      sedsilfrac = 0.03     ! percentage of silica loss in the sediments 
     363      sedcalfrac = 0.6      ! percentage of calcite loss in the sediments 
     364      ! 
     365      lk_sed = ln_sediment .AND. ln_sed_2way  
     366      ! 
     367   END SUBROUTINE p4z_sed_init 
    485368 
    486369   INTEGER FUNCTION p4z_sed_alloc() 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zsink.F90

    r12276 r12377  
    3838   INTEGER  :: ik100 
    3939 
     40   !! * Substitutions 
     41#  include "do_loop_substitute.h90" 
    4042   !!---------------------------------------------------------------------- 
    4143   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4951   !!---------------------------------------------------------------------- 
    5052 
    51    SUBROUTINE p4z_sink ( kt, knt ) 
     53   SUBROUTINE p4z_sink ( kt, knt, Kbb, Kmm, Krhs ) 
    5254      !!--------------------------------------------------------------------- 
    5355      !!                     ***  ROUTINE p4z_sink  *** 
    … …  
    5961      !!--------------------------------------------------------------------- 
    6062      INTEGER, INTENT(in) :: kt, knt 
     63      INTEGER, INTENT(in) :: Kbb, Kmm, Krhs  ! time level indices 
    6164      INTEGER  ::   ji, jj, jk 
    6265      CHARACTER (len=25) :: charout 
    … …  
    7780      !    by data and from the coagulation theory 
    7881      !    ----------------------------------------------------------- 
    79       DO jk = 1, jpkm1 
    80          DO jj = 1, jpj 
    81             DO ji = 1,jpi 
    82                zmax  = MAX( heup_01(ji,jj), hmld(ji,jj) ) 
    83                zfact = MAX( 0., gdepw_n(ji,jj,jk+1) - zmax ) / wsbio2scale 
    84                wsbio4(ji,jj,jk) = wsbio2 + MAX(0., ( wsbio2max - wsbio2 )) * zfact 
    85             END DO 
    86          END DO 
    87       END DO 
     82      DO_3D_11_11( 1, jpkm1 ) 
     83         zmax  = MAX( heup_01(ji,jj), hmld(ji,jj) ) 
     84         zfact = MAX( 0., gdepw(ji,jj,jk+1,Kmm) - zmax ) / wsbio2scale 
     85         wsbio4(ji,jj,jk) = wsbio2 + MAX(0., ( wsbio2max - wsbio2 )) * zfact 
     86      END_3D 
    8887 
    8988      ! limit the values of the sinking speeds to avoid numerical instabilities   
    … …  
    102101      !   Compute the sedimentation term using p4zsink2 for all the sinking particles 
    103102      !   ----------------------------------------------------- 
    104       CALL trc_sink( kt, wsbio3, sinking , jppoc, rfact2 ) 
    105       CALL trc_sink( kt, wsbio3, sinkfer , jpsfe, rfact2 ) 
    106       CALL trc_sink( kt, wsbio4, sinking2, jpgoc, rfact2 ) 
    107       CALL trc_sink( kt, wsbio4, sinkfer2, jpbfe, rfact2 ) 
    108       CALL trc_sink( kt, wsbio4, sinksil , jpgsi, rfact2 ) 
    109       CALL trc_sink( kt, wsbio4, sinkcal , jpcal, rfact2 ) 
     103      CALL trc_sink( kt, Kbb, Kmm, wsbio3, sinking , jppoc, rfact2 ) 
     104      CALL trc_sink( kt, Kbb, Kmm, wsbio3, sinkfer , jpsfe, rfact2 ) 
     105      CALL trc_sink( kt, Kbb, Kmm, wsbio4, sinking2, jpgoc, rfact2 ) 
     106      CALL trc_sink( kt, Kbb, Kmm, wsbio4, sinkfer2, jpbfe, rfact2 ) 
     107      CALL trc_sink( kt, Kbb, Kmm, wsbio4, sinksil , jpgsi, rfact2 ) 
     108      CALL trc_sink( kt, Kbb, Kmm, wsbio4, sinkcal , jpcal, rfact2 ) 
    110109 
    111110      IF( ln_p5z ) THEN 
    … …  
    117116         !   Compute the sedimentation term using p4zsink2 for all the sinking particles 
    118117         !   ----------------------------------------------------- 
    119          CALL trc_sink( kt, wsbio3, sinkingn , jppon, rfact2 ) 
    120          CALL trc_sink( kt, wsbio3, sinkingp , jppop, rfact2 ) 
    121          CALL trc_sink( kt, wsbio4, sinking2n, jpgon, rfact2 ) 
    122          CALL trc_sink( kt, wsbio4, sinking2p, jpgop, rfact2 ) 
     118         CALL trc_sink( kt, Kbb, Kmm, wsbio3, sinkingn , jppon, rfact2 ) 
     119         CALL trc_sink( kt, Kbb, Kmm, wsbio3, sinkingp , jppop, rfact2 ) 
     120         CALL trc_sink( kt, Kbb, Kmm, wsbio4, sinking2n, jpgon, rfact2 ) 
     121         CALL trc_sink( kt, Kbb, Kmm, wsbio4, sinking2p, jpgop, rfact2 ) 
    123122      ENDIF 
    124123 
    … …  
    142141      ENDIF 
    143142      ! 
    144       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     143      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    145144         WRITE(charout, FMT="('sink')") 
    146145         CALL prt_ctl_trc_info(charout) 
    147          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     146         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    148147      ENDIF 
    149148      ! 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zsms.F90

    r12276 r12377  
    1717   USE p4zlys          ! Calcite saturation 
    1818   USE p4zflx          ! Gas exchange 
    19    USE p4zsbc          ! External source of nutrients 
     19   USE p4zbc           ! External source of nutrients 
    2020   USE p4zsed          ! Sedimentation 
    2121   USE p4zint          ! time interpolation 
    … …  
    3939   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xnegtr     ! Array used to indicate negative tracer values 
    4040 
     41   !! * Substitutions 
     42#  include "do_loop_substitute.h90" 
    4143   !!---------------------------------------------------------------------- 
    4244   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4648CONTAINS 
    4749 
    48    SUBROUTINE p4z_sms( kt ) 
     50   SUBROUTINE p4z_sms( kt, Kbb, Kmm, Krhs ) 
    4951      !!--------------------------------------------------------------------- 
    5052      !!                     ***  ROUTINE p4z_sms  *** 
    … …  
    5860      !!--------------------------------------------------------------------- 
    5961      ! 
    60       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     62      INTEGER, INTENT( in ) ::   kt              ! ocean time-step index       
     63      INTEGER, INTENT( in ) ::   Kbb, Kmm, Krhs  ! time level index 
    6164      !! 
    6265      INTEGER ::   ji, jj, jk, jnt, jn, jl 
    … …  
    7679        ! 
    7780        IF( .NOT. ln_rsttr ) THEN 
    78             CALL p4z_che                              ! initialize the chemical constants 
    79             CALL ahini_for_at(hi)   !  set PH at kt=nit000 
     81            CALL p4z_che( Kbb, Kmm )                  ! initialize the chemical constants 
     82            CALL ahini_for_at( hi, Kbb )              !  set PH at kt=nit000 
    8083            t_oce_co2_flx_cum = 0._wp 
    8184        ELSE 
    82             CALL p4z_rst( nittrc000, 'READ' )  !* read or initialize all required fields 
     85            CALL p4z_rst( nittrc000, Kbb, Kmm,  'READ' )  !* read or initialize all required fields 
    8386        ENDIF 
    8487        ! 
    8588      ENDIF 
    8689      ! 
    87       IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 )   CALL p4z_dmp( kt )      ! Relaxation of some tracers 
     90      IF( ln_pisdmp .AND. MOD( kt - 1, nn_pisdmp ) == 0 )   CALL p4z_dmp( kt, Kbb, Kmm )      ! Relaxation of some tracers 
    8891      ! 
    8992      rfact = r2dttrc 
    … …  
    9295      IF( l_trdtrc )  THEN 
    9396         ALLOCATE( ztrdt(jpi,jpj,jpk,jp_pisces) )  !* store now fields before applying the Asselin filter 
    94          ztrdt(:,:,:,:)  = trn(:,:,:,:) 
    95       ENDIF 
    96       ! 
    97  
    98       IF( ( ln_top_euler .AND. kt == nittrc000 )  .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + nn_dttrc ) ) THEN 
     97         ztrdt(:,:,:,:)  = tr(:,:,:,:,Kmm) 
     98      ENDIF 
     99      ! 
     100 
     101      IF( ( ln_top_euler .AND. kt == nittrc000 )  .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + 1 ) ) THEN 
    99102         rfactr  = 1. / rfact 
    100103         rfact2  = rfact / REAL( nrdttrc, wp ) 
    … …  
    110113      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN 
    111114         DO jn = jp_pcs0, jp_pcs1              !   SMS on tracer without Asselin time-filter 
    112             trb(:,:,:,jn) = trn(:,:,:,jn) 
     115            tr(:,:,:,jn,Kbb) = tr(:,:,:,jn,Kmm) 
    113116         END DO 
    114117      ENDIF 
    115118      ! 
    116       IF( ll_sbc ) CALL p4z_sbc( kt )   ! external sources of nutrients  
     119      IF( ll_bc )    CALL p4z_bc( kt, Kbb, Kmm, Krhs )   ! external sources of nutrients  
    117120      ! 
    118121#if ! defined key_sed_off 
    119       CALL p4z_che              ! computation of chemical constants 
    120       CALL p4z_int( kt )        ! computation of various rates for biogeochemistry 
     122      CALL p4z_che(     Kbb, Kmm       ) ! computation of chemical constants 
     123      CALL p4z_int( kt, Kbb, Kmm       ) ! computation of various rates for biogeochemistry 
    121124      ! 
    122125      DO jnt = 1, nrdttrc          ! Potential time splitting if requested 
    123126         ! 
    124          CALL p4z_bio( kt, jnt )   ! Biology 
    125          CALL p4z_lys( kt, jnt )   ! Compute CaCO3 saturation 
    126          CALL p4z_sed( kt, jnt )   ! Surface and Bottom boundary conditions 
    127          CALL p4z_flx( kt, jnt )   ! Compute surface fluxes 
     127         CALL p4z_bio( kt, jnt, Kbb, Kmm, Krhs )   ! Biology 
     128         CALL p4z_lys( kt, jnt, Kbb,      Krhs )   ! Compute CaCO3 saturation 
     129         CALL p4z_sed( kt, jnt, Kbb, Kmm, Krhs )   ! Surface and Bottom boundary conditions 
     130         CALL p4z_flx( kt, jnt, Kbb, Kmm, Krhs )   ! Compute surface fluxes 
    128131         ! 
    129132         xnegtr(:,:,:) = 1.e0 
    130133         DO jn = jp_pcs0, jp_pcs1 
    131             DO jk = 1, jpk 
    132                DO jj = 1, jpj 
    133                   DO ji = 1, jpi 
    134                      IF( ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN 
    135                         ztra             = ABS( trb(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn ) 
    136                         xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk),  ztra ) 
    137                      ENDIF 
    138                  END DO 
    139                END DO 
    140             END DO 
     134            DO_3D_11_11( 1, jpk ) 
     135               IF( ( tr(ji,jj,jk,jn,Kbb) + tr(ji,jj,jk,jn,Krhs) ) < 0.e0 ) THEN 
     136                  ztra             = ABS( tr(ji,jj,jk,jn,Kbb) ) / ( ABS( tr(ji,jj,jk,jn,Krhs) ) + rtrn ) 
     137                  xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk),  ztra ) 
     138               ENDIF 
     139            END_3D 
    141140         END DO 
    142141         !                                ! where at least 1 tracer concentration becomes negative 
    143142         !                                !  
    144143         DO jn = jp_pcs0, jp_pcs1 
    145            trb(:,:,:,jn) = trb(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn) 
     144           tr(:,:,:,jn,Kbb) = tr(:,:,:,jn,Kbb) + xnegtr(:,:,:) * tr(:,:,:,jn,Krhs) 
    146145         END DO 
    147146        ! 
    … …  
    152151          zw3d(:,:,jpk) = 0. 
    153152          DO jk = 1, jpkm1 
    154               zw3d(:,:,jk) = xnegtr(:,:,jk) * xfact * e3t_n(:,:,jk) * tmask(:,:,jk) 
     153              zw3d(:,:,jk) = xnegtr(:,:,jk) * xfact * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
    155154          ENDDO 
    156155          ! 
    157156          zw2d(:,:) = 0. 
    158157          DO jk = 1, jpkm1 
    159              zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tra(:,:,jk,jptal) 
     158             zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jptal,Krhs) 
    160159          ENDDO 
    161160          CALL iom_put( 'INTdtAlk', zw2d ) 
    … …  
    163162          zw2d(:,:) = 0. 
    164163          DO jk = 1, jpkm1 
    165              zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tra(:,:,jk,jpdic) 
     164             zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpdic,Krhs) 
    166165          ENDDO 
    167166          CALL iom_put( 'INTdtDIC', zw2d ) 
    … …  
    169168          zw2d(:,:) = 0. 
    170169          DO jk = 1, jpkm1 
    171              zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * rno3 * ( tra(:,:,jk,jpno3) + tra(:,:,jk,jpnh4) ) 
     170             zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * rno3 * ( tr(:,:,jk,jpno3,Krhs) + tr(:,:,jk,jpnh4,Krhs) ) 
    172171          ENDDO 
    173172          CALL iom_put( 'INTdtDIN', zw2d ) 
    … …  
    175174          zw2d(:,:) = 0. 
    176175          DO jk = 1, jpkm1 
    177              zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * po4r * tra(:,:,jk,jppo4) 
     176             zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * po4r * tr(:,:,jk,jppo4,Krhs) 
    178177          ENDDO 
    179178          CALL iom_put( 'INTdtDIP', zw2d ) 
    … …  
    181180          zw2d(:,:) = 0. 
    182181          DO jk = 1, jpkm1 
    183              zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tra(:,:,jk,jpfer) 
     182             zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpfer,Krhs) 
    184183          ENDDO 
    185184          CALL iom_put( 'INTdtFer', zw2d ) 
    … …  
    187186          zw2d(:,:) = 0. 
    188187          DO jk = 1, jpkm1 
    189              zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tra(:,:,jk,jpsil) 
     188             zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpsil,Krhs) 
    190189          ENDDO 
    191190          CALL iom_put( 'INTdtSil', zw2d ) 
    … …  
    195194        ! 
    196195         DO jn = jp_pcs0, jp_pcs1 
    197             tra(:,:,:,jn) = 0._wp 
     196            tr(:,:,:,jn,Krhs) = 0._wp 
    198197         END DO 
    199198         ! 
    200199         IF( ln_top_euler ) THEN 
    201200            DO jn = jp_pcs0, jp_pcs1 
    202                trn(:,:,:,jn) = trb(:,:,:,jn) 
     201               tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 
    203202            END DO 
    204203         ENDIF 
    … …  
    207206      IF( l_trdtrc ) THEN 
    208207         DO jn = jp_pcs0, jp_pcs1 
    209            ztrdt(:,:,:,jn) = ( trb(:,:,:,jn) - ztrdt(:,:,:,jn) ) * rfact2r  
    210            CALL trd_trc( ztrdt(:,:,:,jn), jn, jptra_sms, kt )   ! save trends 
     208           ztrdt(:,:,:,jn) = ( tr(:,:,:,jn,Kbb) - ztrdt(:,:,:,jn) ) * rfact2r  
     209           CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm )   ! save trends 
    211210         END DO 
    212211         DEALLOCATE( ztrdt )  
    … …  
    216215      IF( ln_sediment ) THEN  
    217216         ! 
    218          CALL sed_model( kt )     !  Main program of Sediment model 
     217         CALL sed_model( kt, Kbb, Kmm, Krhs )     !  Main program of Sediment model 
    219218         ! 
    220219         IF( ln_top_euler ) THEN 
    221220            DO jn = jp_pcs0, jp_pcs1 
    222                trn(:,:,:,jn) = trb(:,:,:,jn) 
     221               tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 
    223222            END DO 
    224223         ENDIF 
    … …  
    226225      ENDIF 
    227226      ! 
    228       IF( lrst_trc )  CALL p4z_rst( kt, 'WRITE' )  !* Write PISCES informations in restart file  
    229       ! 
    230  
    231       IF( lk_iomput .OR. ln_check_mass )  CALL p4z_chk_mass( kt )    ! Mass conservation checking 
    232  
    233       IF( lwm .AND. kt == nittrc000    )  CALL FLUSH( numonp )       ! flush output namelist PISCES 
     227      IF( lrst_trc )  CALL p4z_rst( kt, Kbb, Kmm,  'WRITE' )           !* Write PISCES informations in restart file  
     228      ! 
     229 
     230      IF( lk_iomput .OR. ln_check_mass )  CALL p4z_chk_mass( kt, Kmm ) ! Mass conservation checking 
     231 
     232      IF( lwm .AND. kt == nittrc000    )  CALL FLUSH( numonp )         ! flush output namelist PISCES 
    234233      ! 
    235234      IF( ln_timing )  CALL timing_stop('p4z_sms') 
    … …  
    262261      ENDIF 
    263262 
    264       REWIND( numnatp_ref )              ! Namelist nampisbio in reference namelist : Pisces variables 
    265263      READ  ( numnatp_ref, nampisbio, IOSTAT = ios, ERR = 901) 
    266264901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisbio in reference namelist' ) 
    267       REWIND( numnatp_cfg )              ! Namelist nampisbio in configuration namelist : Pisces variables 
    268265      READ  ( numnatp_cfg, nampisbio, IOSTAT = ios, ERR = 902 ) 
    269266902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisbio in configuration namelist' ) 
    … …  
    293290 
    294291 
    295       REWIND( numnatp_ref )              ! Namelist nampisdmp in reference namelist : Pisces damping 
    296292      READ  ( numnatp_ref, nampisdmp, IOSTAT = ios, ERR = 905) 
    297293905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisdmp in reference namelist' ) 
    298       REWIND( numnatp_cfg )              ! Namelist nampisdmp in configuration namelist : Pisces damping 
    299294      READ  ( numnatp_cfg, nampisdmp, IOSTAT = ios, ERR = 906 ) 
    300295906   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisdmp in configuration namelist' ) 
    … …  
    308303      ENDIF 
    309304 
    310       REWIND( numnatp_ref )              ! Namelist nampismass in reference namelist : Pisces mass conservation check 
    311305      READ  ( numnatp_ref, nampismass, IOSTAT = ios, ERR = 907) 
    312306907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampismass in reference namelist' ) 
    313       REWIND( numnatp_cfg )              ! Namelist nampismass in configuration namelist : Pisces mass conservation check  
    314307      READ  ( numnatp_cfg, nampismass, IOSTAT = ios, ERR = 908 ) 
    315308908   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampismass in configuration namelist' ) 
    … …  
    325318 
    326319 
    327    SUBROUTINE p4z_rst( kt, cdrw ) 
     320   SUBROUTINE p4z_rst( kt, Kbb, Kmm, cdrw ) 
    328321      !!--------------------------------------------------------------------- 
    329322      !!                   ***  ROUTINE p4z_rst  *** 
    … …  
    336329      !!--------------------------------------------------------------------- 
    337330      INTEGER         , INTENT(in) ::   kt         ! ocean time-step 
     331      INTEGER         , INTENT(in) ::   Kbb, Kmm   ! time level indices 
    338332      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
    339333      !!--------------------------------------------------------------------- 
    … …  
    348342            CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:)  ) 
    349343         ELSE 
    350             CALL p4z_che                              ! initialize the chemical constants 
    351             CALL ahini_for_at(hi) 
     344            CALL p4z_che( Kbb, Kmm )                  ! initialize the chemical constants 
     345            CALL ahini_for_at( hi, Kbb ) 
    352346         ENDIF 
    353347         CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) ) 
    … …  
    396390 
    397391 
    398    SUBROUTINE p4z_dmp( kt ) 
     392   SUBROUTINE p4z_dmp( kt, Kbb, Kmm ) 
    399393      !!---------------------------------------------------------------------- 
    400394      !!                    ***  p4z_dmp  *** 
    … …  
    403397      !!---------------------------------------------------------------------- 
    404398      ! 
    405       INTEGER, INTENT( in )  ::     kt ! time step 
     399      INTEGER, INTENT( in )  ::     kt            ! time step 
     400      INTEGER, INTENT( in )  ::     Kbb, Kmm      ! time level indices 
    406401      ! 
    407402      REAL(wp) ::  alkmean = 2426.     ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) 
    … …  
    424419            zarea          = 1._wp / glob_sum( 'p4zsms', cvol(:,:,:) ) * 1e6               
    425420 
    426             zalksumn = glob_sum( 'p4zsms', trn(:,:,:,jptal) * cvol(:,:,:)  ) * zarea 
    427             zpo4sumn = glob_sum( 'p4zsms', trn(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r 
    428             zno3sumn = glob_sum( 'p4zsms', trn(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3 
    429             zsilsumn = glob_sum( 'p4zsms', trn(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea 
     421            zalksumn = glob_sum( 'p4zsms', tr(:,:,:,jptal,Kmm) * cvol(:,:,:)  ) * zarea 
     422            zpo4sumn = glob_sum( 'p4zsms', tr(:,:,:,jppo4,Kmm) * cvol(:,:,:)  ) * zarea * po4r 
     423            zno3sumn = glob_sum( 'p4zsms', tr(:,:,:,jpno3,Kmm) * cvol(:,:,:)  ) * zarea * rno3 
     424            zsilsumn = glob_sum( 'p4zsms', tr(:,:,:,jpsil,Kmm) * cvol(:,:,:)  ) * zarea 
    430425  
    431426            IF(lwp) WRITE(numout,*) '       TALKN mean : ', zalksumn 
    432             trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn 
     427            tr(:,:,:,jptal,Kmm) = tr(:,:,:,jptal,Kmm) * alkmean / zalksumn 
    433428 
    434429            IF(lwp) WRITE(numout,*) '       PO4N  mean : ', zpo4sumn 
    435             trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn 
     430            tr(:,:,:,jppo4,Kmm) = tr(:,:,:,jppo4,Kmm) * po4mean / zpo4sumn 
    436431 
    437432            IF(lwp) WRITE(numout,*) '       NO3N  mean : ', zno3sumn 
    438             trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn 
     433            tr(:,:,:,jpno3,Kmm) = tr(:,:,:,jpno3,Kmm) * no3mean / zno3sumn 
    439434 
    440435            IF(lwp) WRITE(numout,*) '       SiO3N mean : ', zsilsumn 
    441             trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn ) 
     436            tr(:,:,:,jpsil,Kmm) = MIN( 400.e-6,tr(:,:,:,jpsil,Kmm) * silmean / zsilsumn ) 
    442437            ! 
    443438            ! 
    444439            IF( .NOT. ln_top_euler ) THEN 
    445                zalksumb = glob_sum( 'p4zsms', trb(:,:,:,jptal) * cvol(:,:,:)  ) * zarea 
    446                zpo4sumb = glob_sum( 'p4zsms', trb(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r 
    447                zno3sumb = glob_sum( 'p4zsms', trb(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3 
    448                zsilsumb = glob_sum( 'p4zsms', trb(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea 
     440               zalksumb = glob_sum( 'p4zsms', tr(:,:,:,jptal,Kbb) * cvol(:,:,:)  ) * zarea 
     441               zpo4sumb = glob_sum( 'p4zsms', tr(:,:,:,jppo4,Kbb) * cvol(:,:,:)  ) * zarea * po4r 
     442               zno3sumb = glob_sum( 'p4zsms', tr(:,:,:,jpno3,Kbb) * cvol(:,:,:)  ) * zarea * rno3 
     443               zsilsumb = glob_sum( 'p4zsms', tr(:,:,:,jpsil,Kbb) * cvol(:,:,:)  ) * zarea 
    449444  
    450445               IF(lwp) WRITE(numout,*) ' ' 
    451446               IF(lwp) WRITE(numout,*) '       TALKB mean : ', zalksumb 
    452                trb(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb 
     447               tr(:,:,:,jptal,Kbb) = tr(:,:,:,jptal,Kbb) * alkmean / zalksumb 
    453448 
    454449               IF(lwp) WRITE(numout,*) '       PO4B  mean : ', zpo4sumb 
    455                trb(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb 
     450               tr(:,:,:,jppo4,Kbb) = tr(:,:,:,jppo4,Kbb) * po4mean / zpo4sumb 
    456451 
    457452               IF(lwp) WRITE(numout,*) '       NO3B  mean : ', zno3sumb 
    458                trb(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb 
     453               tr(:,:,:,jpno3,Kbb) = tr(:,:,:,jpno3,Kbb) * no3mean / zno3sumb 
    459454 
    460455               IF(lwp) WRITE(numout,*) '       SiO3B mean : ', zsilsumb 
    461                trb(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb ) 
     456               tr(:,:,:,jpsil,Kbb) = MIN( 400.e-6,tr(:,:,:,jpsil,Kbb) * silmean / zsilsumb ) 
    462457           ENDIF 
    463458        ENDIF 
    … …  
    468463 
    469464 
    470    SUBROUTINE p4z_chk_mass( kt ) 
     465   SUBROUTINE p4z_chk_mass( kt, Kmm ) 
    471466      !!---------------------------------------------------------------------- 
    472467      !!                  ***  ROUTINE p4z_chk_mass  *** 
    … …  
    476471      !!--------------------------------------------------------------------- 
    477472      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     473      INTEGER, INTENT( in ) ::   Kmm     ! time level indices 
    478474      REAL(wp)             ::  zrdenittot, zsdenittot, znitrpottot 
    479475      CHARACTER(LEN=100)   ::   cltxt 
    … …  
    499495         !   Compute the budget of NO3, ALK, Si, Fer 
    500496         IF( ln_p4z ) THEN 
    501             zwork(:,:,:) =    trn(:,:,:,jpno3) + trn(:,:,:,jpnh4)                      & 
    502                &          +   trn(:,:,:,jpphy) + trn(:,:,:,jpdia)                      & 
    503                &          +   trn(:,:,:,jppoc) + trn(:,:,:,jpgoc)  + trn(:,:,:,jpdoc)  &         
    504                &          +   trn(:,:,:,jpzoo) + trn(:,:,:,jpmes)  
     497            zwork(:,:,:) =    tr(:,:,:,jpno3,Kmm) + tr(:,:,:,jpnh4,Kmm)                      & 
     498               &          +   tr(:,:,:,jpphy,Kmm) + tr(:,:,:,jpdia,Kmm)                      & 
     499               &          +   tr(:,:,:,jppoc,Kmm) + tr(:,:,:,jpgoc,Kmm)  + tr(:,:,:,jpdoc,Kmm)  &         
     500               &          +   tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm)  
    505501        ELSE 
    506             zwork(:,:,:) =    trn(:,:,:,jpno3) + trn(:,:,:,jpnh4) + trn(:,:,:,jpnph)   & 
    507                &          +   trn(:,:,:,jpndi) + trn(:,:,:,jpnpi)                      &  
    508                &          +   trn(:,:,:,jppon) + trn(:,:,:,jpgon) + trn(:,:,:,jpdon)   & 
    509                &          + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * no3rat3  
     502            zwork(:,:,:) =    tr(:,:,:,jpno3,Kmm) + tr(:,:,:,jpnh4,Kmm) + tr(:,:,:,jpnph,Kmm)   & 
     503               &          +   tr(:,:,:,jpndi,Kmm) + tr(:,:,:,jpnpi,Kmm)                      &  
     504               &          +   tr(:,:,:,jppon,Kmm) + tr(:,:,:,jpgon,Kmm) + tr(:,:,:,jpdon,Kmm)   & 
     505               &          + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * no3rat3  
    510506        ENDIF 
    511507        ! 
    … …  
    517513      IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
    518514         IF( ln_p4z ) THEN 
    519             zwork(:,:,:) =    trn(:,:,:,jppo4)                                         & 
    520                &          +   trn(:,:,:,jpphy) + trn(:,:,:,jpdia)                      & 
    521                &          +   trn(:,:,:,jppoc) + trn(:,:,:,jpgoc)  + trn(:,:,:,jpdoc)  &         
    522                &          +   trn(:,:,:,jpzoo) + trn(:,:,:,jpmes)  
     515            zwork(:,:,:) =    tr(:,:,:,jppo4,Kmm)                                         & 
     516               &          +   tr(:,:,:,jpphy,Kmm) + tr(:,:,:,jpdia,Kmm)                      & 
     517               &          +   tr(:,:,:,jppoc,Kmm) + tr(:,:,:,jpgoc,Kmm)  + tr(:,:,:,jpdoc,Kmm)  &         
     518               &          +   tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm)  
    523519        ELSE 
    524             zwork(:,:,:) =    trn(:,:,:,jppo4) + trn(:,:,:,jppph)                      & 
    525                &          +   trn(:,:,:,jppdi) + trn(:,:,:,jpppi)                      &  
    526                &          +   trn(:,:,:,jppop) + trn(:,:,:,jpgop) + trn(:,:,:,jpdop)   & 
    527                &          + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * po4rat3  
     520            zwork(:,:,:) =    tr(:,:,:,jppo4,Kmm) + tr(:,:,:,jppph,Kmm)                      & 
     521               &          +   tr(:,:,:,jppdi,Kmm) + tr(:,:,:,jpppi,Kmm)                      &  
     522               &          +   tr(:,:,:,jppop,Kmm) + tr(:,:,:,jpgop,Kmm) + tr(:,:,:,jpdop,Kmm)   & 
     523               &          + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * po4rat3  
    528524        ENDIF 
    529525        ! 
    … …  
    534530      ! 
    535531      IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
    536          zwork(:,:,:) =  trn(:,:,:,jpsil) + trn(:,:,:,jpgsi) + trn(:,:,:,jpdsi)  
     532         zwork(:,:,:) =  tr(:,:,:,jpsil,Kmm) + tr(:,:,:,jpgsi,Kmm) + tr(:,:,:,jpdsi,Kmm)  
    537533         ! 
    538534         silbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:)  )   
    … …  
    542538      ! 
    543539      IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
    544          zwork(:,:,:) =  trn(:,:,:,jpno3) * rno3 + trn(:,:,:,jptal) + trn(:,:,:,jpcal) * 2.               
     540         zwork(:,:,:) =  tr(:,:,:,jpno3,Kmm) * rno3 + tr(:,:,:,jptal,Kmm) + tr(:,:,:,jpcal,Kmm) * 2.               
    545541         ! 
    546542         alkbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:)  )         ! 
    … …  
    550546      ! 
    551547      IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
    552          zwork(:,:,:) =   trn(:,:,:,jpfer) + trn(:,:,:,jpnfe) + trn(:,:,:,jpdfe)   & 
    553             &         +   trn(:,:,:,jpbfe) + trn(:,:,:,jpsfe)                      & 
    554             &         + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) )  * ferat3     
     548         zwork(:,:,:) =   tr(:,:,:,jpfer,Kmm) + tr(:,:,:,jpnfe,Kmm) + tr(:,:,:,jpdfe,Kmm)   & 
     549            &         +   tr(:,:,:,jpbfe,Kmm) + tr(:,:,:,jpsfe,Kmm)                      & 
     550            &         + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) )  * ferat3     
    555551         ! 
    556552         ferbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:)  )   

  • NEMO/trunk/src/TOP/PISCES/P4Z/p5zlim.F90

    r12277 r12377  
    9191   REAL(wp) ::  xcoef2   = 1.21E-5 * 14. / 55.85 / 7.625 * 0.5 * 1.5 
    9292   REAL(wp) ::  xcoef3   = 1.15E-4 * 14. / 55.85 / 7.625 * 0.5  
     93   !! * Substitutions 
     94#  include "do_loop_substitute.h90" 
    9395   !!---------------------------------------------------------------------- 
    9496   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    99101CONTAINS 
    100102 
    101    SUBROUTINE p5z_lim( kt, knt ) 
     103   SUBROUTINE p5z_lim( kt, knt, Kbb, Kmm ) 
    102104      !!--------------------------------------------------------------------- 
    103105      !!                     ***  ROUTINE p5z_lim  *** 
    … …  
    110112      ! 
    111113      INTEGER, INTENT(in)  :: kt, knt 
     114      INTEGER, INTENT(in)  :: Kbb, Kmm  ! time level indices 
    112115      ! 
    113116      INTEGER  ::   ji, jj, jk 
    … …  
    128131      zratchl = 6.0 
    129132      ! 
    130       DO jk = 1, jpkm1 
    131          DO jj = 1, jpj 
    132             DO ji = 1, jpi 
    133                !  
    134                ! Tuning of the iron concentration to a minimum level that is set to the detection limit 
    135                !------------------------------------- 
    136                zno3    = trb(ji,jj,jk,jpno3) / 40.e-6 
    137                zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 ) 
    138                zferlim = MIN( zferlim, 7e-11 ) 
    139                trb(ji,jj,jk,jpfer) = MAX( trb(ji,jj,jk,jpfer), zferlim ) 
    140  
    141                ! Computation of the mean relative size of each community 
    142                ! ------------------------------------------------------- 
    143                z1_trnphy   = 1. / ( trb(ji,jj,jk,jpphy) + rtrn ) 
    144                z1_trnpic   = 1. / ( trb(ji,jj,jk,jppic) + rtrn ) 
    145                z1_trndia   = 1. / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    146                znanochl = trb(ji,jj,jk,jpnch) * z1_trnphy 
    147                zpicochl = trb(ji,jj,jk,jppch) * z1_trnpic 
    148                zdiatchl = trb(ji,jj,jk,jpdch) * z1_trndia 
    149  
    150                ! Computation of a variable Ks for iron on diatoms taking into account 
    151                ! that increasing biomass is made of generally bigger cells 
    152                !------------------------------------------------ 
    153                zsized            = sized(ji,jj,jk)**0.81 
    154                zconcdfe          = concdfer * zsized 
    155                zconc1d           = concdno3 * zsized 
    156                zconc1dnh4        = concdnh4 * zsized 
    157                zconc0dpo4        = concdpo4 * zsized 
    158  
    159                zsizep            = 1. 
    160                zconcpfe          = concpfer * zsizep 
    161                zconc0p           = concpno3 * zsizep 
    162                zconc0pnh4        = concpnh4 * zsizep 
    163                zconc0ppo4        = concppo4 * zsizep 
    164  
    165                zsizen            = 1. 
    166                zconcnfe          = concnfer * zsizen 
    167                zconc0n           = concnno3 * zsizen 
    168                zconc0nnh4        = concnnh4 * zsizen 
    169                zconc0npo4        = concnpo4 * zsizen 
    170  
    171                ! Allometric variations of the minimum and maximum quotas 
    172                ! From Talmy et al. (2014) and Maranon et al. (2013) 
    173                ! ------------------------------------------------------- 
    174                xqnnmin(ji,jj,jk) = qnnmin 
    175                xqnnmax(ji,jj,jk) = qnnmax 
    176                xqndmin(ji,jj,jk) = qndmin * sized(ji,jj,jk)**(-0.27)  
    177                xqndmax(ji,jj,jk) = qndmax 
    178                xqnpmin(ji,jj,jk) = qnpmin 
    179                xqnpmax(ji,jj,jk) = qnpmax 
    180  
    181                ! Computation of the optimal allocation parameters 
    182                ! Based on the different papers by Pahlow et al., and Smith et al. 
    183                ! ----------------------------------------------------------------- 
    184                znutlim = MAX( trb(ji,jj,jk,jpnh4) / zconc0nnh4,    & 
    185                  &         trb(ji,jj,jk,jpno3) / zconc0n) 
    186                fanano = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
    187                znutlim = trb(ji,jj,jk,jppo4) / zconc0npo4 
    188                fananop = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
    189                znutlim = biron(ji,jj,jk) / zconcnfe 
    190                fananof = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
    191                znutlim = MAX( trb(ji,jj,jk,jpnh4) / zconc0pnh4,    & 
    192                  &         trb(ji,jj,jk,jpno3) / zconc0p) 
    193                fapico = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
    194                znutlim = trb(ji,jj,jk,jppo4) / zconc0ppo4 
    195                fapicop = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
    196                znutlim = biron(ji,jj,jk) / zconcpfe 
    197                fapicof = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
    198                znutlim = MAX( trb(ji,jj,jk,jpnh4) / zconc1dnh4,    & 
    199                  &         trb(ji,jj,jk,jpno3) / zconc1d ) 
    200                fadiat = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
    201                znutlim = trb(ji,jj,jk,jppo4) / zconc0dpo4 
    202                fadiatp = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
    203                znutlim = biron(ji,jj,jk) / zconcdfe 
    204                fadiatf = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
    205                ! 
    206                ! Michaelis-Menten Limitation term for nutrients Small bacteria 
    207                ! ------------------------------------------------------------- 
    208                zbactnh4 = trb(ji,jj,jk,jpnh4) / ( concbnh4 + trb(ji,jj,jk,jpnh4) ) 
    209                zbactno3 = trb(ji,jj,jk,jpno3) / ( concbno3 + trb(ji,jj,jk,jpno3) ) * (1. - zbactnh4) 
    210                ! 
    211                zlim1    = zbactno3 + zbactnh4 
    212                zlim2    = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concbpo4) 
    213                zlim3    = biron(ji,jj,jk) / ( concbfe + biron(ji,jj,jk) ) 
    214                zlim4    = trb(ji,jj,jk,jpdoc) / ( xkdoc   + trb(ji,jj,jk,jpdoc) ) 
    215                xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 
    216                xlimbac (ji,jj,jk) = xlimbacl(ji,jj,jk) * zlim4 
    217                ! 
    218                ! Michaelis-Menten Limitation term for nutrients Small flagellates 
    219                ! ----------------------------------------------- 
    220                zfalim = (1.-fanano) / fanano 
    221                xnanonh4(ji,jj,jk) = (1. - fanano) * trb(ji,jj,jk,jpnh4) / ( zfalim * zconc0nnh4 + trb(ji,jj,jk,jpnh4) ) 
    222                xnanono3(ji,jj,jk) = (1. - fanano) * trb(ji,jj,jk,jpno3) / ( zfalim * zconc0n + trb(ji,jj,jk,jpno3) )  & 
    223                &                    * (1. - xnanonh4(ji,jj,jk)) 
    224                ! 
    225                zfalim = (1.-fananop) / fananop 
    226                xnanopo4(ji,jj,jk) = (1. - fananop) * trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zfalim * zconc0npo4 ) 
    227                xnanodop(ji,jj,jk) = trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdop) + xkdoc )   & 
    228                &                    * ( 1.0 - xnanopo4(ji,jj,jk) ) 
    229                xnanodop(ji,jj,jk) = 0. 
    230                ! 
    231                zfalim = (1.-fananof) / fananof 
    232                xnanofer(ji,jj,jk) = (1. - fananof) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcnfe ) 
    233                ! 
    234                zratiof   = trb(ji,jj,jk,jpnfe) * z1_trnphy 
    235                zqfemn = xcoef1 * znanochl + xcoef2 + xcoef3 * xnanono3(ji,jj,jk) 
    236                ! 
    237                zration = trb(ji,jj,jk,jpnph) * z1_trnphy 
    238                zration = MIN(xqnnmax(ji,jj,jk), MAX( 2. * xqnnmin(ji,jj,jk), zration )) 
    239                fvnuptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqnnmin(ji,jj,jk) / (zration + rtrn)  & 
    240                &                   * MAX(0., (1. - zratchl * znanochl / 12. ) ) 
    241                ! 
    242                zlim1    = max(0., (zration - 2. * xqnnmin(ji,jj,jk) )  & 
    243                &          / (xqnnmax(ji,jj,jk) - 2. * xqnnmin(ji,jj,jk) ) ) * xqnnmax(ji,jj,jk)  & 
    244                &          / (zration + rtrn) 
    245                zlim3    = MAX( 0.,( zratiof - zqfemn ) / qfnopt )  
    246                xlimnfe(ji,jj,jk) = MIN( 1., zlim3 ) 
    247                xlimphy(ji,jj,jk) = MIN( 1., zlim1, zlim3 ) 
    248                ! 
    249                ! Michaelis-Menten Limitation term for nutrients picophytoplankton 
    250                ! ---------------------------------------------------------------- 
    251                zfalim = (1.-fapico) / fapico  
    252                xpiconh4(ji,jj,jk) = (1. - fapico) * trb(ji,jj,jk,jpnh4) / ( zfalim * zconc0pnh4 + trb(ji,jj,jk,jpnh4) ) 
    253                xpicono3(ji,jj,jk) = (1. - fapico) * trb(ji,jj,jk,jpno3) / ( zfalim * zconc0p + trb(ji,jj,jk,jpno3) )  & 
    254                &                    * (1. - xpiconh4(ji,jj,jk)) 
    255                ! 
    256                zfalim = (1.-fapicop) / fapicop  
    257                xpicopo4(ji,jj,jk) = (1. - fapicop) * trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zfalim * zconc0ppo4 ) 
    258                xpicodop(ji,jj,jk) = trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdop) + xkdoc )   & 
    259                &                    * ( 1.0 - xpicopo4(ji,jj,jk) ) 
    260                xpicodop(ji,jj,jk) = 0. 
    261                ! 
    262                zfalim = (1.-fapicof) / fapicof 
    263                xpicofer(ji,jj,jk) = (1. - fapicof) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcpfe ) 
    264                ! 
    265                zratiof   = trb(ji,jj,jk,jppfe) * z1_trnpic 
    266                zqfemp = xcoef1 * zpicochl + xcoef2 + xcoef3 * xpicono3(ji,jj,jk) 
    267                ! 
    268                zration   = trb(ji,jj,jk,jpnpi) * z1_trnpic 
    269                zration = MIN(xqnpmax(ji,jj,jk), MAX( 2. * xqnpmin(ji,jj,jk), zration )) 
    270                fvpuptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqnpmin(ji,jj,jk) / (zration + rtrn)  & 
    271                &                   * MAX(0., (1. - zratchl * zpicochl / 12. ) )  
    272                ! 
    273                zlim1    = max(0., (zration - 2. * xqnpmin(ji,jj,jk) )  & 
    274                &          / (xqnpmax(ji,jj,jk) - 2. * xqnpmin(ji,jj,jk) ) ) * xqnpmax(ji,jj,jk)  & 
    275                &          / (zration + rtrn) 
    276                zlim3    = MAX( 0.,( zratiof - zqfemp ) / qfpopt ) 
    277                xlimpfe(ji,jj,jk) = MIN( 1., zlim3 ) 
    278                xlimpic(ji,jj,jk) = MIN( 1., zlim1, zlim3 ) 
    279                ! 
    280                !   Michaelis-Menten Limitation term for nutrients Diatoms 
    281                !   ------------------------------------------------------ 
    282                zfalim = (1.-fadiat) / fadiat  
    283                xdiatnh4(ji,jj,jk) = (1. - fadiat) * trb(ji,jj,jk,jpnh4) / ( zfalim * zconc1dnh4 + trb(ji,jj,jk,jpnh4) ) 
    284                xdiatno3(ji,jj,jk) = (1. - fadiat) * trb(ji,jj,jk,jpno3) / ( zfalim * zconc1d + trb(ji,jj,jk,jpno3) )  & 
    285                &                    * (1. - xdiatnh4(ji,jj,jk)) 
    286                ! 
    287                zfalim = (1.-fadiatp) / fadiatp 
    288                xdiatpo4(ji,jj,jk) = (1. - fadiatp) * trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zfalim * zconc0dpo4 ) 
    289                xdiatdop(ji,jj,jk) = trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdop) + xkdoc )  & 
    290                &                    * ( 1.0 - xdiatpo4(ji,jj,jk) ) 
    291                xdiatdop(ji,jj,jk) = 0. 
    292                ! 
    293                zfalim = (1.-fadiatf) / fadiatf 
    294                xdiatfer(ji,jj,jk) = (1. - fadiatf) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcdfe ) 
    295                ! 
    296                zratiof   = trb(ji,jj,jk,jpdfe) * z1_trndia 
    297                zqfemd = xcoef1 * zdiatchl + xcoef2 + xcoef3 * xdiatno3(ji,jj,jk) 
    298                ! 
    299                zration   = trb(ji,jj,jk,jpndi) * z1_trndia 
    300                zration = MIN(xqndmax(ji,jj,jk), MAX( 2. * xqndmin(ji,jj,jk), zration )) 
    301                fvduptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqndmin(ji,jj,jk) / (zration + rtrn)   & 
    302                &                   * MAX(0., (1. - zratchl * zdiatchl / 12. ) )  
    303                ! 
    304                zlim1    = max(0., (zration - 2. * xqndmin(ji,jj,jk) )    & 
    305                &          / (xqndmax(ji,jj,jk) - 2. * xqndmin(ji,jj,jk) ) )   & 
    306                &          * xqndmax(ji,jj,jk) / (zration + rtrn) 
    307                zlim3    = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi(ji,jj) ) 
    308                zlim4    = MAX( 0., ( zratiof - zqfemd ) / qfdopt ) 
    309                xlimdfe(ji,jj,jk) = MIN( 1., zlim4 ) 
    310                xlimdia(ji,jj,jk) = MIN( 1., zlim1, zlim3, zlim4 ) 
    311                xlimsi(ji,jj,jk)  = MIN( zlim1, zlim4 ) 
    312             END DO 
    313          END DO 
    314       END DO 
     133      DO_3D_11_11( 1, jpkm1 ) 
     134         !  
     135         ! Tuning of the iron concentration to a minimum level that is set to the detection limit 
     136         !------------------------------------- 
     137         zno3    = tr(ji,jj,jk,jpno3,Kbb) / 40.e-6 
     138         zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 ) 
     139         zferlim = MIN( zferlim, 7e-11 ) 
     140         tr(ji,jj,jk,jpfer,Kbb) = MAX( tr(ji,jj,jk,jpfer,Kbb), zferlim ) 
     141 
     142         ! Computation of the mean relative size of each community 
     143         ! ------------------------------------------------------- 
     144         z1_trnphy   = 1. / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
     145         z1_trnpic   = 1. / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 
     146         z1_trndia   = 1. / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     147         znanochl = tr(ji,jj,jk,jpnch,Kbb) * z1_trnphy 
     148         zpicochl = tr(ji,jj,jk,jppch,Kbb) * z1_trnpic 
     149         zdiatchl = tr(ji,jj,jk,jpdch,Kbb) * z1_trndia 
     150 
     151         ! Computation of a variable Ks for iron on diatoms taking into account 
     152         ! that increasing biomass is made of generally bigger cells 
     153         !------------------------------------------------ 
     154         zsized            = sized(ji,jj,jk)**0.81 
     155         zconcdfe          = concdfer * zsized 
     156         zconc1d           = concdno3 * zsized 
     157         zconc1dnh4        = concdnh4 * zsized 
     158         zconc0dpo4        = concdpo4 * zsized 
     159 
     160         zsizep            = 1. 
     161         zconcpfe          = concpfer * zsizep 
     162         zconc0p           = concpno3 * zsizep 
     163         zconc0pnh4        = concpnh4 * zsizep 
     164         zconc0ppo4        = concppo4 * zsizep 
     165 
     166         zsizen            = 1. 
     167         zconcnfe          = concnfer * zsizen 
     168         zconc0n           = concnno3 * zsizen 
     169         zconc0nnh4        = concnnh4 * zsizen 
     170         zconc0npo4        = concnpo4 * zsizen 
     171 
     172         ! Allometric variations of the minimum and maximum quotas 
     173         ! From Talmy et al. (2014) and Maranon et al. (2013) 
     174         ! ------------------------------------------------------- 
     175         xqnnmin(ji,jj,jk) = qnnmin 
     176         xqnnmax(ji,jj,jk) = qnnmax 
     177         xqndmin(ji,jj,jk) = qndmin * sized(ji,jj,jk)**(-0.27)  
     178         xqndmax(ji,jj,jk) = qndmax 
     179         xqnpmin(ji,jj,jk) = qnpmin 
     180         xqnpmax(ji,jj,jk) = qnpmax 
     181 
     182         ! Computation of the optimal allocation parameters 
     183         ! Based on the different papers by Pahlow et al., and Smith et al. 
     184         ! ----------------------------------------------------------------- 
     185         znutlim = MAX( tr(ji,jj,jk,jpnh4,Kbb) / zconc0nnh4,    & 
     186           &         tr(ji,jj,jk,jpno3,Kbb) / zconc0n) 
     187         fanano = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
     188         znutlim = tr(ji,jj,jk,jppo4,Kbb) / zconc0npo4 
     189         fananop = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
     190         znutlim = biron(ji,jj,jk) / zconcnfe 
     191         fananof = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
     192         znutlim = MAX( tr(ji,jj,jk,jpnh4,Kbb) / zconc0pnh4,    & 
     193           &         tr(ji,jj,jk,jpno3,Kbb) / zconc0p) 
     194         fapico = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
     195         znutlim = tr(ji,jj,jk,jppo4,Kbb) / zconc0ppo4 
     196         fapicop = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
     197         znutlim = biron(ji,jj,jk) / zconcpfe 
     198         fapicof = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
     199         znutlim = MAX( tr(ji,jj,jk,jpnh4,Kbb) / zconc1dnh4,    & 
     200           &         tr(ji,jj,jk,jpno3,Kbb) / zconc1d ) 
     201         fadiat = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
     202         znutlim = tr(ji,jj,jk,jppo4,Kbb) / zconc0dpo4 
     203         fadiatp = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
     204         znutlim = biron(ji,jj,jk) / zconcdfe 
     205         fadiatf = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
     206         ! 
     207         ! Michaelis-Menten Limitation term for nutrients Small bacteria 
     208         ! ------------------------------------------------------------- 
     209         zbactnh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concbnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 
     210         zbactno3 = tr(ji,jj,jk,jpno3,Kbb) / ( concbno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - zbactnh4) 
     211         ! 
     212         zlim1    = zbactno3 + zbactnh4 
     213         zlim2    = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concbpo4) 
     214         zlim3    = biron(ji,jj,jk) / ( concbfe + biron(ji,jj,jk) ) 
     215         zlim4    = tr(ji,jj,jk,jpdoc,Kbb) / ( xkdoc   + tr(ji,jj,jk,jpdoc,Kbb) ) 
     216         xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 
     217         xlimbac (ji,jj,jk) = xlimbacl(ji,jj,jk) * zlim4 
     218         ! 
     219         ! Michaelis-Menten Limitation term for nutrients Small flagellates 
     220         ! ----------------------------------------------- 
     221         zfalim = (1.-fanano) / fanano 
     222         xnanonh4(ji,jj,jk) = (1. - fanano) * tr(ji,jj,jk,jpnh4,Kbb) / ( zfalim * zconc0nnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 
     223         xnanono3(ji,jj,jk) = (1. - fanano) * tr(ji,jj,jk,jpno3,Kbb) / ( zfalim * zconc0n + tr(ji,jj,jk,jpno3,Kbb) )  & 
     224         &                    * (1. - xnanonh4(ji,jj,jk)) 
     225         ! 
     226         zfalim = (1.-fananop) / fananop 
     227         xnanopo4(ji,jj,jk) = (1. - fananop) * tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zfalim * zconc0npo4 ) 
     228         xnanodop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdop,Kbb) + xkdoc )   & 
     229         &                    * ( 1.0 - xnanopo4(ji,jj,jk) ) 
     230         xnanodop(ji,jj,jk) = 0. 
     231         ! 
     232         zfalim = (1.-fananof) / fananof 
     233         xnanofer(ji,jj,jk) = (1. - fananof) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcnfe ) 
     234         ! 
     235         zratiof   = tr(ji,jj,jk,jpnfe,Kbb) * z1_trnphy 
     236         zqfemn = xcoef1 * znanochl + xcoef2 + xcoef3 * xnanono3(ji,jj,jk) 
     237         ! 
     238         zration = tr(ji,jj,jk,jpnph,Kbb) * z1_trnphy 
     239         zration = MIN(xqnnmax(ji,jj,jk), MAX( 2. * xqnnmin(ji,jj,jk), zration )) 
     240         fvnuptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqnnmin(ji,jj,jk) / (zration + rtrn)  & 
     241         &                   * MAX(0., (1. - zratchl * znanochl / 12. ) ) 
     242         ! 
     243         zlim1    = max(0., (zration - 2. * xqnnmin(ji,jj,jk) )  & 
     244         &          / (xqnnmax(ji,jj,jk) - 2. * xqnnmin(ji,jj,jk) ) ) * xqnnmax(ji,jj,jk)  & 
     245         &          / (zration + rtrn) 
     246         zlim3    = MAX( 0.,( zratiof - zqfemn ) / qfnopt )  
     247         xlimnfe(ji,jj,jk) = MIN( 1., zlim3 ) 
     248         xlimphy(ji,jj,jk) = MIN( 1., zlim1, zlim3 ) 
     249         ! 
     250         ! Michaelis-Menten Limitation term for nutrients picophytoplankton 
     251         ! ---------------------------------------------------------------- 
     252         zfalim = (1.-fapico) / fapico  
     253         xpiconh4(ji,jj,jk) = (1. - fapico) * tr(ji,jj,jk,jpnh4,Kbb) / ( zfalim * zconc0pnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 
     254         xpicono3(ji,jj,jk) = (1. - fapico) * tr(ji,jj,jk,jpno3,Kbb) / ( zfalim * zconc0p + tr(ji,jj,jk,jpno3,Kbb) )  & 
     255         &                    * (1. - xpiconh4(ji,jj,jk)) 
     256         ! 
     257         zfalim = (1.-fapicop) / fapicop  
     258         xpicopo4(ji,jj,jk) = (1. - fapicop) * tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zfalim * zconc0ppo4 ) 
     259         xpicodop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdop,Kbb) + xkdoc )   & 
     260         &                    * ( 1.0 - xpicopo4(ji,jj,jk) ) 
     261         xpicodop(ji,jj,jk) = 0. 
     262         ! 
     263         zfalim = (1.-fapicof) / fapicof 
     264         xpicofer(ji,jj,jk) = (1. - fapicof) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcpfe ) 
     265         ! 
     266         zratiof   = tr(ji,jj,jk,jppfe,Kbb) * z1_trnpic 
     267         zqfemp = xcoef1 * zpicochl + xcoef2 + xcoef3 * xpicono3(ji,jj,jk) 
     268         ! 
     269         zration   = tr(ji,jj,jk,jpnpi,Kbb) * z1_trnpic 
     270         zration = MIN(xqnpmax(ji,jj,jk), MAX( 2. * xqnpmin(ji,jj,jk), zration )) 
     271         fvpuptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqnpmin(ji,jj,jk) / (zration + rtrn)  & 
     272         &                   * MAX(0., (1. - zratchl * zpicochl / 12. ) )  
     273         ! 
     274         zlim1    = max(0., (zration - 2. * xqnpmin(ji,jj,jk) )  & 
     275         &          / (xqnpmax(ji,jj,jk) - 2. * xqnpmin(ji,jj,jk) ) ) * xqnpmax(ji,jj,jk)  & 
     276         &          / (zration + rtrn) 
     277         zlim3    = MAX( 0.,( zratiof - zqfemp ) / qfpopt ) 
     278         xlimpfe(ji,jj,jk) = MIN( 1., zlim3 ) 
     279         xlimpic(ji,jj,jk) = MIN( 1., zlim1, zlim3 ) 
     280         ! 
     281         !   Michaelis-Menten Limitation term for nutrients Diatoms 
     282         !   ------------------------------------------------------ 
     283         zfalim = (1.-fadiat) / fadiat  
     284         xdiatnh4(ji,jj,jk) = (1. - fadiat) * tr(ji,jj,jk,jpnh4,Kbb) / ( zfalim * zconc1dnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 
     285         xdiatno3(ji,jj,jk) = (1. - fadiat) * tr(ji,jj,jk,jpno3,Kbb) / ( zfalim * zconc1d + tr(ji,jj,jk,jpno3,Kbb) )  & 
     286         &                    * (1. - xdiatnh4(ji,jj,jk)) 
     287         ! 
     288         zfalim = (1.-fadiatp) / fadiatp 
     289         xdiatpo4(ji,jj,jk) = (1. - fadiatp) * tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zfalim * zconc0dpo4 ) 
     290         xdiatdop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdop,Kbb) + xkdoc )  & 
     291         &                    * ( 1.0 - xdiatpo4(ji,jj,jk) ) 
     292         xdiatdop(ji,jj,jk) = 0. 
     293         ! 
     294         zfalim = (1.-fadiatf) / fadiatf 
     295         xdiatfer(ji,jj,jk) = (1. - fadiatf) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcdfe ) 
     296         ! 
     297         zratiof   = tr(ji,jj,jk,jpdfe,Kbb) * z1_trndia 
     298         zqfemd = xcoef1 * zdiatchl + xcoef2 + xcoef3 * xdiatno3(ji,jj,jk) 
     299         ! 
     300         zration   = tr(ji,jj,jk,jpndi,Kbb) * z1_trndia 
     301         zration = MIN(xqndmax(ji,jj,jk), MAX( 2. * xqndmin(ji,jj,jk), zration )) 
     302         fvduptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqndmin(ji,jj,jk) / (zration + rtrn)   & 
     303         &                   * MAX(0., (1. - zratchl * zdiatchl / 12. ) )  
     304         ! 
     305         zlim1    = max(0., (zration - 2. * xqndmin(ji,jj,jk) )    & 
     306         &          / (xqndmax(ji,jj,jk) - 2. * xqndmin(ji,jj,jk) ) )   & 
     307         &          * xqndmax(ji,jj,jk) / (zration + rtrn) 
     308         zlim3    = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi(ji,jj) ) 
     309         zlim4    = MAX( 0., ( zratiof - zqfemd ) / qfdopt ) 
     310         xlimdfe(ji,jj,jk) = MIN( 1., zlim4 ) 
     311         xlimdia(ji,jj,jk) = MIN( 1., zlim1, zlim3, zlim4 ) 
     312         xlimsi(ji,jj,jk)  = MIN( zlim1, zlim4 ) 
     313      END_3D 
    315314      ! 
    316315      ! Compute the phosphorus quota values. It is based on Litchmann et al., 2004 and Daines et al, 2013. 
    … …  
    319318      ! phytoplankton (see Daines et al., 2013).  
    320319      ! -------------------------------------------------------------------------------------------------- 
    321       DO jk = 1, jpkm1 
    322          DO jj = 1, jpj 
    323             DO ji = 1, jpi 
    324                ! Size estimation of nanophytoplankton 
    325                ! ------------------------------------ 
    326                zfvn = 2. * fvnuptk(ji,jj,jk) 
    327                sizen(ji,jj,jk) = MAX(1., MIN(xsizern, 1.0 / ( MAX(rtrn, zfvn) ) ) ) 
    328  
    329                ! N/P ratio of nanophytoplankton 
    330                ! ------------------------------ 
    331                zfuptk = 0.23 * zfvn 
    332                zrpho = 2.24 * trb(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpnph) * rno3 * 15. + rtrn ) 
    333                zrass = 1. - 0.2 - zrpho - zfuptk 
    334                xqpnmax(ji,jj,jk) = ( zfuptk + zrpho ) * 0.0128 * 16. + zrass * 1./ 7.2 * 16. 
    335                xqpnmax(ji,jj,jk) = xqpnmax(ji,jj,jk) * trb(ji,jj,jk,jpnph) / ( trb(ji,jj,jk,jpphy) + rtrn ) + 0.13 
    336                xqpnmin(ji,jj,jk) = 0.13 + 0.23 * 0.0128 * 16. 
    337  
    338                ! Size estimation of picophytoplankton 
    339                ! ------------------------------------ 
    340                zfvn = 2. * fvpuptk(ji,jj,jk) 
    341                sizep(ji,jj,jk) = MAX(1., MIN(xsizerp, 1.0 / ( MAX(rtrn, zfvn) ) ) ) 
    342  
    343                ! N/P ratio of picophytoplankton 
    344                ! ------------------------------ 
    345                zfuptk = 0.35 * zfvn 
    346                zrpho = 2.24 * trb(ji,jj,jk,jppch) / ( trb(ji,jj,jk,jpnpi) * rno3 * 15. + rtrn ) 
    347                zrass = 1. - 0.4 - zrpho - zfuptk 
    348                xqppmax(ji,jj,jk) =  (zrpho + zfuptk) * 0.0128 * 16. + zrass * 1./ 9. * 16. 
    349                xqppmax(ji,jj,jk) = xqppmax(ji,jj,jk) * trb(ji,jj,jk,jpnpi) / ( trb(ji,jj,jk,jppic) + rtrn ) + 0.13 
    350                xqppmin(ji,jj,jk) = 0.13 
    351  
    352                ! Size estimation of diatoms 
    353                ! -------------------------- 
    354                zfvn = 2. * fvduptk(ji,jj,jk) 
    355                sized(ji,jj,jk) = MAX(1., MIN(xsizerd, 1.0 / ( MAX(rtrn, zfvn) ) ) ) 
    356                zcoef = trb(ji,jj,jk,jpdia) - MIN(xsizedia, trb(ji,jj,jk,jpdia) ) 
    357                sized(ji,jj,jk) = 1. + xsizerd * zcoef *1E6 / ( 1. + zcoef * 1E6 ) 
    358  
    359                ! N/P ratio of diatoms 
    360                ! -------------------- 
    361                zfuptk = 0.2 * zfvn 
    362                zrpho = 2.24 * trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpndi) * rno3 * 15. + rtrn ) 
    363                zrass = 1. - 0.2 - zrpho - zfuptk 
    364                xqpdmax(ji,jj,jk) = ( zfuptk + zrpho ) * 0.0128 * 16. + zrass * 1./ 7.2 * 16. 
    365                xqpdmax(ji,jj,jk) = xqpdmax(ji,jj,jk) * trb(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn ) + 0.13 
    366                xqpdmin(ji,jj,jk) = 0.13 + 0.2 * 0.0128 * 16. 
    367  
    368             END DO 
    369          END DO 
    370       END DO 
     320      DO_3D_11_11( 1, jpkm1 ) 
     321         ! Size estimation of nanophytoplankton 
     322         ! ------------------------------------ 
     323         zfvn = 2. * fvnuptk(ji,jj,jk) 
     324         sizen(ji,jj,jk) = MAX(1., MIN(xsizern, 1.0 / ( MAX(rtrn, zfvn) ) ) ) 
     325 
     326         ! N/P ratio of nanophytoplankton 
     327         ! ------------------------------ 
     328         zfuptk = 0.23 * zfvn 
     329         zrpho = 2.24 * tr(ji,jj,jk,jpnch,Kbb) / ( tr(ji,jj,jk,jpnph,Kbb) * rno3 * 15. + rtrn ) 
     330         zrass = 1. - 0.2 - zrpho - zfuptk 
     331         xqpnmax(ji,jj,jk) = ( zfuptk + zrpho ) * 0.0128 * 16. + zrass * 1./ 7.2 * 16. 
     332         xqpnmax(ji,jj,jk) = xqpnmax(ji,jj,jk) * tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) + 0.13 
     333         xqpnmin(ji,jj,jk) = 0.13 + 0.23 * 0.0128 * 16. 
     334 
     335         ! Size estimation of picophytoplankton 
     336         ! ------------------------------------ 
     337         zfvn = 2. * fvpuptk(ji,jj,jk) 
     338         sizep(ji,jj,jk) = MAX(1., MIN(xsizerp, 1.0 / ( MAX(rtrn, zfvn) ) ) ) 
     339 
     340         ! N/P ratio of picophytoplankton 
     341         ! ------------------------------ 
     342         zfuptk = 0.35 * zfvn 
     343         zrpho = 2.24 * tr(ji,jj,jk,jppch,Kbb) / ( tr(ji,jj,jk,jpnpi,Kbb) * rno3 * 15. + rtrn ) 
     344         zrass = 1. - 0.4 - zrpho - zfuptk 
     345         xqppmax(ji,jj,jk) =  (zrpho + zfuptk) * 0.0128 * 16. + zrass * 1./ 9. * 16. 
     346         xqppmax(ji,jj,jk) = xqppmax(ji,jj,jk) * tr(ji,jj,jk,jpnpi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) + 0.13 
     347         xqppmin(ji,jj,jk) = 0.13 
     348 
     349         ! Size estimation of diatoms 
     350         ! -------------------------- 
     351         zfvn = 2. * fvduptk(ji,jj,jk) 
     352         sized(ji,jj,jk) = MAX(1., MIN(xsizerd, 1.0 / ( MAX(rtrn, zfvn) ) ) ) 
     353         zcoef = tr(ji,jj,jk,jpdia,Kbb) - MIN(xsizedia, tr(ji,jj,jk,jpdia,Kbb) ) 
     354         sized(ji,jj,jk) = 1. + xsizerd * zcoef *1E6 / ( 1. + zcoef * 1E6 ) 
     355 
     356         ! N/P ratio of diatoms 
     357         ! -------------------- 
     358         zfuptk = 0.2 * zfvn 
     359         zrpho = 2.24 * tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpndi,Kbb) * rno3 * 15. + rtrn ) 
     360         zrass = 1. - 0.2 - zrpho - zfuptk 
     361         xqpdmax(ji,jj,jk) = ( zfuptk + zrpho ) * 0.0128 * 16. + zrass * 1./ 7.2 * 16. 
     362         xqpdmax(ji,jj,jk) = xqpdmax(ji,jj,jk) * tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) + 0.13 
     363         xqpdmin(ji,jj,jk) = 0.13 + 0.2 * 0.0128 * 16. 
     364 
     365      END_3D 
    371366 
    372367      ! Compute the fraction of nanophytoplankton that is made of calcifiers 
    373368      ! -------------------------------------------------------------------- 
    374       DO jk = 1, jpkm1 
    375          DO jj = 1, jpj 
    376             DO ji = 1, jpi 
    377                zlim1 =  trb(ji,jj,jk,jpnh4) / ( trb(ji,jj,jk,jpnh4) + concnnh4 ) + trb(ji,jj,jk,jpno3)    & 
    378                &        / ( trb(ji,jj,jk,jpno3) + concnno3 ) * ( 1.0 - trb(ji,jj,jk,jpnh4)   & 
    379                &        / ( trb(ji,jj,jk,jpnh4) + concnnh4 ) ) 
    380                zlim2  = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concnpo4 ) 
    381                zlim3  = trb(ji,jj,jk,jpfer) / ( trb(ji,jj,jk,jpfer) +  5.E-11 )  
    382                ztem1  = MAX( 0., tsn(ji,jj,jk,jp_tem) ) 
    383                ztem2  = tsn(ji,jj,jk,jp_tem) - 10. 
    384                zetot1 = MAX( 0., etot(ji,jj,jk) - 1.) / ( 4. + etot(ji,jj,jk) ) * 20. / ( 20. + etot(ji,jj,jk) )  
     369      DO_3D_11_11( 1, jpkm1 ) 
     370         zlim1 =  tr(ji,jj,jk,jpnh4,Kbb) / ( tr(ji,jj,jk,jpnh4,Kbb) + concnnh4 ) + tr(ji,jj,jk,jpno3,Kbb)    & 
     371         &        / ( tr(ji,jj,jk,jpno3,Kbb) + concnno3 ) * ( 1.0 - tr(ji,jj,jk,jpnh4,Kbb)   & 
     372         &        / ( tr(ji,jj,jk,jpnh4,Kbb) + concnnh4 ) ) 
     373         zlim2  = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concnpo4 ) 
     374         zlim3  = tr(ji,jj,jk,jpfer,Kbb) / ( tr(ji,jj,jk,jpfer,Kbb) +  5.E-11 )  
     375         ztem1  = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) ) 
     376         ztem2  = ts(ji,jj,jk,jp_tem,Kmm) - 10. 
     377         zetot1 = MAX( 0., etot(ji,jj,jk) - 1.) / ( 4. + etot(ji,jj,jk) ) * 20. / ( 20. + etot(ji,jj,jk) )  
    385378 
    386379!               xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 )                  & 
    387                xfracal(ji,jj,jk) = caco3r                 & 
    388                &                   * ztem1 / ( 1. + ztem1 ) * MAX( 1., trb(ji,jj,jk,jpphy)*1E6 )   & 
    389                   &                * ( 1. + EXP(-ztem2 * ztem2 / 25. ) )         & 
    390                   &                * zetot1 * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) ) 
    391                xfracal(ji,jj,jk) = MAX( 0.02, MIN( 0.8 , xfracal(ji,jj,jk) ) ) 
    392             END DO 
    393          END DO 
    394       END DO 
    395       ! 
    396       DO jk = 1, jpkm1 
    397          DO jj = 1, jpj 
    398             DO ji = 1, jpi 
    399                ! denitrification factor computed from O2 levels 
    400                nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - trb(ji,jj,jk,jpoxy) )    & 
    401                   &                                / ( oxymin + trb(ji,jj,jk,jpoxy) )  ) 
    402                nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 
    403             END DO 
    404          END DO 
    405       END DO 
     380         xfracal(ji,jj,jk) = caco3r                 & 
     381         &                   * ztem1 / ( 1. + ztem1 ) * MAX( 1., tr(ji,jj,jk,jpphy,Kbb)*1E6 )   & 
     382            &                * ( 1. + EXP(-ztem2 * ztem2 / 25. ) )         & 
     383            &                * zetot1 * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) ) 
     384         xfracal(ji,jj,jk) = MAX( 0.02, MIN( 0.8 , xfracal(ji,jj,jk) ) ) 
     385      END_3D 
     386      ! 
     387      DO_3D_11_11( 1, jpkm1 ) 
     388         ! denitrification factor computed from O2 levels 
     389         nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - tr(ji,jj,jk,jpoxy,Kbb) )    & 
     390            &                                / ( oxymin + tr(ji,jj,jk,jpoxy,Kbb) )  ) 
     391         nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 
     392      END_3D 
    406393      ! 
    407394      IF( lk_iomput .AND. knt == nrdttrc ) THEN        ! save output diagnostics 
    … …  
    448435      !!---------------------------------------------------------------------- 
    449436      ! 
    450       REWIND( numnatp_ref ) 
    451437      READ  ( numnatp_ref, namp5zlim, IOSTAT = ios, ERR = 901) 
    452438901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampislim in reference namelist' ) 
    453439      ! 
    454       REWIND( numnatp_cfg ) 
    455440      READ  ( numnatp_cfg, namp5zlim, IOSTAT = ios, ERR = 902 ) 
    456441902   IF( ios >  0 ) CALL ctl_nam ( ios , 'nampislim in configuration namelist' ) 
    … …  
    489474      ENDIF 
    490475 
    491       REWIND( numnatp_ref ) 
    492476      READ  ( numnatp_ref, namp5zquota, IOSTAT = ios, ERR = 903) 
    493477903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisquota in reference namelist' ) 
    494478      ! 
    495       REWIND( numnatp_cfg ) 
    496479      READ  ( numnatp_cfg, namp5zquota, IOSTAT = ios, ERR = 904 ) 
    497480904   IF( ios >  0 ) CALL ctl_nam ( ios , 'nampisquota in configuration namelist' ) 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p5zmeso.F90

    r12276 r12377  
    5151   LOGICAL,  PUBLIC ::  bmetexc2     !: Use of excess carbon for respiration 
    5252 
     53   !! * Substitutions 
     54#  include "do_loop_substitute.h90" 
    5355   !!---------------------------------------------------------------------- 
    5456   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    5961CONTAINS 
    6062 
    61    SUBROUTINE p5z_meso( kt, knt ) 
     63   SUBROUTINE p5z_meso( kt, knt, Kbb, Krhs ) 
    6264      !!--------------------------------------------------------------------- 
    6365      !!                     ***  ROUTINE p5z_meso  *** 
    … …  
    6769      !! ** Method  : - ??? 
    6870      !!--------------------------------------------------------------------- 
    69       INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
     71      INTEGER, INTENT(in) ::   kt, knt    ! ocean time step 
     72      INTEGER, INTENT(in)  ::  Kbb, Krhs  ! time level indices 
    7073      INTEGER  :: ji, jj, jk 
    7174      REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam, zcompames 
    … …  
    8689      CHARACTER (len=25) :: charout 
    8790      REAL(wp) :: zrfact2, zmetexcess 
    88       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing2, zfezoo2, zz2ligprod 
     91      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo2, zz2ligprod 
    8992 
    9093      !!--------------------------------------------------------------------- 
    … …  
    9295      IF( ln_timing )   CALL timing_start('p5z_meso') 
    9396      ! 
    94  
    9597      zmetexcess = 0.0 
    9698      IF ( bmetexc2 ) zmetexcess = 1.0 
    9799 
    98       DO jk = 1, jpkm1 
    99          DO jj = 1, jpj 
    100             DO ji = 1, jpi 
    101                zcompam   = MAX( ( trb(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 ) 
    102                zfact     = xstep * tgfunc2(ji,jj,jk) * zcompam 
    103  
    104                !   Michaelis-Menten mortality rates of mesozooplankton 
    105                !   --------------------------------------------------- 
    106                zrespz   = resrat2 * zfact * ( trb(ji,jj,jk,jpmes) / ( xkmort + trb(ji,jj,jk,jpmes) )  & 
    107                &          + 3. * nitrfac(ji,jj,jk) ) 
    108  
    109                !   Zooplankton mortality. A square function has been selected with 
    110                !   no real reason except that it seems to be more stable and may mimic predation 
    111                !   --------------------------------------------------------------- 
    112                ztortz   = mzrat2 * 1.e6 * zfact * trb(ji,jj,jk,jpmes) * (1. - nitrfac(ji,jj,jk)) 
    113  
    114                !   Computation of the abundance of the preys 
    115                !   A threshold can be specified in the namelist 
    116                !   -------------------------------------------- 
    117                zcompadi  = MAX( ( trb(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 ) 
    118                zcompaz   = MAX( ( trb(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 ) 
    119                zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) 
    120                zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 ) 
    121                zcompames = MAX( ( trb(ji,jj,jk,jpmes) - xthresh2mes ), 0.e0 ) 
    122  
    123                !   Mesozooplankton grazing 
    124                !   ------------------------ 
    125                zfood     = xpref2d * zcompadi + xpref2z * zcompaz + xpref2n * zcompaph + xpref2c * zcompapoc   & 
    126                &           + xpref2m * zcompames  
    127                zfoodlim  = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) ) 
    128                zdenom    = zfoodlim / ( xkgraz2 + zfoodlim ) 
    129                zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes) * (1. - nitrfac(ji,jj,jk))  
    130  
    131                !   An active switching parameterization is used here. 
    132                !   We don't use the KTW parameterization proposed by  
    133                !   Vallina et al. because it tends to produce to steady biomass 
    134                !   composition and the variance of Chl is too low as it grazes 
    135                !   too strongly on winning organisms. Thus, instead of a square 
    136                !   a 1.5 power value is used which decreases the pressure on the 
    137                !   most abundant species 
    138                !   ------------------------------------------------------------   
    139                ztmp1 = xpref2n * zcompaph**1.5 
    140                ztmp2 = xpref2m * zcompames**1.5 
    141                ztmp3 = xpref2c * zcompapoc**1.5 
    142                ztmp4 = xpref2d * zcompadi**1.5 
    143                ztmp5 = xpref2z * zcompaz**1.5 
    144                ztmptot = ztmp1 + ztmp2 + ztmp3 + ztmp4 + ztmp5 + rtrn 
    145                ztmp1 = ztmp1 / ztmptot 
    146                ztmp2 = ztmp2 / ztmptot 
    147                ztmp3 = ztmp3 / ztmptot 
    148                ztmp4 = ztmp4 / ztmptot 
    149                ztmp5 = ztmp5 / ztmptot 
    150  
    151                !   Mesozooplankton regular grazing on the different preys 
    152                !   ------------------------------------------------------ 
    153                zgrazdc   = zgraze2 * ztmp4 * zdenom 
    154                zgrazdn   = zgrazdc * trb(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn) 
    155                zgrazdp   = zgrazdc * trb(ji,jj,jk,jppdi) / ( trb(ji,jj,jk,jpdia) + rtrn) 
    156                zgrazdf   = zgrazdc * trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn) 
    157                zgrazz    = zgraze2 * ztmp5 * zdenom 
    158                zgrazm    = zgraze2 * ztmp2 * zdenom 
    159                zgraznc   = zgraze2 * ztmp1 * zdenom 
    160                zgraznn   = zgraznc * trb(ji,jj,jk,jpnph) / ( trb(ji,jj,jk,jpphy) + rtrn) 
    161                zgraznp   = zgraznc * trb(ji,jj,jk,jppph) / ( trb(ji,jj,jk,jpphy) + rtrn) 
    162                zgraznf   = zgraznc * trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn) 
    163                zgrazpoc  = zgraze2 * ztmp3 * zdenom 
    164                zgrazpon  = zgrazpoc * trb(ji,jj,jk,jppon) / ( trb(ji,jj,jk,jppoc) + rtrn) 
    165                zgrazpop  = zgrazpoc * trb(ji,jj,jk,jppop) / ( trb(ji,jj,jk,jppoc) + rtrn) 
    166                zgrazpof  = zgrazpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn) 
    167  
    168                !   Mesozooplankton flux feeding on GOC 
    169                !   ---------------------------------- 
    170                zgrazffeg = grazflux  * xstep * wsbio4(ji,jj,jk)      & 
    171                &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)  & 
    172                &           * (1. - nitrfac(ji,jj,jk)) 
    173                zgrazfffg = zgrazffeg * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn) 
    174                zgrazffng = zgrazffeg * trb(ji,jj,jk,jpgon) / (trb(ji,jj,jk,jpgoc) + rtrn) 
    175                zgrazffpg = zgrazffeg * trb(ji,jj,jk,jpgop) / (trb(ji,jj,jk,jpgoc) + rtrn) 
    176                zgrazffep = grazflux  * xstep *  wsbio3(ji,jj,jk)     & 
    177                &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpmes)   & 
    178                &           * (1. - nitrfac(ji,jj,jk)) 
    179                zgrazfffp = zgrazffep * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn) 
    180                zgrazffnp = zgrazffep * trb(ji,jj,jk,jppon) / (trb(ji,jj,jk,jppoc) + rtrn) 
    181                zgrazffpp = zgrazffep * trb(ji,jj,jk,jppop) / (trb(ji,jj,jk,jppoc) + rtrn) 
    182                ! 
    183                zgraztotc  = zgrazdc + zgrazz + zgraznc + zgrazm + zgrazpoc + zgrazffep + zgrazffeg 
    184  
    185                !   Compute the proportion of filter feeders 
    186                !   ----------------------------------------   
    187                zproport  = (zgrazffep + zgrazffeg)/(rtrn + zgraztotc) 
    188  
    189                !   Compute fractionation of aggregates. It is assumed that  
    190                !   diatoms based aggregates are more prone to fractionation 
    191                !   since they are more porous (marine snow instead of fecal pellets) 
    192                !   ---------------------------------------------------------------- 
    193                zratio    = trb(ji,jj,jk,jpgsi) / ( trb(ji,jj,jk,jpgoc) + rtrn ) 
    194                zratio2   = zratio * zratio 
    195                zfracc    = zproport * grazflux  * xstep * wsbio4(ji,jj,jk)      & 
    196                &          * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)          & 
    197                &          * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) ) 
    198                zfracfe   = zfracc * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn) 
    199                zfracn    = zfracc * trb(ji,jj,jk,jpgon) / (trb(ji,jj,jk,jpgoc) + rtrn) 
    200                zfracp    = zfracc * trb(ji,jj,jk,jpgop) / (trb(ji,jj,jk,jpgoc) + rtrn) 
    201  
    202                zgrazffep = zproport * zgrazffep   ;   zgrazffeg = zproport * zgrazffeg 
    203                zgrazfffp = zproport * zgrazfffp   ;   zgrazfffg = zproport * zgrazfffg 
    204                zgrazffnp = zproport * zgrazffnp   ;   zgrazffng = zproport * zgrazffng 
    205                zgrazffpp = zproport * zgrazffpp   ;   zgrazffpg = zproport * zgrazffpg 
    206  
    207                zgraztotc  = zgrazdc + zgrazz + zgraznc + zgrazm + zgrazpoc + zgrazffep + zgrazffeg 
    208                zgraztotf  = zgrazdf + zgraznf + ( zgrazz + zgrazm ) * ferat3 + zgrazpof & 
    209                &            + zgrazfffp + zgrazfffg 
    210                zgraztotn  = zgrazdn + (zgrazm + zgrazz) * no3rat3 + zgraznn + zgrazpon  & 
    211                &            + zgrazffnp + zgrazffng 
    212                zgraztotp  = zgrazdp + (zgrazz + zgrazm) * po4rat3 + zgraznp + zgrazpop  & 
    213                &            + zgrazffpp + zgrazffpg 
    214  
    215  
    216                ! Total grazing ( grazing by microzoo is already computed in p5zmicro ) 
    217                zgrazing2(ji,jj,jk) = zgraztotc 
    218  
    219                !   Stoichiometruc ratios of the food ingested by zooplanton  
    220                !   -------------------------------------------------------- 
    221                zgrasratf  =  (zgraztotf + rtrn) / ( zgraztotc + rtrn ) 
    222                zgrasratn  =  (zgraztotn + rtrn) / ( zgraztotc + rtrn ) 
    223                zgrasratp  =  (zgraztotp + rtrn) / ( zgraztotc + rtrn ) 
    224  
    225                !   Growth efficiency is made a function of the quality  
    226                !   and the quantity of the preys 
    227                !   --------------------------------------------------- 
    228                zepshert  = MIN( 1., zgrasratn/ no3rat3, zgrasratp/ po4rat3, zgrasratf / ferat3) 
    229                zbeta     = MAX(0., (epsher2 - epsher2min) ) 
    230                zepsherf  = epsher2min + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 
    231                zepsherv  = zepsherf * zepshert 
    232  
    233                !   Respiration of mesozooplankton 
    234                !   Excess carbon in the food is used preferentially 
    235                !   ----------------  ------------------------------ 
    236                zexcess  = zgraztotc * zepsherf * (1.0 - zepshert) * zmetexcess  
    237                zbasresb = MAX(0., zrespz - zexcess) 
    238                zbasresi = zexcess + MIN(0., zrespz - zexcess) 
    239                zrespirc = srespir2 * zepsherv * zgraztotc + zbasresb 
    240  
    241                !   When excess carbon is used, the other elements in excess 
    242                !   are also used proportionally to their abundance 
    243                !   -------------------------------------------------------- 
    244                zexcess  = ( zgrasratn/ no3rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 
    245                zbasresn = zbasresi * zexcess * zgrasratn 
    246                zexcess  = ( zgrasratp/ po4rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 
    247                zbasresp = zbasresi * zexcess * zgrasratp 
    248                zexcess  = ( zgrasratf/ ferat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 
    249                zbasresf = zbasresi * zexcess * zgrasratf 
    250  
    251                !   Voiding of the excessive elements as organic matter 
    252                !   -------------------------------------------------------- 
    253                zgradoct = (1. - unass2c - zepsherv) * zgraztotc - zbasresi 
    254                zgradont = (1. - unass2n) * zgraztotn - zepsherv * no3rat3 * zgraztotc - zbasresn 
    255                zgradopt = (1. - unass2p) * zgraztotp - zepsherv * po4rat3 * zgraztotc - zbasresp 
    256                zgrareft = (1. - unass2c) * zgraztotf - zepsherv * ferat3 * zgraztotc - zbasresf 
    257                ztmp1   = ( 1. - epsher2 - unass2c ) /( 1. - 0.8 * epsher2 ) * ztortz 
    258                zgradoc = (zgradoct + ztmp1) * ssigma2 
    259                zgradon = (zgradont + no3rat3 * ztmp1) * ssigma2 
    260                zgradop = (zgradopt + po4rat3 * ztmp1) * ssigma2 
    261                zgratmp = 0.2 * epsher2 /( 1. - 0.8 * epsher2 ) * ztortz 
    262  
    263                !  Since only semilabile DOM is represented in PISCES 
    264                !  part of DOM is in fact labile and is then released 
    265                !  as dissolved inorganic compounds (ssigma2) 
    266                !  -------------------------------------------------- 
    267                zgrarem = zgratmp + ( zgradoct + ztmp1 ) * (1.0 - ssigma2) 
    268                zgraren = no3rat3 * zgratmp + ( zgradont + no3rat3 * ztmp1 ) * (1.0 - ssigma2) 
    269                zgrarep = po4rat3 * zgratmp + ( zgradopt + po4rat3 * ztmp1 ) * (1.0 - ssigma2) 
    270                zgraref = zgrareft + ferat3 * ( ztmp1 + zgratmp ) 
    271  
    272                !   Defecation as a result of non assimilated products 
    273                !   -------------------------------------------------- 
    274                zgrapoc  = zgraztotc * unass2c + unass2c / ( 1. - 0.8 * epsher2 ) * ztortz 
    275                zgrapon  = zgraztotn * unass2n + no3rat3 * unass2n / ( 1. - 0.8 * epsher2 ) * ztortz 
    276                zgrapop  = zgraztotp * unass2p + po4rat3 * unass2p / ( 1. - 0.8 * epsher2 ) * ztortz 
    277                zgrapof  = zgraztotf * unass2c + ferat3  * unass2c / ( 1. - 0.8 * epsher2 ) * ztortz 
    278  
    279                !  Addition of respiration to the release of inorganic nutrients 
    280                !  ------------------------------------------------------------- 
    281                zgrarem = zgrarem + zbasresi + zrespirc 
    282                zgraren = zgraren + zbasresn + zrespirc * no3rat3 
    283                zgrarep = zgrarep + zbasresp + zrespirc * po4rat3 
    284                zgraref = zgraref + zbasresf + zrespirc * ferat3 
    285  
    286                !   Update the arrays TRA which contain the biological sources and 
    287                !   sinks 
    288                !   -------------------------------------------------------------- 
    289                tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarep  
    290                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgraren 
    291                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgradoc 
    292                ! 
    293                IF( ln_ligand ) THEN 
    294                   tra(ji,jj,jk,jplgw)  = tra(ji,jj,jk,jplgw) + zgradoc * ldocz 
    295                   zz2ligprod(ji,jj,jk) = zgradoc * ldocz 
    296                ENDIF 
    297                ! 
    298                tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zgradon 
    299                tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zgradop 
    300                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem 
    301                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgraref 
    302                zfezoo2(ji,jj,jk)   = zgraref 
    303                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem 
    304                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgraren 
    305                tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) + zepsherv * zgraztotc - zrespirc   & 
    306                &                     - ztortz - zgrazm 
    307                tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazdc 
    308                tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) - zgrazdn 
    309                tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) - zgrazdp 
    310                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazdf 
    311                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz 
    312                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgraznc 
    313                tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) - zgraznn 
    314                tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) - zgraznp 
    315                tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf 
    316                tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgraznc * trb(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpphy) + rtrn ) 
    317                tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazdc * trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    318                tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazdc * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    319                tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazdc * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    320  
    321                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc - zgrazffep + zfracc 
    322                prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfracc 
    323                conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep 
    324                tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) - zgrazpon - zgrazffnp + zfracn 
    325                tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) - zgrazpop - zgrazffpp + zfracp 
    326                tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zgrazffeg + zgrapoc - zfracc 
    327                prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zgrapoc 
    328                consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfracc 
    329                tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) - zgrazffng + zgrapon - zfracn 
    330                tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) - zgrazffpg + zgrapop - zfracp 
    331                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof - zgrazfffp + zfracfe 
    332                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zgrazfffg + zgrapof - zfracfe 
    333                zfracal = trb(ji,jj,jk,jpcal) / ( trb(ji,jj,jk,jpgoc) + rtrn ) 
    334                zgrazcal = zgrazffeg * (1. - part2) * zfracal 
    335  
    336                !  calcite production 
    337                !  ------------------ 
    338                zprcaca = xfracal(ji,jj,jk) * zgraznc 
    339                prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    340                zprcaca = part2 * zprcaca 
    341                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrazcal - zprcaca 
    342                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * ( zgrazcal - zprcaca ) 
    343                tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) - zgrazcal + zprcaca 
    344             END DO 
    345          END DO 
    346       END DO 
    347       ! 
    348        IF( lk_iomput .AND. knt == nrdttrc ) THEN 
    349          CALL iom_put( "PCAL"  , prodcal(:,:,:) * 1.e+3  * rfact2r * tmask(:,:,:) )  !  Calcite production  
    350          IF( iom_use("GRAZ2") ) THEN  !   Total grazing of phyto by zooplankton 
    351            zgrazing2(:,:,jpk) = 0._wp ;  CALL iom_put( "GRAZ2" , zgrazing2(:,:,:) * 1.e+3  * rfact2r * tmask(:,:,:) )  
     100      DO_3D_11_11( 1, jpkm1 ) 
     101         zcompam   = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - 1.e-9 ), 0.e0 ) 
     102         zfact     = xstep * tgfunc2(ji,jj,jk) * zcompam 
     103 
     104         !   Michaelis-Menten mortality rates of mesozooplankton 
     105         !   --------------------------------------------------- 
     106         zrespz   = resrat2 * zfact * ( tr(ji,jj,jk,jpmes,Kbb) / ( xkmort + tr(ji,jj,jk,jpmes,Kbb) )  & 
     107         &          + 3. * nitrfac(ji,jj,jk) ) 
     108 
     109         !   Zooplankton mortality. A square function has been selected with 
     110         !   no real reason except that it seems to be more stable and may mimic predation 
     111         !   --------------------------------------------------------------- 
     112         ztortz   = mzrat2 * 1.e6 * zfact * tr(ji,jj,jk,jpmes,Kbb) * (1. - nitrfac(ji,jj,jk)) 
     113 
     114         !   Computation of the abundance of the preys 
     115         !   A threshold can be specified in the namelist 
     116         !   -------------------------------------------- 
     117         zcompadi  = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthresh2dia ), 0.e0 ) 
     118         zcompaz   = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - xthresh2zoo ), 0.e0 ) 
     119         zcompaph  = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthresh2phy ), 0.e0 ) 
     120         zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthresh2poc ), 0.e0 ) 
     121         zcompames = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - xthresh2mes ), 0.e0 ) 
     122 
     123         !   Mesozooplankton grazing 
     124         !   ------------------------ 
     125         zfood     = xpref2d * zcompadi + xpref2z * zcompaz + xpref2n * zcompaph + xpref2c * zcompapoc   & 
     126         &           + xpref2m * zcompames  
     127         zfoodlim  = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) ) 
     128         zdenom    = zfoodlim / ( xkgraz2 + zfoodlim ) 
     129         zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpmes,Kbb) * (1. - nitrfac(ji,jj,jk))  
     130 
     131         !   An active switching parameterization is used here. 
     132         !   We don't use the KTW parameterization proposed by  
     133         !   Vallina et al. because it tends to produce to steady biomass 
     134         !   composition and the variance of Chl is too low as it grazes 
     135         !   too strongly on winning organisms. Thus, instead of a square 
     136         !   a 1.5 power value is used which decreases the pressure on the 
     137         !   most abundant species 
     138         !   ------------------------------------------------------------   
     139         ztmp1 = xpref2n * zcompaph**1.5 
     140         ztmp2 = xpref2m * zcompames**1.5 
     141         ztmp3 = xpref2c * zcompapoc**1.5 
     142         ztmp4 = xpref2d * zcompadi**1.5 
     143         ztmp5 = xpref2z * zcompaz**1.5 
     144         ztmptot = ztmp1 + ztmp2 + ztmp3 + ztmp4 + ztmp5 + rtrn 
     145         ztmp1 = ztmp1 / ztmptot 
     146         ztmp2 = ztmp2 / ztmptot 
     147         ztmp3 = ztmp3 / ztmptot 
     148         ztmp4 = ztmp4 / ztmptot 
     149         ztmp5 = ztmp5 / ztmptot 
     150 
     151         !   Mesozooplankton regular grazing on the different preys 
     152         !   ------------------------------------------------------ 
     153         zgrazdc   = zgraze2 * ztmp4 * zdenom 
     154         zgrazdn   = zgrazdc * tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
     155         zgrazdp   = zgrazdc * tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
     156         zgrazdf   = zgrazdc * tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
     157         zgrazz    = zgraze2 * ztmp5 * zdenom 
     158         zgrazm    = zgraze2 * ztmp2 * zdenom 
     159         zgraznc   = zgraze2 * ztmp1 * zdenom 
     160         zgraznn   = zgraznc * tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
     161         zgraznp   = zgraznc * tr(ji,jj,jk,jppph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
     162         zgraznf   = zgraznc * tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
     163         zgrazpoc  = zgraze2 * ztmp3 * zdenom 
     164         zgrazpon  = zgrazpoc * tr(ji,jj,jk,jppon,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
     165         zgrazpop  = zgrazpoc * tr(ji,jj,jk,jppop,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
     166         zgrazpof  = zgrazpoc * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
     167 
     168         !   Mesozooplankton flux feeding on GOC 
     169         !   ---------------------------------- 
     170         zgrazffeg = grazflux  * xstep * wsbio4(ji,jj,jk)      & 
     171         &           * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb)  & 
     172         &           * (1. - nitrfac(ji,jj,jk)) 
     173         zgrazfffg = zgrazffeg * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 
     174         zgrazffng = zgrazffeg * tr(ji,jj,jk,jpgon,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 
     175         zgrazffpg = zgrazffeg * tr(ji,jj,jk,jpgop,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 
     176         zgrazffep = grazflux  * xstep *  wsbio3(ji,jj,jk)     & 
     177         &           * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb)   & 
     178         &           * (1. - nitrfac(ji,jj,jk)) 
     179         zgrazfffp = zgrazffep * tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
     180         zgrazffnp = zgrazffep * tr(ji,jj,jk,jppon,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
     181         zgrazffpp = zgrazffep * tr(ji,jj,jk,jppop,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
     182         ! 
     183         zgraztotc  = zgrazdc + zgrazz + zgraznc + zgrazm + zgrazpoc + zgrazffep + zgrazffeg 
     184 
     185         !   Compute the proportion of filter feeders 
     186         !   ----------------------------------------   
     187         zproport  = (zgrazffep + zgrazffeg)/(rtrn + zgraztotc) 
     188 
     189         !   Compute fractionation of aggregates. It is assumed that  
     190         !   diatoms based aggregates are more prone to fractionation 
     191         !   since they are more porous (marine snow instead of fecal pellets) 
     192         !   ---------------------------------------------------------------- 
     193         zratio    = tr(ji,jj,jk,jpgsi,Kbb) / ( tr(ji,jj,jk,jpgoc,Kbb) + rtrn ) 
     194         zratio2   = zratio * zratio 
     195         zfracc    = zproport * grazflux  * xstep * wsbio4(ji,jj,jk)      & 
     196         &          * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb)          & 
     197         &          * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) ) 
     198         zfracfe   = zfracc * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 
     199         zfracn    = zfracc * tr(ji,jj,jk,jpgon,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 
     200         zfracp    = zfracc * tr(ji,jj,jk,jpgop,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 
     201 
     202         zgrazffep = zproport * zgrazffep   ;   zgrazffeg = zproport * zgrazffeg 
     203         zgrazfffp = zproport * zgrazfffp   ;   zgrazfffg = zproport * zgrazfffg 
     204         zgrazffnp = zproport * zgrazffnp   ;   zgrazffng = zproport * zgrazffng 
     205         zgrazffpp = zproport * zgrazffpp   ;   zgrazffpg = zproport * zgrazffpg 
     206 
     207         zgraztotc  = zgrazdc + zgrazz + zgraznc + zgrazm + zgrazpoc + zgrazffep + zgrazffeg 
     208         zgraztotf  = zgrazdf + zgraznf + ( zgrazz + zgrazm ) * ferat3 + zgrazpof & 
     209         &            + zgrazfffp + zgrazfffg 
     210         zgraztotn  = zgrazdn + (zgrazm + zgrazz) * no3rat3 + zgraznn + zgrazpon  & 
     211         &            + zgrazffnp + zgrazffng 
     212         zgraztotp  = zgrazdp + (zgrazz + zgrazm) * po4rat3 + zgraznp + zgrazpop  & 
     213         &            + zgrazffpp + zgrazffpg 
     214 
     215 
     216         ! Total grazing ( grazing by microzoo is already computed in p5zmicro ) 
     217         zgrazing(ji,jj,jk) = zgraztotc 
     218 
     219         !   Stoichiometruc ratios of the food ingested by zooplanton  
     220         !   -------------------------------------------------------- 
     221         zgrasratf  =  (zgraztotf + rtrn) / ( zgraztotc + rtrn ) 
     222         zgrasratn  =  (zgraztotn + rtrn) / ( zgraztotc + rtrn ) 
     223         zgrasratp  =  (zgraztotp + rtrn) / ( zgraztotc + rtrn ) 
     224 
     225         !   Growth efficiency is made a function of the quality  
     226         !   and the quantity of the preys 
     227         !   --------------------------------------------------- 
     228         zepshert  = MIN( 1., zgrasratn/ no3rat3, zgrasratp/ po4rat3, zgrasratf / ferat3) 
     229         zbeta     = MAX(0., (epsher2 - epsher2min) ) 
     230         zepsherf  = epsher2min + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 
     231         zepsherv  = zepsherf * zepshert 
     232 
     233         !   Respiration of mesozooplankton 
     234         !   Excess carbon in the food is used preferentially 
     235         !   ----------------  ------------------------------ 
     236         zexcess  = zgraztotc * zepsherf * (1.0 - zepshert) * zmetexcess  
     237         zbasresb = MAX(0., zrespz - zexcess) 
     238         zbasresi = zexcess + MIN(0., zrespz - zexcess) 
     239         zrespirc = srespir2 * zepsherv * zgraztotc + zbasresb 
     240 
     241         !   When excess carbon is used, the other elements in excess 
     242         !   are also used proportionally to their abundance 
     243         !   -------------------------------------------------------- 
     244         zexcess  = ( zgrasratn/ no3rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 
     245         zbasresn = zbasresi * zexcess * zgrasratn 
     246         zexcess  = ( zgrasratp/ po4rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 
     247         zbasresp = zbasresi * zexcess * zgrasratp 
     248         zexcess  = ( zgrasratf/ ferat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 
     249         zbasresf = zbasresi * zexcess * zgrasratf 
     250 
     251         !   Voiding of the excessive elements as organic matter 
     252         !   -------------------------------------------------------- 
     253         zgradoct = (1. - unass2c - zepsherv) * zgraztotc - zbasresi 
     254         zgradont = (1. - unass2n) * zgraztotn - zepsherv * no3rat3 * zgraztotc - zbasresn 
     255         zgradopt = (1. - unass2p) * zgraztotp - zepsherv * po4rat3 * zgraztotc - zbasresp 
     256         zgrareft = (1. - unass2c) * zgraztotf - zepsherv * ferat3 * zgraztotc - zbasresf 
     257         ztmp1   = ( 1. - epsher2 - unass2c ) /( 1. - 0.8 * epsher2 ) * ztortz 
     258         zgradoc = (zgradoct + ztmp1) * ssigma2 
     259         zgradon = (zgradont + no3rat3 * ztmp1) * ssigma2 
     260         zgradop = (zgradopt + po4rat3 * ztmp1) * ssigma2 
     261         zgratmp = 0.2 * epsher2 /( 1. - 0.8 * epsher2 ) * ztortz 
     262 
     263         !  Since only semilabile DOM is represented in PISCES 
     264         !  part of DOM is in fact labile and is then released 
     265         !  as dissolved inorganic compounds (ssigma2) 
     266         !  -------------------------------------------------- 
     267         zgrarem = zgratmp + ( zgradoct + ztmp1 ) * (1.0 - ssigma2) 
     268         zgraren = no3rat3 * zgratmp + ( zgradont + no3rat3 * ztmp1 ) * (1.0 - ssigma2) 
     269         zgrarep = po4rat3 * zgratmp + ( zgradopt + po4rat3 * ztmp1 ) * (1.0 - ssigma2) 
     270         zgraref = zgrareft + ferat3 * ( ztmp1 + zgratmp ) 
     271 
     272         !   Defecation as a result of non assimilated products 
     273         !   -------------------------------------------------- 
     274         zgrapoc  = zgraztotc * unass2c + unass2c / ( 1. - 0.8 * epsher2 ) * ztortz 
     275         zgrapon  = zgraztotn * unass2n + no3rat3 * unass2n / ( 1. - 0.8 * epsher2 ) * ztortz 
     276         zgrapop  = zgraztotp * unass2p + po4rat3 * unass2p / ( 1. - 0.8 * epsher2 ) * ztortz 
     277         zgrapof  = zgraztotf * unass2c + ferat3  * unass2c / ( 1. - 0.8 * epsher2 ) * ztortz 
     278 
     279         !  Addition of respiration to the release of inorganic nutrients 
     280         !  ------------------------------------------------------------- 
     281         zgrarem = zgrarem + zbasresi + zrespirc 
     282         zgraren = zgraren + zbasresn + zrespirc * no3rat3 
     283         zgrarep = zgrarep + zbasresp + zrespirc * po4rat3 
     284         zgraref = zgraref + zbasresf + zrespirc * ferat3 
     285 
     286         !   Update the arrays TRA which contain the biological sources and 
     287         !   sinks 
     288         !   -------------------------------------------------------------- 
     289         tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarep  
     290         tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgraren 
     291         tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgradoc 
     292         ! 
     293         IF( ln_ligand ) THEN 
     294            tr(ji,jj,jk,jplgw,Krhs)  = tr(ji,jj,jk,jplgw,Krhs) + zgradoc * ldocz 
     295            zz2ligprod(ji,jj,jk) = zgradoc * ldocz 
     296         ENDIF 
     297         ! 
     298         tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zgradon 
     299         tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zgradop 
     300         tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarem 
     301         tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgraref 
     302         zfezoo2(ji,jj,jk)   = zgraref 
     303         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarem 
     304         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zgraren 
     305         tr(ji,jj,jk,jpmes,Krhs) = tr(ji,jj,jk,jpmes,Krhs) + zepsherv * zgraztotc - zrespirc   & 
     306         &                     - ztortz - zgrazm 
     307         tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazdc 
     308         tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zgrazdn 
     309         tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zgrazdp 
     310         tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazdf 
     311         tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) - zgrazz 
     312         tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgraznc 
     313         tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) - zgraznn 
     314         tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) - zgraznp 
     315         tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgraznf 
     316         tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgraznc * tr(ji,jj,jk,jpnch,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
     317         tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazdc * tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     318         tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazdc * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     319         tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazdc * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     320 
     321         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zgrazpoc - zgrazffep + zfracc 
     322         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfracc 
     323         conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep 
     324         tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) - zgrazpon - zgrazffnp + zfracn 
     325         tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) - zgrazpop - zgrazffpp + zfracp 
     326         tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) - zgrazffeg + zgrapoc - zfracc 
     327         prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zgrapoc 
     328         consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfracc 
     329         tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) - zgrazffng + zgrapon - zfracn 
     330         tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) - zgrazffpg + zgrapop - zfracp 
     331         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zgrazpof - zgrazfffp + zfracfe 
     332         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zgrazfffg + zgrapof - zfracfe 
     333         zfracal = tr(ji,jj,jk,jpcal,Kbb) / ( tr(ji,jj,jk,jpgoc,Kbb) + rtrn ) 
     334         zgrazcal = zgrazffeg * (1. - part2) * zfracal 
     335 
     336         !  calcite production 
     337         !  ------------------ 
     338         zprcaca = xfracal(ji,jj,jk) * zgraznc 
     339         prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
     340         zprcaca = part2 * zprcaca 
     341         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrazcal - zprcaca 
     342         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + 2. * ( zgrazcal - zprcaca ) 
     343         tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) - zgrazcal + zprcaca 
     344      END_3D 
     345      ! 
     346      IF( lk_iomput .AND. knt == nrdttrc ) THEN 
     347        CALL iom_put( "PCAL"  , prodcal(:,:,:) * 1.e+3  * rfact2r * tmask(:,:,:) )  !  Calcite production  
     348        IF( iom_use("GRAZ2") ) THEN  !   Total grazing of phyto by zooplankton 
     349           zgrazing(:,:,jpk) = 0._wp ;  CALL iom_put( "GRAZ2" , zgrazing(:,:,:) * 1.e+3  * rfact2r * tmask(:,:,:) )  
    352350         ENDIF 
    353351         IF( iom_use("FEZOO2") ) THEN   
    … …  
    359357      ENDIF 
    360358      ! 
    361       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     359      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    362360        WRITE(charout, FMT="('meso')") 
    363361        CALL prt_ctl_trc_info(charout) 
    364         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     362        CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    365363      ENDIF 
    366364      ! 
    … …  
    390388      !!---------------------------------------------------------------------- 
    391389      ! 
    392       REWIND( numnatp_ref ) 
    393390      READ  ( numnatp_ref, namp5zmes, IOSTAT = ios, ERR = 901) 
    394391901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismes in reference namelist' ) 
    395392      ! 
    396       REWIND( numnatp_cfg ) 
    397393      READ  ( numnatp_cfg, namp5zmes, IOSTAT = ios, ERR = 902 ) 
    398394902   IF( ios >  0 ) CALL ctl_nam ( ios , 'nampismes in configuration namelist' ) 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p5zmicro.F90

    r12276 r12377  
    5252   LOGICAL,  PUBLIC ::  bmetexc     !: Use of excess carbon for respiration 
    5353 
     54   !! * Substitutions 
     55#  include "do_loop_substitute.h90" 
    5456   !!---------------------------------------------------------------------- 
    5557   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    6062CONTAINS 
    6163 
    62    SUBROUTINE p5z_micro( kt, knt ) 
     64   SUBROUTINE p5z_micro( kt, knt, Kbb, Krhs ) 
    6365      !!--------------------------------------------------------------------- 
    6466      !!                     ***  ROUTINE p5z_micro  *** 
    … …  
    7072      INTEGER, INTENT(in) ::  kt  ! ocean time step 
    7173      INTEGER, INTENT(in) ::  knt  
     74      INTEGER, INTENT(in) ::  Kbb, Krhs      ! time level indices 
    7275      ! 
    7376      INTEGER  :: ji, jj, jk 
    … …  
    9396      IF ( bmetexc ) zmetexcess = 1.0 
    9497      ! 
    95       DO jk = 1, jpkm1 
    96          DO jj = 1, jpj 
    97             DO ji = 1, jpi 
    98                zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 ) 
    99                zfact   = xstep * tgfunc2(ji,jj,jk) * zcompaz 
    100  
    101                !   Michaelis-Menten mortality rates of microzooplankton 
    102                !   ----------------------------------------------------- 
    103                zrespz = resrat * zfact * ( trb(ji,jj,jk,jpzoo) / ( xkmort + trb(ji,jj,jk,jpzoo) )  & 
    104                &        + 3. * nitrfac(ji,jj,jk) ) 
    105  
    106                !   Zooplankton mortality. A square function has been selected with 
    107                !   no real reason except that it seems to be more stable and may mimic predation. 
    108                !   ------------------------------------------------------------------------------ 
    109                ztortz = mzrat * 1.e6 * zfact * trb(ji,jj,jk,jpzoo) * (1. - nitrfac(ji,jj,jk)) 
    110  
    111                !   Computation of the abundance of the preys 
    112                !   A threshold can be specified in the namelist 
    113                !   -------------------------------------------- 
    114                zcompadi  = MIN( MAX( ( trb(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia ) 
    115                zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 ) 
    116                zcompaz   = MAX( ( trb(ji,jj,jk,jpzoo) - xthreshzoo ), 0.e0 ) 
    117                zcompapi  = MAX( ( trb(ji,jj,jk,jppic) - xthreshpic ), 0.e0 ) 
    118                zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 ) 
    119                 
    120                !   Microzooplankton grazing 
    121                !   ------------------------ 
    122                zfood     = xprefn * zcompaph + xprefc * zcompapoc + xprefd * zcompadi   & 
    123                &           + xprefz * zcompaz + xprefp * zcompapi 
    124                zfoodlim  = MAX( 0. , zfood - min(xthresh,0.5*zfood) ) 
    125                zdenom    = zfoodlim / ( xkgraz + zfoodlim ) 
    126                zgraze    = grazrat * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpzoo) * (1. - nitrfac(ji,jj,jk))  
    127  
    128                !   An active switching parameterization is used here. 
    129                !   We don't use the KTW parameterization proposed by  
    130                !   Vallina et al. because it tends to produce to steady biomass 
    131                !   composition and the variance of Chl is too low as it grazes 
    132                !   too strongly on winning organisms. Thus, instead of a square 
    133                !   a 1.5 power value is used which decreases the pressure on the 
    134                !   most abundant species 
    135                !   ------------------------------------------------------------   
    136                ztmp1 = xprefn * zcompaph**1.5 
    137                ztmp2 = xprefp * zcompapi**1.5 
    138                ztmp3 = xprefc * zcompapoc**1.5 
    139                ztmp4 = xprefd * zcompadi**1.5 
    140                ztmp5 = xprefz * zcompaz**1.5 
    141                ztmptot = ztmp1 + ztmp2 + ztmp3 + ztmp4 + ztmp5 + rtrn 
    142                ztmp1 = ztmp1 / ztmptot 
    143                ztmp2 = ztmp2 / ztmptot 
    144                ztmp3 = ztmp3 / ztmptot 
    145                ztmp4 = ztmp4 / ztmptot 
    146                ztmp5 = ztmp5 / ztmptot 
    147  
    148                !   Microzooplankton regular grazing on the different preys 
    149                !   ------------------------------------------------------- 
    150                zgraznc   = zgraze  * ztmp1  * zdenom 
    151                zgraznn   = zgraznc * trb(ji,jj,jk,jpnph) / (trb(ji,jj,jk,jpphy) + rtrn) 
    152                zgraznp   = zgraznc * trb(ji,jj,jk,jppph) / (trb(ji,jj,jk,jpphy) + rtrn) 
    153                zgraznf   = zgraznc * trb(ji,jj,jk,jpnfe) / (trb(ji,jj,jk,jpphy) + rtrn) 
    154                zgrazpc   = zgraze  * ztmp2  * zdenom 
    155                zgrazpn   = zgrazpc * trb(ji,jj,jk,jpnpi) / (trb(ji,jj,jk,jppic) + rtrn) 
    156                zgrazpp   = zgrazpc * trb(ji,jj,jk,jpppi) / (trb(ji,jj,jk,jppic) + rtrn) 
    157                zgrazpf   = zgrazpc * trb(ji,jj,jk,jppfe) / (trb(ji,jj,jk,jppic) + rtrn) 
    158                zgrazz    = zgraze  * ztmp5   * zdenom 
    159                zgrazpoc  = zgraze  * ztmp3   * zdenom 
    160                zgrazpon  = zgrazpoc * trb(ji,jj,jk,jppon) / ( trb(ji,jj,jk,jppoc) + rtrn ) 
    161                zgrazpop  = zgrazpoc * trb(ji,jj,jk,jppop) / ( trb(ji,jj,jk,jppoc) + rtrn ) 
    162                zgrazpof  = zgrazpoc* trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn) 
    163                zgrazdc   = zgraze  * ztmp4  * zdenom 
    164                zgrazdn   = zgrazdc * trb(ji,jj,jk,jpndi) / (trb(ji,jj,jk,jpdia) + rtrn) 
    165                zgrazdp   = zgrazdc * trb(ji,jj,jk,jppdi) / (trb(ji,jj,jk,jpdia) + rtrn) 
    166                zgrazdf   = zgrazdc * trb(ji,jj,jk,jpdfe) / (trb(ji,jj,jk,jpdia) + rtrn) 
    167                ! 
    168                zgraztotc = zgraznc + zgrazpoc + zgrazdc + zgrazz + zgrazpc 
    169                zgraztotn = zgraznn + zgrazpn + zgrazpon + zgrazdn + zgrazz * no3rat3 
    170                zgraztotp = zgraznp + zgrazpp + zgrazpop + zgrazdp + zgrazz * po4rat3 
    171                zgraztotf = zgraznf + zgrazpf + zgrazpof + zgrazdf + zgrazz * ferat3 
    172                ! 
    173                ! Grazing by microzooplankton 
    174                zgrazing(ji,jj,jk) = zgraztotc 
    175  
    176                !   Stoichiometruc ratios of the food ingested by zooplanton  
    177                !   -------------------------------------------------------- 
    178                zgrasratf =  (zgraztotf + rtrn) / ( zgraztotc + rtrn ) 
    179                zgrasratn =  (zgraztotn + rtrn) / ( zgraztotc + rtrn ) 
    180                zgrasratp =  (zgraztotp + rtrn) / ( zgraztotc + rtrn ) 
    181  
    182                !   Growth efficiency is made a function of the quality  
    183                !   and the quantity of the preys 
    184                !   --------------------------------------------------- 
    185                zepshert  = MIN( 1., zgrasratn/ no3rat3, zgrasratp/ po4rat3, zgrasratf / ferat3) 
    186                zbeta     = MAX( 0., (epsher - epshermin) ) 
    187                zepsherf  = epshermin + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 
    188                zepsherv  = zepsherf * zepshert 
    189  
    190                !   Respiration of microzooplankton 
    191                !   Excess carbon in the food is used preferentially 
    192                !   ------------------------------------------------ 
    193                zexcess  = zgraztotc * zepsherf * (1.0 - zepshert) * zmetexcess 
    194                zbasresb = MAX(0., zrespz - zexcess) 
    195                zbasresi = zexcess + MIN(0., zrespz - zexcess)   
    196                zrespirc = srespir * zepsherv * zgraztotc + zbasresb 
    197                 
    198                !   When excess carbon is used, the other elements in excess 
    199                !   are also used proportionally to their abundance 
    200                !   -------------------------------------------------------- 
    201                zexcess  = ( zgrasratn/ no3rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 
    202                zbasresn = zbasresi * zexcess * zgrasratn  
    203                zexcess  = ( zgrasratp/ po4rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 
    204                zbasresp = zbasresi * zexcess * zgrasratp 
    205                zexcess  = ( zgrasratf/ ferat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 
    206                zbasresf = zbasresi * zexcess * zgrasratf 
    207  
    208                !   Voiding of the excessive elements as DOM 
    209                !   ---------------------------------------- 
    210                zgradoct   = (1. - unassc - zepsherv) * zgraztotc - zbasresi   
    211                zgradont   = (1. - unassn) * zgraztotn - zepsherv * no3rat3 * zgraztotc - zbasresn 
    212                zgradopt   = (1. - unassp) * zgraztotp - zepsherv * po4rat3 * zgraztotc - zbasresp 
    213                zgrareft   = (1. - unassc) * zgraztotf - zepsherv * ferat3 * zgraztotc - zbasresf 
    214  
    215                !  Since only semilabile DOM is represented in PISCES 
    216                !  part of DOM is in fact labile and is then released 
    217                !  as dissolved inorganic compounds (ssigma) 
    218                !  -------------------------------------------------- 
    219                zgradoc =  zgradoct * ssigma 
    220                zgradon =  zgradont * ssigma 
    221                zgradop =  zgradopt * ssigma 
    222                zgrarem = (1.0 - ssigma) * zgradoct 
    223                zgraren = (1.0 - ssigma) * zgradont 
    224                zgrarep = (1.0 - ssigma) * zgradopt 
    225                zgraref = zgrareft 
    226  
    227                !   Defecation as a result of non assimilated products 
    228                !   -------------------------------------------------- 
    229                zgrapoc   = zgraztotc * unassc 
    230                zgrapon   = zgraztotn * unassn 
    231                zgrapop   = zgraztotp * unassp 
    232                zgrapof   = zgraztotf * unassc 
    233  
    234                !  Addition of respiration to the release of inorganic nutrients 
    235                !  ------------------------------------------------------------- 
    236                zgrarem = zgrarem + zbasresi + zrespirc 
    237                zgraren = zgraren + zbasresn + zrespirc * no3rat3 
    238                zgrarep = zgrarep + zbasresp + zrespirc * po4rat3 
    239                zgraref = zgraref + zbasresf + zrespirc * ferat3 
    240  
    241                !   Update of the TRA arrays 
    242                !   ------------------------ 
    243                tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarep 
    244                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgraren 
    245                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgradoc 
    246                ! 
    247                IF( ln_ligand ) THEN  
    248                   tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zgradoc * ldocz 
    249                   zzligprod(ji,jj,jk) = zgradoc * ldocz 
    250                ENDIF 
    251                ! 
    252                tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zgradon 
    253                tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zgradop 
    254                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem  
    255                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgraref 
    256                zfezoo(ji,jj,jk)    = zgraref 
    257                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zepsherv * zgraztotc - zrespirc - ztortz - zgrazz 
    258                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgraznc 
    259                tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) - zgraznn 
    260                tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) - zgraznp 
    261                tra(ji,jj,jk,jppic) = tra(ji,jj,jk,jppic) - zgrazpc 
    262                tra(ji,jj,jk,jpnpi) = tra(ji,jj,jk,jpnpi) - zgrazpn 
    263                tra(ji,jj,jk,jpppi) = tra(ji,jj,jk,jpppi) - zgrazpp 
    264                tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazdc 
    265                tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) - zgrazdn 
    266                tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) - zgrazdp 
    267                tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgraznc * trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn) 
    268                tra(ji,jj,jk,jppch) = tra(ji,jj,jk,jppch) - zgrazpc * trb(ji,jj,jk,jppch)/(trb(ji,jj,jk,jppic)+rtrn) 
    269                tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazdc * trb(ji,jj,jk,jpdch)/(trb(ji,jj,jk,jpdia)+rtrn) 
    270                tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazdc * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn) 
    271                tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazdc * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn) 
    272                tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf 
    273                tra(ji,jj,jk,jppfe) = tra(ji,jj,jk,jppfe) - zgrazpf 
    274                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazdf 
    275                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ztortz + zgrapoc - zgrazpoc  
    276                prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ztortz + zgrapoc 
    277                conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc 
    278                tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + no3rat3 * ztortz + zgrapon - zgrazpon 
    279                tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + po4rat3 * ztortz + zgrapop - zgrazpop 
    280                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * ztortz  + zgrapof - zgrazpof 
    281                ! 
    282                ! calcite production 
    283                zprcaca = xfracal(ji,jj,jk) * zgraznc 
    284                prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    285                ! 
    286                zprcaca = part * zprcaca 
    287                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem - zprcaca 
    288                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca     & 
    289                &                     + rno3 * zgraren 
    290                tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 
    291             END DO 
    292          END DO 
    293       END DO 
     98      DO_3D_11_11( 1, jpkm1 ) 
     99         zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - 1.e-9 ), 0.e0 ) 
     100         zfact   = xstep * tgfunc2(ji,jj,jk) * zcompaz 
     101 
     102         !   Michaelis-Menten mortality rates of microzooplankton 
     103         !   ----------------------------------------------------- 
     104         zrespz = resrat * zfact * ( tr(ji,jj,jk,jpzoo,Kbb) / ( xkmort + tr(ji,jj,jk,jpzoo,Kbb) )  & 
     105         &        + 3. * nitrfac(ji,jj,jk) ) 
     106 
     107         !   Zooplankton mortality. A square function has been selected with 
     108         !   no real reason except that it seems to be more stable and may mimic predation. 
     109         !   ------------------------------------------------------------------------------ 
     110         ztortz = mzrat * 1.e6 * zfact * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk)) 
     111 
     112         !   Computation of the abundance of the preys 
     113         !   A threshold can be specified in the namelist 
     114         !   -------------------------------------------- 
     115         zcompadi  = MIN( MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthreshdia ), 0.e0 ), xsizedia ) 
     116         zcompaph  = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthreshphy ), 0.e0 ) 
     117         zcompaz   = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - xthreshzoo ), 0.e0 ) 
     118         zcompapi  = MAX( ( tr(ji,jj,jk,jppic,Kbb) - xthreshpic ), 0.e0 ) 
     119         zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthreshpoc ), 0.e0 ) 
     120          
     121         !   Microzooplankton grazing 
     122         !   ------------------------ 
     123         zfood     = xprefn * zcompaph + xprefc * zcompapoc + xprefd * zcompadi   & 
     124         &           + xprefz * zcompaz + xprefp * zcompapi 
     125         zfoodlim  = MAX( 0. , zfood - min(xthresh,0.5*zfood) ) 
     126         zdenom    = zfoodlim / ( xkgraz + zfoodlim ) 
     127         zgraze    = grazrat * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk))  
     128 
     129         !   An active switching parameterization is used here. 
     130         !   We don't use the KTW parameterization proposed by  
     131         !   Vallina et al. because it tends to produce to steady biomass 
     132         !   composition and the variance of Chl is too low as it grazes 
     133         !   too strongly on winning organisms. Thus, instead of a square 
     134         !   a 1.5 power value is used which decreases the pressure on the 
     135         !   most abundant species 
     136         !   ------------------------------------------------------------   
     137         ztmp1 = xprefn * zcompaph**1.5 
     138         ztmp2 = xprefp * zcompapi**1.5 
     139         ztmp3 = xprefc * zcompapoc**1.5 
     140         ztmp4 = xprefd * zcompadi**1.5 
     141         ztmp5 = xprefz * zcompaz**1.5 
     142         ztmptot = ztmp1 + ztmp2 + ztmp3 + ztmp4 + ztmp5 + rtrn 
     143         ztmp1 = ztmp1 / ztmptot 
     144         ztmp2 = ztmp2 / ztmptot 
     145         ztmp3 = ztmp3 / ztmptot 
     146         ztmp4 = ztmp4 / ztmptot 
     147         ztmp5 = ztmp5 / ztmptot 
     148 
     149         !   Microzooplankton regular grazing on the different preys 
     150         !   ------------------------------------------------------- 
     151         zgraznc   = zgraze  * ztmp1  * zdenom 
     152         zgraznn   = zgraznc * tr(ji,jj,jk,jpnph,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
     153         zgraznp   = zgraznc * tr(ji,jj,jk,jppph,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
     154         zgraznf   = zgraznc * tr(ji,jj,jk,jpnfe,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
     155         zgrazpc   = zgraze  * ztmp2  * zdenom 
     156         zgrazpn   = zgrazpc * tr(ji,jj,jk,jpnpi,Kbb) / (tr(ji,jj,jk,jppic,Kbb) + rtrn) 
     157         zgrazpp   = zgrazpc * tr(ji,jj,jk,jpppi,Kbb) / (tr(ji,jj,jk,jppic,Kbb) + rtrn) 
     158         zgrazpf   = zgrazpc * tr(ji,jj,jk,jppfe,Kbb) / (tr(ji,jj,jk,jppic,Kbb) + rtrn) 
     159         zgrazz    = zgraze  * ztmp5   * zdenom 
     160         zgrazpoc  = zgraze  * ztmp3   * zdenom 
     161         zgrazpon  = zgrazpoc * tr(ji,jj,jk,jppon,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 
     162         zgrazpop  = zgrazpoc * tr(ji,jj,jk,jppop,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 
     163         zgrazpof  = zgrazpoc* tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
     164         zgrazdc   = zgraze  * ztmp4  * zdenom 
     165         zgrazdn   = zgrazdc * tr(ji,jj,jk,jpndi,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
     166         zgrazdp   = zgrazdc * tr(ji,jj,jk,jppdi,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
     167         zgrazdf   = zgrazdc * tr(ji,jj,jk,jpdfe,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
     168         ! 
     169         zgraztotc = zgraznc + zgrazpoc + zgrazdc + zgrazz + zgrazpc 
     170         zgraztotn = zgraznn + zgrazpn + zgrazpon + zgrazdn + zgrazz * no3rat3 
     171         zgraztotp = zgraznp + zgrazpp + zgrazpop + zgrazdp + zgrazz * po4rat3 
     172         zgraztotf = zgraznf + zgrazpf + zgrazpof + zgrazdf + zgrazz * ferat3 
     173         ! 
     174         ! Grazing by microzooplankton 
     175         zgrazing(ji,jj,jk) = zgraztotc 
     176 
     177         !   Stoichiometruc ratios of the food ingested by zooplanton  
     178         !   -------------------------------------------------------- 
     179         zgrasratf =  (zgraztotf + rtrn) / ( zgraztotc + rtrn ) 
     180         zgrasratn =  (zgraztotn + rtrn) / ( zgraztotc + rtrn ) 
     181         zgrasratp =  (zgraztotp + rtrn) / ( zgraztotc + rtrn ) 
     182 
     183         !   Growth efficiency is made a function of the quality  
     184         !   and the quantity of the preys 
     185         !   --------------------------------------------------- 
     186         zepshert  = MIN( 1., zgrasratn/ no3rat3, zgrasratp/ po4rat3, zgrasratf / ferat3) 
     187         zbeta     = MAX( 0., (epsher - epshermin) ) 
     188         zepsherf  = epshermin + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 
     189         zepsherv  = zepsherf * zepshert 
     190 
     191         !   Respiration of microzooplankton 
     192         !   Excess carbon in the food is used preferentially 
     193         !   ------------------------------------------------ 
     194         zexcess  = zgraztotc * zepsherf * (1.0 - zepshert) * zmetexcess 
     195         zbasresb = MAX(0., zrespz - zexcess) 
     196         zbasresi = zexcess + MIN(0., zrespz - zexcess)   
     197         zrespirc = srespir * zepsherv * zgraztotc + zbasresb 
     198          
     199         !   When excess carbon is used, the other elements in excess 
     200         !   are also used proportionally to their abundance 
     201         !   -------------------------------------------------------- 
     202         zexcess  = ( zgrasratn/ no3rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 
     203         zbasresn = zbasresi * zexcess * zgrasratn  
     204         zexcess  = ( zgrasratp/ po4rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 
     205         zbasresp = zbasresi * zexcess * zgrasratp 
     206         zexcess  = ( zgrasratf/ ferat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 
     207         zbasresf = zbasresi * zexcess * zgrasratf 
     208 
     209         !   Voiding of the excessive elements as DOM 
     210         !   ---------------------------------------- 
     211         zgradoct   = (1. - unassc - zepsherv) * zgraztotc - zbasresi   
     212         zgradont   = (1. - unassn) * zgraztotn - zepsherv * no3rat3 * zgraztotc - zbasresn 
     213         zgradopt   = (1. - unassp) * zgraztotp - zepsherv * po4rat3 * zgraztotc - zbasresp 
     214         zgrareft   = (1. - unassc) * zgraztotf - zepsherv * ferat3 * zgraztotc - zbasresf 
     215 
     216         !  Since only semilabile DOM is represented in PISCES 
     217         !  part of DOM is in fact labile and is then released 
     218         !  as dissolved inorganic compounds (ssigma) 
     219         !  -------------------------------------------------- 
     220         zgradoc =  zgradoct * ssigma 
     221         zgradon =  zgradont * ssigma 
     222         zgradop =  zgradopt * ssigma 
     223         zgrarem = (1.0 - ssigma) * zgradoct 
     224         zgraren = (1.0 - ssigma) * zgradont 
     225         zgrarep = (1.0 - ssigma) * zgradopt 
     226         zgraref = zgrareft 
     227 
     228         !   Defecation as a result of non assimilated products 
     229         !   -------------------------------------------------- 
     230         zgrapoc   = zgraztotc * unassc 
     231         zgrapon   = zgraztotn * unassn 
     232         zgrapop   = zgraztotp * unassp 
     233         zgrapof   = zgraztotf * unassc 
     234 
     235         !  Addition of respiration to the release of inorganic nutrients 
     236         !  ------------------------------------------------------------- 
     237         zgrarem = zgrarem + zbasresi + zrespirc 
     238         zgraren = zgraren + zbasresn + zrespirc * no3rat3 
     239         zgrarep = zgrarep + zbasresp + zrespirc * po4rat3 
     240         zgraref = zgraref + zbasresf + zrespirc * ferat3 
     241 
     242         !   Update of the TRA arrays 
     243         !   ------------------------ 
     244         tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarep 
     245         tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgraren 
     246         tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgradoc 
     247         ! 
     248         IF( ln_ligand ) THEN  
     249            tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zgradoc * ldocz 
     250            zzligprod(ji,jj,jk) = zgradoc * ldocz 
     251         ENDIF 
     252         ! 
     253         tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zgradon 
     254         tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zgradop 
     255         tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarem  
     256         tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgraref 
     257         zfezoo(ji,jj,jk)    = zgraref 
     258         tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) + zepsherv * zgraztotc - zrespirc - ztortz - zgrazz 
     259         tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgraznc 
     260         tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) - zgraznn 
     261         tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) - zgraznp 
     262         tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) - zgrazpc 
     263         tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) - zgrazpn 
     264         tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) - zgrazpp 
     265         tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazdc 
     266         tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zgrazdn 
     267         tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zgrazdp 
     268         tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgraznc * tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 
     269         tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) - zgrazpc * tr(ji,jj,jk,jppch,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 
     270         tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazdc * tr(ji,jj,jk,jpdch,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 
     271         tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazdc * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 
     272         tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazdc * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 
     273         tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgraznf 
     274         tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) - zgrazpf 
     275         tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazdf 
     276         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + ztortz + zgrapoc - zgrazpoc  
     277         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ztortz + zgrapoc 
     278         conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc 
     279         tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + no3rat3 * ztortz + zgrapon - zgrazpon 
     280         tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + po4rat3 * ztortz + zgrapop - zgrazpop 
     281         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ferat3 * ztortz  + zgrapof - zgrazpof 
     282         ! 
     283         ! calcite production 
     284         zprcaca = xfracal(ji,jj,jk) * zgraznc 
     285         prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
     286         ! 
     287         zprcaca = part * zprcaca 
     288         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarem - zprcaca 
     289         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca     & 
     290         &                     + rno3 * zgraren 
     291         tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca 
     292      END_3D 
    294293      ! 
    295294      IF( lk_iomput .AND. knt == nrdttrc ) THEN 
    296         IF( iom_use("GRAZ1") ) THEN  !   Total grazing of phyto by zooplankton 
     295       IF( iom_use("GRAZ1") ) THEN  !   Total grazing of phyto by zooplankton 
    297296           zgrazing(:,:,jpk) = 0._wp   ; CALL iom_put( "GRAZ1" , zgrazing(:,:,:) * 1.e+3  * rfact2r * tmask(:,:,:) )  
    298297         ENDIF 
    … …  
    305304      ENDIF 
    306305      ! 
    307       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     306      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    308307         WRITE(charout, FMT="('micro')") 
    309308         CALL prt_ctl_trc_info(charout) 
    310          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     309         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    311310      ENDIF 
    312311      ! 
    … …  
    336335      !!---------------------------------------------------------------------- 
    337336      ! 
    338       REWIND( numnatp_ref ) 
    339337      READ  ( numnatp_ref, namp5zzoo, IOSTAT = ios, ERR = 901) 
    340338901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp5zzoo in reference namelist' ) 
    341339      ! 
    342       REWIND( numnatp_cfg ) 
    343340      READ  ( numnatp_cfg, namp5zzoo, IOSTAT = ios, ERR = 902 ) 
    344341902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namp5zzoo in configuration namelist' ) 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p5zmort.F90

    r11536 r12377  
    3333   REAL(wp), PUBLIC :: mpratd  !: 
    3434 
     35   !! * Substitutions 
     36#  include "do_loop_substitute.h90" 
    3537   !!---------------------------------------------------------------------- 
    3638   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4143CONTAINS 
    4244 
    43    SUBROUTINE p5z_mort( kt ) 
     45   SUBROUTINE p5z_mort( kt, Kbb, Krhs ) 
    4446      !!--------------------------------------------------------------------- 
    4547      !!                     ***  ROUTINE p5z_mort  *** 
    … …  
    5153      !!--------------------------------------------------------------------- 
    5254      INTEGER, INTENT(in) ::   kt ! ocean time step 
    53       !!--------------------------------------------------------------------- 
    54  
    55       CALL p5z_nano            ! nanophytoplankton 
    56       CALL p5z_pico            ! picophytoplankton 
    57       CALL p5z_diat            ! diatoms 
     55      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices 
     56      !!--------------------------------------------------------------------- 
     57 
     58      CALL p5z_nano( Kbb, Krhs )            ! nanophytoplankton 
     59      CALL p5z_pico( Kbb, Krhs )            ! picophytoplankton 
     60      CALL p5z_diat( Kbb, Krhs )            ! diatoms 
    5861 
    5962   END SUBROUTINE p5z_mort 
    6063 
    6164 
    62    SUBROUTINE p5z_nano 
     65   SUBROUTINE p5z_nano( Kbb, Krhs ) 
    6366      !!--------------------------------------------------------------------- 
    6467      !!                     ***  ROUTINE p5z_nano  *** 
    … …  
    6871      !! ** Method  : - ??? 
    6972      !!--------------------------------------------------------------------- 
     73      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices 
    7074      INTEGER  :: ji, jj, jk 
    7175      REAL(wp) :: zcompaph 
    … …  
    7882      ! 
    7983      prodcal(:,:,:) = 0.  !: calcite production variable set to zero 
    80       DO jk = 1, jpkm1 
    81          DO jj = 1, jpj 
    82             DO ji = 1, jpi 
    83                zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - 1e-9 ), 0.e0 ) 
    84                !   Squared mortality of Phyto similar to a sedimentation term during 
    85                !   blooms (Doney et al. 1996) 
    86                !   ----------------------------------------------------------------- 
    87                zrespp = wchln * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * trb(ji,jj,jk,jpphy) 
    88  
    89                !   Phytoplankton linear mortality 
    90                !   ------------------------------ 
    91                ztortp = mpratn * xstep  * zcompaph 
    92                zmortp = zrespp + ztortp 
    93  
    94                !   Update the arrays TRA which contains the biological sources and sinks 
    95  
    96                zfactn  = trb(ji,jj,jk,jpnph)/(trb(ji,jj,jk,jpphy)+rtrn) 
    97                zfactp  = trb(ji,jj,jk,jppph)/(trb(ji,jj,jk,jpphy)+rtrn) 
    98                zfactfe = trb(ji,jj,jk,jpnfe)/(trb(ji,jj,jk,jpphy)+rtrn) 
    99                zfactch = trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn) 
    100                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zmortp 
    101                tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) - zmortp * zfactn 
    102                tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) - zmortp * zfactp 
    103                tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zmortp * zfactch 
    104                tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zmortp * zfactfe 
    105                zprcaca = xfracal(ji,jj,jk) * zmortp 
    106                ! 
    107                prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    108                ! 
    109                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 
    110                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 
    111                tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 
    112                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp 
    113                tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zmortp * zfactn 
    114                tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + zmortp * zfactp 
    115                prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp 
    116                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp * zfactfe 
    117             END DO 
    118          END DO 
    119       END DO 
    120       ! 
    121        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     84      DO_3D_11_11( 1, jpkm1 ) 
     85         zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-9 ), 0.e0 ) 
     86         !   Squared mortality of Phyto similar to a sedimentation term during 
     87         !   blooms (Doney et al. 1996) 
     88         !   ----------------------------------------------------------------- 
     89         zrespp = wchln * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * tr(ji,jj,jk,jpphy,Kbb) 
     90 
     91         !   Phytoplankton linear mortality 
     92         !   ------------------------------ 
     93         ztortp = mpratn * xstep  * zcompaph 
     94         zmortp = zrespp + ztortp 
     95 
     96         !   Update the arrays TRA which contains the biological sources and sinks 
     97 
     98         zfactn  = tr(ji,jj,jk,jpnph,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 
     99         zfactp  = tr(ji,jj,jk,jppph,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 
     100         zfactfe = tr(ji,jj,jk,jpnfe,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 
     101         zfactch = tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 
     102         tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zmortp 
     103         tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) - zmortp * zfactn 
     104         tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) - zmortp * zfactp 
     105         tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zmortp * zfactch 
     106         tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zmortp * zfactfe 
     107         zprcaca = xfracal(ji,jj,jk) * zmortp 
     108         ! 
     109         prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
     110         ! 
     111         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprcaca 
     112         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca 
     113         tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca 
     114         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortp 
     115         tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zmortp * zfactn 
     116         tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + zmortp * zfactp 
     117         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp 
     118         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zmortp * zfactfe 
     119      END_3D 
     120      ! 
     121       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    122122         WRITE(charout, FMT="('nano')") 
    123123         CALL prt_ctl_trc_info(charout) 
    124          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     124         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    125125       ENDIF 
    126126      ! 
    … …  
    130130 
    131131 
    132    SUBROUTINE p5z_pico 
     132   SUBROUTINE p5z_pico( Kbb, Krhs ) 
    133133      !!--------------------------------------------------------------------- 
    134134      !!                     ***  ROUTINE p5z_pico  *** 
    … …  
    138138      !! ** Method  : - ??? 
    139139      !!--------------------------------------------------------------------- 
     140      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices 
    140141      INTEGER  :: ji, jj, jk 
    141142      REAL(wp) :: zcompaph 
    … …  
    147148      IF( ln_timing )   CALL timing_start('p5z_pico') 
    148149      ! 
    149       DO jk = 1, jpkm1 
    150          DO jj = 1, jpj 
    151             DO ji = 1, jpi 
    152                zcompaph = MAX( ( trb(ji,jj,jk,jppic) - 1e-9 ), 0.e0 ) 
    153                !  Squared mortality of Phyto similar to a sedimentation term during 
    154                !  blooms (Doney et al. 1996) 
    155                !  ----------------------------------------------------------------- 
    156                zrespp = wchlp * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * trb(ji,jj,jk,jppic) 
    157  
    158                !     Phytoplankton mortality  
    159                ztortp = mpratp * xstep  * zcompaph 
    160                zmortp = zrespp + ztortp 
    161  
    162                !   Update the arrays TRA which contains the biological sources and sinks 
    163  
    164                zfactn = trb(ji,jj,jk,jpnpi)/(trb(ji,jj,jk,jppic)+rtrn) 
    165                zfactp = trb(ji,jj,jk,jpppi)/(trb(ji,jj,jk,jppic)+rtrn) 
    166                zfactfe = trb(ji,jj,jk,jppfe)/(trb(ji,jj,jk,jppic)+rtrn) 
    167                zfactch = trb(ji,jj,jk,jppch)/(trb(ji,jj,jk,jppic)+rtrn) 
    168                tra(ji,jj,jk,jppic) = tra(ji,jj,jk,jppic) - zmortp 
    169                tra(ji,jj,jk,jpnpi) = tra(ji,jj,jk,jpnpi) - zmortp * zfactn 
    170                tra(ji,jj,jk,jpppi) = tra(ji,jj,jk,jpppi) - zmortp * zfactp 
    171                tra(ji,jj,jk,jppch) = tra(ji,jj,jk,jppch) - zmortp * zfactch 
    172                tra(ji,jj,jk,jppfe) = tra(ji,jj,jk,jppfe) - zmortp * zfactfe 
    173                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp 
    174                tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zmortp * zfactn 
    175                tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + zmortp * zfactp 
    176                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp * zfactfe 
    177                prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp 
    178             END DO 
    179          END DO 
    180       END DO 
    181       ! 
    182        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     150      DO_3D_11_11( 1, jpkm1 ) 
     151         zcompaph = MAX( ( tr(ji,jj,jk,jppic,Kbb) - 1e-9 ), 0.e0 ) 
     152         !  Squared mortality of Phyto similar to a sedimentation term during 
     153         !  blooms (Doney et al. 1996) 
     154         !  ----------------------------------------------------------------- 
     155         zrespp = wchlp * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * tr(ji,jj,jk,jppic,Kbb) 
     156 
     157         !     Phytoplankton mortality  
     158         ztortp = mpratp * xstep  * zcompaph 
     159         zmortp = zrespp + ztortp 
     160 
     161         !   Update the arrays TRA which contains the biological sources and sinks 
     162 
     163         zfactn = tr(ji,jj,jk,jpnpi,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 
     164         zfactp = tr(ji,jj,jk,jpppi,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 
     165         zfactfe = tr(ji,jj,jk,jppfe,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 
     166         zfactch = tr(ji,jj,jk,jppch,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 
     167         tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) - zmortp 
     168         tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) - zmortp * zfactn 
     169         tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) - zmortp * zfactp 
     170         tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) - zmortp * zfactch 
     171         tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) - zmortp * zfactfe 
     172         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortp 
     173         tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zmortp * zfactn 
     174         tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + zmortp * zfactp 
     175         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zmortp * zfactfe 
     176         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp 
     177      END_3D 
     178      ! 
     179       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    183180         WRITE(charout, FMT="('pico')") 
    184181         CALL prt_ctl_trc_info(charout) 
    185          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     182         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    186183       ENDIF 
    187184      ! 
    … …  
    191188 
    192189 
    193    SUBROUTINE p5z_diat 
     190   SUBROUTINE p5z_diat( Kbb, Krhs ) 
    194191      !!--------------------------------------------------------------------- 
    195192      !!                     ***  ROUTINE p5z_diat  *** 
    … …  
    199196      !! ** Method  : - ??? 
    200197      !!--------------------------------------------------------------------- 
     198      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices 
    201199      INTEGER  ::  ji, jj, jk 
    202200      REAL(wp) ::  zfactfe,zfactsi,zfactch, zfactn, zfactp, zcompadi 
    … …  
    209207      ! 
    210208 
    211       DO jk = 1, jpkm1 
    212          DO jj = 1, jpj 
    213             DO ji = 1, jpi 
    214  
    215                zcompadi = MAX( ( trb(ji,jj,jk,jpdia) - 1E-9), 0. ) 
    216  
    217                !   Aggregation term for diatoms is increased in case of nutrient 
    218                !   stress as observed in reality. The stressed cells become more 
    219                !   sticky and coagulate to sink quickly out of the euphotic zone 
    220                !   ------------------------------------------------------------- 
    221                !  Phytoplankton squared mortality 
    222                !  ------------------------------- 
    223                zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk) 
    224                zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 )  
    225                zrespp2 = 1.e6 * xstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trb(ji,jj,jk,jpdia) 
    226  
    227                !  Phytoplankton linear mortality  
    228                !  ------------------------------ 
    229                ztortp2 = mpratd * xstep  * zcompadi 
    230                zmortp2 = zrespp2 + ztortp2 
    231  
    232                !   Update the arrays tra which contains the biological sources and sinks 
    233                !   --------------------------------------------------------------------- 
    234                zfactn  = trb(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    235                zfactp  = trb(ji,jj,jk,jppdi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    236                zfactch = trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    237                zfactfe = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    238                zfactsi = trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    239                tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zmortp2  
    240                tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) - zmortp2 * zfactn 
    241                tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) - zmortp2 * zfactp 
    242                tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zmortp2 * zfactch 
    243                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zmortp2 * zfactfe 
    244                tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zmortp2 * zfactsi 
    245                tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zmortp2 * zfactsi 
    246                tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zrespp2  
    247                tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zrespp2 * zfactn 
    248                tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + zrespp2 * zfactp 
    249                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zrespp2 * zfactfe 
    250                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ztortp2 
    251                tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + ztortp2 * zfactn 
    252                tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + ztortp2 * zfactp 
    253                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ztortp2 * zfactfe 
    254                prodpoc(ji,jj,jk)   = prodpoc(ji,jj,jk) + ztortp2 
    255                prodgoc(ji,jj,jk)   = prodgoc(ji,jj,jk) + zrespp2 
    256             END DO 
    257          END DO 
    258       END DO 
    259       ! 
    260       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     209      DO_3D_11_11( 1, jpkm1 ) 
     210 
     211         zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1E-9), 0. ) 
     212 
     213         !   Aggregation term for diatoms is increased in case of nutrient 
     214         !   stress as observed in reality. The stressed cells become more 
     215         !   sticky and coagulate to sink quickly out of the euphotic zone 
     216         !   ------------------------------------------------------------- 
     217         !  Phytoplankton squared mortality 
     218         !  ------------------------------- 
     219         zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk) 
     220         zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 )  
     221         zrespp2 = 1.e6 * xstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * tr(ji,jj,jk,jpdia,Kbb) 
     222 
     223         !  Phytoplankton linear mortality  
     224         !  ------------------------------ 
     225         ztortp2 = mpratd * xstep  * zcompadi 
     226         zmortp2 = zrespp2 + ztortp2 
     227 
     228         !   Update the arrays tr(:,:,:,:,Krhs) which contains the biological sources and sinks 
     229         !   --------------------------------------------------------------------- 
     230         zfactn  = tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     231         zfactp  = tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     232         zfactch = tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     233         zfactfe = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     234         zfactsi = tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     235         tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zmortp2  
     236         tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zmortp2 * zfactn 
     237         tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zmortp2 * zfactp 
     238         tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zmortp2 * zfactch 
     239         tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zmortp2 * zfactfe 
     240         tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zmortp2 * zfactsi 
     241         tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zmortp2 * zfactsi 
     242         tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zrespp2  
     243         tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zrespp2 * zfactn 
     244         tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + zrespp2 * zfactp 
     245         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zrespp2 * zfactfe 
     246         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + ztortp2 
     247         tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + ztortp2 * zfactn 
     248         tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + ztortp2 * zfactp 
     249         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ztortp2 * zfactfe 
     250         prodpoc(ji,jj,jk)   = prodpoc(ji,jj,jk) + ztortp2 
     251         prodgoc(ji,jj,jk)   = prodgoc(ji,jj,jk) + zrespp2 
     252      END_3D 
     253      ! 
     254      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    261255         WRITE(charout, FMT="('diat')") 
    262256         CALL prt_ctl_trc_info(charout) 
    263          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     257         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    264258      ENDIF 
    265259      ! 
    … …  
    286280      !!---------------------------------------------------------------------- 
    287281 
    288       REWIND( numnatp_ref )              ! Namelist nampismort in reference namelist : Pisces phytoplankton 
    289282      READ  ( numnatp_ref, namp5zmort, IOSTAT = ios, ERR = 901) 
    290283901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp5zmort in reference namelist' ) 
    291284 
    292       REWIND( numnatp_cfg )              ! Namelist nampismort in configuration namelist : Pisces phytoplankton 
    293285      READ  ( numnatp_cfg, namp5zmort, IOSTAT = ios, ERR = 902 ) 
    294286902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namp5zmort in configuration namelist' ) 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p5zprod.F90

    r12280 r12377  
    5050   REAL(wp) :: texcretd               !: 1 - excret2         
    5151 
     52   !! * Substitutions 
     53#  include "do_loop_substitute.h90" 
    5254   !!---------------------------------------------------------------------- 
    5355   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    5759CONTAINS 
    5860 
    59    SUBROUTINE p5z_prod( kt , knt ) 
     61   SUBROUTINE p5z_prod( kt , knt, Kbb, Kmm, Krhs ) 
    6062      !!--------------------------------------------------------------------- 
    6163      !!                     ***  ROUTINE p5z_prod  *** 
    … …  
    6870      ! 
    6971      INTEGER, INTENT(in) :: kt, knt 
     72      INTEGER, INTENT(in) :: Kbb, Kmm, Krhs      ! time level indices 
    7073      ! 
    7174      INTEGER  ::   ji, jj, jk 
    … …  
    121124      ! day length in hours 
    122125      zstrn(:,:) = 0. 
    123       DO jj = 1, jpj 
    124          DO ji = 1, jpi 
    125             zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 
    126             zargu = MAX( -1., MIN(  1., zargu ) ) 
    127             zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 
    128          END DO 
    129       END DO 
     126      DO_2D_11_11 
     127         zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 
     128         zargu = MAX( -1., MIN(  1., zargu ) ) 
     129         zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 
     130      END_2D 
    130131 
    131132         ! Impact of the day duration on phytoplankton growth 
    132       DO jk = 1, jpkm1 
    133          DO jj = 1 ,jpj 
    134             DO ji = 1, jpi 
    135                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    136                   zval = MAX( 1., zstrn(ji,jj) ) 
    137                   IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    138                      zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 
    139                   ENDIF 
    140                   zmxl_chl(ji,jj,jk) = zval / 24. 
    141                   zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval ) 
    142                ENDIF 
    143             END DO 
    144          END DO 
    145       END DO 
     133      DO_3D_11_11( 1, jpkm1 ) 
     134         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     135            zval = MAX( 1., zstrn(ji,jj) ) 
     136            IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
     137               zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 
     138            ENDIF 
     139            zmxl_chl(ji,jj,jk) = zval / 24. 
     140            zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval ) 
     141         ENDIF 
     142      END_3D 
    146143 
    147144      zprbio(:,:,:) = zprmaxn(:,:,:) * zmxl_fac(:,:,:) 
    … …  
    154151      WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 
    155152 
    156       DO jk = 1, jpkm1 
    157          DO jj = 1, jpj 
    158             DO ji = 1, jpi 
    159                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    160                   ! Computation of the P-I slope for nanos and diatoms 
    161                   ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
    162                   zadap       = xadap * ztn / ( 2.+ ztn ) 
    163                   ! 
    164                   zpislopeadn(ji,jj,jk) = pislopen * trb(ji,jj,jk,jpnch)    & 
    165                   &                       /( trb(ji,jj,jk,jpphy) * 12. + rtrn) 
    166                   zpislopeadp(ji,jj,jk) = pislopep * ( 1. + zadap * EXP( -0.25 * epico(ji,jj,jk) ) )   & 
    167                   &                       * trb(ji,jj,jk,jppch) /( trb(ji,jj,jk,jppic) * 12. + rtrn) 
    168                   zpislopeadd(ji,jj,jk) = pisloped * trb(ji,jj,jk,jpdch)    & 
    169                      &                    /( trb(ji,jj,jk,jpdia) * 12. + rtrn) 
    170                   ! 
    171                   zpislopen = zpislopeadn(ji,jj,jk) / ( zprbio(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 
    172                   zpislopep = zpislopeadp(ji,jj,jk) / ( zprpic(ji,jj,jk) * rday * xlimpic(ji,jj,jk) + rtrn ) 
    173                   zpisloped = zpislopeadd(ji,jj,jk) / ( zprdia(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 
    174  
    175                   ! Computation of production function for Carbon 
    176                   !  --------------------------------------------- 
    177                   zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) )  ) 
    178                   zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1.- EXP( -zpislopep * epico(ji,jj,jk) )  ) 
    179                   zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) )  ) 
    180  
    181                   ! Computation of production function for Chlorophyll 
    182                   !  ------------------------------------------------- 
    183                   zpislopen = zpislopen * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
    184                   zpisloped = zpisloped * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
    185                   zpislopep = zpislopep * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
    186                   zprchln(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) )  ) 
    187                   zprchlp(ji,jj,jk) = zprmaxp(ji,jj,jk) * ( 1.- EXP( -zpislopep * epicom(ji,jj,jk) )  ) 
    188                   zprchld(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) )  ) 
    189                ENDIF 
    190             END DO 
    191          END DO 
    192       END DO 
    193  
    194       DO jk = 1, jpkm1 
    195          DO jj = 1, jpj 
    196             DO ji = 1, jpi 
    197  
    198                 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    199                   !    Si/C of diatoms 
    200                   !    ------------------------ 
    201                   !    Si/C increases with iron stress and silicate availability 
    202                   !    Si/C is arbitrariliy increased for very high Si concentrations 
    203                   !    to mimic the very high ratios observed in the Southern Ocean (silpot2) 
    204                   zlim  = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi1 ) 
    205                   zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 
    206                   zsilfac = 3.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0 
    207                   zsiborn = trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) 
    208                   IF (gphit(ji,jj) < -30 ) THEN 
    209                     zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 ) 
    210                   ELSE 
    211                     zsilfac2 = 1. +      zsiborn / ( zsiborn + xksi2**3 ) 
    212                   ENDIF 
    213                   zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2 
    214               ENDIF 
    215             END DO 
    216          END DO 
    217       END DO 
     153      DO_3D_11_11( 1, jpkm1 ) 
     154         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     155            ! Computation of the P-I slope for nanos and diatoms 
     156            ztn         = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. ) 
     157            zadap       = xadap * ztn / ( 2.+ ztn ) 
     158            ! 
     159            zpislopeadn(ji,jj,jk) = pislopen * tr(ji,jj,jk,jpnch,Kbb)    & 
     160            &                       /( tr(ji,jj,jk,jpphy,Kbb) * 12. + rtrn) 
     161            zpislopeadp(ji,jj,jk) = pislopep * ( 1. + zadap * EXP( -0.25 * epico(ji,jj,jk) ) )   & 
     162            &                       * tr(ji,jj,jk,jppch,Kbb) /( tr(ji,jj,jk,jppic,Kbb) * 12. + rtrn) 
     163            zpislopeadd(ji,jj,jk) = pisloped * tr(ji,jj,jk,jpdch,Kbb)    & 
     164               &                    /( tr(ji,jj,jk,jpdia,Kbb) * 12. + rtrn) 
     165            ! 
     166            zpislopen = zpislopeadn(ji,jj,jk) / ( zprbio(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 
     167            zpislopep = zpislopeadp(ji,jj,jk) / ( zprpic(ji,jj,jk) * rday * xlimpic(ji,jj,jk) + rtrn ) 
     168            zpisloped = zpislopeadd(ji,jj,jk) / ( zprdia(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 
     169 
     170            ! Computation of production function for Carbon 
     171            !  --------------------------------------------- 
     172            zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) )  ) 
     173            zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1.- EXP( -zpislopep * epico(ji,jj,jk) )  ) 
     174            zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) )  ) 
     175 
     176            ! Computation of production function for Chlorophyll 
     177            !  ------------------------------------------------- 
     178            zpislopen = zpislopen * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     179            zpisloped = zpisloped * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     180            zpislopep = zpislopep * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     181            zprchln(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) )  ) 
     182            zprchlp(ji,jj,jk) = zprmaxp(ji,jj,jk) * ( 1.- EXP( -zpislopep * epicom(ji,jj,jk) )  ) 
     183            zprchld(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) )  ) 
     184         ENDIF 
     185      END_3D 
     186 
     187      DO_3D_11_11( 1, jpkm1 ) 
     188 
     189          IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     190            !    Si/C of diatoms 
     191            !    ------------------------ 
     192            !    Si/C increases with iron stress and silicate availability 
     193            !    Si/C is arbitrariliy increased for very high Si concentrations 
     194            !    to mimic the very high ratios observed in the Southern Ocean (silpot2) 
     195            zlim  = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi1 ) 
     196            zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 
     197            zsilfac = 3.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0 
     198            zsiborn = tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) 
     199            IF (gphit(ji,jj) < -30 ) THEN 
     200              zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 ) 
     201            ELSE 
     202              zsilfac2 = 1. +      zsiborn / ( zsiborn + xksi2**3 ) 
     203            ENDIF 
     204            zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2 
     205        ENDIF 
     206      END_3D 
    218207 
    219208      !  Sea-ice effect on production                                                                                
    220       DO jk = 1, jpkm1 
    221          DO jj = 1, jpj 
    222             DO ji = 1, jpi 
    223                zprbio(ji,jj,jk)  = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
    224                zprpic(ji,jj,jk)  = zprpic(ji,jj,jk) * ( 1. - fr_i(ji,jj) )  
    225                zprdia(ji,jj,jk)  = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) )  
    226                zprnut(ji,jj,jk)  = zprnut(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
    227             END DO 
    228          END DO 
    229       END DO 
     209      DO_3D_11_11( 1, jpkm1 ) 
     210         zprbio(ji,jj,jk)  = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
     211         zprpic(ji,jj,jk)  = zprpic(ji,jj,jk) * ( 1. - fr_i(ji,jj) )  
     212         zprdia(ji,jj,jk)  = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) )  
     213         zprnut(ji,jj,jk)  = zprnut(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
     214      END_3D 
    230215 
    231216      ! Computation of the various production terms of nanophytoplankton  
    232       DO jk = 1, jpkm1 
    233          DO jj = 1, jpj 
    234             DO ji = 1, jpi 
    235                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    236                   !  production terms for nanophyto. 
    237                   zprorcan(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2 
    238                   ! 
    239                   zration = trb(ji,jj,jk,jpnph) / ( trb(ji,jj,jk,jpphy) + rtrn ) 
    240                   zratiop = trb(ji,jj,jk,jppph) / ( trb(ji,jj,jk,jpphy) + rtrn ) 
    241                   zratiof = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn ) 
    242                   zprnutmax = zprnut(ji,jj,jk) * fvnuptk(ji,jj,jk) / rno3 * trb(ji,jj,jk,jpphy) * rfact2 
    243                   ! Uptake of nitrogen 
    244                   zrat = MIN( 1., zration / (xqnnmax(ji,jj,jk) + rtrn) )  
    245                   zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
    246                   zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpnmin(ji,jj,jk) )   & 
    247                   &          / ( xqpnmax(ji,jj,jk) - xqpnmin(ji,jj,jk) + rtrn ), xlimnfe(ji,jj,jk) ) ) 
    248                   zpronewn(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xnanono3(ji,jj,jk) 
    249                   zproregn(ji,jj,jk) = zpronmax * xnanonh4(ji,jj,jk) 
    250                   ! Uptake of phosphorus 
    251                   zrat = MIN( 1., zratiop / (xqpnmax(ji,jj,jk) + rtrn) ) 
    252                   zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
    253                   zpropmax = zprnutmax * zmax * xlimnfe(ji,jj,jk) 
    254                   zpropo4n(ji,jj,jk) = zpropmax * xnanopo4(ji,jj,jk) 
    255                   zprodopn(ji,jj,jk) = zpropmax * xnanodop(ji,jj,jk) 
    256                   ! Uptake of iron 
    257                   zrat = MIN( 1., zratiof / qfnmax ) 
    258                   zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
    259                   zprofmax = zprnutmax * qfnmax * zmax 
    260                   zprofen(ji,jj,jk) = zprofmax * xnanofer(ji,jj,jk) * ( 3. - 2.4 * xlimnfe(ji,jj,jk)    & 
    261                   &          / ( xlimnfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xnanono3(ji,jj,jk) / ( rtrn  & 
    262                   &          + xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) ) * (1. - xnanofer(ji,jj,jk) ) ) 
    263                ENDIF 
    264             END DO 
    265          END DO 
    266       END DO 
     217      DO_3D_11_11( 1, jpkm1 ) 
     218         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     219            !  production terms for nanophyto. 
     220            zprorcan(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * tr(ji,jj,jk,jpphy,Kbb) * rfact2 
     221            ! 
     222            zration = tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
     223            zratiop = tr(ji,jj,jk,jppph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
     224            zratiof = tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
     225            zprnutmax = zprnut(ji,jj,jk) * fvnuptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jpphy,Kbb) * rfact2 
     226            ! Uptake of nitrogen 
     227            zrat = MIN( 1., zration / (xqnnmax(ji,jj,jk) + rtrn) )  
     228            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
     229            zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpnmin(ji,jj,jk) )   & 
     230            &          / ( xqpnmax(ji,jj,jk) - xqpnmin(ji,jj,jk) + rtrn ), xlimnfe(ji,jj,jk) ) ) 
     231            zpronewn(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xnanono3(ji,jj,jk) 
     232            zproregn(ji,jj,jk) = zpronmax * xnanonh4(ji,jj,jk) 
     233            ! Uptake of phosphorus 
     234            zrat = MIN( 1., zratiop / (xqpnmax(ji,jj,jk) + rtrn) ) 
     235            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
     236            zpropmax = zprnutmax * zmax * xlimnfe(ji,jj,jk) 
     237            zpropo4n(ji,jj,jk) = zpropmax * xnanopo4(ji,jj,jk) 
     238            zprodopn(ji,jj,jk) = zpropmax * xnanodop(ji,jj,jk) 
     239            ! Uptake of iron 
     240            zrat = MIN( 1., zratiof / qfnmax ) 
     241            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
     242            zprofmax = zprnutmax * qfnmax * zmax 
     243            zprofen(ji,jj,jk) = zprofmax * xnanofer(ji,jj,jk) * ( 3. - 2.4 * xlimnfe(ji,jj,jk)    & 
     244            &          / ( xlimnfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xnanono3(ji,jj,jk) / ( rtrn  & 
     245            &          + xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) ) * (1. - xnanofer(ji,jj,jk) ) ) 
     246         ENDIF 
     247      END_3D 
    267248 
    268249      ! Computation of the various production terms of picophytoplankton  
    269       DO jk = 1, jpkm1 
    270          DO jj = 1, jpj 
    271             DO ji = 1, jpi 
    272                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    273                   !  production terms for picophyto. 
    274                   zprorcap(ji,jj,jk) = zprpic(ji,jj,jk)  * xlimpic(ji,jj,jk) * trb(ji,jj,jk,jppic) * rfact2 
    275                   ! 
    276                   zration = trb(ji,jj,jk,jpnpi) / ( trb(ji,jj,jk,jppic) + rtrn ) 
    277                   zratiop = trb(ji,jj,jk,jpppi) / ( trb(ji,jj,jk,jppic) + rtrn ) 
    278                   zratiof = trb(ji,jj,jk,jppfe) / ( trb(ji,jj,jk,jppic) + rtrn ) 
    279                   zprnutmax = zprnut(ji,jj,jk) * fvpuptk(ji,jj,jk) / rno3 * trb(ji,jj,jk,jppic) * rfact2 
    280                   ! Uptake of nitrogen 
    281                   zrat = MIN( 1., zration / (xqnpmax(ji,jj,jk) + rtrn) ) 
    282                   zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
    283                   zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqppmin(ji,jj,jk) )   & 
    284                   &          / ( xqppmax(ji,jj,jk) - xqppmin(ji,jj,jk) + rtrn ), xlimpfe(ji,jj,jk) ) ) 
    285                   zpronewp(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xpicono3(ji,jj,jk)  
    286                   zproregp(ji,jj,jk) = zpronmax * xpiconh4(ji,jj,jk) 
    287                   ! Uptake of phosphorus 
    288                   zrat = MIN( 1., zratiop / (xqppmax(ji,jj,jk) + rtrn) ) 
    289                   zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
    290                   zpropmax = zprnutmax * zmax * xlimpfe(ji,jj,jk) 
    291                   zpropo4p(ji,jj,jk) = zpropmax * xpicopo4(ji,jj,jk) 
    292                   zprodopp(ji,jj,jk) = zpropmax * xpicodop(ji,jj,jk) 
    293                   ! Uptake of iron 
    294                   zrat = MIN( 1., zratiof / qfpmax ) 
    295                   zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
    296                   zprofmax = zprnutmax * qfpmax * zmax 
    297                   zprofep(ji,jj,jk) = zprofmax * xpicofer(ji,jj,jk) * ( 3. - 2.4 * xlimpfe(ji,jj,jk)   & 
    298                   &          / ( xlimpfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xpicono3(ji,jj,jk) / ( rtrn   & 
    299                   &          + xpicono3(ji,jj,jk) + xpiconh4(ji,jj,jk) ) * (1. - xpicofer(ji,jj,jk) ) ) 
    300                ENDIF 
    301             END DO 
    302          END DO 
    303       END DO 
     250      DO_3D_11_11( 1, jpkm1 ) 
     251         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     252            !  production terms for picophyto. 
     253            zprorcap(ji,jj,jk) = zprpic(ji,jj,jk)  * xlimpic(ji,jj,jk) * tr(ji,jj,jk,jppic,Kbb) * rfact2 
     254            ! 
     255            zration = tr(ji,jj,jk,jpnpi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 
     256            zratiop = tr(ji,jj,jk,jpppi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 
     257            zratiof = tr(ji,jj,jk,jppfe,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 
     258            zprnutmax = zprnut(ji,jj,jk) * fvpuptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jppic,Kbb) * rfact2 
     259            ! Uptake of nitrogen 
     260            zrat = MIN( 1., zration / (xqnpmax(ji,jj,jk) + rtrn) ) 
     261            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
     262            zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqppmin(ji,jj,jk) )   & 
     263            &          / ( xqppmax(ji,jj,jk) - xqppmin(ji,jj,jk) + rtrn ), xlimpfe(ji,jj,jk) ) ) 
     264            zpronewp(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xpicono3(ji,jj,jk)  
     265            zproregp(ji,jj,jk) = zpronmax * xpiconh4(ji,jj,jk) 
     266            ! Uptake of phosphorus 
     267            zrat = MIN( 1., zratiop / (xqppmax(ji,jj,jk) + rtrn) ) 
     268            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
     269            zpropmax = zprnutmax * zmax * xlimpfe(ji,jj,jk) 
     270            zpropo4p(ji,jj,jk) = zpropmax * xpicopo4(ji,jj,jk) 
     271            zprodopp(ji,jj,jk) = zpropmax * xpicodop(ji,jj,jk) 
     272            ! Uptake of iron 
     273            zrat = MIN( 1., zratiof / qfpmax ) 
     274            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
     275            zprofmax = zprnutmax * qfpmax * zmax 
     276            zprofep(ji,jj,jk) = zprofmax * xpicofer(ji,jj,jk) * ( 3. - 2.4 * xlimpfe(ji,jj,jk)   & 
     277            &          / ( xlimpfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xpicono3(ji,jj,jk) / ( rtrn   & 
     278            &          + xpicono3(ji,jj,jk) + xpiconh4(ji,jj,jk) ) * (1. - xpicofer(ji,jj,jk) ) ) 
     279         ENDIF 
     280      END_3D 
    304281 
    305282      ! Computation of the various production terms of diatoms 
    306       DO jk = 1, jpkm1 
    307          DO jj = 1, jpj 
    308             DO ji = 1, jpi 
    309                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    310                   !  production terms for diatomees 
    311                   zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trb(ji,jj,jk,jpdia) * rfact2 
    312                   ! Computation of the respiration term according to pahlow  
    313                   ! & oschlies (2013) 
    314                   ! 
    315                   zration = trb(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    316                   zratiop = trb(ji,jj,jk,jppdi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    317                   zratiof = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    318                   zprnutmax = zprnut(ji,jj,jk) * fvduptk(ji,jj,jk) / rno3 * trb(ji,jj,jk,jpdia) * rfact2 
    319                   ! Uptake of nitrogen 
    320                   zrat = MIN( 1., zration / (xqndmax(ji,jj,jk) + rtrn) ) 
    321                   zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))  
    322                   zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpdmin(ji,jj,jk) )   & 
    323                   &          / ( xqpdmax(ji,jj,jk) - xqpdmin(ji,jj,jk) + rtrn ), xlimdfe(ji,jj,jk) ) ) 
    324                   zpronewd(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xdiatno3(ji,jj,jk) 
    325                   zproregd(ji,jj,jk) = zpronmax * xdiatnh4(ji,jj,jk) 
    326                   ! Uptake of phosphorus 
    327                   zrat = MIN( 1., zratiop / (xqpdmax(ji,jj,jk) + rtrn) ) 
    328                   zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))  
    329                   zpropmax = zprnutmax * zmax * xlimdfe(ji,jj,jk) 
    330                   zpropo4d(ji,jj,jk) = zpropmax * xdiatpo4(ji,jj,jk) 
    331                   zprodopd(ji,jj,jk) = zpropmax * xdiatdop(ji,jj,jk) 
    332                   ! Uptake of iron 
    333                   zrat = MIN( 1., zratiof / qfdmax ) 
    334                   zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
    335                   zprofmax = zprnutmax * qfdmax * zmax 
    336                   zprofed(ji,jj,jk) = zprofmax * xdiatfer(ji,jj,jk) * ( 3. - 2.4 * xlimdfe(ji,jj,jk)     & 
    337                   &          / ( xlimdfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xdiatno3(ji,jj,jk) / ( rtrn   & 
    338                   &          + xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) ) * (1. - xdiatfer(ji,jj,jk) ) ) 
    339                ENDIF 
    340             END DO 
    341          END DO 
    342       END DO 
    343  
    344       DO jk = 1, jpkm1 
    345          DO jj = 1, jpj 
    346             DO ji = 1, jpi 
    347                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    348                      !  production terms for nanophyto. ( chlorophyll ) 
    349                   znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
    350                   zprod = rday * (zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)) * zprchln(ji,jj,jk) * xlimphy(ji,jj,jk) 
    351                   thetannm_n   = MIN ( thetannm, ( thetannm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem)))   & 
    352                   &               * (1. - 1.14 / 43.4 * 20.)) 
    353                   zprochln = thetannm_n * zprod / ( zpislopeadn(ji,jj,jk) * znanotot + rtrn ) 
    354                   zprochln = MAX(zprochln, chlcmin * 12. * zprorcan (ji,jj,jk) ) 
    355                      !  production terms for picophyto. ( chlorophyll ) 
    356                   zpicotot = epicom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
    357                   zprod = rday * (zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)) * zprchlp(ji,jj,jk) * xlimpic(ji,jj,jk) 
    358                   thetanpm_n   = MIN ( thetanpm, ( thetanpm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem)))   & 
    359                   &               * (1. - 1.14 / 43.4 * 20.)) 
    360                   zprochlp = thetanpm_n * zprod / ( zpislopeadp(ji,jj,jk) * zpicotot + rtrn ) 
    361                   zprochlp = MAX(zprochlp, chlcmin * 12. * zprorcap(ji,jj,jk) ) 
    362                   !  production terms for diatomees ( chlorophyll ) 
    363                   zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
    364                   zprod = rday * (zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)) * zprchld(ji,jj,jk) * xlimdia(ji,jj,jk) 
    365                   thetandm_n   = MIN ( thetandm, ( thetandm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem)))   & 
    366                   &               * (1. - 1.14 / 43.4 * 20.)) 
    367                   zprochld = thetandm_n * zprod / ( zpislopeadd(ji,jj,jk) * zdiattot + rtrn ) 
    368                   zprochld = MAX(zprochld, chlcmin * 12. * zprorcad(ji,jj,jk) ) 
    369                   !   Update the arrays TRA which contain the Chla sources and sinks 
    370                   tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln * texcretn 
    371                   tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld * texcretd 
    372                   tra(ji,jj,jk,jppch) = tra(ji,jj,jk,jppch) + zprochlp * texcretp 
    373                ENDIF 
    374             END DO 
    375          END DO 
    376       END DO 
     283      DO_3D_11_11( 1, jpkm1 ) 
     284         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     285            !  production terms for diatomees 
     286            zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr(ji,jj,jk,jpdia,Kbb) * rfact2 
     287            ! Computation of the respiration term according to pahlow  
     288            ! & oschlies (2013) 
     289            ! 
     290            zration = tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     291            zratiop = tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     292            zratiof = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     293            zprnutmax = zprnut(ji,jj,jk) * fvduptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jpdia,Kbb) * rfact2 
     294            ! Uptake of nitrogen 
     295            zrat = MIN( 1., zration / (xqndmax(ji,jj,jk) + rtrn) ) 
     296            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))  
     297            zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpdmin(ji,jj,jk) )   & 
     298            &          / ( xqpdmax(ji,jj,jk) - xqpdmin(ji,jj,jk) + rtrn ), xlimdfe(ji,jj,jk) ) ) 
     299            zpronewd(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xdiatno3(ji,jj,jk) 
     300            zproregd(ji,jj,jk) = zpronmax * xdiatnh4(ji,jj,jk) 
     301            ! Uptake of phosphorus 
     302            zrat = MIN( 1., zratiop / (xqpdmax(ji,jj,jk) + rtrn) ) 
     303            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))  
     304            zpropmax = zprnutmax * zmax * xlimdfe(ji,jj,jk) 
     305            zpropo4d(ji,jj,jk) = zpropmax * xdiatpo4(ji,jj,jk) 
     306            zprodopd(ji,jj,jk) = zpropmax * xdiatdop(ji,jj,jk) 
     307            ! Uptake of iron 
     308            zrat = MIN( 1., zratiof / qfdmax ) 
     309            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
     310            zprofmax = zprnutmax * qfdmax * zmax 
     311            zprofed(ji,jj,jk) = zprofmax * xdiatfer(ji,jj,jk) * ( 3. - 2.4 * xlimdfe(ji,jj,jk)     & 
     312            &          / ( xlimdfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xdiatno3(ji,jj,jk) / ( rtrn   & 
     313            &          + xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) ) * (1. - xdiatfer(ji,jj,jk) ) ) 
     314         ENDIF 
     315      END_3D 
     316 
     317      DO_3D_11_11( 1, jpkm1 ) 
     318         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     319               !  production terms for nanophyto. ( chlorophyll ) 
     320            znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     321            zprod = rday * (zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)) * zprchln(ji,jj,jk) * xlimphy(ji,jj,jk) 
     322            thetannm_n   = MIN ( thetannm, ( thetannm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm)))   & 
     323            &               * (1. - 1.14 / 43.4 * 20.)) 
     324            zprochln = thetannm_n * zprod / ( zpislopeadn(ji,jj,jk) * znanotot + rtrn ) 
     325            zprochln = MAX(zprochln, chlcmin * 12. * zprorcan (ji,jj,jk) ) 
     326               !  production terms for picophyto. ( chlorophyll ) 
     327            zpicotot = epicom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     328            zprod = rday * (zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)) * zprchlp(ji,jj,jk) * xlimpic(ji,jj,jk) 
     329            thetanpm_n   = MIN ( thetanpm, ( thetanpm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm)))   & 
     330            &               * (1. - 1.14 / 43.4 * 20.)) 
     331            zprochlp = thetanpm_n * zprod / ( zpislopeadp(ji,jj,jk) * zpicotot + rtrn ) 
     332            zprochlp = MAX(zprochlp, chlcmin * 12. * zprorcap(ji,jj,jk) ) 
     333            !  production terms for diatomees ( chlorophyll ) 
     334            zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     335            zprod = rday * (zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)) * zprchld(ji,jj,jk) * xlimdia(ji,jj,jk) 
     336            thetandm_n   = MIN ( thetandm, ( thetandm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm)))   & 
     337            &               * (1. - 1.14 / 43.4 * 20.)) 
     338            zprochld = thetandm_n * zprod / ( zpislopeadd(ji,jj,jk) * zdiattot + rtrn ) 
     339            zprochld = MAX(zprochld, chlcmin * 12. * zprorcad(ji,jj,jk) ) 
     340            !   Update the arrays TRA which contain the Chla sources and sinks 
     341            tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) + zprochln * texcretn 
     342            tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) + zprochld * texcretd 
     343            tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) + zprochlp * texcretp 
     344         ENDIF 
     345      END_3D 
    377346 
    378347      !   Update the arrays TRA which contain the biological sources and sinks 
    379       DO jk = 1, jpkm1 
    380          DO jj = 1, jpj 
    381            DO ji =1 ,jpi 
    382               zprontot = zpronewn(ji,jj,jk) + zproregn(ji,jj,jk) 
    383               zproptot = zpronewp(ji,jj,jk) + zproregp(ji,jj,jk) 
    384               zprodtot = zpronewd(ji,jj,jk) + zproregd(ji,jj,jk) 
    385               zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)  & 
    386               &          + excretp * zprorcap(ji,jj,jk) 
    387               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zpropo4n(ji,jj,jk) - zpropo4d(ji,jj,jk)  & 
    388               &                     - zpropo4p(ji,jj,jk) 
    389               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk)  & 
    390               &                     - zpronewp(ji,jj,jk) 
    391               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproregn(ji,jj,jk) - zproregd(ji,jj,jk)  & 
    392               &                     - zproregp(ji,jj,jk) 
    393               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorcan(ji,jj,jk) * texcretn    & 
    394                  &                  - zpsino3 * zpronewn(ji,jj,jk) - zpsinh4 * zproregn(ji,jj,jk)   & 
    395                  &                  - zrespn(ji,jj,jk)  
    396               zcroissn(ji,jj,jk) = tra(ji,jj,jk,jpphy) / rfact2/ (trb(ji,jj,jk,jpphy) + rtrn) 
    397               tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) + zprontot * texcretn 
    398               tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) + zpropo4n(ji,jj,jk) * texcretn   & 
    399               &                     + zprodopn(ji,jj,jk) * texcretn 
    400               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcretn 
    401               tra(ji,jj,jk,jppic) = tra(ji,jj,jk,jppic) + zprorcap(ji,jj,jk) * texcretp     & 
    402                  &                  - zpsino3 * zpronewp(ji,jj,jk) - zpsinh4 * zproregp(ji,jj,jk)   & 
    403                  &                  - zrespp(ji,jj,jk)  
    404               zcroissp(ji,jj,jk) = tra(ji,jj,jk,jppic) / rfact2/ (trb(ji,jj,jk,jppic) + rtrn) 
    405               tra(ji,jj,jk,jpnpi) = tra(ji,jj,jk,jpnpi) + zproptot * texcretp 
    406               tra(ji,jj,jk,jpppi) = tra(ji,jj,jk,jpppi) + zpropo4p(ji,jj,jk) * texcretp   & 
    407               &                     + zprodopp(ji,jj,jk) * texcretp 
    408               tra(ji,jj,jk,jppfe) = tra(ji,jj,jk,jppfe) + zprofep(ji,jj,jk) * texcretp 
    409               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcretd   & 
    410                  &                  - zpsino3 * zpronewd(ji,jj,jk) - zpsinh4 * zproregd(ji,jj,jk)   & 
    411                  &                  - zrespd(ji,jj,jk)  
    412               zcroissd(ji,jj,jk) = tra(ji,jj,jk,jpdia) / rfact2 / (trb(ji,jj,jk,jpdia) + rtrn) 
    413               tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) + zprodtot * texcretd 
    414               tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) + zpropo4d(ji,jj,jk) * texcretd   & 
    415               &                     + zprodopd(ji,jj,jk) * texcretd 
    416               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcretd 
    417               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 
    418               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)  & 
    419               &                     + excretp * zprorcap(ji,jj,jk) 
    420               tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + excretd * zprodtot + excretn * zprontot   & 
    421               &                     + excretp * zproptot 
    422               tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + excretd * zpropo4d(ji,jj,jk) + excretn * zpropo4n(ji,jj,jk)   & 
    423               &    - texcretn * zprodopn(ji,jj,jk) - texcretd * zprodopd(ji,jj,jk) + excretp * zpropo4p(ji,jj,jk)     & 
    424               &    - texcretp * zprodopp(ji,jj,jk) 
    425               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk)   & 
    426                  &                + zproregp(ji,jj,jk) ) + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk)           & 
    427                  &                + zpronewd(ji,jj,jk) + zpronewp(ji,jj,jk) )   & 
    428                  &                - o2ut * ( zrespn(ji,jj,jk) + zrespp(ji,jj,jk) + zrespd(ji,jj,jk) ) 
    429               zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) 
    430               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zfeup 
    431               tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 
    432               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) - zprorcap(ji,jj,jk)  & 
    433               &                     + zpsino3 * zpronewn(ji,jj,jk) + zpsinh4 * zproregn(ji,jj,jk)   & 
    434               &                     + zpsino3 * zpronewp(ji,jj,jk) + zpsinh4 * zproregp(ji,jj,jk)   & 
    435               &                     + zpsino3 * zpronewd(ji,jj,jk) + zpsinh4 * zproregd(ji,jj,jk)  & 
    436               &                     + zrespn(ji,jj,jk) + zrespd(ji,jj,jk) + zrespp(ji,jj,jk)  
    437               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk)  & 
    438               &                     + zpronewp(ji,jj,jk) ) - rno3 * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk)     & 
    439               &                     + zproregp(ji,jj,jk) )  
    440           END DO 
    441         END DO 
    442      END DO 
     348      DO_3D_11_11( 1, jpkm1 ) 
     349        zprontot = zpronewn(ji,jj,jk) + zproregn(ji,jj,jk) 
     350        zproptot = zpronewp(ji,jj,jk) + zproregp(ji,jj,jk) 
     351        zprodtot = zpronewd(ji,jj,jk) + zproregd(ji,jj,jk) 
     352        zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)  & 
     353        &          + excretp * zprorcap(ji,jj,jk) 
     354        tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zpropo4n(ji,jj,jk) - zpropo4d(ji,jj,jk)  & 
     355        &                     - zpropo4p(ji,jj,jk) 
     356        tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk)  & 
     357        &                     - zpronewp(ji,jj,jk) 
     358        tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zproregn(ji,jj,jk) - zproregd(ji,jj,jk)  & 
     359        &                     - zproregp(ji,jj,jk) 
     360        tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zprorcan(ji,jj,jk) * texcretn    & 
     361           &                  - zpsino3 * zpronewn(ji,jj,jk) - zpsinh4 * zproregn(ji,jj,jk)   & 
     362           &                  - zrespn(ji,jj,jk)  
     363        zcroissn(ji,jj,jk) = tr(ji,jj,jk,jpphy,Krhs) / rfact2/ (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
     364        tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) + zprontot * texcretn 
     365        tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) + zpropo4n(ji,jj,jk) * texcretn   & 
     366        &                     + zprodopn(ji,jj,jk) * texcretn 
     367        tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) + zprofen(ji,jj,jk) * texcretn 
     368        tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) + zprorcap(ji,jj,jk) * texcretp     & 
     369           &                  - zpsino3 * zpronewp(ji,jj,jk) - zpsinh4 * zproregp(ji,jj,jk)   & 
     370           &                  - zrespp(ji,jj,jk)  
     371        zcroissp(ji,jj,jk) = tr(ji,jj,jk,jppic,Krhs) / rfact2/ (tr(ji,jj,jk,jppic,Kbb) + rtrn) 
     372        tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) + zproptot * texcretp 
     373        tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) + zpropo4p(ji,jj,jk) * texcretp   & 
     374        &                     + zprodopp(ji,jj,jk) * texcretp 
     375        tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) + zprofep(ji,jj,jk) * texcretp 
     376        tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) + zprorcad(ji,jj,jk) * texcretd   & 
     377           &                  - zpsino3 * zpronewd(ji,jj,jk) - zpsinh4 * zproregd(ji,jj,jk)   & 
     378           &                  - zrespd(ji,jj,jk)  
     379        zcroissd(ji,jj,jk) = tr(ji,jj,jk,jpdia,Krhs) / rfact2 / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
     380        tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) + zprodtot * texcretd 
     381        tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) + zpropo4d(ji,jj,jk) * texcretd   & 
     382        &                     + zprodopd(ji,jj,jk) * texcretd 
     383        tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) + zprofed(ji,jj,jk) * texcretd 
     384        tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 
     385        tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)  & 
     386        &                     + excretp * zprorcap(ji,jj,jk) 
     387        tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + excretd * zprodtot + excretn * zprontot   & 
     388        &                     + excretp * zproptot 
     389        tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + excretd * zpropo4d(ji,jj,jk) + excretn * zpropo4n(ji,jj,jk)   & 
     390        &    - texcretn * zprodopn(ji,jj,jk) - texcretd * zprodopd(ji,jj,jk) + excretp * zpropo4p(ji,jj,jk)     & 
     391        &    - texcretp * zprodopp(ji,jj,jk) 
     392        tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + o2ut * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk)   & 
     393           &                + zproregp(ji,jj,jk) ) + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk)           & 
     394           &                + zpronewd(ji,jj,jk) + zpronewp(ji,jj,jk) )   & 
     395           &                - o2ut * ( zrespn(ji,jj,jk) + zrespp(ji,jj,jk) + zrespd(ji,jj,jk) ) 
     396        zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) 
     397        tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zfeup 
     398        tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 
     399        tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) - zprorcap(ji,jj,jk)  & 
     400        &                     + zpsino3 * zpronewn(ji,jj,jk) + zpsinh4 * zproregn(ji,jj,jk)   & 
     401        &                     + zpsino3 * zpronewp(ji,jj,jk) + zpsinh4 * zproregp(ji,jj,jk)   & 
     402        &                     + zpsino3 * zpronewd(ji,jj,jk) + zpsinh4 * zproregd(ji,jj,jk)  & 
     403        &                     + zrespn(ji,jj,jk) + zrespd(ji,jj,jk) + zrespp(ji,jj,jk)  
     404        tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk)  & 
     405        &                     + zpronewp(ji,jj,jk) ) - rno3 * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk)     & 
     406        &                     + zproregp(ji,jj,jk) )  
     407      END_3D 
    443408     ! 
    444409     IF( ln_ligand ) THEN 
    445          zpligprod1(:,:,:) = 0._wp    ;    zpligprod2(:,:,:) = 0._wp         
    446          DO jk = 1, jpkm1 
    447             DO jj = 1, jpj 
    448               DO ji =1 ,jpi 
    449                  zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) + excretp * zprorcap(ji,jj,jk) 
    450                  zfeup    = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) 
    451                  tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 
    452                  zpligprod1(ji,jj,jk) = zdocprod * ldocp 
    453                  zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet 
    454               END DO 
    455            END DO 
    456         END DO 
     410         zpligprod1(:,:,:) = 0._wp    ;    zpligprod2(:,:,:) = 0._wp              
     411         DO_3D_11_11( 1, jpkm1 ) 
     412           zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) + excretp * zprorcap(ji,jj,jk) 
     413           zfeup    = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) 
     414           tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 
     415           zpligprod1(ji,jj,jk) = zdocprod * ldocp 
     416           zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet 
     417         END_3D 
    457418     ENDIF 
    458419 
    … …  
    497458     ENDIF 
    498459 
    499       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     460      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    500461         WRITE(charout, FMT="('prod')") 
    501462         CALL prt_ctl_trc_info(charout) 
    502          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     463         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    503464      ENDIF 
    504465      ! 
    … …  
    525486      !!---------------------------------------------------------------------- 
    526487 
    527       REWIND( numnatp_ref ) 
    528488      READ  ( numnatp_ref, namp5zprod, IOSTAT = ios, ERR = 901) 
    529489901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp5zprod in reference namelist' ) 
    530490 
    531       REWIND( numnatp_cfg ) 
    532491      READ  ( numnatp_cfg, namp5zprod, IOSTAT = ios, ERR = 902 ) 
    533492902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namp5zprod in configuration namelist' ) 

  • NEMO/trunk/src/TOP/PISCES/SED/oce_sed.F90

    r10362 r12377  
    1313   USE dom_oce , ONLY :   glamt     =>   glamt          !: longitude of t-point (degre) 
    1414   USE dom_oce , ONLY :   gphit     =>   gphit          !: latitude  of t-point (degre) 
    15    USE dom_oce , ONLY :   e3t_n     =>   e3t_n          !: latitude  of t-point (degre) 
     15   USE dom_oce , ONLY :   e3t       =>   e3t            !: latitude  of t-point (degre) 
    1616   USE dom_oce , ONLY :   e3t_1d    =>   e3t_1d         !: reference depth of t-points (m) 
    1717   USE dom_oce , ONLY :   gdepw_0   =>   gdepw_0        !: reference depth of t-points (m) 
    … …  
    2626   !                                !: that may have been run with different time steps. 
    2727 
    28    USE oce     , ONLY :  tsn        =>   tsn             !: pot. temperature (celsius) and salinity (psu) 
    29    USE trc     , ONLY :  trb        =>   trb             !: pot. temperature (celsius) and salinity (psu) 
     28   USE oce     , ONLY :   ts        =>   ts              !: pot. temperature (celsius) and salinity (psu) 
     29   USE trc     , ONLY :   tr        =>   tr              !: pot. temperature (celsius) and salinity (psu) 
    3030 
    3131   USE sms_pisces, ONLY : wsbio4    =>   wsbio4          !: sinking flux for POC 
    3232   USE sms_pisces, ONLY : wsbio3    =>   wsbio3          !: sinking flux for GOC 
    33    USE sms_pisces, ONLY : wsbio2    =>   wsbio2           !: sinking flux for calcite 
     33   USE sms_pisces, ONLY : wsbio2    =>   wsbio2          !: sinking flux for calcite 
    3434   USE sms_pisces, ONLY : wsbio     =>   wsbio           !: sinking flux for calcite 
    3535   USE sms_pisces, ONLY : ln_p5z    =>   ln_p5z          !: PISCES-QUOTA flag 
    … …  
    4949   USE p4zche, ONLY     : sulfat    =>   sulfat          !: Chemical constants   
    5050   USE p4zche, ONLY     : sio3eq    =>   sio3eq          !: Chemical constants   
    51    USE p4zsbc, ONLY     : dust      =>   dust 
    52    USE trc       , ONLY : r2dttrc   =>   r2dttrc 
     51   USE p4zbc, ONLY     : dust      =>   dust 
     52   USE trc  , ONLY : r2dttrc   =>   r2dttrc 
    5353 
    5454END MODULE oce_sed 

  • NEMO/trunk/src/TOP/PISCES/SED/sedchem.F90

    r10356 r12377  
    2323   REAL(wp), PARAMETER :: pp_rdel_ah_target = 1.E-4_wp 
    2424 
     25   !! * Substitutions 
     26#  include "do_loop_substitute.h90" 
    2527   !! * Module variables 
    2628   REAL(wp) :: & 
    … …  
    136138         CALL sed_chem_cst 
    137139      ELSE 
    138          DO jj = 1,jpj 
    139             DO ji = 1, jpi 
    140                ikt = mbkt(ji,jj)  
    141                IF ( tmask(ji,jj,ikt) == 1 ) THEN 
    142                   zchem_data(ji,jj,1) = ak13  (ji,jj,ikt) 
    143                   zchem_data(ji,jj,2) = ak23  (ji,jj,ikt) 
    144                   zchem_data(ji,jj,3) = akb3  (ji,jj,ikt) 
    145                   zchem_data(ji,jj,4) = akw3  (ji,jj,ikt) 
    146                   zchem_data(ji,jj,5) = aksp  (ji,jj,ikt) 
    147                   zchem_data(ji,jj,6) = borat (ji,jj,ikt) 
    148                   zchem_data(ji,jj,7) = ak1p3 (ji,jj,ikt) 
    149                   zchem_data(ji,jj,8) = ak2p3 (ji,jj,ikt) 
    150                   zchem_data(ji,jj,9) = ak3p3 (ji,jj,ikt) 
    151                   zchem_data(ji,jj,10)= aksi3 (ji,jj,ikt) 
    152                   zchem_data(ji,jj,11)= sio3eq(ji,jj,ikt) 
    153                   zchem_data(ji,jj,12)= aks3  (ji,jj,ikt) 
    154                   zchem_data(ji,jj,13)= akf3  (ji,jj,ikt) 
    155                   zchem_data(ji,jj,14)= sulfat(ji,jj,ikt) 
    156                   zchem_data(ji,jj,15)= fluorid(ji,jj,ikt) 
    157                ENDIF 
    158             ENDDO 
    159          ENDDO 
     140         DO_2D_11_11 
     141            ikt = mbkt(ji,jj)  
     142            IF ( tmask(ji,jj,ikt) == 1 ) THEN 
     143               zchem_data(ji,jj,1) = ak13  (ji,jj,ikt) 
     144               zchem_data(ji,jj,2) = ak23  (ji,jj,ikt) 
     145               zchem_data(ji,jj,3) = akb3  (ji,jj,ikt) 
     146               zchem_data(ji,jj,4) = akw3  (ji,jj,ikt) 
     147               zchem_data(ji,jj,5) = aksp  (ji,jj,ikt) 
     148               zchem_data(ji,jj,6) = borat (ji,jj,ikt) 
     149               zchem_data(ji,jj,7) = ak1p3 (ji,jj,ikt) 
     150               zchem_data(ji,jj,8) = ak2p3 (ji,jj,ikt) 
     151               zchem_data(ji,jj,9) = ak3p3 (ji,jj,ikt) 
     152               zchem_data(ji,jj,10)= aksi3 (ji,jj,ikt) 
     153               zchem_data(ji,jj,11)= sio3eq(ji,jj,ikt) 
     154               zchem_data(ji,jj,12)= aks3  (ji,jj,ikt) 
     155               zchem_data(ji,jj,13)= akf3  (ji,jj,ikt) 
     156               zchem_data(ji,jj,14)= sulfat(ji,jj,ikt) 
     157               zchem_data(ji,jj,15)= fluorid(ji,jj,ikt) 
     158            ENDIF 
     159         END_2D 
    160160 
    161161         CALL pack_arr ( jpoce, ak1s  (1:jpoce), zchem_data(1:jpi,1:jpj,1) , iarroce(1:jpoce) ) 

  • NEMO/trunk/src/TOP/PISCES/SED/seddta.F90

    r10362 r12377  
    2222   REAL(wp) ::  conv2    ! [kg/m2/month]-->[g/cm2/s] ( 1 month has 30 days ) 
    2323 
     24   !! * Substitutions 
     25#  include "do_loop_substitute.h90" 
    2426   !! $Id$ 
    2527CONTAINS 
    … …  
    2931   !!--------------------------------------------------------------------------- 
    3032 
    31    SUBROUTINE sed_dta( kt ) 
     33   SUBROUTINE sed_dta( kt, Kbb, Kmm ) 
    3234      !!---------------------------------------------------------------------- 
    3335      !!                   ***  ROUTINE sed_dta  *** 
    … …  
    4345 
    4446      !! Arguments 
    45       INTEGER, INTENT(in) ::  kt    ! time-step 
     47      INTEGER, INTENT(in) ::  kt         ! time-step 
     48      INTEGER, INTENT(in) ::  Kbb, Kmm   ! time level indices 
    4649 
    4750      !! * Local declarations 
    … …  
    9295      !    ----------------------------------------------------------- 
    9396      IF (ln_sediment_offline) THEN 
    94          DO jj = 1, jpj 
    95             DO ji = 1, jpi 
    96                ikt = mbkt(ji,jj) 
    97                zwsbio4(ji,jj) = wsbio2 / rday 
    98                zwsbio3(ji,jj) = wsbio  / rday 
    99             END DO 
    100          END DO 
     97         DO_2D_11_11 
     98            ikt = mbkt(ji,jj) 
     99            zwsbio4(ji,jj) = wsbio2 / rday 
     100            zwsbio3(ji,jj) = wsbio  / rday 
     101         END_2D 
    101102      ELSE 
    102          DO jj = 1, jpj 
    103             DO ji = 1, jpi 
    104                ikt = mbkt(ji,jj) 
    105                zdep = e3t_n(ji,jj,ikt) / r2dttrc 
    106                zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) / rday ) 
    107                zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) / rday ) 
    108             END DO 
    109          END DO 
     103         DO_2D_11_11 
     104            ikt = mbkt(ji,jj) 
     105            zdep = e3t(ji,jj,ikt,Kmm) / r2dttrc 
     106            zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) / rday ) 
     107            zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) / rday ) 
     108         END_2D 
    110109      ENDIF 
    111110 
    112111      trc_data(:,:,:) = 0. 
    113       DO jj = 1,jpj 
    114          DO ji = 1, jpi 
    115             ikt = mbkt(ji,jj) 
    116             IF ( tmask(ji,jj,ikt) == 1 ) THEN 
    117                trc_data(ji,jj,1)   = trb(ji,jj,ikt,jpsil) 
    118                trc_data(ji,jj,2)   = trb(ji,jj,ikt,jpoxy) 
    119                trc_data(ji,jj,3)   = trb(ji,jj,ikt,jpdic) 
    120                trc_data(ji,jj,4)   = trb(ji,jj,ikt,jpno3) / 7.625 
    121                trc_data(ji,jj,5)   = trb(ji,jj,ikt,jppo4) / 122. 
    122                trc_data(ji,jj,6)   = trb(ji,jj,ikt,jptal) 
    123                trc_data(ji,jj,7)   = trb(ji,jj,ikt,jpnh4) / 7.625 
    124                trc_data(ji,jj,8)   = 0.0 
    125                trc_data(ji,jj,9)   = 28.0E-3 
    126                trc_data(ji,jj,10)  = trb(ji,jj,ikt,jpfer) 
    127                trc_data(ji,jj,11 ) = MIN(trb(ji,jj,ikt,jpgsi), 1E-4) * zwsbio4(ji,jj) * 1E3 
    128                trc_data(ji,jj,12 ) = MIN(trb(ji,jj,ikt,jppoc), 1E-4) * zwsbio3(ji,jj) * 1E3 
    129                trc_data(ji,jj,13 ) = MIN(trb(ji,jj,ikt,jpgoc), 1E-4) * zwsbio4(ji,jj) * 1E3 
    130                trc_data(ji,jj,14)  = MIN(trb(ji,jj,ikt,jpcal), 1E-4) * zwsbio4(ji,jj) * 1E3 
    131                trc_data(ji,jj,15)  = tsn(ji,jj,ikt,jp_tem) 
    132                trc_data(ji,jj,16)  = tsn(ji,jj,ikt,jp_sal) 
    133                trc_data(ji,jj,17 ) = ( trb(ji,jj,ikt,jpsfe) * zwsbio3(ji,jj) + trb(ji,jj,ikt,jpbfe)  & 
    134                &                     * zwsbio4(ji,jj)  ) * 1E3 / ( trc_data(ji,jj,12 ) + trc_data(ji,jj,13 ) + rtrn ) 
    135                trc_data(ji,jj,17 ) = MIN(1E-3, trc_data(ji,jj,17 ) ) 
    136             ENDIF 
    137          ENDDO 
    138       ENDDO 
     112      DO_2D_11_11 
     113         ikt = mbkt(ji,jj) 
     114         IF ( tmask(ji,jj,ikt) == 1 ) THEN 
     115            trc_data(ji,jj,1)   = tr(ji,jj,ikt,jpsil,Kbb) 
     116            trc_data(ji,jj,2)   = tr(ji,jj,ikt,jpoxy,Kbb) 
     117            trc_data(ji,jj,3)   = tr(ji,jj,ikt,jpdic,Kbb) 
     118            trc_data(ji,jj,4)   = tr(ji,jj,ikt,jpno3,Kbb) / 7.625 
     119            trc_data(ji,jj,5)   = tr(ji,jj,ikt,jppo4,Kbb) / 122. 
     120            trc_data(ji,jj,6)   = tr(ji,jj,ikt,jptal,Kbb) 
     121            trc_data(ji,jj,7)   = tr(ji,jj,ikt,jpnh4,Kbb) / 7.625 
     122            trc_data(ji,jj,8)   = 0.0 
     123            trc_data(ji,jj,9)   = 28.0E-3 
     124            trc_data(ji,jj,10)  = tr(ji,jj,ikt,jpfer,Kbb) 
     125            trc_data(ji,jj,11 ) = MIN(tr(ji,jj,ikt,jpgsi,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 
     126            trc_data(ji,jj,12 ) = MIN(tr(ji,jj,ikt,jppoc,Kbb), 1E-4) * zwsbio3(ji,jj) * 1E3 
     127            trc_data(ji,jj,13 ) = MIN(tr(ji,jj,ikt,jpgoc,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 
     128            trc_data(ji,jj,14)  = MIN(tr(ji,jj,ikt,jpcal,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 
     129            trc_data(ji,jj,15)  = ts(ji,jj,ikt,jp_tem,Kmm) 
     130            trc_data(ji,jj,16)  = ts(ji,jj,ikt,jp_sal,Kmm) 
     131            trc_data(ji,jj,17 ) = ( tr(ji,jj,ikt,jpsfe,Kbb) * zwsbio3(ji,jj) + tr(ji,jj,ikt,jpbfe,Kbb)  & 
     132            &                     * zwsbio4(ji,jj)  ) * 1E3 / ( trc_data(ji,jj,12 ) + trc_data(ji,jj,13 ) + rtrn ) 
     133            trc_data(ji,jj,17 ) = MIN(1E-3, trc_data(ji,jj,17 ) ) 
     134         ENDIF 
     135      END_2D 
    139136 
    140137      ! Pore water initial concentration [mol/l] in  k=1 

  • NEMO/trunk/src/TOP/PISCES/SED/sedini.F90

    r11536 r12377  
    1313   USE sedarr 
    1414   USE sedadv 
    15    USE trc_oce, ONLY : nn_dttrc 
    1615   USE trcdmp_sed 
    1716   USE trcdta 
    … …  
    2322   PRIVATE 
    2423 
     24   !! * Substitutions 
     25#  include "do_loop_substitute.h90" 
    2526   !! Module variables 
    2627   REAL(wp)    ::  & 
    … …  
    134135      ! Determination of sediments number of points and allocate global variables 
    135136      epkbot(:,:) = 0. 
    136       DO jj = 1, jpj 
    137          DO ji = 1, jpi 
    138             ikt = mbkt(ji,jj)  
    139             IF( tmask(ji,jj,ikt) == 1 ) epkbot(ji,jj) = e3t_1d(ikt) 
    140             gdepbot(ji,jj) = gdepw_0(ji,jj,ikt) 
    141          ENDDO 
    142       ENDDO 
     137      DO_2D_11_11 
     138         ikt = mbkt(ji,jj)  
     139         IF( tmask(ji,jj,ikt) == 1 ) epkbot(ji,jj) = e3t_1d(ikt) 
     140         gdepbot(ji,jj) = gdepw_0(ji,jj,ikt) 
     141      END_2D 
    143142 
    144143      ! computation of total number of ocean points 
    … …  
    248247      ! Computation of 1D array of sediments points 
    249248      indoce = 0 
    250       DO jj = 1, jpj 
    251          DO ji = 1, jpi 
    252             IF (  epkbot(ji,jj) > 0. ) THEN 
    253                indoce          = indoce + 1 
    254                iarroce(indoce) = (jj - 1) * jpi + ji 
    255             ENDIF 
    256          END DO 
    257       END DO 
     249      DO_2D_11_11 
     250         IF (  epkbot(ji,jj) > 0. ) THEN 
     251            indoce          = indoce + 1 
     252            iarroce(indoce) = (jj - 1) * jpi + ji 
     253         ENDIF 
     254      END_2D 
    258255 
    259256      IF ( indoce .EQ. 0 ) THEN 
    … …  
    406403      !!---------------------------------------------------------------------- 
    407404 
    408       INTEGER ::   numnamsed_ref = -1           !! Logical units for namelist sediment 
    409       INTEGER ::   numnamsed_cfg = -1           !! Logical units for namelist sediment 
     405      CHARACTER(:), ALLOCATABLE ::   numnamsed_ref           !! Character buffer for reference namelist sediment 
     406      CHARACTER(:), ALLOCATABLE ::   numnamsed_cfg           !! Character buffer for configuration namelist sediment 
    410407      INTEGER :: ios                 ! Local integer output status for namelist read 
    411408      CHARACTER(LEN=20)   ::   clname 
    … …  
    452449      IF(lwp) WRITE(numsed,*) ' sed_init_nam : read SEDIMENT namelist' 
    453450      IF(lwp) WRITE(numsed,*) ' ~~~~~~~~~~~~~~' 
    454       CALL ctl_opn( numnamsed_ref, TRIM( clname )//'_ref', 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    455       CALL ctl_opn( numnamsed_cfg, TRIM( clname )//'_cfg', 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
     451      CALL load_nml( numnamsed_ref, TRIM( clname )//'_ref', numout, lwm ) 
     452      CALL load_nml( numnamsed_cfg, TRIM( clname )//'_cfg', numout, lwm ) 
    456453 
    457454      nitsed000 = nittrc000 
    458455      nitsedend = nitend 
    459456      ! Namelist nam_run 
    460       REWIND( numnamsed_ref )              ! Namelist nam_run in reference namelist : Pisces variables 
    461457      READ  ( numnamsed_ref, nam_run, IOSTAT = ios, ERR = 901) 
    462458901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_run in reference namelist' ) 
    463459 
    464       REWIND( numnamsed_cfg )              ! Namelist nam_run in reference namelist : Pisces variables 
    465460      READ  ( numnamsed_cfg, nam_run, IOSTAT = ios, ERR = 902) 
    466461902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_run in configuration namelist' ) 
    … …  
    474469      IF ( ln_p5z .AND. ln_sed_2way ) CALL ctl_stop( '2 ways coupling with sediment cannot be activated with PISCES-QUOTA' ) 
    475470 
    476       REWIND( numnamsed_ref )              ! Namelist nam_geom in reference namelist : Pisces variables 
    477471      READ  ( numnamsed_ref, nam_geom, IOSTAT = ios, ERR = 903) 
    478472903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_geom in reference namelist' ) 
    479473 
    480       REWIND( numnamsed_cfg )              ! Namelist nam_geom in reference namelist : Pisces variables 
    481474      READ  ( numnamsed_cfg, nam_geom, IOSTAT = ios, ERR = 904) 
    482475904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_geom in configuration namelist' ) 
    … …  
    497490      dtsed = r2dttrc 
    498491 
    499       REWIND( numnamsed_ref )              ! Namelist nam_trased in reference namelist : Pisces variables 
    500492      READ  ( numnamsed_ref, nam_trased, IOSTAT = ios, ERR = 905) 
    501493905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_trased in reference namelist' ) 
    502494 
    503       REWIND( numnamsed_cfg )              ! Namelist nam_trased in reference namelist : Pisces variables 
    504495      READ  ( numnamsed_cfg, nam_trased, IOSTAT = ios, ERR = 906) 
    505496906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_trased in configuration namelist' ) 
    … …  
    530521      ENDIF 
    531522 
    532       REWIND( numnamsed_ref )              ! Namelist nam_diased in reference namelist : Pisces variables 
    533523      READ  ( numnamsed_ref, nam_diased, IOSTAT = ios, ERR = 907) 
    534524907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diased in reference namelist' ) 
    535525 
    536       REWIND( numnamsed_cfg )              ! Namelist nam_diased in reference namelist : Pisces variables 
    537526      READ  ( numnamsed_cfg, nam_diased, IOSTAT = ios, ERR = 908) 
    538527908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diased in configuration namelist' ) 
    … …  
    572561      ! Inorganic chemistry parameters 
    573562      !---------------------------------- 
    574       REWIND( numnamsed_ref )              ! Namelist nam_inorg in reference namelist : Pisces variables 
    575563      READ  ( numnamsed_ref, nam_inorg, IOSTAT = ios, ERR = 909) 
    576564909   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_inorg in reference namelist' ) 
    577565 
    578       REWIND( numnamsed_cfg )              ! Namelist nam_inorg in reference namelist : Pisces variables 
    579566      READ  ( numnamsed_cfg, nam_inorg, IOSTAT = ios, ERR = 910) 
    580567910   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_inorg in configuration namelist' ) 
    … …  
    598585      ! Additional parameter linked to POC/O2/No3/Po4 
    599586      !---------------------------------------------- 
    600       REWIND( numnamsed_ref )              ! Namelist nam_poc in reference namelist : Pisces variables 
    601587      READ  ( numnamsed_ref, nam_poc, IOSTAT = ios, ERR = 911) 
    602588911   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_poc in reference namelist' ) 
    603589 
    604       REWIND( numnamsed_cfg )              ! Namelist nam_poc in reference namelist : Pisces variables 
    605590      READ  ( numnamsed_cfg, nam_poc, IOSTAT = ios, ERR = 912) 
    606591912   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_poc in configuration namelist' ) 
    … …  
    650635      ! Bioturbation parameter 
    651636      !------------------------ 
    652       REWIND( numnamsed_ref )              ! Namelist nam_btb in reference namelist : Pisces variables 
    653637      READ  ( numnamsed_ref, nam_btb, IOSTAT = ios, ERR = 913) 
    654638913   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_btb in reference namelist' ) 
    655639 
    656       REWIND( numnamsed_cfg )              ! Namelist nam_btb in reference namelist : Pisces variables 
    657640      READ  ( numnamsed_cfg, nam_btb, IOSTAT = ios, ERR = 914) 
    658641914   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_btb in configuration namelist' ) 
    … …  
    671654      ! Initial value (t=0) for sediment pore water and solid components 
    672655      !---------------------------------------------------------------- 
    673       REWIND( numnamsed_ref )              ! Namelist nam_rst in reference namelist : Pisces variables 
    674656      READ  ( numnamsed_ref, nam_rst, IOSTAT = ios, ERR = 915) 
    675657915   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_rst in reference namelist' ) 
    676658 
    677       REWIND( numnamsed_cfg )              ! Namelist nam_rst in reference namelist : Pisces variables 
    678659      READ  ( numnamsed_cfg, nam_rst, IOSTAT = ios, ERR = 916) 
    679660916   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_rst in configuration namelist' ) 
    … …  
    684665         WRITE(numsed,*) ' ' 
    685666      ENDIF 
    686       nn_dtsed = nn_dttrc 
    687  
    688       CLOSE( numnamsed_cfg ) 
    689       CLOSE( numnamsed_ref ) 
     667      nn_dtsed = 1 
     668 
    690669 
    691670   END SUBROUTINE sed_init_nam 

  • NEMO/trunk/src/TOP/PISCES/SED/sedinitrc.F90

    r10225 r12377  
    3333 
    3434 
    35    SUBROUTINE sed_initrc 
     35   SUBROUTINE sed_initrc( Kbb, Kmm ) 
    3636      !!---------------------------------------------------------------------- 
    3737      !!                   ***  ROUTINE sed_init  *** 
    … …  
    5050      !!        !  06-07  (C. Ethe)  Re-organization 
    5151      !!---------------------------------------------------------------------- 
     52      INTEGER, INTENT(in)  ::  Kbb, Kmm      ! time level indices 
    5253      INTEGER :: ji, jj, ikt 
    5354      !!---------------------------------------------------------------------- 
    … …  
    6566      ! ( only clay or reading restart file ) 
    6667      !--------------------------------------- 
    67       CALL sed_init_data 
     68      CALL sed_init_data( Kbb, Kmm ) 
    6869 
    6970 
    … …  
    7475 
    7576 
    76    SUBROUTINE sed_init_data 
     77   SUBROUTINE sed_init_data( Kbb, Kmm ) 
    7778      !!---------------------------------------------------------------------- 
    7879      !!                   ***  ROUTINE sed_init_data  *** 
    … …  
    8586      !!        !  06-07  (C. Ethe)  original 
    8687      !!---------------------------------------------------------------------- 
     88      INTEGER, INTENT(in)  ::  Kbb, Kmm      ! time level indices 
    8789  
    8890      ! local variables 
    … …  
    128130 
    129131      ! Load initial Pisces Data for bot. wat. Chem and fluxes 
    130       CALL sed_dta ( nitsed000 )  
     132      CALL sed_dta ( nitsed000, Kbb, Kmm )  
    131133 
    132134      ! Initialization of chemical constants 

  • NEMO/trunk/src/TOP/PISCES/SED/sedmodel.F90

    r10222 r12377  
    1616CONTAINS 
    1717 
    18    SUBROUTINE sed_model ( kt ) 
     18   SUBROUTINE sed_model ( kt, Kbb, Kmm, Krhs ) 
    1919      !!--------------------------------------------------------------------- 
    2020      !!                  ***  ROUTINE sed_model  *** 
    … …  
    2929      !!        !  07-02 (C. Ethe)  Original 
    3030      !!---------------------------------------------------------------------- 
    31       INTEGER, INTENT(in) ::   kt       ! number of iteration 
     31      INTEGER, INTENT(in) ::   kt               ! number of iteration 
     32      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs   ! time level indices 
    3233 
    3334 
    3435      IF( ln_timing )  CALL timing_start('sed_model') 
    3536 
    36       IF( kt == nittrc000 ) CALL sed_initrc       ! Initialization of sediment model 
    37                             CALL sed_stp( kt )  ! Time stepping of Sediment model 
     37      IF( kt == nittrc000 ) CALL sed_initrc( Kbb, Kmm )         ! Initialization of sediment model 
     38                            CALL sed_stp( kt, Kbb, Kmm, Krhs )  ! Time stepping of Sediment model 
    3839 
    3940      IF( ln_timing )  CALL timing_stop('sed_model') 

  • NEMO/trunk/src/TOP/PISCES/SED/sedrst.F90

    r11536 r12377  
    1010   USE sed 
    1111   USE sedarr 
    12    USE trc_oce, ONLY : l_offline, nn_dttrc 
     12   USE trc_oce, ONLY : l_offline 
    1313   USE phycst , ONLY : rday 
    1414   USE iom 
    … …  
    6666 
    6767      ! to get better performances with NetCDF format: 
    68       ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1) 
    69       ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc + 1 
     68      ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 1) 
     69      ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 1 
    7070      IF( kt == nitrst - 2*nn_dtsed .OR. nn_stock == nn_dtsed .OR. ( kt == nitend - nn_dtsed .AND. .NOT. lrst_sed ) ) THEN 
    7171         ! beware of the format used to write kt (default is i8.8, that should be large enough) 

  • NEMO/trunk/src/TOP/PISCES/SED/sedsfc.F90

    r10222 r12377  
    1111   PUBLIC sed_sfc 
    1212 
     13   !! * Substitutions 
     14#  include "do_loop_substitute.h90" 
    1315   !! $Id$ 
    1416CONTAINS 
    1517 
    16    SUBROUTINE sed_sfc( kt ) 
     18   SUBROUTINE sed_sfc( kt, Kbb ) 
    1719      !!--------------------------------------------------------------------- 
    1820      !!                  ***  ROUTINE sed_sfc *** 
    … …  
    2628      !!* Arguments 
    2729      INTEGER, INTENT(in) ::  kt              ! time step 
     30      INTEGER, INTENT(in) ::  Kbb             ! time index 
    2831 
    2932      ! * local variables 
    … …  
    4548 
    4649 
    47       DO jj = 1,jpj 
    48          DO ji = 1, jpi 
    49             ikt = mbkt(ji,jj) 
    50             IF ( tmask(ji,jj,ikt) == 1 ) THEN 
    51                trb(ji,jj,ikt,jptal) = trc_data(ji,jj,1) 
    52                trb(ji,jj,ikt,jpdic) = trc_data(ji,jj,2) 
    53                trb(ji,jj,ikt,jpno3) = trc_data(ji,jj,3) * 7.625 
    54                trb(ji,jj,ikt,jppo4) = trc_data(ji,jj,4) * 122. 
    55                trb(ji,jj,ikt,jpoxy) = trc_data(ji,jj,5) 
    56                trb(ji,jj,ikt,jpsil) = trc_data(ji,jj,6) 
    57                trb(ji,jj,ikt,jpnh4) = trc_data(ji,jj,7) * 7.625 
    58                trb(ji,jj,ikt,jpfer) = trc_data(ji,jj,8) 
    59             ENDIF 
    60          ENDDO 
    61       ENDDO 
     50      DO_2D_11_11 
     51         ikt = mbkt(ji,jj) 
     52         IF ( tmask(ji,jj,ikt) == 1 ) THEN 
     53            tr(ji,jj,ikt,jptal,Kbb) = trc_data(ji,jj,1) 
     54            tr(ji,jj,ikt,jpdic,Kbb) = trc_data(ji,jj,2) 
     55            tr(ji,jj,ikt,jpno3,Kbb) = trc_data(ji,jj,3) * 7.625 
     56            tr(ji,jj,ikt,jppo4,Kbb) = trc_data(ji,jj,4) * 122. 
     57            tr(ji,jj,ikt,jpoxy,Kbb) = trc_data(ji,jj,5) 
     58            tr(ji,jj,ikt,jpsil,Kbb) = trc_data(ji,jj,6) 
     59            tr(ji,jj,ikt,jpnh4,Kbb) = trc_data(ji,jj,7) * 7.625 
     60            tr(ji,jj,ikt,jpfer,Kbb) = trc_data(ji,jj,8) 
     61         ENDIF 
     62      END_2D 
    6263 
    6364      IF( ln_timing )  CALL timing_stop('sed_sfc') 

  • NEMO/trunk/src/TOP/PISCES/SED/sedstp.F90

    r10222 r12377  
    2929CONTAINS 
    3030 
    31    SUBROUTINE sed_stp ( kt ) 
     31   SUBROUTINE sed_stp ( kt, Kbb, Kmm, Krhs ) 
    3232      !!--------------------------------------------------------------------- 
    3333      !!                  ***  ROUTINE sed_stp  *** 
    … …  
    4444      !!        !  06-04 (C. Ethe)  Re-organization 
    4545      !!---------------------------------------------------------------------- 
    46       INTEGER, INTENT(in) ::   kt       ! number of iteration 
     46      INTEGER, INTENT(in) ::   kt                ! number of iteration 
     47      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs    ! time level indices 
    4748      INTEGER :: ji,jk,js,jn,jw 
    4849      !!---------------------------------------------------------------------- 
    … …  
    5253      IF( lrst_sed )            CALL sed_rst_cal  ( kt, 'WRITE' )   ! calenda 
    5354 
    54       IF(ln_sediment_offline)   CALL trc_dmp_sed  ( kt ) 
     55      IF(ln_sediment_offline)   CALL trc_dmp_sed  ( kt, Kbb, Kmm, Krhs ) 
    5556 
    5657      dtsed  = r2dttrc 
    5758!      dtsed2 = dtsed 
    5859      IF (kt /= nitsed000) THEN 
    59          CALL sed_dta( kt )       ! Load  Data for bot. wat. Chem and fluxes 
     60         CALL sed_dta( kt, Kbb, Kmm )       ! Load  Data for bot. wat. Chem and fluxes 
    6061      ENDIF 
    6162 
    … …  
    8081         CALL sed_mbc( kt )         ! cumulation for mass balance calculation 
    8182 
    82          IF (ln_sed_2way) CALL sed_sfc( kt )         ! Give back new bottom wat chem to tracer model 
     83         IF (ln_sed_2way) CALL sed_sfc( kt, Kbb )         ! Give back new bottom wat chem to tracer model 
    8384      ENDIF 
    8485      CALL sed_wri( kt )         ! outputs 

  • NEMO/trunk/src/TOP/PISCES/SED/trcdmp_sed.F90

    r10225 r12377  
    3535 
    3636   !! * Substitutions 
    37 #  include "vectopt_loop_substitute.h90" 
     37#  include "do_loop_substitute.h90" 
    3838   !!---------------------------------------------------------------------- 
    3939   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    5454 
    5555 
    56    SUBROUTINE trc_dmp_sed( kt ) 
     56   SUBROUTINE trc_dmp_sed( kt, Kbb, Kmm, Krhs ) 
    5757      !!---------------------------------------------------------------------- 
    5858      !!                   ***  ROUTINE trc_dmp_sed  *** 
    … …  
    6464      !! ** Method  :   Newtonian damping towards trdta computed  
    6565      !!      and add to the general tracer trends: 
    66       !!                     trn = tra + restotr * (trdta - trb) 
     66      !!                     tr(Kmm) = tr(Krhs) + restotr * (trdta - tr(Kbb)) 
    6767      !!         The trend is computed either throughout the water column 
    6868      !!      (nlmdmptr=0) or in area of weak vertical mixing (nlmdmptr=1) or 
    6969      !!      below the well mixed layer (nlmdmptr=2) 
    7070      !! 
    71       !! ** Action  : - update the tracer trends tra with the newtonian  
     71      !! ** Action  : - update the tracer trends tr(Krhs) with the newtonian  
    7272      !!                damping trends. 
    7373      !!              - save the trends ('key_trdmxl_trc') 
    7474      !!---------------------------------------------------------------------- 
    75       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     75      INTEGER, INTENT(in) ::   kt              ! ocean time-step index 
     76      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level index 
    7677      ! 
    7778      INTEGER ::   ji, jj, jk, jn, jl, ikt   ! dummy loop indices 
    … …  
    9091               ! 
    9192               jl = n_trc_index(jn)  
    92                CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000 
     93               CALL trc_dta( kt, Kmm, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000 
    9394               ! 
    94                DO jj = 1, jpj 
    95                   DO ji = 1, jpi   ! vector opt. 
    96                      ikt = mbkt(ji,jj) 
    97                      trb(ji,jj,ikt,jn) = ztrcdta(ji,jj,ikt) + ( trb(ji,jj,ikt,jn) -  ztrcdta(ji,jj,ikt) )     & 
    98                      &                  * exp( -restosed(ji,jj,ikt) * dtsed ) 
    99                   END DO 
    100                END DO 
     95               DO_2D_11_11 
     96                  ikt = mbkt(ji,jj) 
     97                  tr(ji,jj,ikt,jn,Kbb) = ztrcdta(ji,jj,ikt) + ( tr(ji,jj,ikt,jn,Kbb) -  ztrcdta(ji,jj,ikt) )     & 
     98                  &                  * exp( -restosed(ji,jj,ikt) * dtsed ) 
     99               END_2D 
    101100               !  
    102101            ENDIF 
    … …  
    106105      ! 
    107106      !                                          ! print mean trends (used for debugging) 
    108       IF( ln_ctl ) THEN 
     107      IF( sn_cfctl%l_prttrc ) THEN 
    109108         WRITE(charout, FMT="('dmp ')") 
    110109         CALL prt_ctl_trc_info(charout) 
    111          CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     110         CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    112111      ENDIF 
    113112      ! 
    … …  
    148147   !!---------------------------------------------------------------------- 
    149148CONTAINS 
    150    SUBROUTINE trc_dmp_sed( kt )        ! Empty routine 
     149   SUBROUTINE trc_dmp_sed( kt, Kbb, Kmm, Krhs )   ! Empty routine 
    151150      INTEGER, INTENT(in) :: kt 
     151      INTEGER, INTENT(in) :: Kbb, Kmm, Krhs 
    152152      WRITE(*,*) 'trc_dmp_sed: You should not have seen this print! error?', kt 
    153153   END SUBROUTINE trc_dmp_sed 

  • NEMO/trunk/src/TOP/PISCES/par_pisces.F90

    r10416 r12377  
    66   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture 
    77   !!---------------------------------------------------------------------- 
     8   USE par_kind 
    89 
    910   IMPLICIT NONE 
    … …  
    6061   !!   Default                                   No CFC geochemical model 
    6162   ! Starting/ending PISCES do-loop indices (N.B. no PISCES : jpl_pcs < jpf_pcs the do-loop are never done) 
    62    INTEGER, PUBLIC  ::   jp_pcs0  !: First index of PISCES tracers 
    63    INTEGER, PUBLIC  ::   jp_pcs1  !: Last  index of PISCES tracers 
     63   INTEGER, PUBLIC  ::  jp_pcs0  !: First index of PISCES tracers 
     64   INTEGER, PUBLIC  ::  jp_pcs1  !: Last  index of PISCES tracers 
     65 
     66   REAL(wp), PUBLIC ::  mMass_C  = 12.00      ! Molar mass of carbon 
     67   REAL(wp), PUBLIC ::  mMass_N  = 14.00      ! Molar mass of nitrogen 
     68   REAL(wp), PUBLIC ::  mMass_P  = 31.00      ! Molar mass of phosphorus 
     69   REAL(wp), PUBLIC ::  mMass_Fe = 55.85      ! Molar mass of iron 
     70   REAL(wp), PUBLIC ::  mMass_Si = 28.00      ! Molar mass of silver 
    6471 
    6572   !!---------------------------------------------------------------------- 

  • NEMO/trunk/src/TOP/PISCES/sms_pisces.F90

    r10788 r12377  
    1313   PUBLIC 
    1414 
    15    INTEGER ::   numnatp_ref = -1           !! Logical units for namelist pisces 
    16    INTEGER ::   numnatp_cfg = -1           !! Logical units for namelist pisces 
    17    INTEGER ::   numonp      = -1           !! Logical unit for namelist pisces output 
     15   CHARACTER(:), ALLOCATABLE ::   numnatp_ref   !! Character buffer for reference namelist pisces 
     16   CHARACTER(:), ALLOCATABLE ::   numnatp_cfg   !! Character buffer for configuration namelist pisces 
     17   INTEGER ::   numonp      = -1                !! Logical unit for namelist pisces output 
    1818 
    1919   !                                                       !:  PISCES  : silicon dependant half saturation 
    … …  
    121121   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tgfunc2   !: Temp. dependancy of mesozooplankton rates 
    122122 
     123   LOGICAL, SAVE :: lk_sed 
     124 
    123125   !!---------------------------------------------------------------------- 
    124126   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 

  • NEMO/trunk/src/TOP/PISCES/trcini_pisces.F90

    r10817 r12377  
    3232CONTAINS 
    3333 
    34    SUBROUTINE trc_ini_pisces 
     34   SUBROUTINE trc_ini_pisces( Kmm ) 
    3535      !!---------------------------------------------------------------------- 
    3636      !!                   ***  ROUTINE trc_ini_pisces *** 
    … …  
    3838      !! ** Purpose :   Initialisation of the PISCES biochemical model 
    3939      !!---------------------------------------------------------------------- 
     40      INTEGER, INTENT(in)  ::  Kmm      ! time level indices 
    4041      ! 
    4142      CALL trc_nam_pisces 
    4243      ! 
    43       IF( ln_p4z .OR. ln_p5z ) THEN  ;   CALL p4z_ini   !  PISCES 
    44       ELSE                           ;   CALL p2z_ini   !  LOBSTER 
     44      IF( ln_p4z .OR. ln_p5z ) THEN  ;   CALL p4z_ini( Kmm )   !  PISCES 
     45      ELSE                           ;   CALL p2z_ini( Kmm )   !  LOBSTER 
    4546      ENDIF 
    4647 
    … …  
    4849 
    4950 
    50    SUBROUTINE p4z_ini 
     51   SUBROUTINE p4z_ini( Kmm ) 
    5152      !!---------------------------------------------------------------------- 
    5253      !!                   ***  ROUTINE p4z_ini *** 
    … …  
    5859      USE p4zsink         !  vertical flux of particulate matter due to sinking 
    5960      USE p4zopt          !  optical model 
    60       USE p4zsbc          !  Boundary conditions 
     61      USE p4zbc          !  Boundary conditions 
    6162      USE p4zfechem       !  Iron chemistry 
    6263      USE p4zrem          !  Remineralisation of organic matter 
    … …  
    7778      USE p5zmort         !  Mortality terms for phytoplankton 
    7879      ! 
     80      INTEGER, INTENT(in)  ::  Kmm      ! time level indices 
    7981      REAL(wp), SAVE ::   sco2   =  2.312e-3_wp 
    8082      REAL(wp), SAVE ::   alka0  =  2.426e-3_wp 
    … …  
    189191      !-------------------------------------------------------------- 
    190192      IF( .NOT.ln_rsttr ) THEN   
    191          trn(:,:,:,jpdic) = sco2 
    192          trn(:,:,:,jpdoc) = bioma0 
    193          trn(:,:,:,jptal) = alka0 
    194          trn(:,:,:,jpoxy) = oxyg0 
    195          trn(:,:,:,jpcal) = bioma0 
    196          trn(:,:,:,jppo4) = po4 / po4r 
    197          trn(:,:,:,jppoc) = bioma0 
    198          trn(:,:,:,jpgoc) = bioma0 
    199          trn(:,:,:,jpbfe) = bioma0 * 5.e-6 
    200          trn(:,:,:,jpsil) = silic1 
    201          trn(:,:,:,jpdsi) = bioma0 * 0.15 
    202          trn(:,:,:,jpgsi) = bioma0 * 5.e-6 
    203          trn(:,:,:,jpphy) = bioma0 
    204          trn(:,:,:,jpdia) = bioma0 
    205          trn(:,:,:,jpzoo) = bioma0 
    206          trn(:,:,:,jpmes) = bioma0 
    207          trn(:,:,:,jpfer) = 0.6E-9 
    208          trn(:,:,:,jpsfe) = bioma0 * 5.e-6 
    209          trn(:,:,:,jpdfe) = bioma0 * 5.e-6 
    210          trn(:,:,:,jpnfe) = bioma0 * 5.e-6 
    211          trn(:,:,:,jpnch) = bioma0 * 12. / 55. 
    212          trn(:,:,:,jpdch) = bioma0 * 12. / 55. 
    213          trn(:,:,:,jpno3) = no3 
    214          trn(:,:,:,jpnh4) = bioma0 
     193         tr(:,:,:,jpdic,Kmm) = sco2 
     194         tr(:,:,:,jpdoc,Kmm) = bioma0 
     195         tr(:,:,:,jptal,Kmm) = alka0 
     196         tr(:,:,:,jpoxy,Kmm) = oxyg0 
     197         tr(:,:,:,jpcal,Kmm) = bioma0 
     198         tr(:,:,:,jppo4,Kmm) = po4 / po4r 
     199         tr(:,:,:,jppoc,Kmm) = bioma0 
     200         tr(:,:,:,jpgoc,Kmm) = bioma0 
     201         tr(:,:,:,jpbfe,Kmm) = bioma0 * 5.e-6 
     202         tr(:,:,:,jpsil,Kmm) = silic1 
     203         tr(:,:,:,jpdsi,Kmm) = bioma0 * 0.15 
     204         tr(:,:,:,jpgsi,Kmm) = bioma0 * 5.e-6 
     205         tr(:,:,:,jpphy,Kmm) = bioma0 
     206         tr(:,:,:,jpdia,Kmm) = bioma0 
     207         tr(:,:,:,jpzoo,Kmm) = bioma0 
     208         tr(:,:,:,jpmes,Kmm) = bioma0 
     209         tr(:,:,:,jpfer,Kmm) = 0.6E-9 
     210         tr(:,:,:,jpsfe,Kmm) = bioma0 * 5.e-6 
     211         tr(:,:,:,jpdfe,Kmm) = bioma0 * 5.e-6 
     212         tr(:,:,:,jpnfe,Kmm) = bioma0 * 5.e-6 
     213         tr(:,:,:,jpnch,Kmm) = bioma0 * 12. / 55. 
     214         tr(:,:,:,jpdch,Kmm) = bioma0 * 12. / 55. 
     215         tr(:,:,:,jpno3,Kmm) = no3 
     216         tr(:,:,:,jpnh4,Kmm) = bioma0 
    215217         IF( ln_ligand) THEN 
    216             trn(:,:,:,jplgw) = 0.6E-9 
     218            tr(:,:,:,jplgw,Kmm) = 0.6E-9 
    217219         ENDIF 
    218220         IF( ln_p5z ) THEN 
    219             trn(:,:,:,jpdon) = bioma0 
    220             trn(:,:,:,jpdop) = bioma0 
    221             trn(:,:,:,jppon) = bioma0 
    222             trn(:,:,:,jppop) = bioma0 
    223             trn(:,:,:,jpgon) = bioma0 
    224             trn(:,:,:,jpgop) = bioma0 
    225             trn(:,:,:,jpnph) = bioma0 
    226             trn(:,:,:,jppph) = bioma0 
    227             trn(:,:,:,jppic) = bioma0 
    228             trn(:,:,:,jpnpi) = bioma0 
    229             trn(:,:,:,jpppi) = bioma0 
    230             trn(:,:,:,jpndi) = bioma0 
    231             trn(:,:,:,jppdi) = bioma0 
    232             trn(:,:,:,jppfe) = bioma0 * 5.e-6 
    233             trn(:,:,:,jppch) = bioma0 * 12. / 55. 
     221            tr(:,:,:,jpdon,Kmm) = bioma0 
     222            tr(:,:,:,jpdop,Kmm) = bioma0 
     223            tr(:,:,:,jppon,Kmm) = bioma0 
     224            tr(:,:,:,jppop,Kmm) = bioma0 
     225            tr(:,:,:,jpgon,Kmm) = bioma0 
     226            tr(:,:,:,jpgop,Kmm) = bioma0 
     227            tr(:,:,:,jpnph,Kmm) = bioma0 
     228            tr(:,:,:,jppph,Kmm) = bioma0 
     229            tr(:,:,:,jppic,Kmm) = bioma0 
     230            tr(:,:,:,jpnpi,Kmm) = bioma0 
     231            tr(:,:,:,jpppi,Kmm) = bioma0 
     232            tr(:,:,:,jpndi,Kmm) = bioma0 
     233            tr(:,:,:,jppdi,Kmm) = bioma0 
     234            tr(:,:,:,jppfe,Kmm) = bioma0 * 5.e-6 
     235            tr(:,:,:,jppch,Kmm) = bioma0 * 12. / 55. 
    234236         ENDIF 
    235237         ! initialize the half saturation constant for silicate 
    … …  
    254256         CALL p5z_prod_init      !  phytoplankton growth rate over the global ocean. 
    255257      ENDIF 
    256       CALL p4z_sbc_init          !  boundary conditions 
     258      CALL p4z_bc_init( Kmm )    !  boundary conditions 
    257259      CALL p4z_fechem_init       !  Iron chemistry 
    258260      CALL p4z_rem_init          !  remineralisation 
    … …  
    275277 
    276278      ! Initialization of the sediment model 
    277       IF( ln_sediment)   CALL sed_init 
     279      IF( ln_sediment)   & 
     280        & CALL sed_init ! Initialization of the sediment model  
     281 
     282      CALL p4z_sed_init          ! loss of organic matter in the sediments  
    278283 
    279284      IF(lwp) WRITE(numout,*)  
    … …  
    284289 
    285290 
    286    SUBROUTINE p2z_ini 
     291   SUBROUTINE p2z_ini( Kmm ) 
    287292      !!---------------------------------------------------------------------- 
    288293      !!                   ***  ROUTINE p2z_ini *** 
    … …  
    296301      USE p2zsed 
    297302      ! 
     303      INTEGER, INTENT(in)  ::  Kmm      ! time level indices 
    298304      INTEGER  ::  ji, jj, jk, jn, ierr 
    299305      CHARACTER(len = 10)  ::  cltra 
    … …  
    334340      ! ---------------------- 
    335341      IF( .NOT. ln_rsttr ) THEN             ! in case of  no restart  
    336          trn(:,:,:,jpdet) = 0.1 * tmask(:,:,:) 
    337          trn(:,:,:,jpzoo) = 0.1 * tmask(:,:,:) 
    338          trn(:,:,:,jpnh4) = 0.1 * tmask(:,:,:) 
    339          trn(:,:,:,jpphy) = 0.1 * tmask(:,:,:) 
    340          trn(:,:,:,jpdom) = 1.0 * tmask(:,:,:) 
    341          WHERE( rhd(:,:,:) <= 24.5e-3 )  ;  trn(:,:,:,jpno3) = 2._wp * tmask(:,:,:) 
    342          ELSE WHERE                      ;  trn(:,:,:,jpno3) = ( 15.55 * ( rhd(:,:,:) * 1000. ) - 380.11 ) * tmask(:,:,:) 
     342         tr(:,:,:,jpdet,Kmm) = 0.1 * tmask(:,:,:) 
     343         tr(:,:,:,jpzoo,Kmm) = 0.1 * tmask(:,:,:) 
     344         tr(:,:,:,jpnh4,Kmm) = 0.1 * tmask(:,:,:) 
     345         tr(:,:,:,jpphy,Kmm) = 0.1 * tmask(:,:,:) 
     346         tr(:,:,:,jpdom,Kmm) = 1.0 * tmask(:,:,:) 
     347         WHERE( rhd(:,:,:) <= 24.5e-3 )  ;  tr(:,:,:,jpno3,Kmm) = 2._wp * tmask(:,:,:) 
     348         ELSE WHERE                      ;  tr(:,:,:,jpno3,Kmm) = ( 15.55 * ( rhd(:,:,:) * 1000. ) - 380.11 ) * tmask(:,:,:) 
    343349         END WHERE                        
    344350      ENDIF 
    345       !                       !  Namelist read 
    346       CALL p2z_opt_init       !  Optics parameters 
    347       CALL p2z_sed_init       !  sedimentation 
    348       CALL p2z_bio_init       !  biology 
    349       CALL p2z_exp_init      !  export  
     351      !                        !  Namelist read 
     352      CALL p2z_opt_init        !  Optics parameters 
     353      CALL p2z_sed_init        !  sedimentation 
     354      CALL p2z_bio_init        !  biology 
     355      CALL p2z_exp_init( Kmm ) !  export  
    350356      ! 
    351357      IF(lwp) WRITE(numout,*)  

  • NEMO/trunk/src/TOP/PISCES/trcnam_pisces.F90

    r11536 r12377  
    5151      IF(lwp) WRITE(numout,*) 'trc_nam_pisces : read PISCES namelist' 
    5252      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~' 
    53       CALL ctl_opn( numnatp_ref, TRIM( clname )//'_ref', 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    54       CALL ctl_opn( numnatp_cfg, TRIM( clname )//'_cfg', 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
     53      CALL load_nml( numnatp_ref, TRIM( clname )//'_ref', numout, lwm ) 
     54      CALL load_nml( numnatp_cfg, TRIM( clname )//'_cfg', numout, lwm ) 
    5555      IF(lwm) CALL ctl_opn( numonp     , 'output.namelist.pis' , 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    5656      ! 
    57       REWIND( numnatp_ref )              ! Namelist nampisbio in reference namelist : Pisces variables 
    5857      READ  ( numnatp_ref, nampismod, IOSTAT = ios, ERR = 901) 
    5958901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampismod in reference namelist' ) 
    60       REWIND( numnatp_cfg )              ! Namelist nampisbio in configuration namelist : Pisces variables 
    6159      READ  ( numnatp_cfg, nampismod, IOSTAT = ios, ERR = 902 ) 
    6260902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampismod in configuration namelist' ) 

  • NEMO/trunk/src/TOP/PISCES/trcsms_pisces.F90

    r10068 r12377  
    2525CONTAINS 
    2626 
    27    SUBROUTINE trc_sms_pisces( kt ) 
     27   SUBROUTINE trc_sms_pisces( kt, Kbb, Kmm, Krhs ) 
    2828      !!--------------------------------------------------------------------- 
    2929      !!                     ***  ROUTINE trc_sms_pisces  *** 
    … …  
    3434      !!--------------------------------------------------------------------- 
    3535      ! 
    36       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     36      INTEGER, INTENT( in ) ::   kt               ! ocean time-step index       
     37      INTEGER, INTENT( in ) ::   Kbb, Kmm, Krhs   ! time level index 
    3738      !!--------------------------------------------------------------------- 
    3839      ! 
    39       IF( ln_p4z .OR. ln_p5z ) THEN  ;   CALL p4z_sms( kt )   !  PISCES 
    40       ELSE                           ;   CALL p2z_sms( kt )   !  LOBSTER 
     40      IF( ln_p4z .OR. ln_p5z ) THEN  ;   CALL p4z_sms( kt, Kbb, Kmm, Krhs )   !  PISCES 
     41      ELSE                           ;   CALL p2z_sms( kt,      Kmm, Krhs )   !  LOBSTER 
    4142      ENDIF 
    4243 

  • NEMO/trunk/src/TOP/PISCES/trcwri_pisces.F90

    r10069 r12377  
    1919   PUBLIC trc_wri_pisces  
    2020 
     21   !! * Substitutions 
     22#  include "do_loop_substitute.h90" 
    2123   !!---------------------------------------------------------------------- 
    2224   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    2628CONTAINS 
    2729 
    28    SUBROUTINE trc_wri_pisces 
     30   SUBROUTINE trc_wri_pisces( Kmm ) 
    2931      !!--------------------------------------------------------------------- 
    3032      !!                     ***  ROUTINE trc_wri_trc  *** 
    … …  
    3234      !! ** Purpose :   output passive tracers fields  
    3335      !!--------------------------------------------------------------------- 
     36      INTEGER, INTENT(in)          :: Kmm      ! time level indices 
    3437      CHARACTER (len=20)           :: cltra 
    3538      REAL(wp)                     :: zfact 
    … …  
    4346         DO jn = jp_pcs0, jp_pcs1 
    4447            cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
    45             CALL iom_put( cltra, trn(:,:,:,jn) ) 
     48            CALL iom_put( cltra, tr(:,:,:,jn,Kmm) ) 
    4649         END DO 
    4750      ELSE 
    … …  
    5154            IF( jn == jppo4  )                 zfact = po4r * 1.0e+6 
    5255            cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
    53             IF( iom_use( cltra ) )  CALL iom_put( cltra, trn(:,:,:,jn) * zfact ) 
     56            IF( iom_use( cltra ) )  CALL iom_put( cltra, tr(:,:,:,jn,Kmm) * zfact ) 
    5457         END DO 
    5558 
    … …  
    5760            zdic(:,:) = 0. 
    5861            DO jk = 1, jpkm1 
    59                zdic(:,:) = zdic(:,:) + trn(:,:,jk,jpdic) * e3t_n(:,:,jk) * tmask(:,:,jk) * 12. 
     62               zdic(:,:) = zdic(:,:) + tr(:,:,jk,jpdic,Kmm) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) * 12. 
    6063            ENDDO 
    6164            CALL iom_put( 'INTDIC', zdic )      
    … …  
    6366         ! 
    6467         IF( iom_use( "O2MIN" ) .OR. iom_use ( "ZO2MIN" ) ) THEN  ! Oxygen minimum concentration and depth  
    65             zo2min   (:,:) = trn(:,:,1,jpoxy) * tmask(:,:,1) 
    66             zdepo2min(:,:) = gdepw_n(:,:,1)   * tmask(:,:,1) 
    67             DO jk = 2, jpkm1 
    68                DO jj = 1, jpj 
    69                   DO ji = 1, jpi 
    70                      IF( tmask(ji,jj,jk) == 1 ) then 
    71                         IF( trn(ji,jj,jk,jpoxy) < zo2min(ji,jj) ) then 
    72                            zo2min   (ji,jj) = trn(ji,jj,jk,jpoxy) 
    73                            zdepo2min(ji,jj) = gdepw_n(ji,jj,jk) 
    74                         ENDIF 
    75                      ENDIF 
    76                   END DO 
    77                END DO 
    78             END DO 
     68            zo2min   (:,:) = tr(:,:,1,jpoxy,Kmm) * tmask(:,:,1) 
     69            zdepo2min(:,:) = gdepw(:,:,1,Kmm)   * tmask(:,:,1) 
     70            DO_3D_11_11( 2, jpkm1 ) 
     71               IF( tmask(ji,jj,jk) == 1 ) then 
     72                  IF( tr(ji,jj,jk,jpoxy,Kmm) < zo2min(ji,jj) ) then 
     73                     zo2min   (ji,jj) = tr(ji,jj,jk,jpoxy,Kmm) 
     74                     zdepo2min(ji,jj) = gdepw(ji,jj,jk,Kmm) 
     75                  ENDIF 
     76               ENDIF 
     77            END_3D 
    7978            ! 
    8079            CALL iom_put('O2MIN' , zo2min     )                              ! oxygen minimum concentration 

  • NEMO/trunk/src/TOP/TRP/trcadv.F90

    r11536 r12377  
    5959   INTEGER, PARAMETER ::   np_QCK     = 5   ! QUICK scheme 
    6060    
    61    !! * Substitutions 
    62 #  include "vectopt_loop_substitute.h90" 
    6361   !!---------------------------------------------------------------------- 
    6462   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    6866CONTAINS 
    6967 
    70    SUBROUTINE trc_adv( kt ) 
     68   SUBROUTINE trc_adv( kt, Kbb, Kmm, ptr, Krhs ) 
    7169      !!---------------------------------------------------------------------- 
    7270      !!                  ***  ROUTINE trc_adv  *** 
    … …  
    7472      !! ** Purpose :   compute the ocean tracer advection trend. 
    7573      !! 
    76       !! ** Method  : - Update after tracers (tra) with the advection term following nadv 
    77       !!---------------------------------------------------------------------- 
    78       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     74      !! ** Method  : - Update after tracers (tr(Krhs)) with the advection term following nadv 
     75      !!---------------------------------------------------------------------- 
     76      INTEGER                                   , INTENT(in)    :: kt   ! ocean time-step index 
     77      INTEGER                                   , INTENT(in)    :: Kbb, Kmm, Krhs ! time level indices 
     78      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr            ! passive tracers and RHS of tracer equation 
    7979      ! 
    8080      INTEGER ::   jk   ! dummy loop index 
    8181      CHARACTER (len=22) ::   charout 
    82       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zun, zvn, zwn  ! effective velocity 
     82      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zuu, zvv, zww  ! effective velocity 
    8383      !!---------------------------------------------------------------------- 
    8484      ! 
    … …  
    8787      !                                         !==  effective transport  ==! 
    8888      IF( l_offline ) THEN 
    89          zun(:,:,:) = un(:,:,:)                    ! already in (un,vn,wn) 
    90          zvn(:,:,:) = vn(:,:,:) 
    91          zwn(:,:,:) = wn(:,:,:) 
     89         zuu(:,:,:) = uu(:,:,:,Kmm)                ! already in (uu(Kmm),vv(Kmm),ww) 
     90         zvv(:,:,:) = vv(:,:,:,Kmm) 
     91         zww(:,:,:) = ww(:,:,:) 
    9292      ELSE                                         ! build the effective transport 
    93          zun(:,:,jpk) = 0._wp 
    94          zvn(:,:,jpk) = 0._wp 
    95          zwn(:,:,jpk) = 0._wp 
     93         zuu(:,:,jpk) = 0._wp 
     94         zvv(:,:,jpk) = 0._wp 
     95         zww(:,:,jpk) = 0._wp 
    9696         IF( ln_wave .AND. ln_sdw )  THEN 
    9797            DO jk = 1, jpkm1                                                       ! eulerian transport + Stokes Drift 
    98                zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * ( un(:,:,jk) + usd(:,:,jk) ) 
    99                zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * ( vn(:,:,jk) + vsd(:,:,jk) ) 
    100                zwn(:,:,jk) = e1e2t(:,:)                 * ( wn(:,:,jk) + wsd(:,:,jk) ) 
     98               zuu(:,:,jk) = e2u  (:,:) * e3u(:,:,jk,Kmm) * ( uu(:,:,jk,Kmm) + usd(:,:,jk) ) 
     99               zvv(:,:,jk) = e1v  (:,:) * e3v(:,:,jk,Kmm) * ( vv(:,:,jk,Kmm) + vsd(:,:,jk) ) 
     100               zww(:,:,jk) = e1e2t(:,:)                   * ( ww(:,:,jk) + wsd(:,:,jk) ) 
    101101            END DO 
    102102         ELSE 
    103103            DO jk = 1, jpkm1 
    104                zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)                   ! eulerian transport 
    105                zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    106                zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
     104               zuu(:,:,jk) = e2u  (:,:) * e3u(:,:,jk,Kmm) * uu(:,:,jk,Kmm)                   ! eulerian transport 
     105               zvv(:,:,jk) = e1v  (:,:) * e3v(:,:,jk,Kmm) * vv(:,:,jk,Kmm) 
     106               zww(:,:,jk) = e1e2t(:,:)                   * ww(:,:,jk) 
    107107            END DO 
    108108         ENDIF 
    109109         ! 
    110110         IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                 ! add z-tilde and/or vvl corrections 
    111             zun(:,:,:) = zun(:,:,:) + un_td(:,:,:) 
    112             zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:) 
     111            zuu(:,:,:) = zuu(:,:,:) + un_td(:,:,:) 
     112            zvv(:,:,:) = zvv(:,:,:) + vn_td(:,:,:) 
    113113         ENDIF 
    114114         ! 
    115115         IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   &  
    116             &              CALL ldf_eiv_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the eiv transport 
    117          ! 
    118          IF( ln_mle    )   CALL tra_mle_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the mle transport 
     116            &              CALL ldf_eiv_trp( kt, nittrc000, zuu, zvv, zww, 'TRC', Kmm, Krhs )  ! add the eiv transport 
     117         ! 
     118         IF( ln_mle    )   CALL tra_mle_trp( kt, nittrc000, zuu, zvv, zww, 'TRC', Kmm      )  ! add the mle transport 
    119119         ! 
    120120      ENDIF 
    … …  
    123123      ! 
    124124      CASE ( np_CEN )                                 ! Centered : 2nd / 4th order 
    125          CALL tra_adv_cen( kt, nittrc000,'TRC',          zun, zvn, zwn     , trn, tra, jptra, nn_cen_h, nn_cen_v ) 
     125         CALL tra_adv_cen( kt, nittrc000,'TRC',          zuu, zvv, zww,      Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v ) 
    126126      CASE ( np_FCT )                                 ! FCT      : 2nd / 4th order 
    127          CALL tra_adv_fct( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v ) 
     127         CALL tra_adv_fct( kt, nittrc000,'TRC', r2dttrc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 
    128128      CASE ( np_MUS )                                 ! MUSCL 
    129          CALL tra_adv_mus( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb,      tra, jptra        , ln_mus_ups )  
     129         CALL tra_adv_mus( kt, nittrc000,'TRC', r2dttrc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups        )  
    130130      CASE ( np_UBS )                                 ! UBS 
    131          CALL tra_adv_ubs( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra          , nn_ubs_v ) 
     131         CALL tra_adv_ubs( kt, nittrc000,'TRC', r2dttrc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_ubs_v          ) 
    132132      CASE ( np_QCK )                                 ! QUICKEST 
    133          CALL tra_adv_qck( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra                     ) 
     133         CALL tra_adv_qck( kt, nittrc000,'TRC', r2dttrc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs                     ) 
    134134      ! 
    135135      END SELECT 
    136136      !                   
    137       IF( ln_ctl ) THEN                         !== print mean trends (used for debugging) 
     137      IF( sn_cfctl%l_prttrc ) THEN        !== print mean trends (used for debugging) 
    138138         WRITE(charout, FMT="('adv ')") 
    139139         CALL prt_ctl_trc_info(charout) 
    140          CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     140         CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    141141      END IF 
    142142      ! 
    … …  
    164164      ! 
    165165      !                                !==  Namelist  ==! 
    166       REWIND( numnat_ref )                   !  namtrc_adv in reference namelist  
    167166      READ  ( numnat_ref, namtrc_adv, IOSTAT = ios, ERR = 901) 
    168167901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_adv in reference namelist' ) 
    169       REWIND( numnat_cfg )                   ! namtrc_adv in configuration namelist 
    170168      READ  ( numnat_cfg, namtrc_adv, IOSTAT = ios, ERR = 902 ) 
    171169902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist' ) 

  • NEMO/trunk/src/TOP/TRP/trcbbl.F90

    r10068 r12377  
    2020   !!    trc_bbl      : update the tracer trends due to the bottom boundary layer (advective and/or diffusive) 
    2121   !!---------------------------------------------------------------------- 
    22    USE oce_trc        ! ocean dynamics and active tracers variables 
     22   USE oce_trc        ! ocean dynamics and passive tracers variables 
    2323   USE trc            ! ocean passive tracers variables 
    2424   USE trd_oce        ! trends: ocean variables 
    … …  
    3636CONTAINS 
    3737 
    38    SUBROUTINE trc_bbl( kt ) 
     38   SUBROUTINE trc_bbl( kt, Kbb, Kmm, ptr, Krhs ) 
    3939      !!---------------------------------------------------------------------- 
    4040      !!                  ***  ROUTINE bbl  *** 
    … …  
    4545      !! 
    4646      !!----------------------------------------------------------------------   
    47       INTEGER, INTENT( in ) ::   kt   ! ocean time-step  
     47      INTEGER,                                    INTENT( in  ) :: kt              ! ocean time-step  
     48      INTEGER,                                    INTENT( in  ) :: Kbb, Kmm, Krhs  ! time level indices 
     49      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr             ! passive tracers and RHS of tracer equation 
    4850      INTEGER :: jn                   ! loop index 
    4951      CHARACTER (len=22) :: charout 
    … …  
    5355      IF( ln_timing )   CALL timing_start('trc_bbl') 
    5456      ! 
    55       IF( .NOT. l_offline .AND. nn_dttrc == 1 ) THEN 
    56          CALL bbl( kt, nittrc000, 'TRC' )      ! Online coupling with dynamics  : Computation of bbl coef and bbl transport 
    57          l_bbl = .FALSE.                       ! Offline coupling with dynamics : Read bbl coef and bbl transport from input files 
     57      IF( .NOT. l_offline ) THEN 
     58         CALL bbl( kt, nittrc000, 'TRC', Kbb, Kmm )  ! Online coupling with dynamics  : Computation of bbl coef and bbl transport 
     59         l_bbl = .FALSE.                             ! Offline coupling with dynamics : Read bbl coef and bbl transport from input files 
    5860      ENDIF 
    5961 
    6062      IF( l_trdtrc )  THEN 
    6163         ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) ) ! temporary save of trends 
    62          ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
     64         ztrtrd(:,:,:,:)  = ptr(:,:,:,:,Krhs) 
    6365      ENDIF 
    6466 
    … …  
    6668      IF( nn_bbl_ldf == 1 ) THEN 
    6769         ! 
    68          CALL tra_bbl_dif( trb, tra, jptra )   
    69          IF( ln_ctl )   THEN 
     70         CALL tra_bbl_dif( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm )   
     71         IF( sn_cfctl%l_prttrc )   THEN 
    7072            WRITE(charout, FMT="(' bbl_dif')")  ;  CALL prt_ctl_trc_info(charout) 
    71             CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     73            CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    7274         ENDIF 
    7375         ! 
    … …  
    7779      IF( nn_bbl_adv /= 0 ) THEN 
    7880         ! 
    79          CALL tra_bbl_adv( trb, tra, jptra )   
    80          IF( ln_ctl )   THEN 
     81         CALL tra_bbl_adv( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm )   
     82         IF( sn_cfctl%l_prttrc )   THEN 
    8183            WRITE(charout, FMT="(' bbl_adv')")  ;  CALL prt_ctl_trc_info(charout) 
    82             CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     84            CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    8385         ENDIF 
    8486         ! 
    … …  
    8789      IF( l_trdtrc )   THEN                      ! save the horizontal diffusive trends for further diagnostics 
    8890        DO jn = 1, jptra 
    89            ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 
    90            CALL trd_tra( kt, 'TRC', jn, jptra_bbl, ztrtrd(:,:,:,jn) ) 
     91           ztrtrd(:,:,:,jn) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:,jn) 
     92           CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_bbl, ztrtrd(:,:,:,jn) ) 
    9193        END DO 
    9294        DEALLOCATE( ztrtrd ) ! temporary save of trends 

  • NEMO/trunk/src/TOP/TRP/trcdmp.F90

    r11536 r12377  
    4444 
    4545   !! * Substitutions 
    46 #  include "vectopt_loop_substitute.h90" 
     46#  include "do_loop_substitute.h90" 
    4747   !!---------------------------------------------------------------------- 
    4848   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    6363 
    6464 
    65    SUBROUTINE trc_dmp( kt ) 
     65   SUBROUTINE trc_dmp( kt, Kbb, Kmm, ptr, Krhs ) 
    6666      !!---------------------------------------------------------------------- 
    6767      !!                   ***  ROUTINE trc_dmp  *** 
    … …  
    7373      !! ** Method  :   Newtonian damping towards trdta computed  
    7474      !!      and add to the general tracer trends: 
    75       !!                     trn = tra + restotr * (trdta - trb) 
     75      !!                     tr(Kmm) = tr(Krhs) + restotr * (trdta - tr(Kbb)) 
    7676      !!         The trend is computed either throughout the water column 
    7777      !!      (nlmdmptr=0) or in area of weak vertical mixing (nlmdmptr=1) or 
    7878      !!      below the well mixed layer (nlmdmptr=2) 
    7979      !! 
    80       !! ** Action  : - update the tracer trends tra with the newtonian  
     80      !! ** Action  : - update the tracer trends tr(:,:,:,:,Krhs) with the newtonian  
    8181      !!                damping trends. 
    8282      !!              - save the trends ('key_trdmxl_trc') 
    8383      !!---------------------------------------------------------------------- 
    84       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     84      INTEGER,                                    INTENT(in   ) :: kt              ! ocean time-step index 
     85      INTEGER,                                    INTENT(in   ) :: Kbb, Kmm, Krhs  ! time level indices 
     86      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr             ! passive tracers and RHS of tracer equation 
    8587      ! 
    8688      INTEGER ::   ji, jj, jk, jn, jl   ! dummy loop indices 
    … …  
    100102         DO jn = 1, jptra                                           ! tracer loop 
    101103            !                                                       ! =========== 
    102             IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)    ! save trends  
     104            IF( l_trdtrc ) ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs)    ! save trends  
    103105            ! 
    104106            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
    105107               ! 
    106108               jl = n_trc_index(jn)  
    107                CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000 
     109               CALL trc_dta( kt, Kmm, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000 
    108110               ! 
    109111               SELECT CASE ( nn_zdmp_tr ) 
    110112               ! 
    111113               CASE( 0 )                !==  newtonian damping throughout the water column  ==! 
    112                   DO jk = 1, jpkm1 
    113                      DO jj = 2, jpjm1 
    114                         DO ji = fs_2, fs_jpim1   ! vector opt. 
    115                            tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    116                         END DO 
    117                      END DO 
    118                   END DO 
     114                  DO_3D_00_00( 1, jpkm1 ) 
     115                     ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) ) 
     116                  END_3D 
    119117                  ! 
    120118               CASE ( 1 )                !==  no damping in the turbocline (avt > 5 cm2/s)  ==! 
    121                   DO jk = 1, jpkm1 
    122                      DO jj = 2, jpjm1 
    123                         DO ji = fs_2, fs_jpim1   ! vector opt. 
    124                            IF( avt(ji,jj,jk) <= avt_c )  THEN  
    125                               tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    126                            ENDIF 
    127                         END DO 
    128                      END DO 
    129                   END DO 
     119                  DO_3D_00_00( 1, jpkm1 ) 
     120                     IF( avt(ji,jj,jk) <= avt_c )  THEN  
     121                        ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) ) 
     122                     ENDIF 
     123                  END_3D 
    130124                  ! 
    131125               CASE ( 2 )               !==  no damping in the mixed layer   ==!  
    132                   DO jk = 1, jpkm1 
    133                      DO jj = 2, jpjm1 
    134                         DO ji = fs_2, fs_jpim1   ! vector opt. 
    135                            IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN 
    136                               tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    137                            END IF 
    138                         END DO 
    139                      END DO 
    140                   END DO 
     126                  DO_3D_00_00( 1, jpkm1 ) 
     127                     IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 
     128                        ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) ) 
     129                     END IF 
     130                  END_3D 
    141131                  !   
    142132               END SELECT 
    … …  
    145135            ! 
    146136            IF( l_trdtrc ) THEN 
    147                ztrtrd(:,:,:) = tra(:,:,:,jn) -  ztrtrd(:,:,:) 
    148                CALL trd_tra( kt, 'TRC', jn, jptra_dmp, ztrtrd ) 
     137               ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) -  ztrtrd(:,:,:) 
     138               CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_dmp, ztrtrd ) 
    149139            END IF 
    150140            !                                                       ! =========== 
    … …  
    156146      IF( l_trdtrc )  DEALLOCATE( ztrtrd ) 
    157147      !                                          ! print mean trends (used for debugging) 
    158       IF( ln_ctl ) THEN 
     148      IF( sn_cfctl%l_prttrc ) THEN 
    159149         WRITE(charout, FMT="('dmp ')") 
    160150         CALL prt_ctl_trc_info(charout) 
    161          CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     151         CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    162152      ENDIF 
    163153      ! 
    … …  
    181171      !!---------------------------------------------------------------------- 
    182172      ! 
    183       REWIND( numnat_ref )              ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping 
    184173      READ  ( numnat_ref, namtrc_dmp, IOSTAT = ios, ERR = 909) 
    185174909   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_dmp in reference namelist' ) 
    186       REWIND( numnat_cfg )              ! Namelist namtrc_dmp in configuration namelist : Passive tracers newtonian damping 
    187175      READ  ( numnat_cfg, namtrc_dmp, IOSTAT = ios, ERR = 910) 
    188176910   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_dmp in configuration namelist' ) 
    … …  
    224212 
    225213 
    226    SUBROUTINE trc_dmp_clo( kt ) 
     214   SUBROUTINE trc_dmp_clo( kt, Kbb, Kmm ) 
    227215      !!--------------------------------------------------------------------- 
    228216      !!                  ***  ROUTINE trc_dmp_clo  *** 
    … …  
    236224      !!                nctsi2(), nctsj2() : north-east Closed sea limits (i,j) 
    237225      !!---------------------------------------------------------------------- 
    238       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     226      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index 
     227      INTEGER, INTENT( in ) ::   Kbb, Kmm     ! time level indices 
    239228      ! 
    240229      INTEGER :: ji , jj, jk, jn, jl, jc                    ! dummy loop indicesa 
    … …  
    354343            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
    355344                jl = n_trc_index(jn) 
    356                 CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000 
     345                CALL trc_dta( kt, Kmm, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000 
    357346                DO jc = 1, npncts 
    358347                   DO jk = 1, jpkm1 
    359348                      DO jj = nctsj1(jc), nctsj2(jc) 
    360349                         DO ji = nctsi1(jc), nctsi2(jc) 
    361                             trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk) 
    362                             trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 
     350                            tr(ji,jj,jk,jn,Kmm) = ztrcdta(ji,jj,jk) 
     351                            tr(ji,jj,jk,jn,Kbb) = tr(ji,jj,jk,jn,Kmm) 
    363352                         END DO 
    364353                      END DO 

  • NEMO/trunk/src/TOP/TRP/trcldf.F90

    r11536 r12377  
    4343    
    4444   !! * Substitutions 
    45 #  include "vectopt_loop_substitute.h90" 
     45#  include "do_loop_substitute.h90" 
    4646   !!---------------------------------------------------------------------- 
    4747   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    5151CONTAINS 
    5252 
    53    SUBROUTINE trc_ldf( kt ) 
     53   SUBROUTINE trc_ldf( kt, Kbb, Kmm, ptr, Krhs ) 
    5454      !!---------------------------------------------------------------------- 
    5555      !!                  ***  ROUTINE tra_ldf  *** 
    … …  
    5858      !! 
    5959      !!---------------------------------------------------------------------- 
    60       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     60      INTEGER,                                    INTENT(in   ) :: kt              ! ocean time-step index 
     61      INTEGER,                                    INTENT(in   ) :: Kbb, Kmm, Krhs  ! ocean time-level index 
     62      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr             ! passive tracers and RHS of tracer equation 
    6163      ! 
    6264      INTEGER            :: ji, jj, jk, jn 
    6365      REAL(wp)           :: zdep 
    6466      CHARACTER (len=22) :: charout 
    65       REAL(wp), DIMENSION(jpi,jpj,jpk)  ::   zahu, zahv 
    66       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd 
     67      REAL(wp),          DIMENSION(jpi,jpj,jpk) ::   zahu, zahv 
     68      REAL(wp), POINTER, DIMENSION(:,:,:,:)     ::   ztrtrd 
    6769      !!---------------------------------------------------------------------- 
    6870      ! 
    … …  
    7375      IF( l_trdtrc )  THEN 
    7476         ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) ) 
    75          ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
     77         ztrtrd(:,:,:,:)  = ptr(:,:,:,:,Krhs) 
    7678      ENDIF 
    7779      !                                  !* set the lateral diffusivity coef. for passive tracer       
    … …  
    7981      zahv(:,:,:) = rldf * ahtv(:,:,:) 
    8082      !                                  !* Enhanced zonal diffusivity coefficent in the equatorial domain 
    81       DO jk= 1, jpk 
    82          DO jj = 1, jpj 
    83             DO ji = 1, jpi 
    84                IF( gdept_n(ji,jj,jk) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN 
    85                   zdep = MAX( gdept_n(ji,jj,jk) - 1000., 0. ) / 1000. 
    86                   zahu(ji,jj,jk) = zahu(ji,jj,jk) * MAX( 1., rn_fact_lap * EXP( -zdep ) ) 
    87                ENDIF 
    88             END DO 
    89          END DO 
    90       END DO 
     83      DO_3D_11_11( 1, jpk ) 
     84         IF( gdept(ji,jj,jk,Kmm) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN 
     85            zdep = MAX( gdept(ji,jj,jk,Kmm) - 1000., 0. ) / 1000. 
     86            zahu(ji,jj,jk) = zahu(ji,jj,jk) * MAX( 1., rn_fact_lap * EXP( -zdep ) ) 
     87         ENDIF 
     88      END_3D 
    9189      ! 
    9290      SELECT CASE ( nldf_trc )                 !* compute lateral mixing trend and add it to the general trend 
    9391      ! 
    94       CASE ( np_lap   )                               ! iso-level laplacian 
    95          CALL tra_ldf_lap  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb,      tra, jptra,    1     ) 
    96       CASE ( np_lap_i )                               ! laplacian : standard iso-neutral operator (Madec) 
    97          CALL tra_ldf_iso  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra,    1     ) 
    98       CASE ( np_lap_it )                              ! laplacian : triad iso-neutral operator (griffies) 
    99          CALL tra_ldf_triad( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra,    1     ) 
    100       CASE ( np_blp , np_blp_i , np_blp_it )          ! bilaplacian: all operator (iso-level, -neutral) 
    101          CALL tra_ldf_blp  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb     , tra, jptra, nldf_trc ) 
     92      CASE ( np_lap   )                                                                                    ! iso-level laplacian 
     93         CALL tra_ldf_lap  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            & 
     94           &                     ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs),                   jptra, 1 ) 
     95      CASE ( np_lap_i )                                                                                    ! laplacian : standard iso-neutral operator (Madec) 
     96         CALL tra_ldf_iso  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            & 
     97           &                     ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 ) 
     98      CASE ( np_lap_it )                                                                                   ! laplacian : triad iso-neutral operator (griffies) 
     99         CALL tra_ldf_triad( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            & 
     100           &                     ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 ) 
     101      CASE ( np_blp , np_blp_i , np_blp_it )                                                               ! bilaplacian: all operator (iso-level, -neutral) 
     102         CALL tra_ldf_blp  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            & 
     103           &                     ptr(:,:,:,:,Kbb) , ptr(:,:,:,:,Krhs),                 jptra, nldf_trc ) 
    102104      END SELECT 
    103105      ! 
    104106      IF( l_trdtrc )   THEN                    ! send the trends for further diagnostics 
    105107        DO jn = 1, jptra 
    106            ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 
    107            CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) ) 
     108           ztrtrd(:,:,:,jn) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:,jn) 
     109           CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) ) 
    108110        END DO 
    109111        DEALLOCATE( ztrtrd ) 
    110112      ENDIF 
    111113      !                 
    112       IF( ln_ctl ) THEN                        ! print mean trends (used for debugging) 
     114      IF( sn_cfctl%l_prttrc ) THEN ! print mean trends (used for debugging) 
    113115         WRITE(charout, FMT="('ldf ')") 
    114116         CALL prt_ctl_trc_info(charout) 
    115          CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     117         CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    116118      ENDIF 
    117119      ! 
    … …  
    143145      ENDIF 
    144146      ! 
    145       REWIND( numnat_ref )             !  namtrc_ldf in reference namelist  
    146147      READ  ( numnat_ref, namtrc_ldf, IOSTAT = ios, ERR = 903) 
    147148903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_ldf in reference namelist' ) 
    148149      ! 
    149       REWIND( numnat_cfg )             !  namtrc_ldf in configuration namelist  
    150150      READ  ( numnat_cfg, namtrc_ldf, IOSTAT = ios, ERR = 904 ) 
    151151904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist' ) 
    … …  
    167167      IF( ln_trcldf_OFF  ) THEN   ;   nldf_trc = np_no_ldf   ;   ioptio = ioptio + 1   ;   ENDIF 
    168168      IF( ln_trcldf_tra  ) THEN   ;   nldf_trc = nldf_tra    ;   ioptio = ioptio + 1   ;   ENDIF 
    169       IF( ioptio /=  1   )   CALL ctl_stop( 'trc_ldf_ini: use ONE of the 2 operator options (NONE/tra)' ) 
     169      IF( ioptio /=  1   )   CALL ctl_stop( 'trc_ldf_ini: use ONE of the 2 operator options (OFF/tra)' ) 
    170170       
    171171      !                                ! multiplier : passive/active tracers ration 

  • NEMO/trunk/src/TOP/TRP/trcrad.F90

    r11536 r12377  
    66   !! History :   -   !  01-01  (O. Aumont & E. Kestenare)  Original code 
    77   !!            1.0  !  04-03  (C. Ethe)  free form F90 
     8   !!            4.1  !  08-19  (A. Coward, D. Storkey) tidy up using new time-level indices 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_top 
    … …  
    3031   REAL(wp), DIMENSION(:,:), ALLOCATABLE::   gainmass 
    3132 
     33   !! * Substitutions 
     34#  include "do_loop_substitute.h90" 
    3235   !!---------------------------------------------------------------------- 
    3336   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    3740CONTAINS 
    3841 
    39    SUBROUTINE trc_rad( kt ) 
     42   SUBROUTINE trc_rad( kt, Kbb, Kmm, ptr ) 
    4043      !!---------------------------------------------------------------------- 
    4144      !!                  ***  ROUTINE trc_rad  *** 
    … …  
    5255      !!                (the total CFC content is not strictly preserved) 
    5356      !!---------------------------------------------------------------------- 
    54       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     57      INTEGER,                                    INTENT(in   ) :: kt         ! ocean time-step index 
     58      INTEGER,                                    INTENT(in   ) :: Kbb, Kmm   ! time level indices 
     59      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr        ! passive tracers and RHS of tracer equation 
    5560      ! 
    5661      CHARACTER (len=22) :: charout 
    … …  
    5964      IF( ln_timing )   CALL timing_start('trc_rad') 
    6065      ! 
    61       IF( ln_age     )   CALL trc_rad_sms( kt, trb, trn, jp_age , jp_age                )  !  AGE 
    62       IF( ll_cfc     )   CALL trc_rad_sms( kt, trb, trn, jp_cfc0, jp_cfc1               )  !  CFC model 
    63       IF( ln_c14     )   CALL trc_rad_sms( kt, trb, trn, jp_c14 , jp_c14                )  !  C14 
    64       IF( ln_pisces  )   CALL trc_rad_sms( kt, trb, trn, jp_pcs0, jp_pcs1, cpreserv='Y' )  !  PISCES model 
    65       IF( ln_my_trc  )   CALL trc_rad_sms( kt, trb, trn, jp_myt0, jp_myt1               )  !  MY_TRC model 
    66       ! 
    67       IF(ln_ctl) THEN      ! print mean trends (used for debugging) 
     66      IF( ln_age     )   CALL trc_rad_sms( kt, Kbb, Kmm, ptr, jp_age , jp_age                )  !  AGE 
     67      IF( ll_cfc     )   CALL trc_rad_sms( kt, Kbb, Kmm, ptr, jp_cfc0, jp_cfc1               )  !  CFC model 
     68      IF( ln_c14     )   CALL trc_rad_sms( kt, Kbb, Kmm, ptr, jp_c14 , jp_c14                )  !  C14 
     69      IF( ln_pisces  )   CALL trc_rad_sms( kt, Kbb, Kmm, ptr, jp_pcs0, jp_pcs1, cpreserv='Y' )  !  PISCES model 
     70      IF( ln_my_trc  )   CALL trc_rad_sms( kt, Kbb, Kmm, ptr, jp_myt0, jp_myt1               )  !  MY_TRC model 
     71      ! 
     72      IF(sn_cfctl%l_prttrc) THEN      ! print mean trends (used for debugging) 
    6873         WRITE(charout, FMT="('rad')") 
    6974         CALL prt_ctl_trc_info( charout ) 
    70          CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
     75         CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Kbb), mask=tmask, clinfo=ctrcnm ) 
    7176      ENDIF 
    7277      ! 
    … …  
    8792      !!---------------------------------------------------------------------- 
    8893      ! 
    89       REWIND( numnat_ref )              ! namtrc_rad in reference namelist  
    9094      READ  ( numnat_ref, namtrc_rad, IOSTAT = ios, ERR = 907) 
    9195907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_rad in reference namelist' ) 
    92       REWIND( numnat_cfg )              ! namtrc_rad in configuration namelist  
    9396      READ  ( numnat_cfg, namtrc_rad, IOSTAT = ios, ERR = 908 ) 
    9497908   IF( ios > 0 )   CALL ctl_nam ( ios , 'namtrc_rad in configuration namelist' ) 
    … …  
    113116 
    114117 
    115    SUBROUTINE trc_rad_sms( kt, ptrb, ptrn, jp_sms0, jp_sms1, cpreserv ) 
    116       !!----------------------------------------------------------------------------- 
    117       !!                  ***  ROUTINE trc_rad_sms  *** 
    118       !! 
    119       !! ** Purpose :   "crappy" routine to correct artificial negative 
    120       !!              concentrations due to isopycnal scheme 
    121       !! 
    122       !! ** Method  : 2 cases : 
    123       !!                - Set negative concentrations to zero while computing 
    124       !!                  the corresponding tracer content that is added to the 
    125       !!                  tracers. Then, adjust the tracer concentration using 
    126       !!                  a multiplicative factor so that the total tracer  
    127       !!                  concentration is preserved. 
    128       !!                - simply set to zero the negative CFC concentration 
    129       !!                  (the total content of concentration is not strictly preserved) 
    130       !!-------------------------------------------------------------------------------- 
    131       INTEGER                                , INTENT(in   ) ::   kt                 ! ocean time-step index 
    132       INTEGER                                , INTENT(in   ) ::   jp_sms0, jp_sms1   ! First & last index of the passive tracer model 
    133       REAL(wp), DIMENSION (jpi,jpj,jpk,jptra), INTENT(inout) ::   ptrb    , ptrn     ! before and now traceur concentration 
    134       CHARACTER( len = 1), OPTIONAL          , INTENT(in   ) ::   cpreserv           ! flag to preserve content or not 
    135       ! 
    136       INTEGER ::   ji, ji2, jj, jj2, jk, jn     ! dummy loop indices 
    137       INTEGER ::   icnt 
    138       LOGICAL ::   lldebug = .FALSE.            ! local logical 
    139       REAL(wp)::   zcoef, zs2rdt, ztotmass 
    140       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrneg, ztrpos 
    141       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrtrd   ! workspace arrays 
    142       !!---------------------------------------------------------------------- 
    143       ! 
    144       IF( l_trdtrc )   ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 
    145       zs2rdt = 1. / ( 2. * rdt * REAL( nn_dttrc, wp ) ) 
    146       ! 
    147       IF( PRESENT( cpreserv )  ) THEN     !==  total tracer concentration is preserved  ==! 
    148          ! 
    149          ALLOCATE( ztrneg(1:jpi,1:jpj,jp_sms0:jp_sms1), ztrpos(1:jpi,1:jpj,jp_sms0:jp_sms1) ) 
    150  
    151          DO jn = jp_sms0, jp_sms1 
    152             ztrneg(:,:,jn) = SUM( MIN( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:), dim = 3 )   ! sum of the negative values 
    153             ztrpos(:,:,jn) = SUM( MAX( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:), dim = 3 )   ! sum of the positive values 
    154          END DO 
    155          CALL sum3x3( ztrneg ) 
    156          CALL sum3x3( ztrpos ) 
    157           
    158          DO jn = jp_sms0, jp_sms1 
    159             ! 
    160             IF( l_trdtrc )   ztrtrd(:,:,:) = ptrb(:,:,:,jn)                            ! save input trb for trend computation            
    161             ! 
    162             DO jk = 1, jpkm1 
    163                DO jj = 1, jpj 
    164                   DO ji = 1, jpi 
    165                      IF( ztrneg(ji,jj,jn) /= 0. ) THEN                                 ! if negative values over the 3x3 box 
    166                         ! 
    167                         ptrb(ji,jj,jk,jn) = ptrb(ji,jj,jk,jn) * tmask(ji,jj,jk)   ! really needed? 
    168                         IF( ptrb(ji,jj,jk,jn) < 0. ) ptrb(ji,jj,jk,jn) = 0.       ! supress negative values 
    169                         IF( ptrb(ji,jj,jk,jn) > 0. ) THEN                         ! use positive values to compensate mass gain 
    170                            zcoef = 1. + ztrneg(ji,jj,jn) / ztrpos(ji,jj,jn)       ! ztrpos > 0 as ptrb > 0 
    171                            ptrb(ji,jj,jk,jn) = ptrb(ji,jj,jk,jn) * zcoef 
    172                            IF( zcoef < 0. ) THEN                                  ! if the compensation exceed the positive value 
    173                               gainmass(jn,1) = gainmass(jn,1) - ptrb(ji,jj,jk,jn) * cvol(ji,jj,jk)   ! we are adding mass... 
    174                               ptrb(ji,jj,jk,jn) = 0.                              ! limit the compensation to keep positive value 
    175                            ENDIF 
    176                         ENDIF 
    177                         ! 
    178                      ENDIF 
    179                   END DO 
    180                END DO 
    181             END DO 
    182             ! 
    183             IF( l_trdtrc ) THEN 
    184                ztrtrd(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrd(:,:,:) ) * zs2rdt 
    185                CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrd )       ! Asselin-like trend handling 
    186             ENDIF 
    187             ! 
    188          END DO 
    189   
    190          IF( kt == nitend ) THEN 
    191             CALL mpp_sum( 'trcrad', gainmass(:,1) ) 
    192             DO jn = jp_sms0, jp_sms1 
    193                IF( gainmass(jn,1) > 0. ) THEN 
    194                   ztotmass = glob_sum( 'trcrad', ptrb(:,:,:,jn) * cvol(:,:,:) ) 
    195                   IF(lwp) WRITE(numout, '(a, i2, a, D23.16, a, D23.16)') 'trcrad ptrb, traceur ', jn  & 
    196                      &        , ' total mass : ', ztotmass, ', mass gain : ',  gainmass(jn,1) 
    197                END IF 
    198             END DO 
    199          ENDIF 
    200  
    201          DO jn = jp_sms0, jp_sms1 
    202             ztrneg(:,:,jn) = SUM( MIN( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:), dim = 3 )   ! sum of the negative values 
    203             ztrpos(:,:,jn) = SUM( MAX( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:), dim = 3 )   ! sum of the positive values 
    204          END DO 
    205          CALL sum3x3( ztrneg ) 
    206          CALL sum3x3( ztrpos ) 
    207           
    208          DO jn = jp_sms0, jp_sms1 
    209             ! 
    210             IF( l_trdtrc )   ztrtrd(:,:,:) = ptrn(:,:,:,jn)                            ! save input trb for trend computation 
    211             ! 
    212             DO jk = 1, jpkm1 
    213                DO jj = 1, jpj 
    214                   DO ji = 1, jpi 
    215                      IF( ztrneg(ji,jj,jn) /= 0. ) THEN                                 ! if negative values over the 3x3 box 
    216                         ! 
    217                         ptrn(ji,jj,jk,jn) = ptrn(ji,jj,jk,jn) * tmask(ji,jj,jk)   ! really needed? 
    218                         IF( ptrn(ji,jj,jk,jn) < 0. ) ptrn(ji,jj,jk,jn) = 0.       ! supress negative values 
    219                         IF( ptrn(ji,jj,jk,jn) > 0. ) THEN                         ! use positive values to compensate mass gain 
    220                            zcoef = 1. + ztrneg(ji,jj,jn) / ztrpos(ji,jj,jn)       ! ztrpos > 0 as ptrb > 0 
    221                            ptrn(ji,jj,jk,jn) = ptrn(ji,jj,jk,jn) * zcoef 
    222                            IF( zcoef < 0. ) THEN                                  ! if the compensation exceed the positive value 
    223                               gainmass(jn,2) = gainmass(jn,2) - ptrn(ji,jj,jk,jn) * cvol(ji,jj,jk)   ! we are adding mass... 
    224                               ptrn(ji,jj,jk,jn) = 0.                              ! limit the compensation to keep positive value 
    225                            ENDIF 
    226                         ENDIF 
    227                         ! 
    228                      ENDIF 
    229                   END DO 
    230                END DO 
    231             END DO 
    232             ! 
    233             IF( l_trdtrc ) THEN 
    234                ztrtrd(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrd(:,:,:) ) * zs2rdt 
    235                CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrd )       ! standard     trend handling 
    236             ENDIF 
    237             ! 
    238          END DO 
    239   
    240          IF( kt == nitend ) THEN 
    241             CALL mpp_sum( 'trcrad', gainmass(:,2) ) 
    242             DO jn = jp_sms0, jp_sms1 
    243                IF( gainmass(jn,2) > 0. ) THEN 
    244                   ztotmass = glob_sum( 'trcrad', ptrn(:,:,:,jn) * cvol(:,:,:) ) 
    245                   WRITE(numout, '(a, i2, a, D23.16, a, D23.16)') 'trcrad ptrn, traceur ', jn  & 
    246                      &        , ' total mass : ', ztotmass, ', mass gain : ',  gainmass(jn,1) 
    247                END IF 
    248             END DO 
    249          ENDIF 
    250  
    251          DEALLOCATE( ztrneg, ztrpos ) 
    252          ! 
    253       ELSE                                !==  total CFC content is NOT strictly preserved  ==! 
    254          ! 
    255          DO jn = jp_sms0, jp_sms1   
    256             ! 
    257             IF( l_trdtrc )   ztrtrd(:,:,:) = ptrb(:,:,:,jn)                        ! save input trb for trend computation 
    258             ! 
    259             WHERE( ptrb(:,:,:,jn) < 0. )   ptrb(:,:,:,jn) = 0. 
    260             ! 
    261             IF( l_trdtrc ) THEN 
    262                ztrtrd(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrd(:,:,:) ) * zs2rdt 
    263                CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrd )       ! Asselin-like trend handling 
    264             ENDIF 
    265             ! 
    266             IF( l_trdtrc )   ztrtrd(:,:,:) = ptrn(:,:,:,jn)                        ! save input trn for trend computation 
    267             ! 
    268             WHERE( ptrn(:,:,:,jn) < 0. )   ptrn(:,:,:,jn) = 0. 
    269             ! 
    270             IF( l_trdtrc ) THEN 
    271                ztrtrd(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrd(:,:,:) ) * zs2rdt 
    272                CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrd )       ! standard     trend handling 
    273             ENDIF 
    274             ! 
    275          END DO 
    276          ! 
    277       ENDIF 
     118   SUBROUTINE trc_rad_sms( kt, Kbb, Kmm, ptr, jp_sms0, jp_sms1, cpreserv ) 
     119     !!----------------------------------------------------------------------------- 
     120     !!                  ***  ROUTINE trc_rad_sms  *** 
     121     !! 
     122     !! ** Purpose :   "crappy" routine to correct artificial negative 
     123     !!              concentrations due to isopycnal scheme 
     124     !! 
     125     !! ** Method  : 2 cases : 
     126     !!                - Set negative concentrations to zero while computing 
     127     !!                  the corresponding tracer content that is added to the 
     128     !!                  tracers. Then, adjust the tracer concentration using 
     129     !!                  a multiplicative factor so that the total tracer  
     130     !!                  concentration is preserved. 
     131     !!                - simply set to zero the negative CFC concentration 
     132     !!                  (the total content of concentration is not strictly preserved) 
     133     !!-------------------------------------------------------------------------------- 
     134     INTEGER                                    , INTENT(in   ) ::   kt                 ! ocean time-step index 
     135     INTEGER                                    , INTENT(in   ) ::   Kbb, Kmm           ! time level indices 
     136     INTEGER                                    , INTENT(in   ) ::   jp_sms0, jp_sms1   ! First & last index of the passive tracer model 
     137     REAL(wp), DIMENSION (jpi,jpj,jpk,jptra,jpt), INTENT(inout) ::   ptr                ! before and now traceur concentration 
     138     CHARACTER( len = 1), OPTIONAL              , INTENT(in   ) ::   cpreserv           ! flag to preserve content or not 
     139     ! 
     140     INTEGER ::   ji, ji2, jj, jj2, jk, jn, jt ! dummy loop indices 
     141     INTEGER ::   icnt, itime 
     142     LOGICAL ::   lldebug = .FALSE.            ! local logical 
     143     REAL(wp)::   zcoef, zs2rdt, ztotmass 
     144     REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrneg, ztrpos 
     145     REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrtrd   ! workspace arrays 
     146     !!---------------------------------------------------------------------- 
     147     ! 
     148     IF( l_trdtrc )   ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 
     149     zs2rdt = 1. / ( 2. * rdt ) 
     150     ! 
     151     DO jt = 1,2  ! Loop over time indices since exactly the same fix is applied to "now" and "after" fields 
     152        IF( jt == 1 ) itime = Kbb 
     153        IF( jt == 2 ) itime = Kmm 
     154 
     155        IF( PRESENT( cpreserv )  ) THEN     !==  total tracer concentration is preserved  ==! 
     156           ! 
     157           ALLOCATE( ztrneg(1:jpi,1:jpj,jp_sms0:jp_sms1), ztrpos(1:jpi,1:jpj,jp_sms0:jp_sms1) ) 
     158 
     159           DO jn = jp_sms0, jp_sms1 
     160              ztrneg(:,:,jn) = SUM( MIN( 0., ptr(:,:,:,jn,itime) ) * cvol(:,:,:), dim = 3 )   ! sum of the negative values 
     161              ztrpos(:,:,jn) = SUM( MAX( 0., ptr(:,:,:,jn,itime) ) * cvol(:,:,:), dim = 3 )   ! sum of the positive values 
     162           END DO 
     163           CALL sum3x3( ztrneg ) 
     164           CALL sum3x3( ztrpos ) 
     165 
     166           DO jn = jp_sms0, jp_sms1 
     167              ! 
     168              IF( l_trdtrc )   ztrtrd(:,:,:) = ptr(:,:,:,jn,itime)                       ! save input tr(:,:,:,:,Kbb) for trend computation            
     169              ! 
     170              DO_3D_11_11( 1, jpkm1 ) 
     171                 IF( ztrneg(ji,jj,jn) /= 0. ) THEN                                 ! if negative values over the 3x3 box 
     172                    ! 
     173                    ptr(ji,jj,jk,jn,itime) = ptr(ji,jj,jk,jn,itime) * tmask(ji,jj,jk)   ! really needed? 
     174                    IF( ptr(ji,jj,jk,jn,itime) < 0. ) ptr(ji,jj,jk,jn,itime) = 0.       ! suppress negative values 
     175                    IF( ptr(ji,jj,jk,jn,itime) > 0. ) THEN                    ! use positive values to compensate mass gain 
     176                       zcoef = 1. + ztrneg(ji,jj,jn) / ztrpos(ji,jj,jn)       ! ztrpos > 0 as ptr > 0 
     177                       ptr(ji,jj,jk,jn,itime) = ptr(ji,jj,jk,jn,itime) * zcoef 
     178                       IF( zcoef < 0. ) THEN                                  ! if the compensation exceed the positive value 
     179                          gainmass(jn,1) = gainmass(jn,1) - ptr(ji,jj,jk,jn,itime) * cvol(ji,jj,jk)   ! we are adding mass... 
     180                          ptr(ji,jj,jk,jn,itime) = 0.                         ! limit the compensation to keep positive value 
     181                       ENDIF 
     182                    ENDIF 
     183                    ! 
     184                 ENDIF 
     185              END_3D 
     186              ! 
     187              IF( l_trdtrc ) THEN 
     188                 ztrtrd(:,:,:) = ( ptr(:,:,:,jn,itime) - ztrtrd(:,:,:) ) * zs2rdt 
     189                 CALL trd_tra( kt, Kbb, Kmm, 'TRC', jn, jptra_radb, ztrtrd )       ! Asselin-like trend handling 
     190              ENDIF 
     191              ! 
     192           END DO 
     193 
     194           IF( kt == nitend ) THEN 
     195              CALL mpp_sum( 'trcrad', gainmass(:,1) ) 
     196              DO jn = jp_sms0, jp_sms1 
     197                 IF( gainmass(jn,1) > 0. ) THEN 
     198                    ztotmass = glob_sum( 'trcrad', ptr(:,:,:,jn,itime) * cvol(:,:,:) ) 
     199                    IF(lwp) WRITE(numout, '(a, i2, a, D23.16, a, D23.16)') 'trcrad ptrb, traceur ', jn  & 
     200                         &        , ' total mass : ', ztotmass, ', mass gain : ',  gainmass(jn,1) 
     201                 END IF 
     202              END DO 
     203           ENDIF 
     204 
     205           DEALLOCATE( ztrneg, ztrpos ) 
     206           ! 
     207        ELSE                                !==  total CFC content is NOT strictly preserved  ==! 
     208           ! 
     209           DO jn = jp_sms0, jp_sms1   
     210              ! 
     211              IF( l_trdtrc )   ztrtrd(:,:,:) = ptr(:,:,:,jn,itime)                 ! save input tr for trend computation 
     212              ! 
     213              WHERE( ptr(:,:,:,jn,itime) < 0. )   ptr(:,:,:,jn,itime) = 0. 
     214              ! 
     215              IF( l_trdtrc ) THEN 
     216                 ztrtrd(:,:,:) = ( ptr(:,:,:,jn,itime) - ztrtrd(:,:,:) ) * zs2rdt 
     217                 CALL trd_tra( kt, Kbb, Kmm, 'TRC', jn, jptra_radb, ztrtrd )       ! Asselin-like trend handling 
     218              ENDIF 
     219              ! 
     220           END DO 
     221           ! 
     222        ENDIF 
     223        ! 
     224      END DO 
    278225      ! 
    279226      IF( l_trdtrc )  DEALLOCATE( ztrtrd ) 
    … …  
    286233   !!---------------------------------------------------------------------- 
    287234CONTAINS 
    288    SUBROUTINE trc_rad( kt )              ! Empty routine 
     235   SUBROUTINE trc_rad( kt, Kbb, Kmm )              ! Empty routine 
    289236      INTEGER, INTENT(in) ::   kt 
     237      INTEGER, INTENT(in) ::   Kbb, Kmm  ! time level indices 
    290238      WRITE(*,*) 'trc_rad: You should not have seen this print! error?', kt 
    291239   END SUBROUTINE trc_rad 

  • NEMO/trunk/src/TOP/TRP/trcsbc.F90

    r10788 r12377  
    2929 
    3030   !! * Substitutions 
    31 #  include "vectopt_loop_substitute.h90" 
     31#  include "do_loop_substitute.h90" 
    3232   !!---------------------------------------------------------------------- 
    3333   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    3737CONTAINS 
    3838 
    39    SUBROUTINE trc_sbc ( kt ) 
     39   SUBROUTINE trc_sbc ( kt, Kmm, ptr, Krhs ) 
    4040      !!---------------------------------------------------------------------- 
    4141      !!                  ***  ROUTINE trc_sbc  *** 
    … …  
    4949      !!            The surface freshwater flux modify the ocean volume 
    5050      !!         and thus the concentration of a tracer as : 
    51       !!            tra = tra + emp * trn / e3t   for k=1 
     51      !!            tr(Krhs) = tr(Krhs) + emp * tr(Kmm) / e3t   for k=1 
    5252      !!         where emp, the surface freshwater budget (evaporation minus 
    5353      !!         precipitation ) given in kg/m2/s is divided 
    5454      !!         by 1035 kg/m3 (density of ocean water) to obtain m/s. 
    5555      !! 
    56       !! ** Action  : - Update the 1st level of tra with the trend associated 
     56      !! ** Action  : - Update the 1st level of tr(:,:,:,:,Krhs) with the trend associated 
    5757      !!                with the tracer surface boundary condition  
    5858      !! 
    5959      !!---------------------------------------------------------------------- 
    60       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     60      INTEGER,                                    INTENT(in   ) :: kt        ! ocean time-step index 
     61      INTEGER,                                    INTENT(in   ) :: Kmm, Krhs ! time level indices 
     62      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr       ! passive tracers and RHS of tracer equation 
    6163      ! 
    6264      INTEGER  ::   ji, jj, jn                      ! dummy loop indices 
    … …  
    8284         IF( ln_rsttr .AND. .NOT.ln_top_euler .AND.   &                     ! Restart: read in restart  file 
    8385            iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN 
    84             IF(lwp) WRITE(numout,*) '          nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file' 
     86            IF(lwp) WRITE(numout,*) '          nittrc000-1 surface tracer content forcing fields read in the restart file' 
    8587            zfact = 0.5_wp 
    8688            DO jn = 1, jptra 
    … …  
    102104      ENDIF 
    103105 
    104       ! Coupling online : river runoff is added to the horizontal divergence (hdivn) in the subroutine sbc_rnf_div  
     106      ! Coupling online : river runoff is added to the horizontal divergence (hdiv) in the subroutine sbc_rnf_div  
    105107      ! one only consider the concentration/dilution effect due to evaporation minus precipitation + freezing/melting of sea-ice 
    106108      ! Coupling offline : runoff are in emp which contains E-P-R 
    … …  
    118120         ! 
    119121         DO jn = 1, jptra 
    120             DO jj = 2, jpj 
    121                DO ji = fs_2, fs_jpim1   ! vector opt. 
    122                   sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rau0 * trn(ji,jj,1,jn) 
    123                END DO 
    124             END DO 
     122            DO_2D_01_00 
     123               sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rau0 * ptr(ji,jj,1,jn,Kmm) 
     124            END_2D 
    125125         END DO 
    126126         ! 
    … …  
    128128         ! 
    129129         DO jn = 1, jptra 
    130             DO jj = 2, jpj 
    131                DO ji = fs_2, fs_jpim1   ! vector opt. 
    132                   sbc_trc(ji,jj,jn) = ( zsfx(ji,jj) + fmmflx(ji,jj) ) * r1_rau0 * trn(ji,jj,1,jn) 
    133                END DO 
    134             END DO 
     130            DO_2D_01_00 
     131               sbc_trc(ji,jj,jn) = ( zsfx(ji,jj) + fmmflx(ji,jj) ) * r1_rau0 * ptr(ji,jj,1,jn,Kmm) 
     132            END_2D 
    135133         END DO 
    136134         ! 
    … …  
    138136         ! 
    139137         DO jn = 1, jptra 
    140             DO jj = 2, jpj 
    141                DO ji = fs_2, fs_jpim1   ! vector opt. 
    142                   zse3t = 1. / e3t_n(ji,jj,1) 
    143                   ! tracer flux at the ice/ocean interface (tracer/m2/s) 
    144                   zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice 
    145                   !                                         ! only used in the levitating sea ice case 
    146                   ! tracer flux only       : add concentration dilution term in net tracer flux, no F-M in volume flux 
    147                   ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux 
    148                   ztfx  = zftra                        ! net tracer flux 
    149                   ! 
    150                   zdtra = r1_rau0 * ( ztfx + ( zsfx(ji,jj) + fmmflx(ji,jj) ) * trn(ji,jj,1,jn) )  
    151                   IF ( zdtra < 0. ) THEN 
    152                      zdtra  = MAX(zdtra, -trn(ji,jj,1,jn) * e3t_n(ji,jj,1) / r2dttrc )   ! avoid negative concentrations to arise 
    153                   ENDIF 
    154                   sbc_trc(ji,jj,jn) =  zdtra  
    155                END DO 
    156             END DO 
     138            DO_2D_01_00 
     139               zse3t = 1. / e3t(ji,jj,1,Kmm) 
     140               ! tracer flux at the ice/ocean interface (tracer/m2/s) 
     141               zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice 
     142               !                                         ! only used in the levitating sea ice case 
     143               ! tracer flux only       : add concentration dilution term in net tracer flux, no F-M in volume flux 
     144               ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux 
     145               ztfx  = zftra                        ! net tracer flux 
     146               ! 
     147               zdtra = r1_rau0 * ( ztfx + ( zsfx(ji,jj) + fmmflx(ji,jj) ) * ptr(ji,jj,1,jn,Kmm) )  
     148               IF ( zdtra < 0. ) THEN 
     149                  zdtra  = MAX(zdtra, -ptr(ji,jj,1,jn,Kmm) * e3t(ji,jj,1,Kmm) / r2dttrc )   ! avoid negative concentrations to arise 
     150               ENDIF 
     151               sbc_trc(ji,jj,jn) =  zdtra  
     152            END_2D 
    157153         END DO 
    158154      END SELECT 
    … …  
    162158      DO jn = 1, jptra 
    163159         ! 
    164          IF( l_trdtrc )   ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends 
    165          ! 
    166          DO jj = 2, jpj 
    167             DO ji = fs_2, fs_jpim1   ! vector opt. 
    168                zse3t = zfact / e3t_n(ji,jj,1) 
    169                tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t 
    170             END DO 
    171          END DO 
     160         IF( l_trdtrc )   ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs)  ! save trends 
     161         ! 
     162         DO_2D_01_00 
     163            zse3t = zfact / e3t(ji,jj,1,Kmm) 
     164            ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t 
     165         END_2D 
    172166         ! 
    173167         IF( l_trdtrc ) THEN 
    174             ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 
    175             CALL trd_tra( kt, 'TRC', jn, jptra_nsr, ztrtrd ) 
     168            ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:) 
     169            CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_nsr, ztrtrd ) 
    176170         END IF 
    177171         !                                                       ! =========== 
    … …  
    191185      ENDIF 
    192186      ! 
    193       IF( ln_ctl )   THEN 
     187      IF( sn_cfctl%l_prttrc )   THEN 
    194188         WRITE(charout, FMT="('sbc ')") ;  CALL prt_ctl_trc_info(charout) 
    195                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     189                                           CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    196190      ENDIF 
    197191      IF( l_trdtrc )  DEALLOCATE( ztrtrd ) 
    … …  
    205199   !!   Dummy module :                      NO passive tracer 
    206200   !!---------------------------------------------------------------------- 
     201   USE par_oce 
     202   USE par_trc 
    207203CONTAINS 
    208    SUBROUTINE trc_sbc (kt)              ! Empty routine 
    209       INTEGER, INTENT(in) :: kt 
     204   SUBROUTINE trc_sbc ( kt, Kmm, ptr, Krhs )      ! Empty routine 
     205      INTEGER,                                    INTENT(in   ) :: kt        ! ocean time-step index 
     206      INTEGER,                                    INTENT(in   ) :: Kmm, Krhs ! time level indices 
     207      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr       ! passive tracers and RHS of tracer equation 
    210208      WRITE(*,*) 'trc_sbc: You should not have seen this print! error?', kt 
    211209   END SUBROUTINE trc_sbc 

  • NEMO/trunk/src/TOP/TRP/trcsink.F90

    r11536 r12377  
    2424   INTEGER, PUBLIC :: nitermax      !: Maximum number of iterations for sinking 
    2525 
     26   !! * Substitutions 
     27#  include "do_loop_substitute.h90" 
    2628   !!---------------------------------------------------------------------- 
    2729   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    3537   !!---------------------------------------------------------------------- 
    3638 
    37    SUBROUTINE trc_sink ( kt, pwsink, psinkflx, jp_tra, rsfact ) 
     39   SUBROUTINE trc_sink ( kt, Kbb, Kmm, pwsink, psinkflx, jp_tra, rsfact ) 
    3840      !!--------------------------------------------------------------------- 
    3941      !!                     ***  ROUTINE trc_sink  *** 
    … …  
    4547      !!--------------------------------------------------------------------- 
    4648      INTEGER , INTENT(in)  :: kt 
     49      INTEGER , INTENT(in)  :: Kbb, Kmm 
    4750      INTEGER , INTENT(in)  :: jp_tra    ! tracer index index       
    4851      REAL(wp), INTENT(in)  :: rsfact    ! time step duration 
    … …  
    7073         iiter(:,:) = 1 
    7174      ELSE 
    72          DO jj = 1, jpj 
    73             DO ji = 1, jpi 
    74                iiter(ji,jj) = 1 
    75                DO jk = 1, jpkm1 
    76                   IF( tmask(ji,jj,jk) == 1.0 ) THEN 
    77                       zwsmax =  0.5 * e3t_n(ji,jj,jk) * rday / rsfact 
    78                       iiter(ji,jj) =  MAX( iiter(ji,jj), INT( pwsink(ji,jj,jk) / zwsmax ) ) 
    79                   ENDIF 
    80                END DO 
    81             END DO 
    82          END DO 
     75         DO_2D_11_11 
     76            iiter(ji,jj) = 1 
     77            DO jk = 1, jpkm1 
     78               IF( tmask(ji,jj,jk) == 1.0 ) THEN 
     79                   zwsmax =  0.5 * e3t(ji,jj,jk,Kmm) * rday / rsfact 
     80                   iiter(ji,jj) =  MAX( iiter(ji,jj), INT( pwsink(ji,jj,jk) / zwsmax ) ) 
     81               ENDIF 
     82            END DO 
     83         END_2D 
    8384         iiter(:,:) = MIN( iiter(:,:), nitermax ) 
    8485      ENDIF 
    8586 
    86       DO jk = 1,jpkm1 
    87          DO jj = 1, jpj 
    88             DO ji = 1, jpi 
    89                IF( tmask(ji,jj,jk) == 1.0 ) THEN 
    90                  zwsmax = 0.5 * e3t_n(ji,jj,jk) * rday / rsfact 
    91                  zwsink(ji,jj,jk) = MIN( pwsink(ji,jj,jk), zwsmax * REAL( iiter(ji,jj), wp ) ) 
    92                ELSE 
    93                  ! provide a default value so there is no use of undefinite value in trc_sink2 for zwsink2 initialization 
    94                  zwsink(ji,jj,jk) = 0. 
    95                ENDIF 
    96             END DO 
    97          END DO 
    98       END DO 
     87      DO_3D_11_11( 1,jpkm1 ) 
     88         IF( tmask(ji,jj,jk) == 1.0 ) THEN 
     89           zwsmax = 0.5 * e3t(ji,jj,jk,Kmm) * rday / rsfact 
     90           zwsink(ji,jj,jk) = MIN( pwsink(ji,jj,jk), zwsmax * REAL( iiter(ji,jj), wp ) ) 
     91         ELSE 
     92           ! provide a default value so there is no use of undefinite value in trc_sink2 for zwsink2 initialization 
     93           zwsink(ji,jj,jk) = 0. 
     94         ENDIF 
     95      END_3D 
    9996 
    10097      !  Initializa to zero all the sinking arrays  
    … …  
    104101      !   Compute the sedimentation term using trc_sink2 for the considered sinking particle 
    105102      !   ----------------------------------------------------- 
    106       CALL trc_sink2( zwsink, psinkflx, jp_tra, iiter, rsfact ) 
     103      CALL trc_sink2( Kbb, Kmm, zwsink, psinkflx, jp_tra, iiter, rsfact ) 
    107104      ! 
    108105      IF( ln_timing )   CALL timing_stop('trc_sink') 
    … …  
    110107   END SUBROUTINE trc_sink 
    111108 
    112    SUBROUTINE trc_sink2( pwsink, psinkflx, jp_tra, kiter, rsfact ) 
     109   SUBROUTINE trc_sink2( Kbb, Kmm, pwsink, psinkflx, jp_tra, kiter, rsfact ) 
    113110      !!--------------------------------------------------------------------- 
    114111      !!                     ***  ROUTINE trc_sink2  *** 
    … …  
    121118      !!      transport term, i.e.  div(u*tra). 
    122119      !!--------------------------------------------------------------------- 
     120      INTEGER,  INTENT(in   )                         ::   Kbb, Kmm  ! time level indices 
    123121      INTEGER,  INTENT(in   )                         ::   jp_tra    ! tracer index index       
    124122      REAL(wp), INTENT(in   )                         ::   rsfact    ! duration of time step 
    … …  
    136134      ztraz(:,:,:) = 0.e0 
    137135      zakz (:,:,:) = 0.e0 
    138       ztrb (:,:,:) = trb(:,:,:,jp_tra) 
     136      ztrb (:,:,:) = tr(:,:,:,jp_tra,Kbb) 
    139137 
    140138      DO jk = 1, jpkm1 
    … …  
    147145      DO jn = 1, 2 
    148146         !  first guess of the slopes interior values 
    149          DO jj = 1, jpj 
    150             DO ji = 1, jpi 
    151                ! 
    152                zstep = rsfact / REAL( kiter(ji,jj), wp ) / 2. 
    153                !               
    154                DO jk = 2, jpkm1 
    155                   ztraz(ji,jj,jk) = ( trb(ji,jj,jk-1,jp_tra) - trb(ji,jj,jk,jp_tra) ) * tmask(ji,jj,jk) 
    156                END DO 
    157                ztraz(ji,jj,1  ) = 0.0 
    158                ztraz(ji,jj,jpk) = 0.0 
    159  
    160                ! slopes 
    161                DO jk = 2, jpkm1 
    162                   zign = 0.25 + SIGN( 0.25, ztraz(ji,jj,jk) * ztraz(ji,jj,jk+1) ) 
    163                   zakz(ji,jj,jk) = ( ztraz(ji,jj,jk) + ztraz(ji,jj,jk+1) ) * zign 
    164                END DO 
    165           
    166                ! Slopes limitation 
    167                DO jk = 2, jpkm1 
    168                   zakz(ji,jj,jk) = SIGN( 1., zakz(ji,jj,jk) ) *        & 
    169                      &             MIN( ABS( zakz(ji,jj,jk) ), 2. * ABS(ztraz(ji,jj,jk+1)), 2. * ABS(ztraz(ji,jj,jk) ) ) 
    170                END DO 
    171           
    172                ! vertical advective flux 
    173                DO jk = 1, jpkm1 
    174                   zigma = zwsink2(ji,jj,jk+1) * zstep / e3w_n(ji,jj,jk+1) 
    175                   zew   = zwsink2(ji,jj,jk+1) 
    176                   psinkflx(ji,jj,jk+1) = -zew * ( trb(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep 
    177                END DO 
    178                ! 
    179                ! Boundary conditions 
    180                psinkflx(ji,jj,1  ) = 0.e0 
    181                psinkflx(ji,jj,jpk) = 0.e0 
    182           
    183                DO jk=1,jpkm1 
    184                   zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t_n(ji,jj,jk) 
    185                   trb(ji,jj,jk,jp_tra) = trb(ji,jj,jk,jp_tra) + zflx 
    186                END DO 
    187             END DO 
    188          END DO 
     147         DO_2D_11_11 
     148            ! 
     149            zstep = rsfact / REAL( kiter(ji,jj), wp ) / 2. 
     150            !               
     151            DO jk = 2, jpkm1 
     152               ztraz(ji,jj,jk) = ( tr(ji,jj,jk-1,jp_tra,Kbb) - tr(ji,jj,jk,jp_tra,Kbb) ) * tmask(ji,jj,jk) 
     153            END DO 
     154            ztraz(ji,jj,1  ) = 0.0 
     155            ztraz(ji,jj,jpk) = 0.0 
     156 
     157            ! slopes 
     158            DO jk = 2, jpkm1 
     159               zign = 0.25 + SIGN( 0.25, ztraz(ji,jj,jk) * ztraz(ji,jj,jk+1) ) 
     160               zakz(ji,jj,jk) = ( ztraz(ji,jj,jk) + ztraz(ji,jj,jk+1) ) * zign 
     161            END DO 
     162       
     163            ! Slopes limitation 
     164            DO jk = 2, jpkm1 
     165               zakz(ji,jj,jk) = SIGN( 1., zakz(ji,jj,jk) ) *        & 
     166                  &             MIN( ABS( zakz(ji,jj,jk) ), 2. * ABS(ztraz(ji,jj,jk+1)), 2. * ABS(ztraz(ji,jj,jk) ) ) 
     167            END DO 
     168       
     169            ! vertical advective flux 
     170            DO jk = 1, jpkm1 
     171               zigma = zwsink2(ji,jj,jk+1) * zstep / e3w(ji,jj,jk+1,Kmm) 
     172               zew   = zwsink2(ji,jj,jk+1) 
     173               psinkflx(ji,jj,jk+1) = -zew * ( tr(ji,jj,jk,jp_tra,Kbb) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep 
     174            END DO 
     175            ! 
     176            ! Boundary conditions 
     177            psinkflx(ji,jj,1  ) = 0.e0 
     178            psinkflx(ji,jj,jpk) = 0.e0 
     179       
     180            DO jk=1,jpkm1 
     181               zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 
     182               tr(ji,jj,jk,jp_tra,Kbb) = tr(ji,jj,jk,jp_tra,Kbb) + zflx 
     183            END DO 
     184         END_2D 
    189185      END DO 
    190186 
    191       DO jk = 1,jpkm1 
    192          DO jj = 1,jpj 
    193             DO ji = 1, jpi 
    194                zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t_n(ji,jj,jk) 
    195                ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx 
    196             END DO 
    197          END DO 
    198       END DO 
    199  
    200       trb(:,:,:,jp_tra) = ztrb(:,:,:) 
     187      DO_3D_11_11( 1,jpkm1 ) 
     188         zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 
     189         ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx 
     190      END_3D 
     191 
     192      tr(:,:,:,jp_tra,Kbb) = ztrb(:,:,:) 
    201193      psinkflx(:,:,:)   = 2. * psinkflx(:,:,:) 
    202194      ! 
    … …  
    216208      !!---------------------------------------------------------------------- 
    217209      ! 
    218       REWIND( numnat_ref )              ! namtrc_rad in reference namelist  
    219210      READ  ( numnat_ref, namtrc_snk, IOSTAT = ios, ERR = 907) 
    220211907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_snk in reference namelist' ) 
    221       REWIND( numnat_cfg )              ! namtrc_rad in configuration namelist  
    222212      READ  ( numnat_cfg, namtrc_snk, IOSTAT = ios, ERR = 908 ) 
    223213908   IF( ios > 0 )   CALL ctl_nam ( ios , 'namtrc_snk in configuration namelist' ) 

  • NEMO/trunk/src/TOP/TRP/trctrp.F90

    r10068 r12377  
    2020   USE trcadv          ! advection                           (trc_adv routine) 
    2121   USE trczdf          ! vertical diffusion                  (trc_zdf routine) 
    22    USE trcnxt          ! time-stepping                       (trc_nxt routine) 
     22   USE trcatf          ! time filtering                      (trc_atf routine) 
    2323   USE trcrad          ! positivity                          (trc_rad routine) 
    2424   USE trcsbc          ! surface boundary condition          (trc_sbc routine) 
     25   USE trcbc           ! Tracers boundary condtions          ( trc_bc routine) 
    2526   USE zpshde          ! partial step: hor. derivative       (zps_hde routine) 
    2627   USE bdy_oce   , ONLY: ln_bdy 
    … …  
    4445CONTAINS 
    4546 
    46    SUBROUTINE trc_trp( kt ) 
     47   SUBROUTINE trc_trp( kt, Kbb, Kmm, Krhs, Kaa ) 
    4748      !!---------------------------------------------------------------------- 
    4849      !!                     ***  ROUTINE trc_trp  *** 
    … …  
    5354      !!              - Update the passive tracers 
    5455      !!---------------------------------------------------------------------- 
    55       INTEGER, INTENT( in ) ::  kt  ! ocean time-step index 
     56      INTEGER, INTENT( in ) :: kt                  ! ocean time-step index 
     57      INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs, Kaa ! time level indices (not swapped in this routine) 
    5658      !! --------------------------------------------------------------------- 
    5759      ! 
    … …  
    6062      IF( .NOT. lk_c1d ) THEN 
    6163         ! 
    62                                 CALL trc_sbc    ( kt )      ! surface boundary condition 
    63          IF( ln_trabbl )        CALL trc_bbl    ( kt )      ! advective (and/or diffusive) bottom boundary layer scheme 
    64          IF( ln_trcdmp )        CALL trc_dmp    ( kt )      ! internal damping trends 
    65          IF( ln_bdy )           CALL trc_bdy_dmp( kt )      ! BDY damping trends 
    66                                 CALL trc_adv    ( kt )      ! horizontal & vertical advection  
     64                                CALL trc_sbc    ( kt,      Kmm, tr, Krhs )      ! surface boundary condition 
     65         IF( ln_trcbc .AND. lltrcbc .AND. kt /= nit000 )  & 
     66                                CALL trc_bc     ( kt,      Kmm, tr, Krhs )      ! tracers: surface and lateral Boundary Conditions  
     67         IF( ln_trabbl )        CALL trc_bbl    ( kt, Kbb, Kmm, tr, Krhs )      ! advective (and/or diffusive) bottom boundary layer scheme 
     68         IF( ln_trcdmp )        CALL trc_dmp    ( kt, Kbb, Kmm, tr, Krhs )      ! internal damping trends 
     69         IF( ln_bdy )           CALL trc_bdy_dmp( kt, Kbb,      Krhs )      ! BDY damping trends 
     70                                CALL trc_adv    ( kt, Kbb, Kmm, tr, Krhs )      ! horizontal & vertical advection  
    6771         !                                                         ! Partial top/bottom cell: GRADh( trb )   
    6872         IF( ln_zps ) THEN 
    69            IF( ln_isfcav ) THEN ; CALL zps_hde_isf( kt, jptra, trb, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )  ! both top & bottom 
    70            ELSE                 ; CALL zps_hde    ( kt, jptra, trb, gtru, gtrv )                                      !  only bottom 
     73           IF( ln_isfcav ) THEN ; CALL zps_hde_isf( kt, Kmm, jptra, tr(:,:,:,:,Kbb), pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )  ! both top & bottom 
     74           ELSE                 ; CALL zps_hde    ( kt, Kmm, jptra, tr(:,:,:,:,Kbb), gtru, gtrv )                                      !  only bottom 
    7175           ENDIF 
    7276         ENDIF 
    7377         !                                                       
    74                                 CALL trc_ldf    ( kt )      ! lateral mixing 
     78                                CALL trc_ldf    ( kt, Kbb, Kmm,       tr, Krhs )  ! lateral mixing 
    7579#if defined key_agrif 
    7680         IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc       ! tracers sponge 
    7781#endif 
    78                                 CALL trc_zdf    ( kt )      ! vertical mixing and after tracer fields 
    79                                 CALL trc_nxt    ( kt )      ! tracer fields at next time step      
    80          IF( ln_trcrad )        CALL trc_rad    ( kt )      ! Correct artificial negative concentrations 
    81          IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kt )      ! internal damping trends on closed seas only 
     82                                CALL trc_zdf    ( kt, Kbb, Kmm, Krhs, tr, Kaa  )  ! vert. mixing & after tracer   ==> after 
     83                                CALL trc_atf    ( kt, Kbb, Kmm, Kaa , tr )        ! time filtering of "now" tracer fields     
     84         ! 
     85         ! Subsequent calls use the filtered values: Kmm and Kaa  
     86         ! These are used explicitly here since time levels will not be swapped until after tra_atf/dyn_atf/ssh_atf in stp 
     87         ! 
     88         IF( ln_trcrad )        CALL trc_rad    ( kt, Kmm, Kaa, tr       )    ! Correct artificial negative concentrations 
     89         IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kt, Kmm, Kaa )              ! internal damping trends on closed seas only 
    8290 
    8391         ! 
    8492      ELSE                                               ! 1D vertical configuration 
    85                                 CALL trc_sbc( kt )            ! surface boundary condition 
    86          IF( ln_trcdmp )        CALL trc_dmp( kt )            ! internal damping trends 
    87                                 CALL trc_zdf( kt )            ! vertical mixing and after tracer fields 
    88                                 CALL trc_nxt( kt )            ! tracer fields at next time step      
    89           IF( ln_trcrad )       CALL trc_rad( kt )            ! Correct artificial negative concentrations 
     93                                CALL trc_sbc( kt,      Kmm,       tr, Krhs )  ! surface boundary condition 
     94         IF( ln_trcdmp )        CALL trc_dmp( kt, Kbb, Kmm,       tr, Krhs )  ! internal damping trends 
     95                                CALL trc_zdf( kt, Kbb, Kmm, Krhs, tr, Kaa  )  ! vert. mixing & after tracer ==> after 
     96                                CALL trc_atf( kt, Kbb, Kmm, Kaa , tr )        ! time filtering of "now" tracer fields 
     97         ! 
     98         ! Subsequent calls use the filtered values: Kmm and Kaa  
     99         ! These are used explicitly here since time levels will not be swapped until after tra_atf/dyn_atf/ssh_atf in stp 
     100         ! 
     101         IF( ln_trcrad )       CALL trc_rad( kt, Kmm, Kaa, tr       )  ! Correct artificial negative concentrations 
    90102         ! 
    91103      END IF 

  • NEMO/trunk/src/TOP/TRP/trczdf.F90

    r10068 r12377  
    3636CONTAINS 
    3737 
    38    SUBROUTINE trc_zdf( kt ) 
     38   SUBROUTINE trc_zdf( kt, Kbb, Kmm, Krhs, ptr, Kaa ) 
    3939      !!---------------------------------------------------------------------- 
    4040      !!                  ***  ROUTINE trc_zdf  *** 
    … …  
    4343      !!              an implicit time-stepping scheme. 
    4444      !!--------------------------------------------------------------------- 
    45       INTEGER, INTENT( in ) ::  kt      ! ocean time-step index 
     45      INTEGER                                   , INTENT(in   ) ::   kt                   ! ocean time-step index 
     46      INTEGER                                   , INTENT(in   ) ::   Kbb, Kmm, Krhs, Kaa  ! ocean time level indices 
     47      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) ::   ptr                  ! passive tracers and RHS of tracer equation 
    4648      ! 
    4749      INTEGER               ::  jk, jn 
    … …  
    5254      IF( ln_timing )   CALL timing_start('trc_zdf') 
    5355      ! 
    54       IF( l_trdtrc )   ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
     56      IF( l_trdtrc )   ztrtrd(:,:,:,:)  = ptr(:,:,:,:,Krhs) 
    5557      ! 
    56       CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dttrc, trb, tra, jptra )    !   implicit scheme           
     58      CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dttrc, Kbb, Kmm, Krhs, ptr, Kaa, jptra )    !   implicit scheme           
    5759      ! 
    5860      IF( l_trdtrc )   THEN                      ! save the vertical diffusive trends for further diagnostics 
    5961         DO jn = 1, jptra 
    6062            DO jk = 1, jpkm1 
    61                ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dttrc ) - ztrtrd(:,:,jk,jn) 
     63               ztrtrd(:,:,jk,jn) = ( ( ptr(:,:,jk,jn,Kaa) - ptr(:,:,jk,jn,Kbb) ) / r2dttrc ) - ztrtrd(:,:,jk,jn) 
    6264            END DO 
    63             CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) ) 
     65            CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) ) 
    6466         END DO 
    6567      ENDIF 
    6668      !                                          ! print mean trends (used for debugging) 
    67       IF( ln_ctl )   THEN 
     69      IF( sn_cfctl%l_prttrc )   THEN 
    6870         WRITE(charout, FMT="('zdf ')") 
    6971         CALL prt_ctl_trc_info(charout) 
    70          CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     72         CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kaa), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    7173      END IF 
    7274      ! 

  • NEMO/trunk/src/TOP/TRP/trdmxl_trc.F90

    r11536 r12377  
    1616   !!   trd_mxl_trc_init : initialization step 
    1717   !!---------------------------------------------------------------------- 
    18    USE trc               ! tracer definitions (trn, trb, tra, etc.) 
    19    USE trc_oce, ONLY :   nn_dttrc  ! frequency of step on passive tracers 
     18   USE trc               ! tracer definitions (tr etc.) 
    2019   USE dom_oce           ! domain definition 
    2120   USE zdfmxl  , ONLY : nmln ! number of level in the mixed layer 
    … …  
    5049   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  ztmltrd2   ! 
    5150 
     51   !! * Substitutions 
     52#  include "do_loop_substitute.h90" 
    5253   !!---------------------------------------------------------------------- 
    5354   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    7071 
    7172 
    72    SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn ) 
     73   SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn, Kmm ) 
    7374      !!---------------------------------------------------------------------- 
    7475      !!                  ***  ROUTINE trd_mxl_trc_zint  *** 
    … …  
    9293      !! 
    9394      INTEGER, INTENT( in ) ::   ktrd, kjn                        ! ocean trend index and passive tracer rank 
     95      INTEGER, INTENT( in ) ::   Kmm                              ! time level index 
    9496      CHARACTER(len=2), INTENT( in ) ::  ctype                    ! surface/bottom (2D) or interior (3D) physics 
    9597      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::  ptrc_trdmxl ! passive tracer trend 
    … …  
    122124 
    123125            IF( jpktrd_trc < jpk ) THEN                           ! description ??? 
    124                DO jj = 1, jpj 
    125                   DO ji = 1, jpi 
    126                      IF( nmld_trc(ji,jj) <= jpktrd_trc ) THEN 
    127                         zvlmsk(ji,jj) = tmask(ji,jj,1) 
    128                      ELSE 
    129                         isum = isum + 1 
    130                         zvlmsk(ji,jj) = 0.e0 
    131                      ENDIF 
    132                   END DO 
    133                END DO 
     126               DO_2D_11_11 
     127                  IF( nmld_trc(ji,jj) <= jpktrd_trc ) THEN 
     128                     zvlmsk(ji,jj) = tmask(ji,jj,1) 
     129                  ELSE 
     130                     isum = isum + 1 
     131                     zvlmsk(ji,jj) = 0.e0 
     132                  ENDIF 
     133               END_2D 
    134134            ENDIF 
    135135 
    … …  
    147147         ! ... Weights for vertical averaging 
    148148         wkx_trc(:,:,:) = 0.e0 
    149          DO jk = 1, jpktrd_trc                                    ! initialize wkx_trc with vertical scale factor in mixed-layer 
    150             DO jj = 1, jpj 
    151                DO ji = 1, jpi 
    152                   IF( jk - nmld_trc(ji,jj) < 0 )   wkx_trc(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
    153                END DO 
    154             END DO 
    155          END DO 
     149         DO_3D_11_11( 1, jpktrd_trc ) 
     150            IF( jk - nmld_trc(ji,jj) < 0 )   wkx_trc(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 
     151         END_3D 
    156152          
    157153         rmld_trc(:,:) = 0.e0 
    … …  
    183179 
    184180 
    185    SUBROUTINE trd_mxl_trc( kt ) 
     181   SUBROUTINE trd_mxl_trc( kt, Kmm ) 
    186182      !!---------------------------------------------------------------------- 
    187183      !!                  ***  ROUTINE trd_mxl_trc  *** 
    … …  
    232228      ! 
    233229      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     230      INTEGER, INTENT(in) ::   Kmm                              ! time level index 
    234231      ! 
    235232      INTEGER ::   ji, jj, jk, jl, ik, it, itmod, jn 
    … …  
    251248 
    252249 
    253       IF( nn_dttrc  /= 1  )   CALL ctl_stop( " Be careful, trends diags never validated " ) 
    254  
    255250      ! ====================================================================== 
    256251      ! I. Diagnose the purely vertical (K_z) diffusion trend 
    … …  
    263258         ! 
    264259         DO jn = 1, jptra 
    265             DO jj = 1, jpj 
    266                DO ji = 1, jpi 
    267                   ik = nmld_trc(ji,jj) 
    268                   IF( ln_trdtrc(jn) )    & 
    269                   tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - avs(ji,jj,ik) / e3w_n(ji,jj,ik) * tmask(ji,jj,ik)  & 
    270                        &                    * ( trn(ji,jj,ik-1,jn) - trn(ji,jj,ik,jn) )            & 
    271                        &                    / MAX( 1., rmld_trc(ji,jj) ) * tmask(ji,jj,1) 
    272                END DO 
    273             END DO 
     260            DO_2D_11_11 
     261               ik = nmld_trc(ji,jj) 
     262               IF( ln_trdtrc(jn) )    & 
     263               tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - avs(ji,jj,ik) / e3w(ji,jj,ik,Kmm) * tmask(ji,jj,ik)  & 
     264                    &                    * ( tr(ji,jj,ik-1,jn,Kmm) - tr(ji,jj,ik,jn,Kmm) )            & 
     265                    &                    / MAX( 1., rmld_trc(ji,jj) ) * tmask(ji,jj,1) 
     266            END_2D 
    274267         END DO 
    275268 
    … …  
    322315         DO jn = 1, jptra 
    323316            IF( ln_trdtrc(jn) ) & 
    324                tml_trc(:,:,jn) = tml_trc(:,:,jn) + wkx_trc(:,:,jk) * trn(:,:,jk,jn) 
     317               tml_trc(:,:,jn) = tml_trc(:,:,jn) + wkx_trc(:,:,jk) * tr(:,:,jk,jn,Kmm) 
    325318         END DO 
    326319      END DO 
    … …  
    328321      ! II.3 Initialize mixed-layer "before" arrays for the 1rst analysis window     
    329322      ! ------------------------------------------------------------------------ 
    330       IF( kt == nittrc000 + nn_dttrc ) THEN  !  i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1)    ??? 
     323      IF( kt == nittrc000 + 1 ) THEN  !  i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1)    ??? 
    331324         ! 
    332325         DO jn = 1, jptra 
    … …  
    870863#  endif 
    871864      zout = nn_trd_trc * rdt 
    872       iiter = ( nittrc000 - 1 ) / nn_dttrc 
     865      iiter = nittrc000 - 1 
    873866 
    874867      IF(lwp) WRITE (numout,*) '                netCDF initialization' 
    … …  
    970963   !!---------------------------------------------------------------------- 
    971964CONTAINS 
    972    SUBROUTINE trd_mxl_trc( kt )                                   ! Empty routine 
     965   SUBROUTINE trd_mxl_trc( kt, Kmm )                                   ! Empty routine 
    973966      INTEGER, INTENT( in) ::   kt 
     967      INTEGER, INTENT( in) ::   Kmm            ! time level index 
    974968      WRITE(*,*) 'trd_mxl_trc: You should not have seen this print! error?', kt 
    975969   END SUBROUTINE trd_mxl_trc 
    976    SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn ) 
     970   SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn, Kmm ) 
    977971      INTEGER               , INTENT( in ) ::  ktrd, kjn              ! ocean trend index and passive tracer rank 
     972      INTEGER               , INTENT( in ) ::  Kmm                    ! time level index 
    978973      CHARACTER(len=2)      , INTENT( in ) ::  ctype                  ! surface/bottom (2D) or interior (3D) physics 
    979974      REAL, DIMENSION(:,:,:), INTENT( in ) ::  ptrc_trdmxl            ! passive trc trend 

  • NEMO/trunk/src/TOP/TRP/trdmxl_trc_rst.F90

    r10425 r12377  
    1111   USE in_out_manager  ! I/O manager 
    1212   USE iom             ! I/O module 
    13    USE trc             ! for nn_dttrc ctrcnm 
     13   USE trc             ! for ctrcnm 
    1414   USE trdmxl_trc_oce  ! for lk_trdmxl_trc 
    1515 
    … …  
    4444      !!-------------------------------------------------------------------------------- 
    4545 
    46       IF( kt == nitrst - nn_dttrc .OR. nitend - nit000 + 1 < 2 * nn_dttrc ) THEN ! idem trcrst.F90 
     46      IF( kt == nitrst - 1 .OR. nitend - nit000 + 1 < 2 ) THEN ! idem trcrst.F90 
    4747         IF( nitrst > 1.0e9 ) THEN 
    4848            WRITE(clkt,*) nitrst 

  • NEMO/trunk/src/TOP/TRP/trdtrc.F90

    r10096 r12377  
    1313   !!   trdtrc      : passive tracer trends  
    1414   !!---------------------------------------------------------------------- 
    15    USE trc               ! tracer definitions (trn, trb, tra, etc.) 
     15   USE trc               ! tracer definitions (tr(:,:,:,:,Kmm), tr(:,:,:,:,Kbb), tr(:,:,:,:,Krhs), etc.) 
    1616   USE trd_oce 
    1717   USE trdtrc_oce       ! definition of main arrays used for trends computations 
    … …  
    3232CONTAINS 
    3333 
    34    SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt ) 
     34   SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt, Kmm ) 
    3535      !!---------------------------------------------------------------------- 
    3636      !!                  ***  ROUTINE trd_trc  *** 
    3737      !!---------------------------------------------------------------------- 
    3838      INTEGER, INTENT( in )  ::   kt                                  ! time step 
     39      INTEGER, INTENT( in )  ::   Kmm                                 ! time level index 
    3940      INTEGER, INTENT( in )  ::   kjn                                 ! tracer index 
    4041      INTEGER, INTENT( in )  ::   ktrd                                ! tracer trend index 
    … …  
    5657         ! 
    5758         SELECT CASE ( ktrd ) 
    58          CASE ( jptra_xad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_xad, '3D', kjn ) 
    59          CASE ( jptra_yad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_yad, '3D', kjn ) 
    60          CASE ( jptra_zad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zad, '3D', kjn ) 
    61          CASE ( jptra_ldf     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn ) 
    62          CASE ( jptra_bbl     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_bbl, '3D', kjn ) 
     59         CASE ( jptra_xad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_xad, '3D', kjn, Kmm ) 
     60         CASE ( jptra_yad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_yad, '3D', kjn, Kmm ) 
     61         CASE ( jptra_zad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zad, '3D', kjn, Kmm ) 
     62         CASE ( jptra_ldf     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn, Kmm ) 
     63         CASE ( jptra_bbl     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_bbl, '3D', kjn, Kmm ) 
    6364         CASE ( jptra_zdf     ) 
    6465            IF( ln_trcldf_iso ) THEN 
    65                CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn ) 
     66               CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn, Kmm ) 
    6667            ELSE 
    67                CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zdf, '3D', kjn ) 
     68               CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zdf, '3D', kjn, Kmm ) 
    6869            ENDIF 
    69          CASE ( jptra_dmp     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_dmp , '3D', kjn ) 
    70          CASE ( jptra_nsr     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_sbc , '2D', kjn ) 
    71          CASE ( jptra_sms     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_sms , '3D', kjn ) 
    72          CASE ( jptra_radb    )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_radb, '3D', kjn ) 
    73          CASE ( jptra_radn    )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_radn, '3D', kjn ) 
    74          CASE ( jptra_atf     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_atf , '3D', kjn ) 
     70         CASE ( jptra_dmp     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_dmp , '3D', kjn, Kmm ) 
     71         CASE ( jptra_nsr     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_sbc , '2D', kjn, Kmm ) 
     72         CASE ( jptra_sms     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_sms , '3D', kjn, Kmm ) 
     73         CASE ( jptra_radb    )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_radb, '3D', kjn, Kmm ) 
     74         CASE ( jptra_radn    )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_radn, '3D', kjn, Kmm ) 
     75         CASE ( jptra_atf     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_atf , '3D', kjn, Kmm ) 
    7576         END SELECT 
    7677         ! 
    … …  
    110111CONTAINS 
    111112 
    112    SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt ) 
     113   SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt, Kmm ) 
    113114      INTEGER               , INTENT( in )     ::   kt      ! time step 
     115      INTEGER               , INTENT( in )     ::   Kmm     ! time level index 
    114116      INTEGER               , INTENT( in )     ::   kjn     ! tracer index 
    115117      INTEGER               , INTENT( in )     ::   ktrd    ! tracer trend index 

  • NEMO/trunk/src/TOP/oce_trc.F90

    r10351 r12377  
    88   !!---------------------------------------------------------------------- 
    99   !                                            !* Domain size * 
     10   USE par_oce , ONLY :   jpt      =>   jpt        !: time dimension 
    1011   USE par_oce , ONLY :   jpi      =>   jpi        !: first  dimension of grid --> i  
    1112   USE par_oce , ONLY :   jpj      =>   jpj        !: second dimension of grid --> j   
    … …  
    3334 
    3435   !* ocean fields: here now and after fields * 
    35    USE oce , ONLY :   un      =>    un      !: i-horizontal velocity (m s-1)  
    36    USE oce , ONLY :   vn      =>    vn      !: j-horizontal velocity (m s-1) 
    37    USE oce , ONLY :   wn      =>    wn      !: vertical velocity (m s-1)   
    38    USE oce , ONLY :   tsn     =>    tsn     !: 4D array contaning ( tn, sn ) 
    39    USE oce , ONLY :   tsb     =>    tsb     !: 4D array contaning ( tb, sb ) 
    40    USE oce , ONLY :   tsa     =>    tsa     !: 4D array contaning ( ta, sa ) 
    41    USE oce , ONLY :   rhop    =>    rhop    !: potential volumic mass (kg m-3)  
    42    USE oce , ONLY :   rhd     =>    rhd     !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 
    43    USE oce , ONLY :   hdivn   =>    hdivn   !: horizontal divergence (1/s) 
    44    USE oce , ONLY :   sshn    =>    sshn    !: sea surface height at t-point [m]    
    45    USE oce , ONLY :   sshb    =>    sshb    !: sea surface height at t-point [m]    
    46    USE oce , ONLY :   ssha    =>    ssha    !: sea surface height at t-point [m]    
    47    USE oce , ONLY :   rab_n   =>    rab_n   !: local thermal/haline expension ratio at T-points 
     36   USE oce , ONLY :   uu     =>    uu     !: i-horizontal velocity (m s-1)  
     37   USE oce , ONLY :   vv     =>    vv     !: j-horizontal velocity (m s-1) 
     38   USE oce , ONLY :   ww     =>    ww     !: vertical velocity (m s-1)   
     39   USE oce , ONLY :   ts     =>    ts     !: 4D array contaning ( tn, sn ) 
     40   USE oce , ONLY :   rhop   =>    rhop   !: potential volumic mass (kg m-3)  
     41   USE oce , ONLY :   rhd    =>    rhd    !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 
     42   USE oce , ONLY :   hdiv   =>    hdiv   !: horizontal divergence (1/s) 
     43   USE oce , ONLY :   ssh    =>    ssh    !: sea surface height at t-point [m]    
     44   USE oce , ONLY :   rab_n  =>    rab_n  !: local thermal/haline expension ratio at T-points 
    4845 
    4946   !* surface fluxes * 

  • NEMO/trunk/src/TOP/prtctl_trc.F90

    r10570 r12377  
    3535   SUBROUTINE prt_ctl_trc( tab4d, mask, clinfo, ovlap, kdim, clinfo2 ) 
    3636      !!---------------------------------------------------------------------- 
    37       !!                     ***  ROUTINE prt_ctl  *** 
     37      !!                     ***  ROUTINE prt_ctl_trc  *** 
    3838      !! 
    3939      !! ** Purpose : - print sum control 3D arrays over the same area  
    … …  
    4141      !!                debugging a new parametrization in mono or mpp.  
    4242      !! 
    43       !! ** Method  : 2 possibilities exist when setting the ln_ctl parameter to 
     43      !! ** Method  : 2 possibilities exist when setting the sn_cfctl%prttrc parameter to 
    4444      !!                .true. in the ocean namelist: 
    4545      !!              - to debug a MPI run .vs. a mono-processor one;  
    … …  
    5454      !!              - All arguments of the above calling sequence are optional so their 
    5555      !!                name must be explicitly typed if used. For instance if the mask 
    56       !!                array tmask(:,:,:) must be passed through the prt_ctl subroutine,  
    57       !!                it must looks like: CALL prt_ctl( mask=tmask ). 
     56      !!                array tmask(:,:,:) must be passed through the prt_ctl_trc subroutine,  
     57      !!                it must look like: CALL prt_ctl_trc( mask=tmask ). 
    5858      !!---------------------------------------------------------------------- 
    5959      REAL(wp)         , DIMENSION(:,:,:,:), INTENT(in), OPTIONAL ::   tab4d     ! 4D array 

  • NEMO/trunk/src/TOP/trc.F90

    r10425 r12377  
    1818 
    1919   !                                     !!- logical units of passive tracers 
    20    INTEGER, PUBLIC ::   numnat_ref = -1   !: reference passive tracer namelist_top_ref 
    21    INTEGER, PUBLIC ::   numnat_cfg = -1   !: reference passive tracer namelist_top_cfg 
    2220   INTEGER, PUBLIC ::   numont     = -1   !: reference passive tracer namelist output output.namelist.top 
    23    INTEGER, PUBLIC ::   numtrc_ref = -1   !: reference passive tracer namelist_top_ref 
    24    INTEGER, PUBLIC ::   numtrc_cfg = -1   !: reference passive tracer namelist_top_cfg 
    2521   INTEGER, PUBLIC ::   numonr     = -1   !: reference passive tracer namelist output output.namelist.top 
    2622   INTEGER, PUBLIC ::   numstr            !: tracer statistics 
    2723   INTEGER, PUBLIC ::   numrtr            !: trc restart (read ) 
    2824   INTEGER, PUBLIC ::   numrtw            !: trc restart ( write ) 
     25   CHARACTER(:), ALLOCATABLE, PUBLIC ::   numnat_ref   !: character buffer for reference passive tracer namelist_top_ref 
     26   CHARACTER(:), ALLOCATABLE, PUBLIC ::   numnat_cfg   !: character buffer for configuration specific passive tracer namelist_top_cfg 
     27   CHARACTER(:), ALLOCATABLE, PUBLIC ::   numtrc_ref   !: character buffer for reference passive tracer namelist_trc_ref 
     28   CHARACTER(:), ALLOCATABLE, PUBLIC ::   numtrc_cfg   !: character buffer for configuration specific passive tracer namelist_trc_cfg 
    2929 
    3030   !! passive tracers fields (before,now,after) 
    … …  
    3333   REAL(wp), PUBLIC                                        ::  areatot        !: total volume  
    3434   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  cvol           !: volume correction -degrad option-  
    35    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  trn            !: tracer concentration for now time step 
    36    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  tra            !: tracer concentration for next time step 
    37    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  trb            !: tracer concentration for before time step 
     35   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::  tr           !: tracer concentration  
    3836   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  sbc_trc_b      !: Before sbc fluxes for tracers 
    3937   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  sbc_trc        !: Now sbc fluxes for tracers 
    … …  
    6765   LOGICAL             , PUBLIC ::   ln_top_euler       !: boolean term for euler integration  
    6866   LOGICAL             , PUBLIC ::   ln_trcdta          !: Read inputs data from files 
     67   LOGICAL             , PUBLIC ::   ln_trcbc           !: Enable surface, lateral or open boundaries conditions 
    6968   LOGICAL             , PUBLIC ::   ln_trcdmp          !: internal damping flag 
    7069   LOGICAL             , PUBLIC ::   ln_trcdmp_clo      !: internal damping flag on closed seas 
    … …  
    117116   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ln_trc_cbc    !: Use coastal boundary condition data 
    118117   LOGICAL , PUBLIC                                  ::   ln_rnf_ctl    !: remove runoff dilution on tracers 
    119    REAL(wp), PUBLIC                                  ::   rn_bc_time    !: Time scaling factor for SBC and CBC data (seconds in a day) 
     118   REAL(wp), PUBLIC                                  ::   rn_sbc_time   !: Time scaling factor for SBC data (seconds in a day) 
     119   REAL(wp), PUBLIC                                  ::   rn_cbc_time   !: Time scaling factor for CBC data (seconds in a day) 
     120   LOGICAL , PUBLIC                                  ::   lltrcbc       !: Applying one of the boundary conditions  
    120121   ! 
    121122   CHARACTER(len=20), PUBLIC, DIMENSION(jp_bdy) :: cn_trc_dflt   ! Default OBC condition for all tracers 
    … …  
    130131!$AGRIF_END_DO_NOT_TREAT 
    131132   ! 
     133   !! Substitutions 
     134#include "do_loop_substitute.h90" 
    132135   !!---------------------------------------------------------------------- 
    133136   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    147150      ierr(:) = 0 
    148151      ! 
    149       ALLOCATE( trn(jpi,jpj,jpk,jptra), trb(jpi,jpj,jpk,jptra), tra(jpi,jpj,jpk,jptra),       &   
     152      ALLOCATE( tr(jpi,jpj,jpk,jptra,jpt)                                             ,       &   
    150153         &      trc_i(jpi,jpj,jptra)  , trc_o(jpi,jpj,jptra)                          ,       & 
    151154         &      gtru (jpi,jpj,jptra)  , gtrv (jpi,jpj,jptra)                          ,       & 

  • NEMO/trunk/src/TOP/trcbc.F90

    r11536 r12377  
    77   !!            3.6 !  2015 (T . Lovato) Revision and BDY support 
    88   !!            4.0 !  2016 (T . Lovato) Include application of sbc and cbc 
    9    !!---------------------------------------------------------------------- 
    10 #if defined key_top 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_top'                                                TOP model  
    139   !!---------------------------------------------------------------------- 
    1410   !!   trc_bc       :  Apply tracer Boundary Conditions 
    … …  
    4541#endif 
    4642 
     43#if defined key_top 
     44   !!---------------------------------------------------------------------- 
     45   !!   'key_top'                                                TOP model  
     46   !!---------------------------------------------------------------------- 
     47 
    4748   !! * Substitutions 
    48 #  include "vectopt_loop_substitute.h90" 
     49#  include "do_loop_substitute.h90" 
    4950   !!---------------------------------------------------------------------- 
    5051   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    5455CONTAINS 
    5556 
    56    SUBROUTINE trc_bc_ini( ntrc ) 
     57   SUBROUTINE trc_bc_ini( ntrc, Kmm ) 
    5758      !!---------------------------------------------------------------------- 
    5859      !!                   ***  ROUTINE trc_bc_ini  *** 
    … …  
    6364      !!              - allocates passive tracer BC data structure  
    6465      !!---------------------------------------------------------------------- 
    65       INTEGER,INTENT(in) :: ntrc                           ! number of tracers 
     66      INTEGER, INTENT(in) :: ntrc                          ! number of tracers 
     67      INTEGER, INTENT(in) ::   Kmm                         ! time level index 
    6668      ! 
    6769      INTEGER            :: jl, jn , ib, ibd, ii, ij, ik   ! dummy loop indices 
    … …  
    8183      !! 
    8284      NAMELIST/namtrc_bc/ cn_dir_obc, sn_trcobc, rn_trofac, cn_dir_sbc, sn_trcsbc, rn_trsfac, &  
    83                         & cn_dir_cbc, sn_trccbc, rn_trcfac, ln_rnf_ctl, rn_bc_time 
     85                        & cn_dir_cbc, sn_trccbc, rn_trcfac, ln_rnf_ctl, rn_sbc_time, rn_cbc_time 
    8486      NAMELIST/namtrc_bdy/ cn_trc_dflt, cn_trc, nn_trcdmp_bdy 
    8587      !!---------------------------------------------------------------------- 
    … …  
    120122      ! 
    121123      ! Read Boundary Conditions Namelists 
    122       REWIND( numnat_ref )              ! Namelist namtrc_bc in reference namelist : Passive tracer data structure 
    123124      READ  ( numnat_ref, namtrc_bc, IOSTAT = ios, ERR = 901) 
    124125901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_bc in reference namelist' ) 
    125       REWIND( numnat_cfg )              ! Namelist namtrc_bc in configuration namelist : Passive tracer data structure 
    126126      READ  ( numnat_cfg, namtrc_bc, IOSTAT = ios, ERR = 902 ) 
    127127902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist' ) 
    … …  
    129129 
    130130      IF ( ln_bdy ) THEN 
    131          REWIND( numnat_ref )              ! Namelist namtrc_bdy in reference namelist : Passive tracer data structure 
    132131         READ  ( numnat_ref, namtrc_bdy, IOSTAT = ios, ERR = 903) 
    133132903      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_bdy in reference namelist' ) 
    … …  
    135134         cn_trc     (2:jp_bdy) = cn_trc     (1) 
    136135         cn_trc_dflt(2:jp_bdy) = cn_trc_dflt(1) 
    137          REWIND( numnat_cfg )              ! Namelist namtrc_bdy in configuration namelist : Passive tracer data structure 
    138136         READ  ( numnat_cfg, namtrc_bdy, IOSTAT = ios, ERR = 904 ) 
    139137904      IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_bdy in configuration namelist' ) 
    … …  
    264262                        ii = idx_bdy(ib)%nbi(ibd,igrd) 
    265263                        ij = idx_bdy(ib)%nbj(ibd,igrd) 
    266                         trcdta_bdy(jn,ib)%trc(ibd,ik) = trn(ii,ij,ik,jn) * tmask(ii,ij,ik) 
     264                        trcdta_bdy(jn,ib)%trc(ibd,ik) = tr(ii,ij,ik,jn,Kmm) * tmask(ii,ij,ik) 
    267265                     END DO 
    268266                  END DO 
    … …  
    339337 
    340338 
    341    SUBROUTINE trc_bc(kt, jit) 
     339   SUBROUTINE trc_bc(kt, Kmm, ptr, Krhs, jit) 
    342340      !!---------------------------------------------------------------------- 
    343341      !!                   ***  ROUTINE trc_bc  *** 
    … …  
    350348      USE fldread 
    351349      !!       
    352       INTEGER, INTENT(in)           ::   kt    ! ocean time-step index 
    353       INTEGER, INTENT(in), OPTIONAL ::   jit   ! subcycle time-step index (for timesplitting option) 
     350      INTEGER                                   , INTENT(in)           ::   kt        ! ocean time-step index 
     351      INTEGER                                   , INTENT(in)           ::   Kmm, Krhs ! time level indices 
     352      INTEGER                                   , INTENT(in), OPTIONAL ::   jit       ! subcycle time-step index (for timesplitting option) 
     353      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr            ! passive tracers and RHS of tracer equation 
    354354      !! 
    355355      INTEGER  :: ji, jj, jk, jn, jl             ! Loop index 
    … …  
    368368      IF( PRESENT(jit) ) THEN  
    369369         ! 
    370          ! OPEN boundary conditions (use kt_offset=+1 as they are applied at the end of the step) 
     370         ! BDY: use pt_offset=0.5 as applied at the end of the step and fldread is referenced at the middle of the step 
    371371         IF( nb_trcobc > 0 ) THEN 
    372372           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 
    373            CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, kit=jit, kt_offset=+1) 
     373           CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, kit=jit, pt_offset = 0.5_wp ) 
    374374         ENDIF 
    375375         ! 
    … …  
    388388      ELSE 
    389389         ! 
    390          ! OPEN boundary conditions (use kt_offset=+1 as they are applied at the end of the step) 
     390         ! BDY: use pt_offset=0.5 as applied at the end of the step and fldread is referenced at the middle of the step 
    391391         IF( nb_trcobc > 0 ) THEN 
    392392           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 
    393            CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, kt_offset=+1) 
     393           CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, pt_offset = 0.5_wp ) 
    394394         ENDIF 
    395395         ! 
    … …  
    414414         ! Remove river dilution for tracers with absent river load 
    415415         IF( ln_rnf_ctl .AND. .NOT.ln_trc_cbc(jn) ) THEN 
    416             DO jj = 2, jpj 
    417                DO ji = fs_2, fs_jpim1 
    418                   DO jk = 1, nk_rnf(ji,jj) 
    419                      zrnf = (rnf(ji,jj) + rnf_b(ji,jj)) * 0.5_wp * r1_rau0 / h_rnf(ji,jj) 
    420                      tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn)  + (trn(ji,jj,jk,jn) * zrnf) 
    421                   END DO 
     416            DO_2D_01_00 
     417               DO jk = 1, nk_rnf(ji,jj) 
     418                  zrnf = (rnf(ji,jj) + rnf_b(ji,jj)) * 0.5_wp * r1_rau0 / h_rnf(ji,jj) 
     419                  ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs)  + (ptr(ji,jj,jk,jn,Kmm) * zrnf) 
    422420               END DO 
    423             END DO 
     421            END_2D 
    424422         ENDIF 
    425423         ! 
    … …  
    429427         IF( ln_trc_sbc(jn) ) THEN 
    430428            jl = n_trc_indsbc(jn) 
    431             DO jj = 2, jpj 
    432                DO ji = fs_2, fs_jpim1   ! vector opt. 
    433                   zfact = 1. / ( e3t_n(ji,jj,1) * rn_bc_time ) 
    434                   tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) * zfact 
     429            sf_trcsbc(jl)%fnow(:,:,1) = MAX( rtrn, sf_trcsbc(jl)%fnow(:,:,1) ) ! avoid nedgative value due to interpolation 
     430            DO_2D_01_00 
     431               zfact = 1. / ( e3t(ji,jj,1,Kmm) * rn_sbc_time ) 
     432               ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) * zfact 
     433            END_2D 
     434         ENDIF 
     435         ! 
     436         ! COASTAL boundary conditions 
     437         IF( ( ln_rnf .OR. l_offline ) .AND. ln_trc_cbc(jn) ) THEN 
     438            IF( l_offline )   rn_rfact = 1._wp 
     439            jl = n_trc_indcbc(jn) 
     440            DO_2D_01_00 
     441               DO jk = 1, nk_rnf(ji,jj) 
     442                  zfact = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_cbc_time ) * tmask(ji,jj,1) 
     443                  ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zfact 
    435444               END DO 
    436             END DO 
    437          ENDIF 
    438          ! 
    439          ! COASTAL boundary conditions 
    440          IF( ln_rnf .AND. ln_trc_cbc(jn) ) THEN 
    441             jl = n_trc_indcbc(jn) 
    442             DO jj = 2, jpj 
    443                DO ji = fs_2, fs_jpim1   ! vector opt. 
    444                   DO jk = 1, nk_rnf(ji,jj) 
    445                      zfact = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_bc_time )  
    446                      tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zfact 
    447                   END DO 
    448                END DO 
    449             END DO 
     445            END_2D 
    450446         ENDIF 
    451447         !                                                       ! =========== 
    … …  
    461457   !!---------------------------------------------------------------------- 
    462458CONTAINS 
    463    SUBROUTINE trc_bc_ini( ntrc )        ! Empty routine 
    464       INTEGER,INTENT(IN) :: ntrc                           ! number of tracers 
    465       WRITE(*,*) 'trc_bc_ini: You should not have seen this print! error?', kt 
     459   SUBROUTINE trc_bc_ini( ntrc, Kmm )        ! Empty routine 
     460      INTEGER, INTENT(IN) :: ntrc                           ! number of tracers 
     461      INTEGER, INTENT(in) :: Kmm                            ! time level index 
     462      WRITE(*,*) 'trc_bc_ini: You should not have seen this print! error?', ntrc, Kmm 
    466463   END SUBROUTINE trc_bc_ini 
    467    SUBROUTINE trc_bc( kt )        ! Empty routine 
    468       WRITE(*,*) 'trc_bc: You should not have seen this print! error?', kt 
     464   SUBROUTINE trc_bc( kt, Kmm, Krhs )        ! Empty routine 
     465      INTEGER, INTENT(in) :: kt, Kmm, Krhs ! time level indices 
     466      WRITE(*,*) 'trc_bc: You should not have seen this print! error?', kt, Kmm, Krhs  
    469467   END SUBROUTINE trc_bc 
    470468#endif 

  • NEMO/trunk/src/TOP/trcbdy.F90

    r11821 r12377  
    3737CONTAINS 
    3838 
    39    SUBROUTINE trc_bdy( kt ) 
     39   SUBROUTINE trc_bdy( kt, Kbb, Kmm, Krhs ) 
    4040      !!---------------------------------------------------------------------- 
    4141      !!                  ***  SUBROUTINE trc_bdy  *** 
    … …  
    4444      !! 
    4545      !!---------------------------------------------------------------------- 
    46       INTEGER, INTENT( in ) :: kt     ! Main time step counter 
     46      INTEGER, INTENT( in ) :: kt              ! Main time step counter 
     47      INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs  ! time level indices 
    4748      !! 
    4849      INTEGER                           :: ib_bdy ,ir, jn ,igrd ! Loop indices 
    … …  
    7071               CASE('none'        )   ;   CYCLE 
    7172               CASE('frs'         )   ! treat the whole boundary at once 
    72                   IF( ir == 0 ) CALL bdy_frs( idx_bdy(ib_bdy),                tra(:,:,:,jn), ztrc*zfac ) 
     73                  IF( ir == 0 ) CALL bdy_frs( idx_bdy(ib_bdy),                tr(:,:,:,jn,Krhs), ztrc*zfac ) 
    7374               CASE('specified'   )   ! treat the whole rim      at once 
    74                   IF( ir == 0 ) CALL bdy_spe( idx_bdy(ib_bdy),                tra(:,:,:,jn), ztrc*zfac ) 
    75                CASE('neumann'     )   ;   CALL bdy_nmn( idx_bdy(ib_bdy), igrd         , tra(:,:,:,jn) )   ! tra masked 
    76                CASE('orlanski'    )   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), ztrc*zfac, ll_npo=.false. ) 
    77                CASE('orlanski_npo')   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), ztrc*zfac, ll_npo=.true. ) 
     75                  IF( ir == 0 ) CALL bdy_spe( idx_bdy(ib_bdy),                tr(:,:,:,jn,Krhs), ztrc*zfac ) 
     76               CASE('neumann'     )   ;   CALL bdy_nmn( idx_bdy(ib_bdy), igrd         , tr(:,:,:,jn,Krhs) )   ! tra masked 
     77               CASE('orlanski'    )   ;   CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), ztrc*zfac, ll_npo=.false. ) 
     78               CASE('orlanski_npo')   ;   CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), ztrc*zfac, ll_npo=.true. ) 
    7879               CASE DEFAULT           ;   CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' ) 
    7980               END SELECT 
    … …  
    9596         END DO 
    9697         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
    97             CALL lbc_lnk( 'trcbdy', tra, 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
     98            CALL lbc_lnk( 'trcbdy', tr(:,:,:,:,Krhs), 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
    9899         END IF 
    99100         ! 
    … …  
    105106 
    106107 
    107    SUBROUTINE trc_bdy_dmp( kt ) 
     108   SUBROUTINE trc_bdy_dmp( kt, Kbb, Krhs ) 
    108109      !!---------------------------------------------------------------------- 
    109110      !!                 ***  SUBROUTINE trc_bdy_dmp  *** 
    … …  
    114115      !!---------------------------------------------------------------------- 
    115116      INTEGER,         INTENT(in) ::   kt 
     117      INTEGER,         INTENT(in) ::   Kbb, Krhs  ! time level indices 
    116118      !!  
    117119      INTEGER  ::   jn             ! Tracer index 
    … …  
    134136                  zwgt = idx_bdy(ib_bdy)%nbd(ib,igrd) 
    135137                  DO ik = 1, jpkm1 
    136                      zta = zwgt * ( trcdta_bdy(jn, ib_bdy)%trc(ib,ik) - trb(ii,ij,ik,jn) ) * tmask(ii,ij,ik) 
    137                      tra(ii,ij,ik,jn) = tra(ii,ij,ik,jn) + zta 
     138                     zta = zwgt * ( trcdta_bdy(jn, ib_bdy)%trc(ib,ik) - tr(ii,ij,ik,jn,Kbb) ) * tmask(ii,ij,ik) 
     139                     tr(ii,ij,ik,jn,Krhs) = tr(ii,ij,ik,jn,Krhs) + zta 
    138140                  END DO 
    139141               END DO 

  • NEMO/trunk/src/TOP/trcdta.F90

    r11536 r12377  
    3939!$AGRIF_END_DO_NOT_TREAT 
    4040 
     41   !! Substitutions 
     42#include "do_loop_substitute.h90" 
    4143   !!---------------------------------------------------------------------- 
    4244   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    98100      ENDIF 
    99101      ! 
    100       REWIND( numnat_ref )              ! Namelist namtrc_dta in reference namelist : Passive tracer input data 
    101102      READ  ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901) 
    102103901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_dta_ini in reference namelist' ) 
    103       REWIND( numnat_cfg )              ! Namelist namtrc_dta in configuration namelist : Passive tracer input data 
    104104      READ  ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 ) 
    105105902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_dta_ini in configuration namelist' ) 
    … …  
    154154 
    155155 
    156    SUBROUTINE trc_dta( kt, sf_trcdta, ptrcfac, ptrcdta) 
     156   SUBROUTINE trc_dta( kt, Kmm, sf_trcdta, ptrcfac, ptrcdta) 
    157157      !!---------------------------------------------------------------------- 
    158158      !!                   ***  ROUTINE trc_dta  *** 
    … …  
    167167      !!---------------------------------------------------------------------- 
    168168      INTEGER                          , INTENT(in   )   ::   kt         ! ocean time-step 
     169      INTEGER                          , INTENT(in   )   ::   Kmm        ! time level index 
    169170      TYPE(FLD), DIMENSION(1)          , INTENT(inout)   ::   sf_trcdta  ! array of information on the field to read 
    170171      REAL(wp)                         , INTENT(in   )   ::   ptrcfac    ! multiplication factor 
    … …  
    178179      ! 
    179180      IF( ln_timing )   CALL timing_start('trc_dta') 
     181      ! 
     182      IF( kt == nit000 .AND. lwp) THEN 
     183         WRITE(numout,*) 
     184         WRITE(numout,*) 'trc_dta : passive tracers data for IC' 
     185         WRITE(numout,*) '~~~~~~~ ' 
     186      ENDIF 
    180187      ! 
    181188      IF( nb_trcdta > 0 ) THEN 
    … …  
    191198               WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh' 
    192199            ENDIF 
    193             DO jj = 1, jpj                         ! vertical interpolation of T & S 
    194                DO ji = 1, jpi 
    195                   DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
    196                      zl = gdept_n(ji,jj,jk) 
    197                      IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data 
    198                         ztp(jk) = ptrcdta(ji,jj,1) 
    199                      ELSEIF( zl > gdept_1d(jpk) ) THEN         ! below the last level of data 
    200                         ztp(jk) = ptrcdta(ji,jj,jpkm1) 
    201                      ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1 
    202                         DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1) 
    203                            IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 
    204                               zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 
    205                               ztp(jk) = ptrcdta(ji,jj,jkk) + ( ptrcdta(ji,jj,jkk+1) - ptrcdta(ji,jj,jkk) ) * zi 
    206                            ENDIF 
    207                         END DO 
    208                      ENDIF 
    209                   END DO 
    210                   DO jk = 1, jpkm1 
    211                      ptrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord 
    212                   END DO 
    213                   ptrcdta(ji,jj,jpk) = 0._wp 
    214                 END DO 
    215             END DO 
     200            DO_2D_11_11 
     201               DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
     202                  zl = gdept(ji,jj,jk,Kmm) 
     203                  IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data 
     204                     ztp(jk) = ptrcdta(ji,jj,1) 
     205                  ELSEIF( zl > gdept_1d(jpk) ) THEN         ! below the last level of data 
     206                     ztp(jk) = ptrcdta(ji,jj,jpkm1) 
     207                  ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1 
     208                     DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1) 
     209                        IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 
     210                           zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 
     211                           ztp(jk) = ptrcdta(ji,jj,jkk) + ( ptrcdta(ji,jj,jkk+1) - ptrcdta(ji,jj,jkk) ) * zi 
     212                        ENDIF 
     213                     END DO 
     214                  ENDIF 
     215               END DO 
     216               DO jk = 1, jpkm1 
     217                  ptrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord 
     218               END DO 
     219               ptrcdta(ji,jj,jpk) = 0._wp 
     220            END_2D 
    216221            !  
    217222         ELSE                                !==   z- or zps- coordinate   ==! 

  • NEMO/trunk/src/TOP/trcice.F90

    r11536 r12377  
    8585      ENDIF 
    8686      ! 
    87       REWIND( numnat_ref )              ! Namelist namtrc_ice in reference namelist : Passive tracer input data 
    8887      READ  ( numnat_ref, namtrc_ice, IOSTAT = ios, ERR = 901) 
    8988 901  IF( ios /= 0 )   CALL ctl_nam ( ios , ' namtrc_ice in reference namelist ' ) 
    90       REWIND( numnat_cfg )              ! Namelist namtrc_ice in configuration namelist : Pisces external sources of nutrients 
    9189      READ  ( numnat_cfg, namtrc_ice, IOSTAT = ios, ERR = 902 ) 
    9290 902  IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_ice in configuration namelist' ) 

  • NEMO/trunk/src/TOP/trcini.F90

    r12136 r12377  
    2121   USE daymod          ! calendar manager 
    2222   USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine) 
    23    USE trcsub          ! variables to substep passive tracers 
    2423   USE trcrst 
    2524   USE lib_mpp         ! distribued memory computing library 
    2625   USE trcice          ! tracers in sea ice 
    27    USE trcbc,   only : trc_bc_ini ! generalized Boundary Conditions 
     26   USE trcbc          ! generalized Boundary Conditions 
    2827  
    2928   IMPLICIT NONE 
    … …  
    3938CONTAINS 
    4039    
    41    SUBROUTINE trc_init 
     40   SUBROUTINE trc_init( Kbb, Kmm, Kaa ) 
    4241      !!--------------------------------------------------------------------- 
    4342      !!                     ***  ROUTINE trc_init  *** 
    … …  
    5150      !!                or read data or analytical formulation 
    5251      !!--------------------------------------------------------------------- 
     52      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa   ! time level indices 
    5353      ! 
    5454      IF( ln_timing )   CALL timing_start('trc_init') 
    … …  
    6060      CALL trc_nam       ! read passive tracers namelists 
    6161      CALL top_alloc()   ! allocate TOP arrays 
     62 
    6263      ! 
    6364      IF(.NOT.ln_trcdta )   ln_trc_ini(:) = .FALSE. 
    … …  
    6768      IF(lwp) WRITE(numout,*) 
    6869      ! 
    69       CALL trc_ini_sms   ! SMS 
    70       CALL trc_ini_trp   ! passive tracers transport 
    71       CALL trc_ice_ini   ! Tracers in sea ice 
     70      CALL trc_ini_sms( Kmm )   ! SMS 
     71      CALL trc_ini_trp          ! passive tracers transport 
     72      CALL trc_ice_ini          ! Tracers in sea ice 
    7273      ! 
    7374      IF( lwm .AND. sn_cfctl%l_trcstat ) THEN 
    … …  
    7576      ENDIF 
    7677      ! 
    77       CALL trc_ini_state  !  passive tracers initialisation : from a restart or from clim 
    78       IF( nn_dttrc /= 1 ) & 
    79       CALL trc_sub_ini    ! Initialize variables for substepping passive tracers 
    80       ! 
    81       CALL trc_ini_inv   ! Inventories 
     78      CALL trc_ini_state( Kbb, Kmm, Kaa )  !  passive tracers initialisation : from a restart or from clim 
     79      ! 
     80      CALL trc_ini_inv( Kmm )              ! Inventories 
    8281      ! 
    8382      IF( ln_timing )   CALL timing_stop('trc_init') 
    … …  
    8685 
    8786 
    88    SUBROUTINE trc_ini_inv 
     87   SUBROUTINE trc_ini_inv( Kmm ) 
    8988      !!---------------------------------------------------------------------- 
    9089      !!                     ***  ROUTINE trc_ini_stat  *** 
    9190      !! ** Purpose :      passive tracers inventories at initialsation phase 
    9291      !!---------------------------------------------------------------------- 
    93       INTEGER ::  jk, jn    ! dummy loop indices 
     92      INTEGER, INTENT(in) ::   Kmm    ! time level index 
     93      INTEGER             ::  jk, jn  ! dummy loop indices 
    9494      CHARACTER (len=25) :: charout 
    9595      !!---------------------------------------------------------------------- 
    … …  
    101101      !                          ! masked grid volume 
    102102      DO jk = 1, jpk 
    103          cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 
     103         cvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
    104104      END DO 
    105105      !                          ! total volume of the ocean  
    … …  
    108108      trai(:) = 0._wp            ! initial content of all tracers 
    109109      DO jn = 1, jptra 
    110          trai(jn) = trai(jn) + glob_sum( 'trcini', trn(:,:,:,jn) * cvol(:,:,:)   ) 
     110         trai(jn) = trai(jn) + glob_sum( 'trcini', tr(:,:,:,jn,Kmm) * cvol(:,:,:)   ) 
    111111      END DO 
    112112 
    … …  
    123123      ENDIF 
    124124      IF(lwp) WRITE(numout,*) 
    125       IF(ln_ctl) THEN            ! print mean trends (used for debugging) 
     125      IF(sn_cfctl%l_prttrc) THEN            ! print mean trends (used for debugging) 
    126126         CALL prt_ctl_trc_init 
    127127         WRITE(charout, FMT="('ini ')") 
    128128         CALL prt_ctl_trc_info( charout ) 
    129          CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
     129         CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm ) 
    130130      ENDIF 
    1311319000  FORMAT('      tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10) 
    … …  
    134134 
    135135 
    136    SUBROUTINE trc_ini_sms 
     136   SUBROUTINE trc_ini_sms( Kmm ) 
    137137      !!---------------------------------------------------------------------- 
    138138      !!                     ***  ROUTINE trc_ini_sms  *** 
    … …  
    145145      USE trcini_my_trc  ! MY_TRC   initialisation 
    146146      ! 
     147      INTEGER, INTENT(in) ::   Kmm ! time level indices 
    147148      INTEGER :: jn 
    148149      !!---------------------------------------------------------------------- 
    … …  
    158159         ln_trc_obc(jn) =       sn_tracer(jn)%llobc 
    159160      END DO 
     161      ! 
     162      IF( .NOT.ln_trcbc ) THEN 
     163         DO jn = 1, jp_bgc 
     164            ln_trc_sbc(jn) = .FALSE. 
     165            ln_trc_cbc(jn) = .FALSE. 
     166            ln_trc_obc(jn) = .FALSE. 
     167         END DO 
     168      ENDIF 
     169      
     170      lltrcbc = ( COUNT(ln_trc_sbc) + COUNT(ln_trc_obc) + COUNT(ln_trc_cbc) ) > 0  
    160171      !     
    161       IF( ln_pisces      )   CALL trc_ini_pisces     !  PISCES model 
    162       IF( ln_my_trc      )   CALL trc_ini_my_trc     !  MY_TRC model 
    163       IF( ll_cfc         )   CALL trc_ini_cfc        !  CFC's 
    164       IF( ln_c14         )   CALL trc_ini_c14        !  C14 model 
    165       IF( ln_age         )   CALL trc_ini_age        !  AGE 
     172      IF( ln_pisces      )   CALL trc_ini_pisces( Kmm )     !  PISCES model 
     173      IF( ln_my_trc      )   CALL trc_ini_my_trc( Kmm )     !  MY_TRC model 
     174      IF( ll_cfc         )   CALL trc_ini_cfc   ( Kmm )     !  CFC's 
     175      IF( ln_c14         )   CALL trc_ini_c14   ( Kmm )     !  C14 model 
     176      IF( ln_age         )   CALL trc_ini_age   ( Kmm )     !  AGE 
    166177      ! 
    167178      IF(lwp) THEN                   ! control print 
    … …  
    174185         END DO 
    175186      ENDIF 
     187      IF( lwp .AND. ln_trcbc .AND. lltrcbc ) THEN 
     188         WRITE(numout,*) 
     189         WRITE(numout,*) ' Applying tracer boundary conditions ' 
     190      ENDIF 
     191      
    1761929001  FORMAT(3x,i3,1x,a10,3x,l2,3x,l2,3x,l2,3x,l2) 
    177193      ! 
    … …  
    204220 
    205221 
    206    SUBROUTINE trc_ini_state 
     222   SUBROUTINE trc_ini_state( Kbb, Kmm, Kaa ) 
    207223      !!---------------------------------------------------------------------- 
    208224      !!                     ***  ROUTINE trc_ini_state *** 
    … …  
    213229      USE trcdta          ! initialisation from files 
    214230      ! 
    215       INTEGER :: jn, jl   ! dummy loop indices 
    216       !!---------------------------------------------------------------------- 
    217       ! 
    218       IF( ln_trcdta )   CALL trc_dta_ini( jptra )      ! set initial tracers values 
    219       ! 
    220       IF( ln_my_trc )   CALL trc_bc_ini ( jptra )      ! set tracers Boundary Conditions 
     231      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa   ! time level index 
     232      INTEGER             :: jn, jl          ! dummy loop indices 
     233      !!---------------------------------------------------------------------- 
     234      ! 
     235      IF( ln_trcdta )   CALL trc_dta_ini( jptra )           ! set initial tracers values 
     236      ! 
     237      IF( ln_trcbc .AND. lltrcbc )  THEN  
     238        CALL trc_bc_ini ( jptra, Kmm  )            ! set tracers Boundary Conditions 
     239        CALL trc_bc     ( nit000, Kmm, tr, Kaa )   ! tracers: surface and lateral Boundary Conditions 
     240      ENDIF 
    221241      ! 
    222242      ! 
    223243      IF( ln_rsttr ) THEN              ! restart from a file 
    224244        ! 
    225         CALL trc_rst_read 
     245        CALL trc_rst_read( Kbb, Kmm ) 
    226246        ! 
    227247      ELSE                             ! Initialisation of tracer from a file that may also be used for damping 
    … …  
    232252               IF( ln_trc_ini(jn) ) THEN 
    233253                  jl = n_trc_index(jn)  
    234                   CALL trc_dta( nit000, sf_trcdta(jl), rf_trfac(jl), trn(:,:,:,jn) ) 
     254                  CALL trc_dta( nit000, Kmm, sf_trcdta(jl), rf_trfac(jl), tr(:,:,:,jn,Kmm) ) 
    235255                  ! 
    236256                  ! deallocate data structure if data are not used for damping 
    … …  
    246266        ENDIF 
    247267        ! 
    248         trb(:,:,:,:) = trn(:,:,:,:) 
     268        tr(:,:,:,:,Kbb) = tr(:,:,:,:,Kmm) 
    249269        !  
    250270      ENDIF 
    251271      ! 
    252       tra(:,:,:,:) = 0._wp 
    253       !                                                         ! Partial top/bottom cell: GRADh(trn) 
     272      tr(:,:,:,:,Kaa) = 0._wp 
     273      !                                                         ! Partial top/bottom cell: GRADh(tr(Kmm)) 
    254274   END SUBROUTINE trc_ini_state 
    255275 

  • NEMO/trunk/src/TOP/trcnam.F90

    r11536 r12377  
    2323   USE trdtrc_oce  ! 
    2424   USE iom         ! I/O manager 
    25 #if defined key_mpp_mpi 
    26    USE lib_mpp, ONLY: ncom_dttrc 
    27 #endif 
    2825 
    2926   IMPLICIT NONE 
    … …  
    7976      ENDIF 
    8077      ! 
    81       rdttrc = rdt * FLOAT( nn_dttrc )          ! passive tracer time-step       
     78      rdttrc = rdt                              ! passive tracer time-step       
    8279      !  
    8380      IF(lwp) THEN                              ! control print 
    8481        WRITE(numout,*)  
    85         WRITE(numout,*) '   ==>>>   Passive Tracer  time step    rdttrc = nn_dttrc*rdt = ', rdttrc 
     82        WRITE(numout,*) '   ==>>>   Passive Tracer  time step    rdttrc = rdt = ', rdttrc 
    8683      ENDIF 
    8784      ! 
    … …  
    10097      INTEGER  ::   ios   ! Local integer 
    10198      !! 
    102       NAMELIST/namtrc_run/ nn_dttrc, ln_rsttr, nn_rsttr, ln_top_euler, & 
     99      NAMELIST/namtrc_run/ ln_rsttr, nn_rsttr, ln_top_euler, & 
    103100        &                  cn_trcrst_indir, cn_trcrst_outdir, cn_trcrst_in, cn_trcrst_out 
    104101      !!--------------------------------------------------------------------- 
    … …  
    108105      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    109106      ! 
    110       CALL ctl_opn( numnat_ref, 'namelist_top_ref'   , 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    111       CALL ctl_opn( numnat_cfg, 'namelist_top_cfg'   , 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
     107      CALL load_nml( numnat_ref, 'namelist_top_ref' , numout, lwm ) 
     108      CALL load_nml( numnat_cfg, 'namelist_top_cfg' , numout, lwm ) 
    112109      IF(lwm) CALL ctl_opn( numont, 'output.namelist.top', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., 1 ) 
    113110      ! 
    114       REWIND( numnat_ref )              ! Namelist namtrc in reference namelist : Passive tracer variables 
    115111      READ  ( numnat_ref, namtrc_run, IOSTAT = ios, ERR = 901) 
    116112901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc in reference namelist' ) 
    117       REWIND( numnat_cfg )              ! Namelist namtrc in configuration namelist : Passive tracer variables 
    118113      READ  ( numnat_cfg, namtrc_run, IOSTAT = ios, ERR = 902 ) 
    119114902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc in configuration namelist' ) 
    120115      IF(lwm) WRITE( numont, namtrc_run ) 
    121116 
    122       nittrc000 = nit000 + nn_dttrc - 1      ! first time step of tracer model 
     117      nittrc000 = nit000             ! first time step of tracer model 
    123118 
    124119      IF(lwp) THEN                   ! control print 
    125120         WRITE(numout,*) '   Namelist : namtrc_run' 
    126          WRITE(numout,*) '      time step freq. for passive tracer           nn_dttrc      = ', nn_dttrc 
    127121         WRITE(numout,*) '      restart  for passive tracer                  ln_rsttr      = ', ln_rsttr 
    128122         WRITE(numout,*) '      control of time step for passive tracer      nn_rsttr      = ', nn_rsttr 
    … …  
    131125      ENDIF 
    132126      ! 
    133 #if defined key_mpp_mpi 
    134       ncom_dttrc = nn_dttrc    ! make nn_fsbc available for lib_mpp 
    135 #endif 
    136       ! 
    137127   END SUBROUTINE trc_nam_run 
    138128 
    … …  
    148138      !! 
    149139      NAMELIST/namtrc/jp_bgc, ln_pisces, ln_my_trc, ln_age, ln_cfc11, ln_cfc12, ln_sf6, ln_c14, & 
    150          &            sn_tracer, ln_trcdta, ln_trcdmp, ln_trcdmp_clo, jp_dia3d, jp_dia2d 
     140         &            sn_tracer, ln_trcdta, ln_trcbc, ln_trcdmp, ln_trcdmp_clo, jp_dia3d, jp_dia2d 
    151141      !!--------------------------------------------------------------------- 
    152142      ! Dummy settings to fill tracers data structure 
    … …  
    158148      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    159149 
    160       REWIND( numnat_ref )              ! Namelist namtrc in reference namelist : Passive tracer variables 
    161150      READ  ( numnat_ref, namtrc, IOSTAT = ios, ERR = 901) 
    162151901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc in reference namelist' ) 
    163       REWIND( numnat_cfg )              ! Namelist namtrc in configuration namelist : Passive tracer variables 
    164152      READ  ( numnat_cfg, namtrc, IOSTAT = ios, ERR = 902 ) 
    165153902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc in configuration namelist' ) 
    … …  
    222210         WRITE(numout,*) '      Simulating C14   passive tracer              ln_c14        = ', ln_c14 
    223211         WRITE(numout,*) '      Read inputs data from file (y/n)             ln_trcdta     = ', ln_trcdta 
     212         WRITE(numout,*) '      Enable surface, lateral or open boundaries conditions (y/n)  ln_trcbc  = ', ln_trcbc 
    224213         WRITE(numout,*) '      Damping of passive tracer (y/n)              ln_trcdmp     = ', ln_trcdmp 
    225214         WRITE(numout,*) '      Restoring of tracer on closed seas           ln_trcdmp_clo = ', ln_trcdmp_clo 
    … …  
    228217      IF( ll_cfc .OR. ln_c14 ) THEN 
    229218        !                             ! Open namelist files 
    230         CALL ctl_opn( numtrc_ref, 'namelist_trc_ref'   ,     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    231         CALL ctl_opn( numtrc_cfg, 'namelist_trc_cfg'   ,     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
     219        CALL load_nml( numtrc_ref, 'namelist_trc_ref' , numout, lwm ) 
     220        CALL load_nml( numtrc_cfg, 'namelist_trc_cfg' , numout, lwm ) 
    232221        IF(lwm) CALL ctl_opn( numonr, 'output.namelist.trc', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    233222        ! 
    … …  
    261250      ALLOCATE( ln_trdtrc(jptra) )  
    262251      ! 
    263       REWIND( numnat_ref )              ! Namelist namtrc_trd in reference namelist : Passive tracer trends 
    264252      READ  ( numnat_ref, namtrc_trd, IOSTAT = ios, ERR = 905) 
    265253905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_trd in reference namelist' ) 
    266       REWIND( numnat_cfg )              ! Namelist namtrc_trd in configuration namelist : Passive tracer trends 
    267254      READ  ( numnat_cfg, namtrc_trd, IOSTAT = ios, ERR = 906 ) 
    268255906   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_trd in configuration namelist' ) 

  • NEMO/trunk/src/TOP/trcrst.F90

    r11536 r12377  
    7676 
    7777      ! to get better performances with NetCDF format: 
    78       ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1) 
    79       ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc + 1 
    80       IF( kt == nitrst - 2*nn_dttrc .OR. nn_stock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .AND. .NOT. lrst_trc ) ) THEN 
     78      ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 1) 
     79      ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 1 
     80      IF( kt == nitrst - 1 .OR. nn_stock == 1 .OR. ( kt == nitend - 1 .AND. .NOT. lrst_trc ) ) THEN 
    8181         ! beware of the format used to write kt (default is i8.8, that should be large enough) 
    8282         IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst 
    … …  
    9696   END SUBROUTINE trc_rst_opn 
    9797 
    98    SUBROUTINE trc_rst_read 
     98   SUBROUTINE trc_rst_read( Kbb, Kmm ) 
    9999      !!---------------------------------------------------------------------- 
    100100      !!                    ***  trc_rst_opn  *** 
    … …  
    102102      !! ** purpose  :   read passive tracer fields in restart files 
    103103      !!---------------------------------------------------------------------- 
     104      INTEGER, INTENT( in ) ::   Kbb, Kmm  ! time level indices 
    104105      INTEGER  ::  jn      
    105106 
    … …  
    112113      ! READ prognostic variables and computes diagnostic variable 
    113114      DO jn = 1, jptra 
    114          CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 
    115       END DO 
    116  
    117       DO jn = 1, jptra 
    118          CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 
     115         CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), tr(:,:,:,jn,Kmm) ) 
     116      END DO 
     117 
     118      DO jn = 1, jptra 
     119         CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), tr(:,:,:,jn,Kbb) ) 
    119120      END DO 
    120121      ! 
    … …  
    123124   END SUBROUTINE trc_rst_read 
    124125 
    125    SUBROUTINE trc_rst_wri( kt ) 
     126   SUBROUTINE trc_rst_wri( kt, Kbb, Kmm, Krhs ) 
    126127      !!---------------------------------------------------------------------- 
    127128      !!                    ***  trc_rst_wri  *** 
    … …  
    129130      !! ** purpose  :   write passive tracer fields in restart files 
    130131      !!---------------------------------------------------------------------- 
    131       INTEGER, INTENT( in ) ::   kt    ! ocean time-step index 
     132      INTEGER, INTENT( in ) ::   kt              ! ocean time-step index 
     133      INTEGER, INTENT( in ) ::   Kbb, Kmm, Krhs  ! time level indices 
    132134      !! 
    133135      INTEGER  :: jn 
    … …  
    138140      ! --------------------  
    139141      DO jn = 1, jptra 
    140          CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 
    141       END DO 
    142  
    143       DO jn = 1, jptra 
    144          CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 
     142         CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), tr(:,:,:,jn,Kmm) ) 
     143      END DO 
     144 
     145      DO jn = 1, jptra 
     146         CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), tr(:,:,:,jn,Kbb) ) 
    145147      END DO 
    146148      ! 
    … …  
    148150     
    149151      IF( kt == nitrst ) THEN 
    150           CALL trc_rst_stat            ! statistics 
     152          CALL trc_rst_stat( Kmm, Krhs )             ! statistics 
    151153          CALL iom_close( numrtw )     ! close the restart file (only at last time step) 
    152154#if ! defined key_trdmxl_trc 
    … …  
    219221            ENDIF 
    220222            ! Control of date  
    221             IF( nittrc000  - NINT( zkt ) /= nn_dttrc .AND.  nn_rsttr /= 0 )                                  & 
     223            IF( nittrc000  - NINT( zkt ) /= 1 .AND.  nn_rsttr /= 0 )                                  & 
    222224               &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 & 
    223225               &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' ) 
    … …  
    299301 
    300302 
    301    SUBROUTINE trc_rst_stat 
     303   SUBROUTINE trc_rst_stat( Kmm, Krhs ) 
    302304      !!---------------------------------------------------------------------- 
    303305      !!                    ***  trc_rst_stat  *** 
    … …  
    305307      !! ** purpose  :   Compute tracers statistics 
    306308      !!---------------------------------------------------------------------- 
     309      INTEGER, INTENT( in ) ::   Kmm, Krhs  ! time level indices 
    307310      INTEGER  :: jk, jn 
    308311      REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift 
    … …  
    317320      ! 
    318321      DO jk = 1, jpk 
    319          zvol(:,:,jk) = e1e2t(:,:) * e3t_a(:,:,jk) * tmask(:,:,jk) 
    320       END DO 
    321       ! 
    322       DO jn = 1, jptra 
    323          ztraf = glob_sum( 'trcrst', trn(:,:,:,jn) * zvol(:,:,:) ) 
    324          zmin  = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
    325          zmax  = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
     322         zvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Krhs) * tmask(:,:,jk) 
     323      END DO 
     324      ! 
     325      DO jn = 1, jptra 
     326         ztraf = glob_sum( 'trcrst', tr(:,:,:,jn,Kmm) * zvol(:,:,:) ) 
     327         zmin  = MINVAL( tr(:,:,:,jn,Kmm), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
     328         zmax  = MAXVAL( tr(:,:,:,jn,Kmm), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
    326329         IF( lk_mpp ) THEN 
    327330            CALL mpp_min( 'trcrst', zmin )      ! min over the global domain 
    … …  
    343346   !!---------------------------------------------------------------------- 
    344347CONTAINS 
    345    SUBROUTINE trc_rst_read                      ! Empty routines 
     348   SUBROUTINE trc_rst_read( Kbb, Kmm)                      ! Empty routines 
     349      INTEGER, INTENT( in ) :: Kbb, Kmm  ! time level indices 
    346350   END SUBROUTINE trc_rst_read 
    347    SUBROUTINE trc_rst_wri( kt ) 
    348       INTEGER, INTENT ( in ) :: kt 
     351   SUBROUTINE trc_rst_wri( kt, Kbb, Kmm, Krhs ) 
     352      INTEGER, INTENT( in ) :: kt 
     353      INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs  ! time level indices 
    349354      WRITE(*,*) 'trc_rst_wri: You should not have seen this print! error?', kt 
    350355   END SUBROUTINE trc_rst_wri    

  • NEMO/trunk/src/TOP/trcsms.F90

    r10068 r12377  
    3434CONTAINS 
    3535 
    36    SUBROUTINE trc_sms( kt ) 
     36   SUBROUTINE trc_sms( kt, Kbb, Kmm , Krhs ) 
    3737      !!--------------------------------------------------------------------- 
    3838      !!                     ***  ROUTINE trc_sms  *** 
    … …  
    4242      !! ** Method  : -  call the main routine of of each defined tracer model 
    4343      !! ------------------------------------------------------------------------------------- 
    44       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     44      INTEGER, INTENT( in ) ::   kt        ! ocean time-step index       
     45      INTEGER, INTENT( in ) ::   Kbb, Kmm, Krhs ! time level indices 
    4546      !! 
    4647      CHARACTER (len=25) :: charout 
    … …  
    4950      IF( ln_timing )   CALL timing_start('trc_sms') 
    5051      ! 
    51       IF( ln_pisces  )   CALL trc_sms_pisces ( kt )    ! main program of PISCES  
    52       IF( ll_cfc     )   CALL trc_sms_cfc    ( kt )    ! surface fluxes of CFC 
    53       IF( ln_c14     )   CALL trc_sms_c14    ( kt )    ! surface fluxes of C14 
    54       IF( ln_age     )   CALL trc_sms_age    ( kt )    ! Age tracer 
    55       IF( ln_my_trc  )   CALL trc_sms_my_trc ( kt )    ! MY_TRC  tracers 
     52      IF( ln_pisces  )   CALL trc_sms_pisces ( kt, Kbb, Kmm, Krhs )    ! main program of PISCES  
     53      IF( ll_cfc     )   CALL trc_sms_cfc    ( kt, Kbb, Kmm, Krhs )    ! surface fluxes of CFC 
     54      IF( ln_c14     )   CALL trc_sms_c14    ( kt, Kbb, Kmm, Krhs )    ! surface fluxes of C14 
     55      IF( ln_age     )   CALL trc_sms_age    ( kt, Kbb, Kmm, Krhs )    ! Age tracer 
     56      IF( ln_my_trc  )   CALL trc_sms_my_trc ( kt, Kbb, Kmm, Krhs )    ! MY_TRC  tracers 
    5657 
    57       IF(ln_ctl) THEN      ! print mean trends (used for debugging) 
     58      IF(sn_cfctl%l_prttrc) THEN                       ! print mean trends (used for debugging) 
    5859         WRITE(charout, FMT="('sms ')") 
    5960         CALL prt_ctl_trc_info( charout ) 
    60          CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
     61         CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm ) 
    6162      ENDIF 
    6263      ! 

  • NEMO/trunk/src/TOP/trcstp.F90

    r12136 r12377  
    55   !!====================================================================== 
    66   !! History :  1.0  !  2004-03  (C. Ethe)  Original 
     7   !!            4.1  !  2019-08  (A. Coward, D. Storkey) rewrite in preparation for new timestepping scheme 
    78   !!---------------------------------------------------------------------- 
    89#if defined key_top 
    … …  
    1718   USE trcwri 
    1819   USE trcrst 
    19    USE trcsub         ! 
    2020   USE trdtrc_oce 
    2121   USE trdmxl_trc 
    … …  
    4444CONTAINS 
    4545 
    46    SUBROUTINE trc_stp( kt ) 
     46   SUBROUTINE trc_stp( kt, Kbb, Kmm, Krhs, Kaa ) 
    4747      !!------------------------------------------------------------------- 
    4848      !!                     ***  ROUTINE trc_stp  *** 
    … …  
    5353      !!                Update the passive tracers 
    5454      !!------------------------------------------------------------------- 
    55       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     55      INTEGER, INTENT( in ) :: kt                  ! ocean time-step index 
     56      INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs, Kaa ! time level indices 
    5657      ! 
    5758      INTEGER ::   jk, jn   ! dummy loop indices 
    … …  
    6566      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000 
    6667         r2dttrc =  rdttrc           ! = rdttrc (use or restarting with Euler time stepping) 
    67       ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1 
    68          r2dttrc = 2. * rdttrc       ! = 2 rdttrc (leapfrog) 
    69       ENDIF 
    70       ! 
    71       ll_trcstat  = ( ln_ctl .OR. sn_cfctl%l_trcstat ) .AND. & 
     68      ELSEIF( kt <= nittrc000 + 1 ) THEN                                     ! at nittrc000 or nittrc000+1  
     69         r2dttrc = 2. * rdttrc       ! = 2 rdttrc (leapfrog)  
     70      ENDIF 
     71      ! 
     72      ll_trcstat  = ( sn_cfctl%l_trcstat ) .AND. & 
    7273     &              ( ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) ) 
    7374 
    … …  
    7778      IF( .NOT.ln_linssh ) THEN                                           ! update ocean volume due to ssh temporal evolution 
    7879         DO jk = 1, jpk 
    79             cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 
     80            cvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
    8081         END DO 
    81          IF ( ln_ctl .OR. kt == nitrst .OR. ( ln_check_mass .AND. kt == nitend )              & 
     82         IF ( ll_trcstat .OR. kt == nitrst .OR. ( ln_check_mass .AND. kt == nitend )   & 
    8283            & .OR. iom_use( "pno3tot" ) .OR. iom_use( "ppo4tot" ) .OR. iom_use( "psiltot" )   & 
    8384            & .OR. iom_use( "palktot" ) .OR. iom_use( "pfertot" ) )                           & 
    … …  
    8788      IF( l_trcdm2dc )   CALL trc_mean_qsr( kt ) 
    8889      !     
    89       IF( nn_dttrc /= 1 )   CALL trc_sub_stp( kt )  ! averaging physical variables for sub-stepping 
    90       !     
    91       IF( MOD( kt , nn_dttrc ) == 0 ) THEN      ! only every nn_dttrc time step 
    92          ! 
    93          IF(ln_ctl) THEN 
    94             WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear 
    95             CALL prt_ctl_trc_info(charout) 
    96          ENDIF 
    97          ! 
    98          tra(:,:,:,:) = 0.e0 
    99          ! 
    100                                    CALL trc_rst_opn  ( kt )       ! Open tracer restart file  
    101          IF( lrst_trc )            CALL trc_rst_cal  ( kt, 'WRITE' )   ! calendar 
    102                                    CALL trc_wri      ( kt )       ! output of passive tracers with iom I/O manager 
    103                                    CALL trc_sms      ( kt )       ! tracers: sinks and sources 
    104                                    CALL trc_trp      ( kt )       ! transport of passive tracers 
    105          IF( kt == nittrc000 ) THEN 
    106             CALL iom_close( numrtr )       ! close input tracer restart file 
    107             IF(lwm) CALL FLUSH( numont )   ! flush namelist output 
    108          ENDIF 
    109          IF( lrst_trc )            CALL trc_rst_wri  ( kt )       ! write tracer restart file 
    110          IF( lk_trdmxl_trc  )      CALL trd_mxl_trc  ( kt )       ! trends: Mixed-layer 
    111          ! 
    112          IF( nn_dttrc /= 1   )     CALL trc_sub_reset( kt )       ! resetting physical variables when sub-stepping 
    113          ! 
     90      ! 
     91      IF(sn_cfctl%l_prttrc) THEN 
     92         WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear 
     93         CALL prt_ctl_trc_info(charout) 
     94      ENDIF 
     95      ! 
     96      tr(:,:,:,:,Krhs) = 0._wp 
     97      ! 
     98      CALL trc_rst_opn  ( kt )                            ! Open tracer restart file  
     99      IF( lrst_trc )  CALL trc_rst_cal  ( kt, 'WRITE' )   ! calendar 
     100      CALL trc_wri      ( kt,      Kmm            )       ! output of passive tracers with iom I/O manager 
     101      CALL trc_sms      ( kt, Kbb, Kmm, Krhs      )       ! tracers: sinks and sources 
     102      CALL trc_trp      ( kt, Kbb, Kmm, Krhs, Kaa )       ! transport of passive tracers 
     103           ! 
     104           ! Note passive tracers have been time-filtered in trc_trp but the time level 
     105           ! indices will not be swapped until after tra_atf/dyn_atf/ssh_atf in stp. Subsequent calls here 
     106           ! anticipate this update which will be: Nrhs= Nbb ; Nbb = Nnn ; Nnn = Naa ; Naa = Nrhs 
     107           ! and use the filtered levels explicitly. 
     108           ! 
     109      IF( kt == nittrc000 ) THEN 
     110         CALL iom_close( numrtr )                         ! close input tracer restart file 
     111         IF(lwm) CALL FLUSH( numont )                     ! flush namelist output 
     112      ENDIF 
     113      IF( lrst_trc )            CALL trc_rst_wri  ( kt, Kmm, Kaa, Kbb  )       ! write tracer restart file 
     114      IF( lk_trdmxl_trc  )      CALL trd_mxl_trc  ( kt,      Kaa       )       ! trends: Mixed-layer 
     115      ! 
     116      IF( ln_top_euler ) THEN  
     117         ! For Euler timestepping for TOP we need to copy the "after" to the "now" fields  
     118         ! here then after the (leapfrog) swapping of the time-level indices in OCE/step.F90 we have  
     119         ! "before" fields = "now" fields. 
     120         tr(:,:,:,:,Kmm) = tr(:,:,:,:,Kaa) 
    114121      ENDIF 
    115122      ! 
    … …  
    117124         ztrai = 0._wp                                                   !  content of all tracers 
    118125         DO jn = 1, jptra 
    119             ztrai = ztrai + glob_sum( 'trcstp', trn(:,:,:,jn) * cvol(:,:,:)   ) 
     126            ztrai = ztrai + glob_sum( 'trcstp', tr(:,:,:,jn,Kaa) * cvol(:,:,:)   ) 
    120127         END DO 
    121128         IF( lwm ) WRITE(numstr,9300) kt,  ztrai / areatot 
    … …  
    126133      ! 
    127134   END SUBROUTINE trc_stp 
     135 
    128136 
    129137   SUBROUTINE trc_stp_ctl 

  • NEMO/trunk/src/TOP/trcwri.F90

    r12280 r12377  
    3030CONTAINS 
    3131 
    32    SUBROUTINE trc_wri( kt ) 
     32   SUBROUTINE trc_wri( kt, Kmm ) 
    3333      !!--------------------------------------------------------------------- 
    3434      !!                     ***  ROUTINE trc_wri  *** 
    … …  
    3737      !!--------------------------------------------------------------------- 
    3838      INTEGER, INTENT( in )     :: kt 
     39      INTEGER, INTENT( in )     :: Kmm  ! time level indices 
    3940      ! 
    4041      INTEGER                   :: jn 
    … …  
    5354           CLOSE(inum) 
    5455        ENDIF 
    55         ! Output of initial vertical scale factor 
    56         CALL iom_put("e3t_0", e3t_0(:,:,:) ) 
    57         CALL iom_put("e3u_0", e3u_0(:,:,:) ) 
    58         CALL iom_put("e3v_0", e3v_0(:,:,:) ) 
    59         ! 
    60         CALL iom_put( "e3t" , e3t_n(:,:,:) ) 
    61         CALL iom_put( "e3u" , e3u_n(:,:,:) ) 
    62         CALL iom_put( "e3v" , e3v_n(:,:,:) ) 
    63         ! 
     56 
     57       ! Output of initial vertical scale factor 
     58       CALL iom_put( "e3t_0", e3t_0(:,:,:) ) 
     59       CALL iom_put( "e3u_0", e3u_0(:,:,:) ) 
     60       CALL iom_put( "e3v_0", e3v_0(:,:,:) ) 
     61       ! 
     62       CALL iom_put( "e3t" , e3t(:,:,:,Kmm) ) 
     63       CALL iom_put( "e3u" , e3u(:,:,:,Kmm) ) 
     64       CALL iom_put( "e3v" , e3v(:,:,:,Kmm) ) 
     65       ! 
    6466      ENDIF 
    6567      ! write the tracer concentrations in the file 
    6668      ! --------------------------------------- 
    67       IF( ln_pisces  )   CALL trc_wri_pisces     ! PISCES  
    68       IF( ll_cfc     )   CALL trc_wri_cfc        ! surface fluxes of CFC 
    69       IF( ln_c14     )   CALL trc_wri_c14        ! surface fluxes of C14 
    70       IF( ln_age     )   CALL trc_wri_age        ! AGE tracer 
    71       IF( ln_my_trc  )   CALL trc_wri_my_trc     ! MY_TRC  tracers 
     69      IF( ln_pisces  )   CALL trc_wri_pisces( Kmm )     ! PISCES  
     70      IF( ll_cfc     )   CALL trc_wri_cfc   ( Kmm )     ! surface fluxes of CFC 
     71      IF( ln_c14     )   CALL trc_wri_c14   ( Kmm )     ! surface fluxes of C14 
     72      IF( ln_age     )   CALL trc_wri_age   ( Kmm )     ! AGE tracer 
     73      IF( ln_my_trc  )   CALL trc_wri_my_trc( Kmm )     ! MY_TRC  tracers 
    7274      ! 
    7375      IF( ln_timing )   CALL timing_stop('trc_wri') 
    … …  
    8183   PUBLIC trc_wri 
    8284CONTAINS 
    83    SUBROUTINE trc_wri( kt )                     ! Empty routine    
     85   SUBROUTINE trc_wri( kt, Kmm )                     ! Empty routine    
    8486   INTEGER, INTENT(in) :: kt 
     87   INTEGER, INTENT(in) :: Kmm  ! time level indices 
    8588   END SUBROUTINE trc_wri 
    8689#endif 
Note: See TracChangeset for help on using the changeset viewer.