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 13463 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP – NEMO

Ignore:
Timestamp:
2020-09-14T17:40:34+02:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2195:update to trunk 13461

Location:
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
Files:
4 deleted
89 edited
2 copied

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS

    • 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_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@13382        sette 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/AGE/trcini_age.F90

    r10070 r13463  
    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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/AGE/trcnam_age.F90

    r10069 r13463  
    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) 
    58 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namage in reference namelist', lwp ) 
    59       REWIND( numnat_cfg )              ! Namelist namagedate in configuration namelist : AGE parameters 
     57901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namage in reference namelist' ) 
    6058      READ  ( numnat_cfg, namage, IOSTAT = ios, ERR = 902 ) 
    61 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namage in configuration namelist', lwp ) 
     59902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namage in configuration namelist' ) 
    6260      IF(lwm) WRITE ( numont, namage ) 
    6361      ! 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/AGE/trcsms_age.F90

    r10070 r13463  
    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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/AGE/trcwri_age.F90

    r10070 r13463  
    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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/C14/trcatm_c14.F90

    r10069 r13463  
    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( 1, 1, 1, 1 ) 
     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 
    … …  
    223223      IF(kc14typ >= 1) THEN  ! Transient C14 & CO2 
    224224      ! 
    225          tyrc14_now = tyrc14_now + ( rdt / ( rday * nyear_len(1)) )    !  current time step in yr relative to tyrc14_beg 
     225         tyrc14_now = tyrc14_now + ( rn_Dt / ( rday * nyear_len(1)) )    !  current time step in yr relative to tyrc14_beg 
    226226      ! 
    227227      ! CO2 -------------------------------------------------------- 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/C14/trcini_c14.F90

    r10069 r13463  
    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 
    … …  
    6869        !  
    6970        CALL iom_get( numrtr, 'co2sbc', co2sbc )  
    70         CALL iom_get( numrtr, jpdom_autoglo, 'c14sbc', c14sbc )  
    71         CALL iom_get( numrtr, jpdom_autoglo, 'exch_co2', exch_co2 )  
    72         CALL iom_get( numrtr, jpdom_autoglo, 'exch_c14', exch_c14 )  
    73         CALL iom_get( numrtr, jpdom_autoglo, 'qtr_c14', qtr_c14 ) 
     71        CALL iom_get( numrtr, jpdom_auto, 'c14sbc', c14sbc )  
     72        CALL iom_get( numrtr, jpdom_auto, 'exch_co2', exch_co2 )  
     73        CALL iom_get( numrtr, jpdom_auto, 'exch_c14', exch_c14 )  
     74        CALL iom_get( numrtr, jpdom_auto, 'qtr_c14', qtr_c14 ) 
    7475        ! 
    7576      END IF 
    … …  
    8485      ELSE 
    8586        ! 
    86         CALL iom_get( numrtr, jpdom_autoglo, 'qint_c14', qint_c14 )  
     87        CALL iom_get( numrtr, jpdom_auto, 'qint_c14', qint_c14 )  
    8788        ! 
    8889      ENDIF 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/C14/trcnam_c14.F90

    r10069 r13463  
    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) 
    65 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc14_typ in reference namelist', lwp ) 
    66       REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist  
     64901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc14_typ in reference namelist' ) 
    6765      READ  ( numtrc_cfg, namc14_typ, IOSTAT = ios, ERR = 902) 
    68 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc14_typ in configuration namelist', lwp ) 
     66902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc14_typ in configuration namelist' ) 
    6967      IF(lwm) WRITE ( numonr, namc14_typ ) 
    7068      ! 
    … …  
    7876      ENDIF 
    7977 
    80       REWIND( numtrc_ref )              ! Namelist namc14_typ in reference namelist : 
    8178      READ  ( numtrc_ref, namc14_sbc, IOSTAT = ios, ERR = 903) 
    82 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc14_sbc in reference namelist', lwp ) 
    83       REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist  
     79903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc14_sbc in reference namelist' ) 
    8480      READ  ( numtrc_cfg, namc14_sbc, IOSTAT = ios, ERR = 904) 
    85 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc14_sbc in configuration namelist', lwp ) 
     81904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc14_sbc in configuration namelist' ) 
    8682      IF(lwm) WRITE( numonr, namc14_sbc ) 
    8783      ! 
    … …  
    9490      ENDIF 
    9591 
    96       REWIND( numtrc_ref )              ! Namelist namc14_typ in reference namelist : 
    9792      READ  ( numtrc_ref, namc14_fcg, IOSTAT = ios, ERR = 905) 
    98 905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc14_fcg in reference namelist', lwp ) 
    99       REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist  
     93905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc14_fcg in reference namelist' ) 
    10094      READ  ( numtrc_cfg, namc14_fcg, IOSTAT = ios, ERR = 906) 
    101 906   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc14_fcg in configuration namelist', lwp ) 
     95906   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc14_fcg in configuration namelist' ) 
    10296      IF(lwm) WRITE ( numonr, namc14_fcg ) 
    10397      ! 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/C14/trcsms_c14.F90

    r10069 r13463  
    2626   PUBLIC   trc_sms_c14       ! called in trcsms.F90 
    2727 
     28   !! * Substitutions 
     29#  include "do_loop_substitute.h90" 
     30#  include "domzgr_substitute.h90" 
    2831   !!---------------------------------------------------------------------- 
    2932   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    3336CONTAINS 
    3437 
    35    SUBROUTINE trc_sms_c14( kt ) 
     38   SUBROUTINE trc_sms_c14( kt, Kbb, Kmm, Krhs ) 
    3639      !!---------------------------------------------------------------------- 
    3740      !!                  ***  ROUTINE trc_sms_c14  *** 
    … …  
    4649      !            freshwater fluxes which should not impact the C14/C ratio 
    4750      ! 
    48       !        =>   Delta-C14= ( trn(...jp_c14) -1)*1000. 
     51      !        =>   Delta-C14= ( tr(...jp_c14,Kmm) -1)*1000. 
    4952      !! 
    5053      !!---------------------------------------------------------------------- 
    5154      ! 
    52       INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     55      INTEGER, INTENT(in) ::   kt               ! ocean time-step index 
     56      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs   ! ocean time level 
    5357      ! 
    54       INTEGER  :: ji, jj, jk         ! dummy loop indices  
     58      INTEGER  :: ji, jj, jk        ! dummy loop indices  
    5559      REAL(wp) :: zt, ztp, zsk      ! dummy variables 
    5660      REAL(wp) :: zsol              ! solubility 
    … …  
    7781      ! ------------------------------------------------------------------- 
    7882 
    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 
     83      DO_2D( 1, 1, 1, 1 ) 
     84         IF( tmask(ji,jj,1) >  0. ) THEN 
     85            ! 
     86            zt   = MIN( 40. , ts(ji,jj,1,jp_tem,Kmm) ) 
     87            ! 
     88            !  Computation of solubility zsol in [mol/(L * atm)] 
     89            !   after Wanninkhof (2014) referencing Weiss (1974) 
     90            ztp  = ( zt + 273.16 ) * 0.01 
     91            zsk  = 0.027766 + ztp * ( -0.025888 + 0.0050578 * ztp )   ! [mol/(L * atm)] 
     92            zsol = EXP( -58.0931 + 90.5069 / ztp  + 22.2940 * LOG( ztp ) + zsk * ts(ji,jj,1,jp_sal,Kmm) ) 
     93            ! convert solubilities [mol/(L * atm)] -> [mol/(m^3 * ppm)] 
     94            zsol = zsol * 1.e-03 
    9295 
    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 ) ) ) 
     96            ! Computes the Schmidt number of CO2 in seawater 
     97            !               Wanninkhof-2014 
     98            zsch = 2116.8 + zt * ( -136.25 + zt * (4.7353 + zt * (-0.092307 + 0.0007555 * zt ) ) ) 
    9699 
    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) 
     100            ! Wanninkhof Piston velocity: zpv in units [m/s] 
     101            zv2 = xkwind * (wndm(ji,jj) * wndm(ji,jj))              ! wind speed module at T points 
     102            ! chemical enhancement (Wanninkhof & Knox, 1996) 
     103            IF( ln_chemh ) zv2 = zv2 + 2.5 * ( 0.5246 + zt * (0.016256 + 0.00049946  * zt ) ) 
     104            zv2 = zv2/360000._wp                                    ! conversion cm/h -> m/s 
     105            ! 
     106            zpv  = ( zv2 * SQRT( 660./ zsch ) ) * ( 1. - fr_i(ji,jj) ) * tmask(ji,jj,1) 
    104107 
    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 
     108            ! CO2 piston velocity (m/s) 
     109            exch_co2(ji,jj)= zpv 
     110            ! CO2 invasion rate (mol/ppm/m2/s) = 1st part of 14C/C exchange velocity 
     111            exch_c14(ji,jj)= zpv * zsol 
     112         ELSE 
     113            exch_co2(ji,jj) = 0._wp 
     114            exch_c14(ji,jj) = 0._wp 
     115         ENDIF 
     116      END_2D 
    115117 
    116118      ! Exchange velocity for 14C/C ratio (m/s) 
    … …  
    120122      ! Flux of C-14 from air-to-sea; units: (C14/C ratio) x m/s 
    121123      !                               already masked 
    122       qtr_c14(:,:) = exch_c14(:,:) * ( c14sbc(:,:) - trb(:,:,1,jp_c14) ) 
     124      qtr_c14(:,:) = exch_c14(:,:) * ( c14sbc(:,:) - tr(:,:,1,jp_c14,Kbb) ) 
    123125             
    124126      ! cumulation of air-to-sea flux at each time step 
    125       qint_c14(:,:) = qint_c14(:,:) + qtr_c14(:,:) * rdttrc 
     127      qint_c14(:,:) = qint_c14(:,:) + qtr_c14(:,:) * rn_Dt 
    126128      ! 
    127129      ! 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 
     130      DO_2D( 1, 1, 1, 1 ) 
     131         tr(ji,jj,1,jp_c14,Krhs) = tr(ji,jj,1,jp_c14,Krhs) + qtr_c14(ji,jj) / e3t(ji,jj,1,Kmm)  
     132      END_2D 
    133133      ! 
    134134      ! 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 
     135      DO_3D( 1, 1, 1, 1, 1, jpk ) 
     136         ! 
     137         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)  
     138         ! 
     139      END_3D 
    144140      ! 
    145141      IF( lrst_trc ) THEN 
    … …  
    157153      ENDIF 
    158154 
    159       IF( l_trdtrc )  CALL trd_trc( tra(:,:,:,jp_c14), 1, jptra_sms, kt )   ! save trends 
     155      IF( l_trdtrc )  CALL trd_trc( tr(:,:,:,jp_c14,Krhs), 1, jptra_sms, kt, Kmm )   ! save trends 
    160156      ! 
    161157      IF( ln_timing )   CALL timing_stop('trc_sms_c14') 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/C14/trcwri_c14.F90

    r10425 r13463  
    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( 1, 1, 1, 1, 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( 1, 1, 1, 1 ) 
     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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/CFC/trcini_cfc.F90

    r10068 r13463  
    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( 1, 1, 1, 1 ) 
     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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/CFC/trcnam_cfc.F90

    r10068 r13463  
    5151      ENDIF 
    5252      ! 
    53       REWIND( numtrc_ref )              ! Namelist namcfcdate in reference namelist : CFC parameters 
    5453      READ  ( numtrc_ref, namcfc, IOSTAT = ios, ERR = 901) 
    55 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfc in reference namelist', lwp ) 
    56       REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist : CFC parameters 
     54901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfc in reference namelist' ) 
    5755      READ  ( numtrc_cfg, namcfc, IOSTAT = ios, ERR = 902 ) 
    58 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfc in configuration namelist', lwp ) 
     56902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfc in configuration namelist' ) 
    5957      IF(lwm) WRITE( numonr, namcfc ) 
    6058      IF(lwm) CALL FLUSH ( numonr )     ! flush output namelist CFC 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/CFC/trcsms_cfc.F90

    r10425 r13463  
    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" 
     51#  include "domzgr_substitute.h90" 
    4952   !!---------------------------------------------------------------------- 
    5053   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    5457CONTAINS 
    5558 
    56    SUBROUTINE trc_sms_cfc( kt ) 
     59   SUBROUTINE trc_sms_cfc( kt, Kbb, Kmm, Krhs ) 
    5760      !!---------------------------------------------------------------------- 
    5861      !!                     ***  ROUTINE trc_sms_cfc  *** 
    … …  
    7073      !!                CFC concentration in pico-mol/m3 
    7174      !!---------------------------------------------------------------------- 
    72       INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     75      INTEGER, INTENT(in) ::   kt               ! ocean time-step index 
     76      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs   ! ocean time level 
    7377      ! 
    7478      INTEGER  ::   ji, jj, jn, jl, jm 
    … …  
    105109         im2       =      nmonth - 7 
    106110      ENDIF 
     111      ! Avoid bad interpolation if starting date is =< 1900 
     112      IF( iyear_beg .LE. 0      )  iyear_beg = 1 
     113      IF( iyear_beg .GE. jpyear )  iyear_beg = jpyear - 1 
     114      ! 
    107115      iyear_end = iyear_beg + 1 
    108116 
    … …  
    118126          
    119127         !                                                         !------------! 
    120          DO jj = 1, jpj                                            !  i-j loop  ! 
    121             DO ji = 1, jpi                                         !------------! 
     128         DO_2D( 1, 1, 1, 1 ) 
    122129  
    123                ! space interpolation 
    124                zpp_cfc  =       xphem(ji,jj)   * zpatm(1,jl)   & 
    125                   &     + ( 1.- xphem(ji,jj) ) * zpatm(2,jl) 
    126  
    127                ! Computation of concentration at equilibrium : in picomol/l 
    128                ! coefficient for solubility for CFC-11/12 in  mol/l/atm 
    129                IF( tmask(ji,jj,1) .GE. 0.5 ) THEN 
    130                   ztap  = ( tsn(ji,jj,1,jp_tem) + 273.16 ) * 0.01 
    131                   zdtap = sob(1,jl) + ztap * ( sob(2,jl) + ztap * sob(3,jl) )  
    132                   zsol  =  EXP( soa(1,jl) + soa(2,jl) / ztap + soa(3,jl) * LOG( ztap )   & 
    133                      &                    + soa(4,jl) * ztap * ztap + tsn(ji,jj,1,jp_sal) * zdtap )  
    134                ELSE 
    135                   zsol  = 0.e0 
    136                ENDIF 
    137                ! conversion from mol/l/atm to mol/m3/atm and from mol/m3/atm to mol/m3/pptv     
    138                zsol = xconv4 * xconv3 * zsol * tmask(ji,jj,1)   
    139                ! concentration at equilibrium 
    140                zca_cfc = xconv1 * zpp_cfc * zsol * tmask(ji,jj,1)              
    141    
    142                ! Computation of speed transfert 
    143                !    Schmidt number revised in Wanninkhof (2014) 
    144                zt1  = tsn(ji,jj,1,jp_tem) 
    145                zt2  = zt1 * zt1  
    146                zt3  = zt1 * zt2 
    147                zt4  = zt2 * zt2 
    148                zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 + sca(5,jl) * zt4 
    149  
    150                !    speed transfert : formulae revised in Wanninkhof (2014) 
    151                zv2     = wndm(ji,jj) * wndm(ji,jj) 
    152                zsch    = zsch / 660. 
    153                zak_cfc = ( 0.251 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 
    154  
    155                ! Input function  : speed *( conc. at equil - concen at surface ) 
    156                ! trn in pico-mol/l idem qtr; ak in en m/a 
    157                qtr_cfc(ji,jj,jl) = -zak_cfc * ( trb(ji,jj,1,jn) - zca_cfc )   & 
    158                   &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) 
    159                ! Add the surface flux to the trend 
    160                tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / e3t_n(ji,jj,1)  
    161  
    162                ! cumulation of surface flux at each time step 
    163                qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * rdt 
    164                !                                               !----------------! 
    165             END DO                                             !  end i-j loop  ! 
    166          END DO                                                !----------------! 
     130            ! space interpolation 
     131            zpp_cfc  =       xphem(ji,jj)   * zpatm(1,jl)   & 
     132               &     + ( 1.- xphem(ji,jj) ) * zpatm(2,jl) 
     133 
     134            ! Computation of concentration at equilibrium : in picomol/l 
     135            ! coefficient for solubility for CFC-11/12 in  mol/l/atm 
     136            IF( tmask(ji,jj,1) .GE. 0.5 ) THEN 
     137               ztap  = ( ts(ji,jj,1,jp_tem,Kmm) + 273.16 ) * 0.01 
     138               zdtap = sob(1,jl) + ztap * ( sob(2,jl) + ztap * sob(3,jl) )  
     139               zsol  =  EXP( soa(1,jl) + soa(2,jl) / ztap + soa(3,jl) * LOG( ztap )   & 
     140                  &                    + soa(4,jl) * ztap * ztap + ts(ji,jj,1,jp_sal,Kmm) * zdtap )  
     141            ELSE 
     142               zsol  = 0.e0 
     143            ENDIF 
     144            ! conversion from mol/l/atm to mol/m3/atm and from mol/m3/atm to mol/m3/pptv     
     145            zsol = xconv4 * xconv3 * zsol * tmask(ji,jj,1)   
     146            ! concentration at equilibrium 
     147            zca_cfc = xconv1 * zpp_cfc * zsol * tmask(ji,jj,1)              
     148            ! Computation of speed transfert 
     149            !    Schmidt number revised in Wanninkhof (2014) 
     150            zt1  = ts(ji,jj,1,jp_tem,Kmm) 
     151            zt2  = zt1 * zt1  
     152            zt3  = zt1 * zt2 
     153            zt4  = zt2 * zt2 
     154            zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 + sca(5,jl) * zt4 
     155 
     156            !    speed transfert : formulae revised in Wanninkhof (2014) 
     157            zv2     = wndm(ji,jj) * wndm(ji,jj) 
     158            zsch    = zsch / 660. 
     159            zak_cfc = ( 0.251 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 
     160 
     161            ! Input function  : speed *( conc. at equil - concen at surface ) 
     162            ! tr(:,:,:,:,Kmm) in pico-mol/l idem qtr; ak in en m/a 
     163            qtr_cfc(ji,jj,jl) = -zak_cfc * ( tr(ji,jj,1,jn,Kbb) - zca_cfc )   & 
     164               &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) 
     165            ! Add the surface flux to the trend 
     166            tr(ji,jj,1,jn,Krhs) = tr(ji,jj,1,jn,Krhs) + qtr_cfc(ji,jj,jl) / e3t(ji,jj,1,Kmm)  
     167 
     168            ! cumulation of surface flux at each time step 
     169            qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * rn_Dt 
     170            !                                               !----------------! 
     171         END_2D 
    167172         !                                                  !----------------! 
    168173      END DO                                                !  end CFC loop  ! 
    … …  
    191196      IF( l_trdtrc ) THEN 
    192197          DO jn = jp_cfc0, jp_cfc1 
    193             CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends 
     198            CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm )   ! save trends 
    194199          END DO 
    195200      END IF 
    … …  
    293298         DO jn = jp_cfc0, jp_cfc1 
    294299            jl = jl + 1 
    295             CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) )  
     300            CALL iom_get( numrtr, jpdom_auto, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) )  
    296301         END DO 
    297302      ENDIF 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/CFC/trcwri_cfc.F90

    r10069 r13463  
    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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/MY_TRC/trcini_my_trc.F90

    r10068 r13463  
    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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/MY_TRC/trcsms_my_trc.F90

    r10425 r13463  
    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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/MY_TRC/trcwri_my_trc.F90

    r10069 r13463  
    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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P2Z/p2zbio.F90

    r10425 r13463  
    1919   ! 
    2020   USE lbclnk          !  
    21    USE prtctl_trc      ! Print control for debbuging 
     21   USE prtctl          ! Print control for debbuging 
    2222   USE iom             ! 
    2323    
    … …  
    5757 
    5858   !! * Substitutions 
    59 #  include "vectopt_loop_substitute.h90" 
     59#  include "do_loop_substitute.h90" 
     60#  include "domzgr_substitute.h90" 
    6061   !!---------------------------------------------------------------------- 
    6162   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    6566CONTAINS 
    6667 
    67    SUBROUTINE p2z_bio( kt ) 
     68   SUBROUTINE p2z_bio( kt, Kmm, Krhs ) 
    6869      !!--------------------------------------------------------------------- 
    6970      !!                     ***  ROUTINE p2z_bio  *** 
    … …  
    7879      !!              is added to the general trend. 
    7980      !!         
    80       !!                      tra = tra + zf...tra - zftra... 
     81      !!                      tr(Krhs) = tr(Krhs) + zf...tr(Krhs) - zftra... 
    8182      !!                                     |         | 
    8283      !!                                     |         | 
    … …  
    8485      !!         
    8586      !!--------------------------------------------------------------------- 
    86       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     87      INTEGER, INTENT( in ) ::   kt             ! ocean time-step index       
     88      INTEGER, INTENT( in ) ::   Kmm, Krhs      ! time level indices 
    8789      ! 
    8890      INTEGER  ::   ji, jj, jk, jl 
    … …  
    120122      DO jk = 1, jpkbm1                      !  Upper ocean (bio-layers)  ! 
    121123         !                                   ! -------------------------- ! 
    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 
     124         DO_2D( 0, 0, 0, 0 ) 
     125            ! trophic variables( det, zoo, phy, no3, nh4, dom) 
     126            ! ------------------------------------------------ 
     127 
     128            ! negative trophic variables DO not contribute to the fluxes 
     129            zdet = MAX( 0.e0, tr(ji,jj,jk,jpdet,Kmm) ) 
     130            zzoo = MAX( 0.e0, tr(ji,jj,jk,jpzoo,Kmm) ) 
     131            zphy = MAX( 0.e0, tr(ji,jj,jk,jpphy,Kmm) ) 
     132            zno3 = MAX( 0.e0, tr(ji,jj,jk,jpno3,Kmm) ) 
     133            znh4 = MAX( 0.e0, tr(ji,jj,jk,jpnh4,Kmm) ) 
     134            zdom = MAX( 0.e0, tr(ji,jj,jk,jpdom,Kmm) ) 
     135 
     136            ! Limitations 
     137            zlt   = 1. 
     138            zle   = 1. - EXP( -etot(ji,jj,jk) / aki / zlt ) 
     139            ! psinut,akno3,aknh4 added by asklod AS Kremeur 2005-03 
     140            zlno3 = zno3 * EXP( -psinut * znh4 ) / ( akno3 + zno3 ) 
     141            zlnh4 = znh4 / (znh4+aknh4)   
     142 
     143            ! sinks and sources 
     144            !    phytoplankton production and exsudation 
     145            zno3phy = tmumax * zle * zlt * zlno3 * zphy 
     146            znh4phy = tmumax * zle * zlt * zlnh4 * zphy 
     147 
     148            !    fphylab added by asklod AS Kremeur 2005-03 
     149            zphydom = rgamma * (1 - fphylab) * (zno3phy + znh4phy) 
     150            zphynh4 = rgamma * fphylab * (zno3phy + znh4phy) 
     151            ! zooplankton production 
     152            !    preferences 
     153            zppz = rppz 
     154            zpdz = 1. - rppz 
     155            zpppz = ( zppz * zphy ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 ) 
     156            zppdz = ( zpdz * zdet ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 ) 
     157            zfood = zpppz * zphy + zppdz * zdet 
     158            !    filtration  
     159            zfilpz = taus * zpppz / (aks + zfood) 
     160            zfildz = taus * zppdz / (aks + zfood) 
     161            !    grazing 
     162            zphyzoo = zfilpz * zphy * zzoo 
     163            zdetzoo = zfildz * zdet * zzoo 
     164 
     165            ! fecal pellets production 
     166            zzoodet = rpnaz * zphyzoo + rdnaz * zdetzoo 
     167 
     168            ! zooplankton liquide excretion 
     169            zzoonh4 = tauzn * fzoolab * zzoo   
     170            zzoodom = tauzn * (1 - fzoolab) * zzoo 
     171 
     172            ! mortality 
     173            !    phytoplankton mortality 
     174            zphydet = tmminp * zphy 
     175 
     176            !    zooplankton mortality 
     177            !    closure : flux grazing is redistributed below level jpkbio 
     178            zzoobod = tmminz * zzoo * zzoo 
     179            xksi(ji,jj) = xksi(ji,jj) + (1-fdbod) * zzoobod * e3t(ji,jj,jk,Kmm) 
     180            zboddet = fdbod * zzoobod 
     181 
     182            ! detritus and dom breakdown 
     183            zdetnh4 = taudn * fdetlab * zdet 
     184            zdetdom = taudn * (1 - fdetlab) * zdet 
     185 
     186            zdomnh4 = taudomn * zdom 
     187 
     188            ! flux added to express how the excess of nitrogen from  
     189            ! PHY, ZOO and DET to DOM goes directly to NH4 (flux of ajustment) 
     190            zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 
     191 
     192            ! Nitrification  
     193            znh4no3 = taunn * znh4 
     194 
     195            ! determination of trends 
     196            !    total trend for each biological tracer 
     197            zphya =   zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet 
     198            zzooa =   zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod 
     199            zno3a = - zno3phy + znh4no3 
     200            znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju 
     201            zdeta =   zphydet + zzoodet - zdetzoo - zdetnh4 - zdetdom + zboddet 
     202            zdoma =   zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju 
     203 
     204            ! tracer flux at totox-point added to the general trend 
     205            tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + zdeta 
     206            tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) + zzooa 
     207            tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zphya 
     208            tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + zno3a 
     209            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + znh4a 
     210            tr(ji,jj,jk,jpdom,Krhs) = tr(ji,jj,jk,jpdom,Krhs) + zdoma 
     211 
     212             IF( lk_iomput ) THEN 
     213               ! convert fluxes in per day 
     214               ze3t = e3t(ji,jj,jk,Kmm) * 86400._wp 
     215               zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t 
     216               zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t 
     217               zw2d(ji,jj,3)  = zw2d(ji,jj,3)  + zphydom * ze3t 
     218               zw2d(ji,jj,4)  = zw2d(ji,jj,4)  + zphynh4 * ze3t 
     219               zw2d(ji,jj,5)  = zw2d(ji,jj,5)  + zphyzoo * ze3t 
     220               zw2d(ji,jj,6)  = zw2d(ji,jj,6)  + zphydet * ze3t 
     221               zw2d(ji,jj,7)  = zw2d(ji,jj,7)  + zdetzoo * ze3t 
     222               zw2d(ji,jj,8)  = zw2d(ji,jj,8)  + zzoodet * ze3t 
     223               zw2d(ji,jj,9)  = zw2d(ji,jj,9)  + zzoobod * ze3t 
     224               zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t 
     225               zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t 
     226               zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t 
     227               zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t 
     228               zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t 
     229               zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t 
     230               zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t 
     231               zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 
     232               !    
     233               zw3d(ji,jj,jk,1) = zno3phy * 86400 
     234               zw3d(ji,jj,jk,2) = znh4phy * 86400      
     235               zw3d(ji,jj,jk,3) = znh4no3 * 86400    
     236                !  
     237             ENDIF 
     238         END_2D 
    239239      END DO 
    240240 
    … …  
    242242      DO jk = jpkb, jpkm1                    !  Upper ocean (bio-layers)  ! 
    243243         !                                   ! -------------------------- ! 
    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 
     244         DO_2D( 0, 0, 0, 0 ) 
     245            ! remineralisation of all quantities towards nitrate  
     246 
     247            !    trophic variables( det, zoo, phy, no3, nh4, dom) 
     248            !       negative trophic variables DO not contribute to the fluxes 
     249            zdet = MAX( 0.e0, tr(ji,jj,jk,jpdet,Kmm) ) 
     250            zzoo = MAX( 0.e0, tr(ji,jj,jk,jpzoo,Kmm) ) 
     251            zphy = MAX( 0.e0, tr(ji,jj,jk,jpphy,Kmm) ) 
     252            zno3 = MAX( 0.e0, tr(ji,jj,jk,jpno3,Kmm) ) 
     253            znh4 = MAX( 0.e0, tr(ji,jj,jk,jpnh4,Kmm) ) 
     254            zdom = MAX( 0.e0, tr(ji,jj,jk,jpdom,Kmm) ) 
     255 
     256            !    Limitations 
     257            zlt   = 0.e0 
     258            zle   = 0.e0 
     259            zlno3 = 0.e0 
     260            zlnh4 = 0.e0 
     261 
     262            !    sinks and sources 
     263            !       phytoplankton production and exsudation 
     264            zno3phy = 0.e0 
     265            znh4phy = 0.e0 
     266            zphydom = 0.e0 
     267            zphynh4 = 0.e0 
     268 
     269            !    zooplankton production 
     270            zphyzoo = 0.e0      ! grazing 
     271            zdetzoo = 0.e0 
     272 
     273            zzoodet = 0.e0      ! fecal pellets production 
     274 
     275            zzoonh4 = tauzn * fzoolab * zzoo         ! zooplankton liquide excretion 
     276            zzoodom = tauzn * (1 - fzoolab) * zzoo 
     277 
     278            !    mortality 
     279            zphydet = tmminp * zphy      ! phytoplankton mortality 
     280 
     281            zzoobod = 0.e0               ! zooplankton mortality 
     282            zboddet = 0.e0               ! closure : flux fbod is redistributed below level jpkbio 
     283 
     284            !    detritus and dom breakdown 
     285            zdetnh4 = taudn * fdetlab * zdet 
     286            zdetdom = taudn * (1 - fdetlab) * zdet 
     287 
     288            zdomnh4 = taudomn * zdom 
     289            zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 
     290 
     291            !    Nitrification 
     292            znh4no3 = taunn * znh4 
     293 
     294 
     295            ! determination of trends 
     296            !     total trend for each biological tracer 
     297            zphya =   zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet 
     298            zzooa =   zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod 
     299            zno3a = - zno3phy + znh4no3  
     300            znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju 
     301            zdeta = zphydet + zzoodet  - zdetzoo - zdetnh4 - zdetdom + zboddet 
     302            zdoma = zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju 
     303 
     304            ! tracer flux at totox-point added to the general trend 
     305            tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + zdeta 
     306            tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) + zzooa 
     307            tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zphya 
     308            tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + zno3a 
     309            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + znh4a 
     310            tr(ji,jj,jk,jpdom,Krhs) = tr(ji,jj,jk,jpdom,Krhs) + zdoma 
     311            ! 
     312             IF( lk_iomput ) THEN                  ! convert fluxes in per day 
     313               ze3t = e3t(ji,jj,jk,Kmm) * 86400._wp 
     314               zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t 
     315               zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t 
     316               zw2d(ji,jj,3)  = zw2d(ji,jj,3)  + zphydom * ze3t 
     317               zw2d(ji,jj,4)  = zw2d(ji,jj,4)  + zphynh4 * ze3t 
     318               zw2d(ji,jj,5)  = zw2d(ji,jj,5)  + zphyzoo * ze3t 
     319               zw2d(ji,jj,6)  = zw2d(ji,jj,6)  + zphydet * ze3t 
     320               zw2d(ji,jj,7)  = zw2d(ji,jj,7)  + zdetzoo * ze3t 
     321               zw2d(ji,jj,8)  = zw2d(ji,jj,8)  + zzoodet * ze3t 
     322               zw2d(ji,jj,9)  = zw2d(ji,jj,9)  + zzoobod * ze3t 
     323               zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t 
     324               zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t 
     325               zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t 
     326               zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t 
     327               zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t 
     328               zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t 
     329               zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t 
     330               zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 
     331               !    
     332               zw3d(ji,jj,jk,1) = zno3phy * 86400._wp 
     333               zw3d(ji,jj,jk,2) = znh4phy * 86400._wp 
     334               zw3d(ji,jj,jk,3) = znh4no3 * 86400._wp 
    312335               ! 
    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 
     336            ENDIF 
     337         END_2D 
    340338      END DO 
    341339      ! 
    342340      IF( lk_iomput ) THEN 
    343          CALL lbc_lnk( 'p2zbio', zw2d(:,:,:),'T', 1. ) 
    344          CALL lbc_lnk_multi( 'p2zbio', zw3d(:,:,:,1),'T', 1., zw3d(:,:,:,2),'T', 1., zw3d(:,:,:,3),'T', 1. ) 
     341         CALL lbc_lnk( 'p2zbio', zw2d(:,:,:),'T', 1.0_wp ) 
     342         CALL lbc_lnk_multi( 'p2zbio', zw3d(:,:,:,1),'T', 1.0_wp, zw3d(:,:,:,2),'T', 1.0_wp, zw3d(:,:,:,3),'T', 1.0_wp ) 
    345343         ! Save diagnostics 
    346344         CALL iom_put( "TNO3PHY", zw2d(:,:,1) ) 
    … …  
    367365      ENDIF 
    368366 
    369       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     367      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    370368         WRITE(charout, FMT="('bio')") 
    371          CALL prt_ctl_trc_info(charout) 
    372          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     369         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     370         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    373371      ENDIF 
    374372      ! 
    … …  
    402400      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~' 
    403401      ! 
    404       REWIND( numnatp_ref )              ! Namelist namlobphy in reference namelist : Lobster biological parameters 
    405402      READ  ( numnatp_ref, namlobphy, IOSTAT = ios, ERR = 901) 
    406 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlobphy in reference namelist', lwp ) 
    407       REWIND( numnatp_cfg )              ! Namelist namlobphy in configuration namelist : Lobster biological parameters 
     403901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlobphy in reference namelist' ) 
    408404      READ  ( numnatp_cfg, namlobphy, IOSTAT = ios, ERR = 902 ) 
    409 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlobphy in configuration namelist', lwp ) 
     405902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlobphy in configuration namelist' ) 
    410406      IF(lwm) WRITE ( numonp, namlobphy ) 
    411407      ! 
    … …  
    419415      ENDIF 
    420416 
    421       REWIND( numnatp_ref )              ! Namelist namlobnut in reference namelist : Lobster nutriments parameters 
    422417      READ  ( numnatp_ref, namlobnut, IOSTAT = ios, ERR = 903) 
    423 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlobnut in reference namelist', lwp ) 
    424       REWIND( numnatp_cfg )              ! Namelist namlobnut in configuration namelist : Lobster nutriments parameters 
     418903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlobnut in reference namelist' ) 
    425419      READ  ( numnatp_cfg, namlobnut, IOSTAT = ios, ERR = 904 ) 
    426 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlobnut in configuration namelist', lwp ) 
     420904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlobnut in configuration namelist' ) 
    427421      IF(lwm) WRITE ( numonp, namlobnut ) 
    428422 
    … …  
    436430      ENDIF 
    437431 
    438       REWIND( numnatp_ref )              ! Namelist namlobzoo in reference namelist : Lobster zooplankton parameters 
    439432      READ  ( numnatp_ref, namlobzoo, IOSTAT = ios, ERR = 905) 
    440 905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlobzoo in reference namelist', lwp ) 
    441       REWIND( numnatp_cfg )              ! Namelist namlobzoo in configuration namelist : Lobster zooplankton parameters 
     433905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlobzoo in reference namelist' ) 
    442434      READ  ( numnatp_cfg, namlobzoo, IOSTAT = ios, ERR = 906 ) 
    443 906   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlobzoo in configuration namelist', lwp ) 
     435906   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlobzoo in configuration namelist' ) 
    444436      IF(lwm) WRITE ( numonp, namlobzoo ) 
    445437 
    … …  
    458450      ENDIF 
    459451 
    460       REWIND( numnatp_ref )              ! Namelist namlobdet in reference namelist : Lobster detritus parameters 
    461452      READ  ( numnatp_ref, namlobdet, IOSTAT = ios, ERR = 907) 
    462 907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlobdet in reference namelist', lwp ) 
    463       REWIND( numnatp_cfg )              ! Namelist namlobdet in configuration namelist : Lobster detritus parameters 
     453907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlobdet in reference namelist' ) 
    464454      READ  ( numnatp_cfg, namlobdet, IOSTAT = ios, ERR = 908 ) 
    465 908   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlobdet in configuration namelist', lwp ) 
     455908   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlobdet in configuration namelist' ) 
    466456      IF(lwm) WRITE ( numonp, namlobdet ) 
    467457 
    … …  
    473463      ENDIF 
    474464 
    475       REWIND( numnatp_ref )              ! Namelist namlobdom in reference namelist : Lobster DOM breakdown rate 
    476465      READ  ( numnatp_ref, namlobdom, IOSTAT = ios, ERR = 909) 
    477 909   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlobdom in reference namelist', lwp ) 
    478       REWIND( numnatp_cfg )              ! Namelist namlobdom in configuration namelist : Lobster DOM breakdown rate 
     466909   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlobdom in reference namelist' ) 
    479467      READ  ( numnatp_cfg, namlobdom, IOSTAT = ios, ERR = 910 ) 
    480 910   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlobdom in configuration namelist', lwp ) 
     468910   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlobdom in configuration namelist' ) 
    481469      IF(lwm) WRITE ( numonp, namlobdom ) 
    482470 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P2Z/p2zexp.F90

    r10425 r13463  
    1717   USE p2zsed 
    1818   USE lbclnk 
    19    USE prtctl_trc      ! Print control for debbuging 
     19   USE prtctl          ! Print control for debbuging 
    2020   USE trd_oce 
    2121   USE trdtrc 
    … …  
    3838 
    3939   !! * Substitutions 
    40 #  include "vectopt_loop_substitute.h90" 
     40#  include "do_loop_substitute.h90" 
     41#  include "domzgr_substitute.h90" 
    4142   !!---------------------------------------------------------------------- 
    4243   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4647CONTAINS 
    4748 
    48    SUBROUTINE p2z_exp( kt ) 
     49   SUBROUTINE p2z_exp( kt, Kmm, Krhs ) 
    4950      !!--------------------------------------------------------------------- 
    5051      !!                     ***  ROUTINE p2z_exp  *** 
    … …  
    6061      !!--------------------------------------------------------------------- 
    6162      !! 
    62       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     63      INTEGER, INTENT( in ) ::   kt             ! ocean time-step index       
     64      INTEGER, INTENT( in ) ::   Kmm, Krhs      ! time level indices 
    6365      !! 
    6466      INTEGER  ::   ji, jj, jk, jl, ikt 
    … …  
    7072      IF( ln_timing )   CALL timing_start('p2z_exp') 
    7173      ! 
    72       IF( kt == nittrc000 )   CALL p2z_exp_init 
     74      IF( kt == nittrc000 )   CALL p2z_exp_init( Kmm ) 
    7375 
    7476      zsedpoca(:,:) = 0. 
    … …  
    8082      ! LAYERS IS DETERMINED BY DMIN3 DEFINED IN sms_p2z.F90 
    8183      ! ---------------------------------------------------------------------- 
    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 
     84      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     85         ze3t = 1. / e3t(ji,jj,jk,Kmm) 
     86         tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj) 
     87      END_3D 
    9088 
    9189      ! Find the last level of the water column 
    … …  
    9593      zgeolpoc = 0.e0         !     Initialization 
    9694      ! 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 
    114  
    115       CALL lbc_lnk( 'p2zexp', sedpocn, 'T', 1. ) 
     95      DO_2D( 0, 0, 0, 0 ) 
     96         ikt = mbkt(ji,jj)  
     97         tr(ji,jj,ikt,jpno3,Krhs) = tr(ji,jj,ikt,jpno3,Krhs) + sedlam * sedpocn(ji,jj) / e3t(ji,jj,ikt,Kmm)  
     98         ! Deposition of organic matter in the sediment 
     99         zwork = vsed * tr(ji,jj,ikt,jpdet,Kmm) 
     100         zsedpoca(ji,jj) = ( zwork + dminl(ji,jj) * xksi(ji,jj)   & 
     101            &           - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rn_Dt 
     102         zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1e2t(ji,jj) 
     103      END_2D 
     104 
     105      DO_2D( 0, 0, 0, 0 ) 
     106         tr(ji,jj,1,jpno3,Krhs) = tr(ji,jj,1,jpno3,Krhs) + zgeolpoc * cmask(ji,jj) / areacot / e3t(ji,jj,1,Kmm) 
     107      END_2D 
     108 
     109      CALL lbc_lnk( 'p2zexp', sedpocn, 'T', 1.0_wp ) 
    116110  
    117111      ! Oa & Ek: diagnostics depending on jpdia2d !          left as example 
    … …  
    121115      ! Time filter and swap of arrays 
    122116      ! ------------------------------ 
    123       IF( neuler == 0 .AND. kt == nittrc000 ) THEN        ! Euler time-stepping at first time-step 
    124         !                                             ! (only swap) 
     117      IF( l_1st_euler ) THEN        ! Euler time-stepping at first time-step 
     118        !                           ! (only swap) 
    125119        sedpocn(:,:) = zsedpoca(:,:) 
    126120        !                                               
    127121      ELSE 
    128122        ! 
    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 
     123        DO_2D( 1, 1, 1, 1 ) 
     124           zsedpocd = zsedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj)      ! time laplacian on tracers 
     125           sedpocb(ji,jj) = sedpocn(ji,jj) + rn_atfp * zsedpocd                     ! sedpocb <-- filtered sedpocn 
     126           sedpocn(ji,jj) = zsedpoca(ji,jj)                                       ! sedpocn <-- sedpoca 
     127        END_2D 
    136128        !  
    137129      ENDIF 
    … …  
    146138      ENDIF 
    147139      ! 
    148       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     140      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    149141         WRITE(charout, FMT="('exp')") 
    150          CALL prt_ctl_trc_info(charout) 
    151          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     142         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     143         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    152144      ENDIF 
    153145      ! 
    … …  
    157149 
    158150 
    159    SUBROUTINE p2z_exp_init 
     151   SUBROUTINE p2z_exp_init( Kmm ) 
    160152      !!---------------------------------------------------------------------- 
    161153      !!                    ***  ROUTINE p4z_exp_init  *** 
    162154      !! ** purpose :   specific initialisation for export 
    163155      !!---------------------------------------------------------------------- 
     156      INTEGER, INTENT(in)  ::  Kmm      ! time level index 
    164157      INTEGER  ::   ji, jj, jk 
    165158      REAL(wp) ::   zmaskt, zfluo, zfluu 
    … …  
    181174      zdm0 = 0._wp 
    182175      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 
     176      DO_3D( 1, 1, 1, 1, jpkb, jpkm1 ) 
     177         zfluo = ( gdepw(ji,jj,jk  ,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr 
     178         zfluu = ( gdepw(ji,jj,jk+1,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr 
     179         IF( zfluo.GT.1. )   zfluo = 1._wp 
     180         zdm0(ji,jj,jk) = zfluo - zfluu 
     181         IF( jk <= jpkb-1 )   zdm0(ji,jj,jk) = 0._wp 
     182         zrro(ji,jj) = zrro(ji,jj) - zdm0(ji,jj,jk) 
     183      END_3D 
    195184      ! 
    196185      zdm0(:,:,jpk) = zrro(:,:) 
    … …  
    202191      dminl(:,:)   = 0._wp 
    203192      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 
     193      DO_3D( 1, 1, 1, 1, 1, jpk ) 
     194         IF( tmask(ji,jj,jk) == 0._wp ) THEN 
     195            dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk) 
     196            dmin3(ji,jj,jk) = 0._wp 
     197         ENDIF 
     198      END_3D 
     199 
     200      DO_2D( 1, 1, 1, 1 ) 
     201         IF( tmask(ji,jj,1) == 0 )   dmin3(ji,jj,1) = 0._wp 
     202      END_2D 
    220203 
    221204      ! Coastal mask  
    222205      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 
    231       CALL lbc_lnk( 'p2zexp', cmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged) 
     206      DO_2D( 0, 0, 0, 0 ) 
     207         IF( tmask(ji,jj,1) /= 0. ) THEN 
     208            zmaskt = tmask(ji+1,jj,1) * tmask(ji-1,jj,1) * tmask(ji,jj+1,1) * tmask(ji,jj-1,1)  
     209            IF( zmaskt == 0. )   cmask(ji,jj) = 1._wp 
     210         END IF 
     211      END_2D 
     212      CALL lbc_lnk( 'p2zexp', cmask , 'T', 1.0_wp )      ! lateral boundary conditions on cmask   (sign unchanged) 
    232213      areacot = glob_sum( 'p2zexp', e1e2t(:,:) * cmask(:,:) ) 
    233214      ! 
    234215      IF( ln_rsttr ) THEN 
    235          CALL iom_get( numrtr, jpdom_autoglo, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) ) 
    236          CALL iom_get( numrtr, jpdom_autoglo, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) ) 
     216         CALL iom_get( numrtr, jpdom_auto, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) ) 
     217         CALL iom_get( numrtr, jpdom_auto, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) ) 
    237218      ELSE 
    238219         sedpocb(:,:) = 0._wp 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P2Z/p2zopt.F90

    r10068 r13463  
    1818   USE trc 
    1919   USE sms_pisces 
    20    USE prtctl_trc      ! Print control for debbuging 
     20   USE prtctl          ! Print control for debbuging 
    2121 
    2222   IMPLICIT NONE 
    … …  
    3838   REAL(wp), PUBLIC ::  reddom    ! redfield ratio (C:N) for DOM 
    3939 
     40   !! * Substitutions 
     41#  include "do_loop_substitute.h90" 
     42#  include "domzgr_substitute.h90" 
    4043   !!---------------------------------------------------------------------- 
    4144   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4548CONTAINS 
    4649 
    47    SUBROUTINE p2z_opt( kt ) 
     50   SUBROUTINE p2z_opt( kt, Kmm ) 
    4851      !!--------------------------------------------------------------------- 
    4952      !!                     ***  ROUTINE p2z_opt  *** 
    … …  
    6164      !! 
    6265      INTEGER, INTENT( in ) ::   kt   ! index of the time stepping 
     66      INTEGER, INTENT( in ) ::   Kmm  ! time level index 
    6367      !! 
    6468      INTEGER  ::   ji, jj, jk          ! dummy loop indices 
    … …  
    9195      !                                          ! Photosynthetically Available Radiation (PAR) 
    9296      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 
     97      DO_3D( 1, 1, 1, 1, 2, jpk ) 
     98         zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk-1,jpphy,Kmm) ) * zcoef  ) 
     99         zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
     100         zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
     101         zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * e3t(ji,jj,jk-1,Kmm) ) 
     102         zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t(ji,jj,jk-1,Kmm) ) 
     103      END_3D 
     104      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     105         zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk,jpphy,Kmm) ) * zcoef  ) 
     106         zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
     107         zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
     108         zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * e3t(ji,jj,jk,Kmm) ) * ( 1 - EXP( -zkr * e3t(ji,jj,jk,Kmm) ) ) 
     109         zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * e3t(ji,jj,jk,Kmm) ) * ( 1 - EXP( -zkg * e3t(ji,jj,jk,Kmm) ) ) 
     110         etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 ) 
     111      END_3D 
    116112 
    117113      !                                          ! Euphotic layer 
    118114      !                                          ! -------------- 
    119115      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 
     116      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     117        IF( etot(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk + 1  
     118      END_3D 
    127119      !                                               ! 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  
     120      DO_2D( 1, 1, 1, 1 ) 
     121         heup(ji,jj) = gdepw(ji,jj,neln(ji,jj),Kmm) 
     122      END_2D 
    133123 
    134124 
    135       IF(ln_ctl) THEN      ! print mean trends (used for debugging) 
     125      IF(sn_cfctl%l_prttrc) THEN      ! print mean trends (used for debugging) 
    136126         WRITE(charout, FMT="('opt')") 
    137          CALL prt_ctl_trc_info( charout ) 
    138          CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
     127         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     128         CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kmm), mask1=tmask, clinfo=ctrcnm ) 
    139129      ENDIF 
    140130      ! 
    … …  
    159149      !!---------------------------------------------------------------------- 
    160150 
    161       REWIND( numnatp_ref )              ! Namelist namlobopt in reference namelist : Lobster options 
    162151      READ  ( numnatp_ref, namlobopt, IOSTAT = ios, ERR = 901) 
    163 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobopt in reference namelist', lwp ) 
     152901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobopt in reference namelist' ) 
    164153 
    165       REWIND( numnatp_cfg )              ! Namelist namlobopt in configuration namelist : Lobster options 
    166154      READ  ( numnatp_cfg, namlobopt, IOSTAT = ios, ERR = 902 ) 
    167 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namlobopt in configuration namelist', lwp ) 
     155902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namlobopt in configuration namelist' ) 
    168156      IF(lwm) WRITE ( numonp, namlobopt ) 
    169157 
    … …  
    181169      ENDIF 
    182170      ! 
    183       REWIND( numnatp_ref )              ! Namelist namlobrat in reference namelist : Lobster ratios 
    184171      READ  ( numnatp_ref, namlobrat, IOSTAT = ios, ERR = 903) 
    185 903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobrat in reference namelist', lwp ) 
     172903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobrat in reference namelist' ) 
    186173 
    187       REWIND( numnatp_cfg )              ! Namelist namlobrat in configuration namelist : Lobster ratios 
    188174      READ  ( numnatp_cfg, namlobrat, IOSTAT = ios, ERR = 904 ) 
    189 904   IF( ios >  0 ) CALL ctl_nam ( ios , 'namlobrat in configuration namelist', lwp ) 
     175904   IF( ios >  0 ) CALL ctl_nam ( ios , 'namlobrat in configuration namelist' ) 
    190176      IF(lwm) WRITE ( numonp, namlobrat ) 
    191177 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P2Z/p2zsed.F90

    r10068 r13463  
    1818   USE lbclnk          ! 
    1919   USE iom             ! 
    20    USE prtctl_trc      ! Print control for debbuging 
     20   USE prtctl          ! Print control for debbuging 
    2121 
    2222   IMPLICIT NONE 
    … …  
    3131   REAL(wp), PUBLIC ::   xhr         !: coeff for martin''s remineralisation profile 
    3232 
     33   !! * Substitutions 
     34#  include "do_loop_substitute.h90" 
     35#  include "domzgr_substitute.h90" 
    3336   !!---------------------------------------------------------------------- 
    3437   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    3841CONTAINS 
    3942 
    40    SUBROUTINE p2z_sed( kt ) 
     43   SUBROUTINE p2z_sed( kt, Kmm, Krhs ) 
    4144      !!--------------------------------------------------------------------- 
    4245      !!                     ***  ROUTINE p2z_sed  *** 
    … …  
    4952      !!              using an upstream scheme 
    5053      !!              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) 
     54      !!                      dz(tr(:,:,:,:,Kmm) ww) = 1/bt dk+1( e1t e2t vsed (tr(:,:,:,:,Kmm)) ) 
     55      !!              add this trend now to the general trend of tracer (ta,sa,tr(:,:,:,:,Krhs)): 
     56      !!                             tr(:,:,:,:,Krhs) = tr(:,:,:,:,Krhs) + dz(tr(:,:,:,:,Kmm) ww) 
    5457      !!         
    5558      !!              IF 'key_diabio' is defined, the now vertical advection 
    5659      !!              trend of passive tracers is saved for futher diagnostics. 
    5760      !!--------------------------------------------------------------------- 
    58       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     61      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index       
     62      INTEGER, INTENT( in ) ::   Kmm, Krhs  ! time level indices 
    5963      ! 
    6064      INTEGER  ::   ji, jj, jk, jl, ierr 
    … …  
    8185      ! tracer flux at w-point: we use -vsed (downward flux)  with simplification : no e1*e2 
    8286      DO jk = 2, jpkm1 
    83          zwork(:,:,jk) = -vsed * trn(:,:,jk-1,jpdet) 
     87         zwork(:,:,jk) = -vsed * tr(:,:,jk-1,jpdet,Kmm) 
    8488      END DO 
    8589 
    8690      ! 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 
     91      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     92         ztra(ji,jj,jk)  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 
     93         tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + ztra(ji,jj,jk)  
     94      END_3D 
    9595 
    9696      IF( lk_iomput )  THEN 
    9797         IF( iom_use( "TDETSED" ) ) THEN 
    9898            ALLOCATE( zw2d(jpi,jpj) ) 
    99             zw2d(:,:) =  ztra(:,:,1) * e3t_n(:,:,1) * 86400._wp 
     99            zw2d(:,:) =  ztra(:,:,1) * e3t(:,:,1,Kmm) * 86400._wp 
    100100            DO jk = 2, jpkm1 
    101                zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400._wp 
     101               zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t(:,:,jk,Kmm) * 86400._wp 
    102102            END DO 
    103103            CALL iom_put( "TDETSED", zw2d ) 
    … …  
    107107      ! 
    108108 
    109       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     109      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    110110         WRITE(charout, FMT="('sed')") 
    111          CALL prt_ctl_trc_info(charout) 
    112          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     111         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     112         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    113113      ENDIF 
    114114      ! 
    … …  
    132132      !!---------------------------------------------------------------------- 
    133133      ! 
    134       REWIND( numnatp_ref )              ! Namelist namlobsed in reference namelist : Lobster sediments 
    135134      READ  ( numnatp_ref, namlobsed, IOSTAT = ios, ERR = 901) 
    136 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlosed in reference namelist', lwp ) 
    137       REWIND( numnatp_cfg )              ! Namelist namlobsed in configuration namelist : Lobster sediments 
     135901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlosed in reference namelist' ) 
    138136      READ  ( numnatp_cfg, namlobsed, IOSTAT = ios, ERR = 902 ) 
    139 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlobsed in configuration namelist', lwp ) 
     137902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlobsed in configuration namelist' ) 
    140138      IF(lwm) WRITE ( numonp, namlobsed ) 
    141139      ! 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P2Z/p2zsms.F90

    r10068 r13463  
    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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p4zagg.F90

    r10069 r13463  
    1717   USE trc             !  passive tracers common variables  
    1818   USE sms_pisces      !  PISCES Source Minus Sink variables 
    19    USE prtctl_trc      !  print control for debugging 
     19   USE prtctl          !  print control for debugging 
    2020 
    2121   IMPLICIT NONE 
    … …  
    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( 1, 1, 1, 1, 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( 1, 1, 1, 1, 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')") 
    177          CALL prt_ctl_trc_info(charout) 
    178          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     172         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     173         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    179174      ENDIF 
    180175      ! 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p4zbio.F90

    r10227 r13463  
    3030   USE p4zfechem 
    3131   USE p4zligand       !  Prognostic ligand model 
    32    USE prtctl_trc      !  print control for debugging 
     32   USE prtctl          !  print control for debugging 
    3333   USE iom             !  I/O manager 
    3434   
    … …  
    3838   PUBLIC  p4z_bio     
    3939 
     40   !! * Substitutions 
     41#  include "do_loop_substitute.h90" 
     42#  include "domzgr_substitute.h90" 
    4043   !!---------------------------------------------------------------------- 
    4144   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4548CONTAINS 
    4649 
    47    SUBROUTINE p4z_bio ( kt, knt ) 
     50   SUBROUTINE p4z_bio ( kt, knt, Kbb, Kmm, Krhs ) 
    4851      !!--------------------------------------------------------------------- 
    4952      !!                     ***  ROUTINE p4z_bio  *** 
    … …  
    5659      !!--------------------------------------------------------------------- 
    5760      INTEGER, INTENT(in) :: kt, knt 
     61      INTEGER, INTENT(in) :: Kbb, Kmm, Krhs  ! time level indices 
    5862      ! 
    5963      INTEGER             :: ji, jj, jk, jn 
    … …  
    6872      xdiss(:,:,:) = 1. 
    6973!!gm the use of nmld should be better here? 
    70       DO jk = 2, jpkm1 
    71          DO jj = 1, jpj 
    72             DO ji = 1, jpi 
     74      DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 
    7375!!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 
     76         IF( gdepw(ji,jj,jk+1,Kmm) > hmld(ji,jj) )   xdiss(ji,jj,jk) = 0.01 
     77      END_3D 
    7878 
    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 
     79      CALL p4z_opt     ( kt, knt, Kbb, Kmm      )     ! Optic: PAR in the water column 
     80      CALL p4z_sink    ( kt, knt, Kbb, Kmm, Krhs )     ! vertical flux of particulate organic matter 
     81      CALL p4z_fechem  ( kt, knt, Kbb, Kmm, Krhs )     ! Iron chemistry/scavenging 
    8282      ! 
    8383      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 
     84         CALL p4z_lim  ( kt, knt, Kbb, Kmm      )     ! co-limitations by the various nutrients 
     85         CALL p4z_prod ( kt, knt, Kbb, Kmm, Krhs )     ! phytoplankton growth rate over the global ocean.  
     86         !                                          ! (for each element : C, Si, Fe, Chl ) 
     87         CALL p4z_mort ( kt,      Kbb,      Krhs )     ! phytoplankton mortality 
     88         !                                          ! zooplankton sources/sinks routines  
     89         CALL p4z_micro( kt, knt, Kbb,      Krhs )     ! microzooplankton 
     90         CALL p4z_meso ( kt, knt, Kbb,      Krhs )     ! mesozooplankton 
    9191      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 
     92         CALL p5z_lim  ( kt, knt, Kbb, Kmm      )     ! co-limitations by the various nutrients 
     93         CALL p5z_prod ( kt, knt, Kbb, Kmm, Krhs )     ! phytoplankton growth rate over the global ocean.  
     94         !                                          ! (for each element : C, Si, Fe, Chl ) 
     95         CALL p5z_mort ( kt,      Kbb,      Krhs      )     ! phytoplankton mortality 
     96         !                                          ! zooplankton sources/sinks routines  
     97         CALL p5z_micro( kt, knt, Kbb,      Krhs )           ! microzooplankton 
     98         CALL p5z_meso ( kt, knt, Kbb,      Krhs )           ! mesozooplankton 
    9999      ENDIF 
    100100      ! 
    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 
     101      CALL p4z_agg     ( kt, knt, Kbb,      Krhs )     ! Aggregation of particles 
     102      CALL p4z_rem     ( kt, knt, Kbb, Kmm, Krhs )     ! remineralization terms of organic matter+scavenging of Fe 
     103      CALL p4z_poc     ( kt, knt, Kbb, Kmm, Krhs )     ! Remineralization of organic particles 
    104104      ! 
    105105      IF( ln_ligand )  & 
    106       & CALL p4z_ligand( kt, knt ) 
     106      & CALL p4z_ligand( kt, knt, Kbb,      Krhs ) 
    107107      !                                                             ! 
    108       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     108      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    109109         WRITE(charout, FMT="('bio ')") 
    110          CALL prt_ctl_trc_info(charout) 
    111          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     110         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     111         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    112112      ENDIF 
    113113      ! 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p4zche.F90

    r10425 r13463  
    130130   INTEGER :: niter_atgen    = jp_maxniter_atgen 
    131131 
     132   !! * Substitutions 
     133#  include "do_loop_substitute.h90" 
     134#  include "domzgr_substitute.h90" 
    132135   !!---------------------------------------------------------------------- 
    133136   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    137140CONTAINS 
    138141 
    139    SUBROUTINE p4z_che 
     142   SUBROUTINE p4z_che( Kbb, Kmm ) 
    140143      !!--------------------------------------------------------------------- 
    141144      !!                     ***  ROUTINE p4z_che  *** 
    … …  
    145148      !! ** Method  : - ... 
    146149      !!--------------------------------------------------------------------- 
     150      INTEGER, INTENT(in) ::   Kbb, Kmm  ! time level indices 
    147151      INTEGER  ::   ji, jj, jk 
    148152      REAL(wp) ::   ztkel, ztkel1, zt , zsal  , zsal2 , zbuf1 , zbuf2 
    … …  
    164168      ! ------------------------------------------------------------- 
    165169      IF (neos == -1) THEN 
    166          salinprac(:,:,:) = tsn(:,:,:,jp_sal) * 35.0 / 35.16504 
     170         salinprac(:,:,:) = ts(:,:,:,jp_sal,Kmm) * 35.0 / 35.16504 
    167171      ELSE 
    168          salinprac(:,:,:) = tsn(:,:,:,jp_sal) 
     172         salinprac(:,:,:) = ts(:,:,:,jp_sal,Kmm) 
    169173      ENDIF 
    170174 
    … …  
    175179      ! 0.04°C relative to an exact computation 
    176180      ! --------------------------------------------------------------------- 
    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 
     181      DO_3D( 1, 1, 1, 1, 1, jpk ) 
     182         zpres = gdept(ji,jj,jk,Kmm) / 1000. 
     183         za1 = 0.04 * ( 1.0 + 0.185 * ts(ji,jj,jk,jp_tem,Kmm) + 0.035 * (salinprac(ji,jj,jk) - 35.0) ) 
     184         za2 = 0.0075 * ( 1.0 - ts(ji,jj,jk,jp_tem,Kmm) / 30.0 ) 
     185         tempis(ji,jj,jk) = ts(ji,jj,jk,jp_tem,Kmm) - za1 * zpres + za2 * zpres**2 
     186      END_3D 
    187187      ! 
    188188      ! CHEMICAL CONSTANTS - SURFACE LAYER 
    … …  
    245245               zplat   = SIN ( ABS(gphit(ji,jj)*3.141592654/180.) ) 
    246246               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 
     247               zpres = ((1-zc1)-SQRT(((1-zc1)**2)-(8.84E-6*gdept(ji,jj,jk,Kmm)))) / 4.42E-6 
    248248               zpres = zpres / 10.0 
    249249 
    … …  
    448448   END SUBROUTINE p4z_che 
    449449 
    450    SUBROUTINE ahini_for_at(p_hini) 
     450   SUBROUTINE ahini_for_at(p_hini, Kbb ) 
    451451      !!--------------------------------------------------------------------- 
    452452      !!                     ***  ROUTINE ahini_for_at  *** 
    … …  
    462462      !!--------------------------------------------------------------------- 
    463463      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT)  ::  p_hini 
     464      INTEGER,                          INTENT(in)   ::  Kbb      ! time level indices 
    464465      INTEGER  ::   ji, jj, jk 
    465466      REAL(wp)  ::  zca1, zba1 
    … …  
    471472      IF( ln_timing )  CALL timing_start('ahini_for_at') 
    472473      ! 
    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 
     474      DO_3D( 1, 1, 1, 1, 1, jpk ) 
     475      p_alkcb  = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 
     476      p_dictot = tr(ji,jj,jk,jpdic,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 
     477      p_bortot = borat(ji,jj,jk) 
     478      IF (p_alkcb <= 0.) THEN 
     479          p_hini(ji,jj,jk) = 1.e-3 
     480      ELSEIF (p_alkcb >= (2.*p_dictot + p_bortot)) THEN 
     481          p_hini(ji,jj,jk) = 1.e-10_wp 
     482      ELSE 
     483          zca1 = p_dictot/( p_alkcb + rtrn ) 
     484          zba1 = p_bortot/ (p_alkcb + rtrn ) 
     485     ! Coefficients of the cubic polynomial 
     486          za2 = aKb3(ji,jj,jk)*(1. - zba1) + ak13(ji,jj,jk)*(1.-zca1) 
     487          za1 = ak13(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - zca1)    & 
     488          &     + ak13(ji,jj,jk)*ak23(ji,jj,jk)*(1. - (zca1+zca1)) 
     489          za0 = ak13(ji,jj,jk)*ak23(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - (zca1+zca1)) 
     490                                  ! Taylor expansion around the minimum 
     491          zd = za2*za2 - 3.*za1   ! Discriminant of the quadratic equation 
     492                                  ! for the minimum close to the root 
     493 
     494          IF(zd > 0.) THEN        ! If the discriminant is positive 
     495            zsqrtd = SQRT(zd) 
     496            IF(za2 < 0) THEN 
     497              zhmin = (-za2 + zsqrtd)/3. 
    483498            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 
     499              zhmin = -za1/(za2 + zsqrtd) 
     500            ENDIF 
     501            p_hini(ji,jj,jk) = zhmin + SQRT(-(za0 + zhmin*(za1 + zhmin*(za2 + zhmin)))/zsqrtd) 
     502          ELSE 
     503            p_hini(ji,jj,jk) = 1.e-7 
     504          ENDIF 
     505       ! 
     506       ENDIF 
     507      END_3D 
    511508      ! 
    512509      IF( ln_timing )  CALL timing_stop('ahini_for_at') 
    … …  
    516513   !=============================================================================== 
    517514 
    518    SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup ) 
     515   SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup, Kbb ) 
    519516 
    520517   ! Subroutine returns the lower and upper bounds of "non-water-selfionization" 
    … …  
    525522   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_inf 
    526523   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_sup 
    527  
    528    p_alknw_inf(:,:,:) =  -trb(:,:,:,jppo4) * 1000. / (rhop(:,:,:) + rtrn) - sulfat(:,:,:)  & 
     524   INTEGER,                          INTENT(in)  ::  Kbb      ! time level indices 
     525 
     526   p_alknw_inf(:,:,:) =  -tr(:,:,:,jppo4,Kbb) * 1000. / (rhop(:,:,:) + rtrn) - sulfat(:,:,:)  & 
    529527   &              - fluorid(:,:,:) 
    530    p_alknw_sup(:,:,:) =   (2. * trb(:,:,:,jpdic) + 2. * trb(:,:,:,jppo4) + trb(:,:,:,jpsil) )    & 
     528   p_alknw_sup(:,:,:) =   (2. * tr(:,:,:,jpdic,Kbb) + 2. * tr(:,:,:,jppo4,Kbb) + tr(:,:,:,jpsil,Kbb) )    & 
    531529   &               * 1000. / (rhop(:,:,:) + rtrn) + borat(:,:,:)  
    532530 
    … …  
    534532 
    535533 
    536    SUBROUTINE solve_at_general( p_hini, zhi ) 
     534   SUBROUTINE solve_at_general( p_hini, zhi, Kbb ) 
    537535 
    538536   ! Universal pH solver that converges from any given initial value, 
    … …  
    543541   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN)   :: p_hini 
    544542   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT)  :: zhi 
     543   INTEGER,                          INTENT(in)   :: Kbb  ! time level indices 
    545544 
    546545   ! Local variables 
    … …  
    565564   IF( ln_timing )  CALL timing_start('solve_at_general') 
    566565 
    567    CALL anw_infsup( zalknw_inf, zalknw_sup ) 
     566   CALL anw_infsup( zalknw_inf, zalknw_sup, Kbb ) 
    568567 
    569568   rmask(:,:,:) = tmask(:,:,:) 
    … …  
    571570 
    572571   ! 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)) 
     572   DO_3D( 1, 1, 1, 1, 1, jpk ) 
     573      IF (rmask(ji,jj,jk) == 1.) THEN 
     574         p_alktot = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 
     575         aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 
     576         zh_ini = p_hini(ji,jj,jk) 
     577 
     578         zdelta = (p_alktot-zalknw_inf(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 
     579 
     580         IF(p_alktot >= zalknw_inf(ji,jj,jk)) THEN 
     581           zh_min(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_inf(ji,jj,jk) + SQRT(zdelta) ) 
     582         ELSE 
     583           zh_min(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_inf(ji,jj,jk)) + SQRT(zdelta) ) / 2. 
     584         ENDIF 
     585 
     586         zdelta = (p_alktot-zalknw_sup(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 
     587 
     588         IF(p_alktot <= zalknw_sup(ji,jj,jk)) THEN 
     589           zh_max(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_sup(ji,jj,jk)) + SQRT(zdelta) ) / 2. 
     590         ELSE 
     591           zh_max(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_sup(ji,jj,jk) + SQRT(zdelta) ) 
     592         ENDIF 
     593 
     594         zhi(ji,jj,jk) = MAX(MIN(zh_max(ji,jj,jk), zh_ini), zh_min(ji,jj,jk)) 
     595      ENDIF 
     596   END_3D 
     597 
     598   zeqn_absmin(:,:,:) = HUGE(1._wp) 
     599 
     600   DO jn = 1, jp_maxniter_atgen  
     601   DO_3D( 1, 1, 1, 1, 1, jpk ) 
     602      IF (rmask(ji,jj,jk) == 1.) THEN 
     603         zfact = rhop(ji,jj,jk) / 1000. + rtrn 
     604         p_alktot = tr(ji,jj,jk,jptal,Kbb) / zfact 
     605         zdic  = tr(ji,jj,jk,jpdic,Kbb) / zfact 
     606         zbot  = borat(ji,jj,jk) 
     607         zpt = tr(ji,jj,jk,jppo4,Kbb) / zfact * po4r 
     608         zsit = tr(ji,jj,jk,jpsil,Kbb) / zfact 
     609         zst = sulfat (ji,jj,jk) 
     610         zft = fluorid(ji,jj,jk) 
     611         aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 
     612         zh = zhi(ji,jj,jk) 
     613         zh_prev = zh 
     614 
     615         ! H2CO3 - HCO3 - CO3 : n=2, m=0 
     616         znumer_dic = 2.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk) 
     617         zdenom_dic = ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*(ak13(ji,jj,jk) + zh) 
     618         zalk_dic   = zdic * (znumer_dic/zdenom_dic) 
     619         zdnumer_dic = ak13(ji,jj,jk)*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh     & 
     620                       *(4.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk)) 
     621         zdalk_dic   = -zdic*(zdnumer_dic/zdenom_dic**2) 
     622 
     623 
     624         ! B(OH)3 - B(OH)4 : n=1, m=0 
     625         znumer_bor = akb3(ji,jj,jk) 
     626         zdenom_bor = akb3(ji,jj,jk) + zh 
     627         zalk_bor   = zbot * (znumer_bor/zdenom_bor) 
     628         zdnumer_bor = akb3(ji,jj,jk) 
     629         zdalk_bor   = -zbot*(zdnumer_bor/zdenom_bor**2) 
     630 
     631 
     632         ! H3PO4 - H2PO4 - HPO4 - PO4 : n=3, m=1 
     633         znumer_po4 = 3.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  & 
     634         &            + zh*(2.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh* ak1p3(ji,jj,jk)) 
     635         zdenom_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)     & 
     636         &            + zh*( ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh*(ak1p3(ji,jj,jk) + zh)) 
     637         zalk_po4   = zpt * (znumer_po4/zdenom_po4 - 1.) ! Zero level of H3PO4 = 1 
     638         zdnumer_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  & 
     639         &             + zh*(4.*ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)         & 
     640         &             + zh*(9.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)                         & 
     641         &             + ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)                                & 
     642         &             + zh*(4.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh * ak1p3(ji,jj,jk) ) ) ) 
     643         zdalk_po4   = -zpt * (zdnumer_po4/zdenom_po4**2) 
     644 
     645         ! H4SiO4 - H3SiO4 : n=1, m=0 
     646         znumer_sil = aksi3(ji,jj,jk) 
     647         zdenom_sil = aksi3(ji,jj,jk) + zh 
     648         zalk_sil   = zsit * (znumer_sil/zdenom_sil) 
     649         zdnumer_sil = aksi3(ji,jj,jk) 
     650         zdalk_sil   = -zsit * (zdnumer_sil/zdenom_sil**2) 
     651 
     652         ! HSO4 - SO4 : n=1, m=1 
     653         aphscale = 1.0 + zst/aks3(ji,jj,jk) 
     654         znumer_so4 = aks3(ji,jj,jk) * aphscale 
     655         zdenom_so4 = aks3(ji,jj,jk) * aphscale + zh 
     656         zalk_so4   = zst * (znumer_so4/zdenom_so4 - 1.) 
     657         zdnumer_so4 = aks3(ji,jj,jk) 
     658         zdalk_so4   = -zst * (zdnumer_so4/zdenom_so4**2) 
     659 
     660         ! HF - F : n=1, m=1 
     661         znumer_flu =  akf3(ji,jj,jk) 
     662         zdenom_flu =  akf3(ji,jj,jk) + zh 
     663         zalk_flu   =  zft * (znumer_flu/zdenom_flu - 1.) 
     664         zdnumer_flu = akf3(ji,jj,jk) 
     665         zdalk_flu   = -zft * (zdnumer_flu/zdenom_flu**2) 
     666 
     667         ! H2O - OH 
     668         aphscale = 1.0 + zst/aks3(ji,jj,jk) 
     669         zalk_wat   = akw3(ji,jj,jk)/zh - zh/aphscale 
     670         zdalk_wat  = -akw3(ji,jj,jk)/zh**2 - 1./aphscale 
     671 
     672         ! CALCULATE [ALK]([CO3--], [HCO3-]) 
     673         zeqn = zalk_dic + zalk_bor + zalk_po4 + zalk_sil   & 
     674         &      + zalk_so4 + zalk_flu                       & 
     675         &      + zalk_wat - p_alktot 
     676 
     677         zalka = p_alktot - (zalk_bor + zalk_po4 + zalk_sil   & 
     678         &       + zalk_so4 + zalk_flu + zalk_wat) 
     679 
     680         zdeqndh = zdalk_dic + zdalk_bor + zdalk_po4 + zdalk_sil & 
     681         &         + zdalk_so4 + zdalk_flu + zdalk_wat 
     682 
     683         ! Adapt bracketing interval 
     684         IF(zeqn > 0._wp) THEN 
     685           zh_min(ji,jj,jk) = zh_prev 
     686         ELSEIF(zeqn < 0._wp) THEN 
     687           zh_max(ji,jj,jk) = zh_prev 
     688         ENDIF 
     689 
     690         IF(ABS(zeqn) >= 0.5_wp*zeqn_absmin(ji,jj,jk)) THEN 
     691         ! if the function evaluation at the current point is 
     692         ! not decreasing faster than with a bisection step (at least linearly) 
     693         ! in absolute value take one bisection step on [ph_min, ph_max] 
     694         ! ph_new = (ph_min + ph_max)/2d0 
     695         ! 
     696         ! In terms of [H]_new: 
     697         ! [H]_new = 10**(-ph_new) 
     698         !         = 10**(-(ph_min + ph_max)/2d0) 
     699         !         = SQRT(10**(-(ph_min + phmax))) 
     700         !         = SQRT(zh_max * zh_min) 
     701            zh = SQRT(zh_max(ji,jj,jk) * zh_min(ji,jj,jk)) 
     702            zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 
     703         ELSE 
     704         ! dzeqn/dpH = dzeqn/d[H] * d[H]/dpH 
     705         !           = -zdeqndh * LOG(10) * [H] 
     706         ! \Delta pH = -zeqn/(zdeqndh*d[H]/dpH) = zeqn/(zdeqndh*[H]*LOG(10)) 
     707         ! 
     708         ! pH_new = pH_old + \deltapH 
     709         ! 
     710         ! [H]_new = 10**(-pH_new) 
     711         !         = 10**(-pH_old - \Delta pH) 
     712         !         = [H]_old * 10**(-zeqn/(zdeqndh*[H]_old*LOG(10))) 
     713         !         = [H]_old * EXP(-LOG(10)*zeqn/(zdeqndh*[H]_old*LOG(10))) 
     714         !         = [H]_old * EXP(-zeqn/(zdeqndh*[H]_old)) 
     715 
     716            zh_lnfactor = -zeqn/(zdeqndh*zh_prev) 
     717 
     718            IF(ABS(zh_lnfactor) > pz_exp_threshold) THEN 
     719               zh          = zh_prev*EXP(zh_lnfactor) 
     720            ELSE 
     721               zh_delta    = zh_lnfactor*zh_prev 
     722               zh          = zh_prev + zh_delta 
    598723            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                ! 
     724 
     725            IF( zh < zh_min(ji,jj,jk) ) THEN 
     726               ! if [H]_new < [H]_min 
     727               ! i.e., if ph_new > ph_max then 
     728               ! take one bisection step on [ph_prev, ph_max] 
     729               ! ph_new = (ph_prev + ph_max)/2d0 
    703730               ! In terms of [H]_new: 
    704731               ! [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  
     732               !         = 10**(-(ph_prev + ph_max)/2d0) 
     733               !         = SQRT(10**(-(ph_prev + phmax))) 
     734               !         = SQRT([H]_old*10**(-ph_max)) 
     735               !         = SQRT([H]_old * zh_min) 
     736               zh                = SQRT(zh_prev * zh_min(ji,jj,jk)) 
     737               zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below 
    789738            ENDIF 
    790          END DO 
    791       END DO 
    792    END DO 
     739 
     740            IF( zh > zh_max(ji,jj,jk) ) THEN 
     741               ! if [H]_new > [H]_max 
     742               ! i.e., if ph_new < ph_min, then 
     743               ! take one bisection step on [ph_min, ph_prev] 
     744               ! ph_new = (ph_prev + ph_min)/2d0 
     745               ! In terms of [H]_new: 
     746               ! [H]_new = 10**(-ph_new) 
     747               !         = 10**(-(ph_prev + ph_min)/2d0) 
     748               !         = SQRT(10**(-(ph_prev + ph_min))) 
     749               !         = SQRT([H]_old*10**(-ph_min)) 
     750               !         = SQRT([H]_old * zhmax) 
     751               zh                = SQRT(zh_prev * zh_max(ji,jj,jk)) 
     752               zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below 
     753            ENDIF 
     754         ENDIF 
     755 
     756         zeqn_absmin(ji,jj,jk) = MIN( ABS(zeqn), zeqn_absmin(ji,jj,jk)) 
     757 
     758         ! Stop iterations once |\delta{[H]}/[H]| < rdel 
     759         ! <=> |(zh - zh_prev)/zh_prev| = |EXP(-zeqn/(zdeqndh*zh_prev)) -1| < rdel 
     760         ! |EXP(-zeqn/(zdeqndh*zh_prev)) -1| ~ |zeqn/(zdeqndh*zh_prev)| 
     761 
     762         ! Alternatively: 
     763         ! |\Delta pH| = |zeqn/(zdeqndh*zh_prev*LOG(10))| 
     764         !             ~ 1/LOG(10) * |\Delta [H]|/[H] 
     765         !             < 1/LOG(10) * rdel 
     766 
     767         ! Hence |zeqn/(zdeqndh*zh)| < rdel 
     768 
     769         ! rdel <-- pp_rdel_ah_target 
     770         l_exitnow = (ABS(zh_lnfactor) < pp_rdel_ah_target) 
     771 
     772         IF(l_exitnow) THEN  
     773            rmask(ji,jj,jk) = 0. 
     774         ENDIF 
     775 
     776         zhi(ji,jj,jk) =  zh 
     777 
     778         IF(jn >= jp_maxniter_atgen) THEN 
     779            zhi(ji,jj,jk) = -1._wp 
     780         ENDIF 
     781 
     782      ENDIF 
     783   END_3D 
    793784   END DO 
    794785   ! 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p4zfechem.F90

    r10416 r13463  
    1515   USE sms_pisces      ! PISCES Source Minus Sink variables 
    1616   USE p4zche          ! chemical model 
    17    USE p4zsbc          ! Boundary conditions from sediments 
    18    USE prtctl_trc      ! print control for debugging 
     17   USE p4zbc           ! Boundary conditions from sediments 
     18   USE prtctl          ! print control for debugging 
    1919   USE iom             ! I/O manager 
    2020 
    … …  
    3131   REAL(wp), PUBLIC ::   kfep         !: rate constant for nanoparticle formation 
    3232 
     33   !! * Substitutions 
     34#  include "do_loop_substitute.h90" 
     35#  include "domzgr_substitute.h90" 
    3336   !!---------------------------------------------------------------------- 
    3437   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    3841CONTAINS 
    3942 
    40    SUBROUTINE p4z_fechem( kt, knt ) 
     43   SUBROUTINE p4z_fechem( kt, knt, Kbb, Kmm, Krhs ) 
    4144      !!--------------------------------------------------------------------- 
    4245      !!                     ***  ROUTINE p4z_fechem  *** 
    … …  
    4851      !!--------------------------------------------------------------------- 
    4952      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step 
     53      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices 
    5054      ! 
    5155      INTEGER  ::   ji, jj, jk, jic, jn 
    … …  
    7175      IF( ln_timing )   CALL timing_start('p4z_fechem') 
    7276      ! 
    73       zFe3 (:,:,:) = 0. 
    74       zFeL1(:,:,:) = 0. 
    75       zTL1 (:,:,:) = 0. 
    76  
    7777      ! Total ligand concentration : Ligands can be chosen to be constant or variable 
    7878      ! Parameterization from Tagliabue and Voelker (2011) 
    7979      ! ------------------------------------------------- 
    8080      IF( ln_ligvar ) THEN 
    81          ztotlig(:,:,:) =  0.09 * trb(:,:,:,jpdoc) * 1E6 + ligand * 1E9 
     81         ztotlig(:,:,:) =  0.09 * tr(:,:,:,jpdoc,Kbb) * 1E6 + ligand * 1E9 
    8282         ztotlig(:,:,:) =  MIN( ztotlig(:,:,:), 10. ) 
    8383      ELSE 
    84         IF( ln_ligand ) THEN  ;   ztotlig(:,:,:) = trb(:,:,:,jplgw) * 1E9 
     84        IF( ln_ligand ) THEN  ;   ztotlig(:,:,:) = tr(:,:,:,jplgw,Kbb) * 1E9 
    8585        ELSE                  ;   ztotlig(:,:,:) = ligand * 1E9 
    8686        ENDIF 
    … …  
    9292      ! Chemistry is supposed to be fast enough to be at equilibrium 
    9393      ! ------------------------------------------------------------ 
    94       DO jk = 1, jpkm1 
    95          DO jj = 1, jpj 
    96             DO ji = 1, jpi 
    97                zTL1(ji,jj,jk)  = ztotlig(ji,jj,jk) 
    98                zkeq            = fekeq(ji,jj,jk) 
    99                zfesatur        = zTL1(ji,jj,jk) * 1E-9 
    100                ztfe            = trb(ji,jj,jk,jpfer)  
    101                ! Fe' is the root of a 2nd order polynom 
    102                zFe3 (ji,jj,jk) = ( -( 1. + zfesatur * zkeq - zkeq * ztfe )               & 
    103                   &              + SQRT( ( 1. + zfesatur * zkeq - zkeq * ztfe )**2       & 
    104                   &              + 4. * ztfe * zkeq) ) / ( 2. * zkeq ) 
    105                zFe3 (ji,jj,jk) = zFe3(ji,jj,jk) * 1E9 
    106                zFeL1(ji,jj,jk) = MAX( 0., trb(ji,jj,jk,jpfer) * 1E9 - zFe3(ji,jj,jk) ) 
    107            END DO 
    108          END DO 
    109       END DO 
     94      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     95         zTL1(ji,jj,jk)  = ztotlig(ji,jj,jk) 
     96         zkeq            = fekeq(ji,jj,jk) 
     97         zfesatur        = zTL1(ji,jj,jk) * 1E-9 
     98         ztfe            = tr(ji,jj,jk,jpfer,Kbb)  
     99         ! Fe' is the root of a 2nd order polynom 
     100         zFe3 (ji,jj,jk) = ( -( 1. + zfesatur * zkeq - zkeq * ztfe )               & 
     101            &              + SQRT( ( 1. + zfesatur * zkeq - zkeq * ztfe )**2       & 
     102            &              + 4. * ztfe * zkeq) ) / ( 2. * zkeq ) 
     103         zFe3 (ji,jj,jk) = zFe3(ji,jj,jk) * 1E9 
     104         zFeL1(ji,jj,jk) = MAX( 0., tr(ji,jj,jk,jpfer,Kbb) * 1E9 - zFe3(ji,jj,jk) ) 
     105      END_3D 
    110106         ! 
    111107 
    112108      zdust = 0.         ! if no dust available 
    113       DO jk = 1, jpkm1 
    114          DO jj = 1, jpj 
    115             DO ji = 1, jpi 
    116                ! Scavenging rate of iron. This scavenging rate depends on the load of particles of sea water.  
    117                ! This parameterization assumes a simple second order kinetics (k[Particles][Fe]). 
    118                ! Scavenging onto dust is also included as evidenced from the DUNE experiments. 
    119                ! -------------------------------------------------------------------------------------- 
    120                zhplus  = max( rtrn, hi(ji,jj,jk) ) 
    121                fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  & 
    122                &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     & 
    123                &         + fesol(ji,jj,jk,5) / zhplus ) 
    124                ! 
    125                zfeequi = zFe3(ji,jj,jk) * 1E-9 
    126                zhplus  = max( rtrn, hi(ji,jj,jk) ) 
    127                fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  & 
    128                   &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     & 
    129                   &         + fesol(ji,jj,jk,5) / zhplus ) 
    130                zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9 
    131                ! precipitation of Fe3+, creation of nanoparticles 
    132                precip(ji,jj,jk) = MAX( 0., ( zFe3(ji,jj,jk) * 1E-9 - fe3sol ) ) * kfep * xstep 
    133                ! 
    134                ztrc   = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6  
    135                IF( ln_dust )  zdust  = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) & 
    136                &  * EXP( -gdept_n(ji,jj,jk) / 540. ) 
    137                IF (ln_ligand) THEN 
    138                   zxlam  = xlam1 * MAX( 1.E-3, EXP(-2 * etot(ji,jj,jk) / 10. ) * (1. - EXP(-2 * trb(ji,jj,jk,jpoxy) / 100.E-6 ) )) 
    139                ELSE 
    140                   zxlam  = xlam1 * 1.0 
    141                ENDIF 
    142                zlam1b = 3.e-5 + xlamdust * zdust + zxlam * ztrc 
    143                zscave = zfeequi * zlam1b * xstep 
    144  
    145                ! Compute the different ratios for scavenging of iron 
    146                ! to later allocate scavenged iron to the different organic pools 
    147                ! --------------------------------------------------------- 
    148                zdenom1 = zxlam * trb(ji,jj,jk,jppoc) / zlam1b 
    149                zdenom2 = zxlam * trb(ji,jj,jk,jpgoc) / zlam1b 
    150  
    151                !  Increased scavenging for very high iron concentrations found near the coasts  
    152                !  due to increased lithogenic particles and let say it is unknown processes (precipitation, ...) 
    153                !  ----------------------------------------------------------- 
    154                zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 
    155                zlamfac = MIN( 1.  , zlamfac ) 
    156                zdep    = MIN( 1., 1000. / gdept_n(ji,jj,jk) ) 
    157                zcoag   = 1E-4 * ( 1. - zlamfac ) * zdep * xstep * trb(ji,jj,jk,jpfer) 
    158  
    159                !  Compute the coagulation of colloidal iron. This parameterization  
    160                !  could be thought as an equivalent of colloidal pumping. 
    161                !  It requires certainly some more work as it is very poorly constrained. 
    162                !  ---------------------------------------------------------------- 
    163                zlam1a   = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    & 
    164                    &      + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) ) 
    165                zaggdfea = zlam1a * xstep * zfecoll 
    166                ! 
    167                zlam1b   = 3.53E3 * trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk) 
    168                zaggdfeb = zlam1b * xstep * zfecoll 
    169                ! 
    170                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfea - zaggdfeb & 
    171                &                     - zcoag - precip(ji,jj,jk) 
    172                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea 
    173                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zscave * zdenom2 + zaggdfeb 
    174                zscav3d(ji,jj,jk)   = zscave 
    175                zcoll3d(ji,jj,jk)   = zaggdfea + zaggdfeb 
    176                ! 
    177             END DO 
    178          END DO 
    179       END DO 
     109      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     110         ! Scavenging rate of iron. This scavenging rate depends on the load of particles of sea water.  
     111         ! This parameterization assumes a simple second order kinetics (k[Particles][Fe]). 
     112         ! Scavenging onto dust is also included as evidenced from the DUNE experiments. 
     113         ! -------------------------------------------------------------------------------------- 
     114         zhplus  = max( rtrn, hi(ji,jj,jk) ) 
     115         fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  & 
     116         &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     & 
     117         &         + fesol(ji,jj,jk,5) / zhplus ) 
     118         ! 
     119         zfeequi = zFe3(ji,jj,jk) * 1E-9 
     120         zhplus  = max( rtrn, hi(ji,jj,jk) ) 
     121         fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  & 
     122            &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     & 
     123            &         + fesol(ji,jj,jk,5) / zhplus ) 
     124         zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9 
     125         ! precipitation of Fe3+, creation of nanoparticles 
     126         precip(ji,jj,jk) = MAX( 0., ( zFe3(ji,jj,jk) * 1E-9 - fe3sol ) ) * kfep * xstep 
     127         ! 
     128         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  
     129         IF( ll_dust )  zdust  = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) & 
     130         &  * EXP( -gdept(ji,jj,jk,Kmm) / 540. ) 
     131         IF (ln_ligand) THEN 
     132            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 ) )) 
     133         ELSE 
     134            zxlam  = xlam1 * 1.0 
     135         ENDIF 
     136         zlam1b = 3.e-5 + xlamdust * zdust + zxlam * ztrc 
     137         zscave = zfeequi * zlam1b * xstep 
     138 
     139         ! Compute the different ratios for scavenging of iron 
     140         ! to later allocate scavenged iron to the different organic pools 
     141         ! --------------------------------------------------------- 
     142         zdenom1 = zxlam * tr(ji,jj,jk,jppoc,Kbb) / zlam1b 
     143         zdenom2 = zxlam * tr(ji,jj,jk,jpgoc,Kbb) / zlam1b 
     144 
     145         !  Increased scavenging for very high iron concentrations found near the coasts  
     146         !  due to increased lithogenic particles and let say it is unknown processes (precipitation, ...) 
     147         !  ----------------------------------------------------------- 
     148         zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 
     149         zlamfac = MIN( 1.  , zlamfac ) 
     150         zdep    = MIN( 1., 1000. / gdept(ji,jj,jk,Kmm) ) 
     151         zcoag   = 1E-4 * ( 1. - zlamfac ) * zdep * xstep * tr(ji,jj,jk,jpfer,Kbb) 
     152 
     153         !  Compute the coagulation of colloidal iron. This parameterization  
     154         !  could be thought as an equivalent of colloidal pumping. 
     155         !  It requires certainly some more work as it is very poorly constrained. 
     156         !  ---------------------------------------------------------------- 
     157         zlam1a   = ( 0.369  * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4  * tr(ji,jj,jk,jppoc,Kbb) ) * xdiss(ji,jj,jk)    & 
     158             &      + ( 114.   * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) ) 
     159         zaggdfea = zlam1a * xstep * zfecoll 
     160         ! 
     161         zlam1b   = 3.53E3 * tr(ji,jj,jk,jpgoc,Kbb) * xdiss(ji,jj,jk) 
     162         zaggdfeb = zlam1b * xstep * zfecoll 
     163         ! 
     164         tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zscave - zaggdfea - zaggdfeb & 
     165         &                     - zcoag - precip(ji,jj,jk) 
     166         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zscave * zdenom1 + zaggdfea 
     167         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zscave * zdenom2 + zaggdfeb 
     168         zscav3d(ji,jj,jk)   = zscave 
     169         zcoll3d(ji,jj,jk)   = zaggdfea + zaggdfeb 
     170         ! 
     171      END_3D 
    180172      ! 
    181173      !  Define the bioavailable fraction of iron 
    182174      !  ---------------------------------------- 
    183       biron(:,:,:) = trb(:,:,:,jpfer)  
     175      biron(:,:,:) = tr(:,:,:,jpfer,Kbb)  
    184176      ! 
    185177      IF( ln_ligand ) THEN 
    186178         ! 
    187          DO jk = 1, jpkm1 
    188             DO jj = 1, jpj 
    189                DO ji = 1, jpi 
    190                   zlam1a   = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    & 
    191                       &    + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) ) 
    192                   ! 
    193                   zlam1b   = 3.53E3 *   trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk) 
    194                   zligco   = 0.5 * trn(ji,jj,jk,jplgw) 
    195                   zaggliga = zlam1a * xstep * zligco 
    196                   zaggligb = zlam1b * xstep * zligco 
    197                   tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) - zaggliga - zaggligb 
    198                   zlcoll3d(ji,jj,jk)  = zaggliga + zaggligb 
    199                END DO 
    200             END DO 
    201          END DO 
    202          ! 
    203          plig(:,:,:) =  MAX( 0., ( ( zFeL1(:,:,:) * 1E-9 ) / ( trb(:,:,:,jpfer) +rtrn ) ) ) 
     179         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     180            zlam1a   = ( 0.369  * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4  * tr(ji,jj,jk,jppoc,Kbb) ) * xdiss(ji,jj,jk)    & 
     181                &    + ( 114.   * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) ) 
     182            ! 
     183            zlam1b   = 3.53E3 *   tr(ji,jj,jk,jpgoc,Kbb) * xdiss(ji,jj,jk) 
     184            zligco   = 0.5 * tr(ji,jj,jk,jplgw,Kmm) 
     185            zaggliga = zlam1a * xstep * zligco 
     186            zaggligb = zlam1b * xstep * zligco 
     187            tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) - zaggliga - zaggligb 
     188            zlcoll3d(ji,jj,jk)  = zaggliga + zaggligb 
     189         END_3D 
     190         ! 
     191         plig(:,:,:) =  MAX( 0., ( ( zFeL1(:,:,:) * 1E-9 ) / ( tr(:,:,:,jpfer,Kbb) +rtrn ) ) ) 
    204192         ! 
    205193      ENDIF 
    … …  
    209197         IF( knt == nrdttrc ) THEN 
    210198            zrfact2 = 1.e3 * rfact2r  ! conversion from mol/L/timestep into mol/m3/s 
    211             IF( iom_use("Fe3")    )  CALL iom_put("Fe3"    , zFe3   (:,:,:)       * tmask(:,:,:) )   ! Fe3+ 
    212             IF( iom_use("FeL1")   )  CALL iom_put("FeL1"   , zFeL1  (:,:,:)       * tmask(:,:,:) )   ! FeL1 
    213             IF( iom_use("TL1")    )  CALL iom_put("TL1"    , zTL1   (:,:,:)       * tmask(:,:,:) )   ! TL1 
     199            IF( iom_use("Fe3")  )  THEN 
     200               zFe3(:,:,jpk) = 0.  ;  CALL iom_put("Fe3" , zFe3(:,:,:) * tmask(:,:,:) )   ! Fe3+ 
     201            ENDIF 
     202            IF( iom_use("FeL1") )  THEN 
     203              zFeL1(:,:,jpk) = 0.  ;  CALL iom_put("FeL1", zFeL1(:,:,:) * tmask(:,:,:) )   ! FeL1 
     204            ENDIF 
     205            IF( iom_use("TL1")  )  THEN 
     206              zTL1(:,:,jpk) = 0.   ;  CALL iom_put("TL1" , zTL1(:,:,:) * tmask(:,:,:) )   ! TL1 
     207            ENDIF 
    214208            IF( iom_use("Totlig") )  CALL iom_put("Totlig" , ztotlig(:,:,:)       * tmask(:,:,:) )   ! TL 
    215209            IF( iom_use("Biron")  )  CALL iom_put("Biron"  , biron  (:,:,:)  * 1e9 * tmask(:,:,:) )   ! biron 
    216             IF( iom_use("FESCAV") )  CALL iom_put("FESCAV" , zscav3d(:,:,:)  * 1e9 * tmask(:,:,:) * zrfact2 ) 
    217             IF( iom_use("FECOLL") )  CALL iom_put("FECOLL" , zcoll3d(:,:,:)  * 1e9 * tmask(:,:,:) * zrfact2 ) 
    218             IF( iom_use("LGWCOLL"))  CALL iom_put("LGWCOLL", zlcoll3d(:,:,:) * 1e9 * tmask(:,:,:) * zrfact2 ) 
    219          ENDIF 
    220       ENDIF 
    221  
    222       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     210            IF( iom_use("FESCAV") )  THEN 
     211               zscav3d (:,:,jpk) = 0.  ;  CALL iom_put("FESCAV" , zscav3d(:,:,:)  * 1e9 * tmask(:,:,:) * zrfact2 ) 
     212            ENDIF 
     213            IF( iom_use("FECOLL") ) THEN 
     214               zcoll3d (:,:,jpk) = 0.  ;   CALL iom_put("FECOLL" , zcoll3d(:,:,:)  * 1e9 * tmask(:,:,:) * zrfact2 ) 
     215            ENDIF 
     216            IF( iom_use("LGWCOLL")) THEN 
     217               zlcoll3d(:,:,jpk) = 0.  ;  CALL iom_put("LGWCOLL", zlcoll3d(:,:,:) * 1e9 * tmask(:,:,:) * zrfact2 ) 
     218            ENDIF 
     219          ENDIF 
     220      ENDIF 
     221 
     222      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    223223         WRITE(charout, FMT="('fechem')") 
    224          CALL prt_ctl_trc_info(charout) 
    225          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     224         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     225         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    226226      ENDIF 
    227227      ! 
    … …  
    254254      ENDIF 
    255255      ! 
    256       REWIND( numnatp_ref )            ! Namelist nampisfer in reference namelist : Pisces iron chemistry 
    257256      READ  ( numnatp_ref, nampisfer, IOSTAT = ios, ERR = 901) 
    258 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisfer in reference namelist', lwp ) 
    259       REWIND( numnatp_cfg )            ! Namelist nampisfer in configuration namelist : Pisces iron chemistry 
     257901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisfer in reference namelist' ) 
    260258      READ  ( numnatp_cfg, nampisfer, IOSTAT = ios, ERR = 902 ) 
    261 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisfer in configuration namelist', lwp ) 
     259902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisfer in configuration namelist' ) 
    262260      IF(lwm) WRITE( numonp, nampisfer ) 
    263261 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p4zflx.F90

    r10425 r13463  
    1919   USE sms_pisces     !  PISCES Source Minus Sink variables 
    2020   USE p4zche         !  Chemical model 
    21    USE prtctl_trc     !  print control for debugging 
     21   USE prtctl         !  print control for debugging 
    2222   USE iom            !  I/O manager 
    2323   USE fldread        !  read input fields 
    … …  
    5252   REAL(wp) ::   xconv  = 0.01_wp / 3600._wp   !: coefficients for conversion  
    5353 
     54   !! * Substitutions 
     55#  include "do_loop_substitute.h90" 
     56#  include "domzgr_substitute.h90" 
    5457   !!---------------------------------------------------------------------- 
    5558   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    5962CONTAINS 
    6063 
    61    SUBROUTINE p4z_flx ( kt, knt ) 
     64   SUBROUTINE p4z_flx ( kt, knt, Kbb, Kmm, Krhs ) 
    6265      !!--------------------------------------------------------------------- 
    6366      !!                     ***  ROUTINE p4z_flx  *** 
    … …  
    7174      !!--------------------------------------------------------------------- 
    7275      INTEGER, INTENT(in) ::   kt, knt   ! 
     76      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs      ! time level indices 
    7377      ! 
    7478      INTEGER  ::   ji, jj, jm, iind, iindm1 
    … …  
    8084      CHARACTER (len=25) ::   charout 
    8185      REAL(wp), DIMENSION(jpi,jpj) ::   zkgco2, zkgo2, zh2co3, zoflx,  zpco2atm   
    82       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zw2d 
    8386      !!--------------------------------------------------------------------- 
    8487      ! 
    … …  
    107110      IF( l_co2cpl )   satmco2(:,:) = atm_co2(:,:) 
    108111 
    109       DO jj = 1, jpj 
    110          DO ji = 1, jpi 
    111             ! DUMMY VARIABLES FOR DIC, H+, AND BORATE 
    112             zfact = rhop(ji,jj,1) / 1000. + rtrn 
    113             zdic  = trb(ji,jj,1,jpdic) 
    114             zph   = MAX( hi(ji,jj,1), 1.e-10 ) / zfact 
    115             ! CALCULATE [H2CO3] 
    116             zh2co3(ji,jj) = zdic/(1. + ak13(ji,jj,1)/zph + ak13(ji,jj,1)*ak23(ji,jj,1)/zph**2) 
    117          END DO 
    118       END DO 
     112      DO_2D( 1, 1, 1, 1 ) 
     113         ! DUMMY VARIABLES FOR DIC, H+, AND BORATE 
     114         zfact = rhop(ji,jj,1) / 1000. + rtrn 
     115         zdic  = tr(ji,jj,1,jpdic,Kbb) 
     116         zph   = MAX( hi(ji,jj,1), 1.e-10 ) / zfact 
     117         ! CALCULATE [H2CO3] 
     118         zh2co3(ji,jj) = zdic/(1. + ak13(ji,jj,1)/zph + ak13(ji,jj,1)*ak23(ji,jj,1)/zph**2) 
     119      END_2D 
    119120 
    120121      ! -------------- 
    … …  
    125126      ! ------------------------------------------- 
    126127 
    127       DO jj = 1, jpj 
    128          DO ji = 1, jpi 
    129             ztc  = MIN( 35., tsn(ji,jj,1,jp_tem) ) 
    130             ztc2 = ztc * ztc 
    131             ztc3 = ztc * ztc2  
    132             ztc4 = ztc2 * ztc2  
    133             ! Compute the schmidt Number both O2 and CO2 
    134             zsch_co2 = 2116.8 - 136.25 * ztc + 4.7353 * ztc2 - 0.092307 * ztc3 + 0.0007555 * ztc4 
    135             zsch_o2  = 1920.4 - 135.6  * ztc + 5.2122 * ztc2 - 0.109390 * ztc3 + 0.0009377 * ztc4 
    136             !  wind speed  
    137             zws  = wndm(ji,jj) * wndm(ji,jj) 
    138             ! Compute the piston velocity for O2 and CO2 
    139             zkgwan = 0.251 * zws 
    140             zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) 
    141             ! compute gas exchange for CO2 and O2 
    142             zkgco2(ji,jj) = zkgwan * SQRT( 660./ zsch_co2 ) 
    143             zkgo2 (ji,jj) = zkgwan * SQRT( 660./ zsch_o2 ) 
    144          END DO 
    145       END DO 
    146  
    147  
    148       DO jj = 1, jpj 
    149          DO ji = 1, jpi 
    150             ztkel = tempis(ji,jj,1) + 273.15 
    151             zsal  = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35. 
    152             zvapsw    = EXP(24.4543 - 67.4509*(100.0/ztkel) - 4.8489*LOG(ztkel/100) - 0.000544*zsal) 
    153             zpco2atm(ji,jj) = satmco2(ji,jj) * ( patm(ji,jj) - zvapsw ) 
    154             zxc2      = ( 1.0 - zpco2atm(ji,jj) * 1E-6 )**2 
    155             zfugcoeff = EXP( patm(ji,jj) * (chemc(ji,jj,2) + 2.0 * zxc2 * chemc(ji,jj,3) )   & 
    156             &           / ( 82.05736 * ztkel )) 
    157             zfco2 = zpco2atm(ji,jj) * zfugcoeff 
    158  
    159             ! Compute CO2 flux for the sea and air 
    160             zfld = zfco2 * chemc(ji,jj,1) * zkgco2(ji,jj)  ! (mol/L) * (m/s) 
    161             zflu = zh2co3(ji,jj) * zkgco2(ji,jj)                                   ! (mol/L) (m/s) ? 
    162             oce_co2(ji,jj) = ( zfld - zflu ) * rfact2 * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000. 
    163             ! compute the trend 
    164             tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) * rfact2 / e3t_n(ji,jj,1) * tmask(ji,jj,1) 
    165  
    166             ! Compute O2 flux  
    167             zfld16 = patm(ji,jj) * chemo2(ji,jj,1) * zkgo2(ji,jj)          ! (mol/L) * (m/s) 
    168             zflu16 = trb(ji,jj,1,jpoxy) * zkgo2(ji,jj) 
    169             zoflx(ji,jj) = ( zfld16 - zflu16 ) * tmask(ji,jj,1) 
    170             tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) * rfact2 / e3t_n(ji,jj,1) 
    171          END DO 
    172       END DO 
     128      DO_2D( 1, 1, 1, 1 ) 
     129         ztc  = MIN( 35., ts(ji,jj,1,jp_tem,Kmm) ) 
     130         ztc2 = ztc * ztc 
     131         ztc3 = ztc * ztc2  
     132         ztc4 = ztc2 * ztc2  
     133         ! Compute the schmidt Number both O2 and CO2 
     134         zsch_co2 = 2116.8 - 136.25 * ztc + 4.7353 * ztc2 - 0.092307 * ztc3 + 0.0007555 * ztc4 
     135         zsch_o2  = 1920.4 - 135.6  * ztc + 5.2122 * ztc2 - 0.109390 * ztc3 + 0.0009377 * ztc4 
     136         !  wind speed  
     137         zws  = wndm(ji,jj) * wndm(ji,jj) 
     138         ! Compute the piston velocity for O2 and CO2 
     139         zkgwan = 0.251 * zws 
     140         zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) 
     141         ! compute gas exchange for CO2 and O2 
     142         zkgco2(ji,jj) = zkgwan * SQRT( 660./ zsch_co2 ) 
     143         zkgo2 (ji,jj) = zkgwan * SQRT( 660./ zsch_o2 ) 
     144      END_2D 
     145 
     146 
     147      DO_2D( 1, 1, 1, 1 ) 
     148         ztkel = tempis(ji,jj,1) + 273.15 
     149         zsal  = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35. 
     150         zvapsw    = EXP(24.4543 - 67.4509*(100.0/ztkel) - 4.8489*LOG(ztkel/100) - 0.000544*zsal) 
     151         zpco2atm(ji,jj) = satmco2(ji,jj) * ( patm(ji,jj) - zvapsw ) 
     152         zxc2      = ( 1.0 - zpco2atm(ji,jj) * 1E-6 )**2 
     153         zfugcoeff = EXP( patm(ji,jj) * (chemc(ji,jj,2) + 2.0 * zxc2 * chemc(ji,jj,3) )   & 
     154         &           / ( 82.05736 * ztkel )) 
     155         zfco2 = zpco2atm(ji,jj) * zfugcoeff 
     156 
     157         ! Compute CO2 flux for the sea and air 
     158         zfld = zfco2 * chemc(ji,jj,1) * zkgco2(ji,jj)  ! (mol/L) * (m/s) 
     159         zflu = zh2co3(ji,jj) * zkgco2(ji,jj)                                   ! (mol/L) (m/s) ? 
     160         oce_co2(ji,jj) = ( zfld - zflu ) * tmask(ji,jj,1)  
     161         ! compute the trend 
     162         tr(ji,jj,1,jpdic,Krhs) = tr(ji,jj,1,jpdic,Krhs) + oce_co2(ji,jj) * rfact2 / e3t(ji,jj,1,Kmm) 
     163 
     164         ! Compute O2 flux  
     165         zfld16 = patm(ji,jj) * chemo2(ji,jj,1) * zkgo2(ji,jj)          ! (mol/L) * (m/s) 
     166         zflu16 = tr(ji,jj,1,jpoxy,Kbb) * zkgo2(ji,jj) 
     167         zoflx(ji,jj) = ( zfld16 - zflu16 ) * tmask(ji,jj,1) 
     168         tr(ji,jj,1,jpoxy,Krhs) = tr(ji,jj,1,jpoxy,Krhs) + zoflx(ji,jj) * rfact2 / e3t(ji,jj,1,Kmm) 
     169      END_2D 
    173170 
    174171      IF( iom_use("tcflx") .OR. iom_use("tcflxcum") .OR. kt == nitrst   & 
    175172         &                 .OR. (ln_check_mass .AND. kt == nitend) )    & 
    176          t_oce_co2_flx  = glob_sum( 'p4zflx', oce_co2(:,:) )                    !  Total Flux of Carbon 
     173         t_oce_co2_flx  = glob_sum( 'p4zflx', oce_co2(:,:) * e1e2t(:,:) * 1000. )                    !  Total Flux of Carbon 
    177174      t_oce_co2_flx_cum = t_oce_co2_flx_cum + t_oce_co2_flx       !  Cumulative Total Flux of Carbon 
    178175!      t_atm_co2_flx     = glob_sum( 'p4zflx', satmco2(:,:) * e1e2t(:,:) )       ! Total atmospheric pCO2 
    179176      t_atm_co2_flx     =  atcco2      ! Total atmospheric pCO2 
    180177  
    181       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     178      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    182179         WRITE(charout, FMT="('flx ')") 
    183          CALL prt_ctl_trc_info(charout) 
    184          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     180         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     181         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    185182      ENDIF 
    186183 
    187184      IF( lk_iomput .AND. knt == nrdttrc ) THEN 
    188          ALLOCATE( zw2d(jpi,jpj) )   
    189          IF( iom_use( "Cflx"  ) )  THEN 
    190             zw2d(:,:) = oce_co2(:,:) / e1e2t(:,:) * rfact2r 
    191             CALL iom_put( "Cflx"     , zw2d )  
    192          ENDIF 
    193          IF( iom_use( "Oflx"  ) )  THEN 
    194             zw2d(:,:) =  zoflx(:,:) * 1000 * tmask(:,:,1) 
    195             CALL iom_put( "Oflx" , zw2d ) 
    196          ENDIF 
    197          IF( iom_use( "Kg"    ) )  THEN 
    198             zw2d(:,:) =  zkgco2(:,:) * tmask(:,:,1) 
    199             CALL iom_put( "Kg"   , zw2d ) 
    200          ENDIF 
    201          IF( iom_use( "Dpco2" ) ) THEN 
    202            zw2d(:,:) = ( zpco2atm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) 
    203            CALL iom_put( "Dpco2" ,  zw2d ) 
    204          ENDIF 
    205          IF( iom_use( "Dpo2" ) )  THEN 
    206            zw2d(:,:) = ( atcox * patm(:,:) - atcox * trb(:,:,1,jpoxy) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1) 
    207            CALL iom_put( "Dpo2"  , zw2d ) 
    208          ENDIF 
    209          CALL iom_put( "tcflx"    , t_oce_co2_flx * rfact2r )   ! molC/s 
    210          CALL iom_put( "tcflxcum" , t_oce_co2_flx_cum       )   ! molC 
    211          ! 
    212          DEALLOCATE( zw2d ) 
     185         CALL iom_put( "AtmCo2"  , satmco2(:,:) * tmask(:,:,1) )   ! Atmospheric CO2 concentration 
     186         CALL iom_put( "Cflx"    , oce_co2(:,:) * 1000. )  
     187         CALL iom_put( "Oflx"    , zoflx(:,:) * 1000.  ) 
     188         CALL iom_put( "Kg"      , zkgco2(:,:) * tmask(:,:,1)  ) 
     189         CALL iom_put( "Dpco2"   , ( zpco2atm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) ) 
     190         CALL iom_put( "pCO2sea" , ( zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) ) 
     191         CALL iom_put( "Dpo2"    , ( atcox * patm(:,:) - atcox * tr(:,:,1,jpoxy,Kbb) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1) ) 
     192         CALL iom_put( "tcflx"   , t_oce_co2_flx     )   ! molC/s 
     193         CALL iom_put( "tcflxcum", t_oce_co2_flx_cum )   ! molC 
    213194      ENDIF 
    214195      ! 
    … …  
    239220      ENDIF 
    240221      ! 
    241       REWIND( numnatp_ref )              ! Namelist nampisext in reference namelist : Pisces atm. conditions 
    242222      READ  ( numnatp_ref, nampisext, IOSTAT = ios, ERR = 901) 
    243 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisext in reference namelist', lwp ) 
    244       REWIND( numnatp_cfg )              ! Namelist nampisext in configuration namelist : Pisces atm. conditions 
     223901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisext in reference namelist' ) 
    245224      READ  ( numnatp_cfg, nampisext, IOSTAT = ios, ERR = 902 ) 
    246 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisext in configuration namelist', lwp ) 
     225902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisext in configuration namelist' ) 
    247226      IF(lwm) WRITE ( numonp, nampisext ) 
    248227      ! 
    … …  
    320299         ENDIF 
    321300         ! 
    322          REWIND( numnatp_ref )              ! Namelist nampisatm in reference namelist : Pisces atm. sea level pressure file 
    323301         READ  ( numnatp_ref, nampisatm, IOSTAT = ios, ERR = 901) 
    324 901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisatm in reference namelist', lwp ) 
    325          REWIND( numnatp_cfg )              ! Namelist nampisatm in configuration namelist : Pisces atm. sea level pressure file  
     302901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisatm in reference namelist' ) 
    326303         READ  ( numnatp_cfg, nampisatm, IOSTAT = ios, ERR = 902 ) 
    327 902      IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisatm in configuration namelist', lwp ) 
     304902      IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisatm in configuration namelist' ) 
    328305         IF(lwm) WRITE ( numonp, nampisatm ) 
    329306         ! 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p4zint.F90

    r10068 r13463  
    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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p4zligand.F90

    r10416 r13463  
    1212   USE trc             ! passive tracers common variables  
    1313   USE sms_pisces      ! PISCES Source Minus Sink variables 
    14    USE prtctl_trc      ! print control for debugging 
     14   USE prtctl          ! print control for debugging 
    1515   USE iom             !  I/O manager 
    1616 
    … …  
    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 
    4447      REAL(wp) ::   zlgwp, zlgwpr, zlgwr, zlablgw 
    45       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zligrem, zligpr, zrligprod 
    46       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zw3d 
     48      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zligrem, zligpr, zligprod 
    4749      CHARACTER (len=25) ::   charout 
    4850      !!--------------------------------------------------------------------- 
    … …  
    5052      IF( ln_timing )   CALL timing_start('p4z_ligand') 
    5153      ! 
    52       DO jk = 1, jpkm1 
    53          DO jj = 1, jpj 
    54             DO ji = 1, jpi 
    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 * (trb(ji,jj,jk,jplgw)*1e9) ) ) ! years 
    65                zlgwr = 1. / zlgwr * tgfunc(ji,jj,jk) * ( xstep / nyear_len(1) ) * blim(ji,jj,jk) * trb(ji,jj,jk,jplgw) 
    66                ! photochem loss of weak ligand 
    67                zlgwpr = prlgw * xstep * etot(ji,jj,jk) * trb(ji,jj,jk,jplgw) * (1. - fr_i(ji,jj)) 
    68                tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zlgwp - zlgwr - zlgwpr 
    69                zligrem(ji,jj,jk)   = zlgwr 
    70                zligpr(ji,jj,jk)    = zlgwpr 
    71                zrligprod(ji,jj,jk) = zlgwp 
    72                ! 
    73             END DO 
    74          END DO 
    75       END DO 
     54      DO_3D( 1, 1, 1, 1, 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 
    7674      ! 
    7775      !  Output of some diagnostics variables 
    7876      !     --------------------------------- 
    7977      IF( lk_iomput .AND. knt == nrdttrc ) THEN 
    80          ALLOCATE( zw3d(jpi,jpj,jpk) ) 
    8178         IF( iom_use( "LIGREM" ) ) THEN 
    82             zw3d(:,:,:) = zligrem(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) 
    83             CALL iom_put( "LIGREM", zw3d ) 
     79           zligrem(:,:,jpk) = 0.  ; CALL iom_put( "LIGREM", zligrem(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) ) 
    8480         ENDIF 
    8581         IF( iom_use( "LIGPR" ) ) THEN 
    86             zw3d(:,:,:) = zligpr(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:)  
    87             CALL iom_put( "LIGPR", zw3d ) 
     82           zligpr(:,:,jpk) = 0.   ; CALL iom_put( "LIGPR" , zligpr(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) ) 
    8883         ENDIF 
    8984         IF( iom_use( "LPRODR" ) ) THEN 
    90             zw3d(:,:,:) = zrligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:)  
    91             CALL iom_put( "LPRODR", zw3d ) 
     85           zligprod(:,:,jpk) = 0. ; CALL iom_put( "LPRODR", zligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) ) 
    9286         ENDIF 
    93          DEALLOCATE( zw3d ) 
    9487      ENDIF 
    9588      ! 
    96       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     89      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    9790         WRITE(charout, FMT="('ligand1')") 
    98          CALL prt_ctl_trc_info(charout) 
    99          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     91         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     92         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    10093      ENDIF 
    10194      ! 
    … …  
    125118         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    126119      ENDIF 
    127       REWIND( numnatp_ref )              ! Namelist nampislig in reference namelist : Pisces remineralization 
    128120      READ  ( numnatp_ref, nampislig, IOSTAT = ios, ERR = 901) 
    129 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampislig in reference namelist', lwp ) 
    130       REWIND( numnatp_cfg )              ! Namelist nampislig in configuration namelist : Pisces remineralization 
     121901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampislig in reference namelist' ) 
    131122      READ  ( numnatp_cfg, nampislig, IOSTAT = ios, ERR = 902 ) 
    132 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampislig in configuration namelist', lwp ) 
     123902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampislig in configuration namelist' ) 
    133124      IF(lwm) WRITE ( numonp, nampislig ) 
    134125      ! 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p4zlim.F90

    r10425 r13463  
    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( 1, 1, 1, 1, 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) + rtrn ) 
     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( 1, 1, 1, 1, 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( 1, 1, 1, 1, 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 
    217         IF( iom_use( "xfracal" ) )   CALL iom_put( "xfracal", xfracal(:,:,:) * tmask(:,:,:) )  ! euphotic layer deptht 
    218         IF( iom_use( "LNnut"   ) )   CALL iom_put( "LNnut"  , xlimphy(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term 
    219         IF( iom_use( "LDnut"   ) )   CALL iom_put( "LDnut"  , xlimdia(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term 
    220         IF( iom_use( "LNFe"    ) )   CALL iom_put( "LNFe"   , xlimnfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term 
    221         IF( iom_use( "LDFe"    ) )   CALL iom_put( "LDFe"   , xlimdfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term 
     208        CALL iom_put( "xfracal", xfracal(:,:,:) * tmask(:,:,:) )  ! euphotic layer deptht 
     209        CALL iom_put( "LNnut"  , xlimphy(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term 
     210        CALL iom_put( "LDnut"  , xlimdia(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term 
     211        CALL iom_put( "LNFe"   , xlimnfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term 
     212        CALL iom_put( "LDFe"   , xlimdfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term 
    222213      ENDIF 
    223214      ! 
    … …  
    252243      ENDIF 
    253244      ! 
    254       REWIND( numnatp_ref )              ! Namelist nampislim in reference namelist : Pisces nutrient limitation parameters 
    255245      READ  ( numnatp_ref, namp4zlim, IOSTAT = ios, ERR = 901) 
    256 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zlim in reference namelist', lwp ) 
    257       REWIND( numnatp_cfg )              ! Namelist nampislim in configuration namelist : Pisces nutrient limitation parameters  
     246901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zlim in reference namelist' ) 
    258247      READ  ( numnatp_cfg, namp4zlim, IOSTAT = ios, ERR = 902 ) 
    259 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zlim in configuration namelist', lwp ) 
     248902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zlim in configuration namelist' ) 
    260249      IF(lwm) WRITE( numonp, namp4zlim ) 
    261250      ! 
    … …  
    284273      ENDIF 
    285274      ! 
    286       nitrfac (:,:,:) = 0._wp 
     275      nitrfac (:,:,jpk) = 0._wp 
     276      nitrfac2(:,:,jpk) = 0._wp 
     277      xfracal (:,:,jpk) = 0._wp 
     278      xlimphy (:,:,jpk) = 0._wp 
     279      xlimdia (:,:,jpk) = 0._wp 
     280      xlimnfe (:,:,jpk) = 0._wp 
     281      xlimdfe (:,:,jpk) = 0._wp 
    287282      ! 
    288283   END SUBROUTINE p4z_lim_init 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p4zlys.F90

    r10069 r13463  
    2020   USE sms_pisces      !  PISCES Source Minus Sink variables 
    2121   USE p4zche          !  Chemical model 
    22    USE prtctl_trc      !  print control for debugging 
     22   USE prtctl          !  print control for debugging 
    2323   USE iom             !  I/O manager 
    2424 
    … …  
    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 
    … …  
    6467      IF( ln_timing )  CALL timing_start('p4z_lys') 
    6568      ! 
    66       zco3    (:,:,:) = 0. 
    67       zcaldiss(:,:,:) = 0. 
    6869      zhinit  (:,:,:) = hi(:,:,:) * 1000. / ( rhop(:,:,:) + rtrn ) 
    6970      ! 
    … …  
    7273      !     ------------------------------------------- 
    7374 
    74       CALL solve_at_general( zhinit, zhi ) 
     75      CALL solve_at_general( zhinit, zhi, Kbb ) 
    7576 
    76       DO jk = 1, jpkm1 
    77          DO jj = 1, jpj 
    78             DO ji = 1, jpi 
    79                zco3(ji,jj,jk) = trb(ji,jj,jk,jpdic) * ak13(ji,jj,jk) * ak23(ji,jj,jk) / (zhi(ji,jj,jk)**2   & 
    80                   &             + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn ) 
    81                hi  (ji,jj,jk) = zhi(ji,jj,jk) * rhop(ji,jj,jk) / 1000. 
    82             END DO 
    83          END DO 
    84       END DO 
     77      DO_3D( 1, 1, 1, 1, 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 
    8582 
    8683      !     --------------------------------------------------------- 
    … …  
    9087      !     --------------------------------------------------------- 
    9188 
    92       DO jk = 1, jpkm1 
    93          DO jj = 1, jpj 
    94             DO ji = 1, jpi 
     89      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    9590 
    96                ! DEVIATION OF [CO3--] FROM SATURATION VALUE 
    97                ! Salinity dependance in zomegaca and divide by rhop/1000 to have good units 
    98                zcalcon  = calcon * ( salinprac(ji,jj,jk) / 35._wp ) 
    99                zfact    = rhop(ji,jj,jk) / 1000._wp 
    100                zomegaca = ( zcalcon * zco3(ji,jj,jk) ) / ( aksp(ji,jj,jk) * zfact + rtrn ) 
    101                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 ) 
    10297 
    103                ! SET DEGREE OF UNDER-/SUPERSATURATION 
    104                excess(ji,jj,jk) = 1._wp - zomegaca 
    105                zexcess0 = MAX( 0., excess(ji,jj,jk) ) 
    106                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 
    107102 
    108                ! AMOUNT CACO3 (12C) THAT RE-ENTERS SOLUTION 
    109                !       (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE 
    110                !       CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION) 
    111                zdispot = kdca * zexcess * trb(ji,jj,jk,jpcal) 
    112               !  CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3], 
    113               !       AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION 
    114               zcaldiss(ji,jj,jk)  = zdispot * rfact2 / rmtss ! calcite dissolution 
    115               ! 
    116               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zcaldiss(ji,jj,jk) 
    117               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) -      zcaldiss(ji,jj,jk) 
    118               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +      zcaldiss(ji,jj,jk) 
    119             END DO 
    120          END DO 
    121       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 
    122115      ! 
    123116 
    124117      IF( lk_iomput .AND. knt == nrdttrc ) THEN 
    125          IF( iom_use( "PH"     ) ) CALL iom_put( "PH"    , -1. * LOG10( MAX( hi(:,:,:), rtrn ) ) * tmask(:,:,:) ) 
    126          IF( iom_use( "CO3"    ) ) CALL iom_put( "CO3"   , zco3(:,:,:)     * 1.e+3               * tmask(:,:,:) ) 
    127          IF( iom_use( "CO3sat" ) ) CALL iom_put( "CO3sat", zco3sat(:,:,:)  * 1.e+3               * tmask(:,:,:) ) 
    128          IF( iom_use( "DCAL"   ) ) CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * 1.e+3 * rfact2r     * tmask(:,:,:) ) 
     118         CALL iom_put( "PH" , -1. * LOG10( MAX( hi(:,:,:), rtrn ) ) * tmask(:,:,:) ) 
     119         IF( iom_use( "CO3" ) ) THEN 
     120            zco3(:,:,jpk) = 0.    ; CALL iom_put( "CO3"   , zco3(:,:,:)     * 1.e+3           * tmask(:,:,:) ) 
     121         ENDIF 
     122         IF( iom_use( "CO3sat" ) ) THEN 
     123           zco3sat(:,:,jpk) = 0.  ; CALL iom_put( "CO3sat", zco3sat(:,:,:)  * 1.e+3           * tmask(:,:,:) ) 
     124         ENDIF 
     125         IF( iom_use( "DCAL" ) ) THEN 
     126           zcaldiss(:,:,jpk) = 0. ; CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) 
     127         ENDIF               
    129128      ENDIF 
    130129      ! 
    131       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     130      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    132131        WRITE(charout, FMT="('lys ')") 
    133         CALL prt_ctl_trc_info(charout) 
    134         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     132        CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     133        CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    135134      ENDIF 
    136135      ! 
    … …  
    162161      ENDIF 
    163162      ! 
    164       REWIND( numnatp_ref )              ! Namelist nampiscal in reference namelist : Pisces CaCO3 dissolution 
    165163      READ  ( numnatp_ref, nampiscal, IOSTAT = ios, ERR = 901) 
    166 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampiscal in reference namelist', lwp ) 
    167       REWIND( numnatp_cfg )              ! Namelist nampiscal in configuration namelist : Pisces CaCO3 dissolution 
     164901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampiscal in reference namelist' ) 
    168165      READ  ( numnatp_cfg, nampiscal, IOSTAT = ios, ERR = 902 ) 
    169 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampiscal in configuration namelist', lwp ) 
     166902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampiscal in configuration namelist' ) 
    170167      IF(lwm) WRITE( numonp, nampiscal ) 
    171168      ! 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p4zmeso.F90

    r10367 r13463  
    1515   USE sms_pisces      ! PISCES Source Minus Sink variables 
    1616   USE p4zprod         ! production 
    17    USE prtctl_trc      ! print control for debugging 
     17   USE prtctl          ! print control for debugging 
    1818   USE iom             ! I/O manager 
    1919 
    … …  
    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 
    … …  
    6669      REAL(wp) :: zfact   , zfood, zfoodlim, zproport, zbeta 
    6770      REAL(wp) :: zmortzgoc, zfrac, zfracfe, zratio, zratio2, zfracal, zgrazcal 
    68       REAL(wp) :: zepsherf, zepshert, zepsherv, zgrarsig, zgraztotc, zgraztotn, zgraztotf 
     71      REAL(wp) :: zepsherf, zepshert, zepsherv, zepsherq  
     72      REAL(wp) :: zgrarsig, zgraztotc, zgraztotn, zgraztotf 
    6973      REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz, zgrasrat, zgrasratn 
    7074      REAL(wp) :: zrespz, ztortz, zgrazd, zgrazz, zgrazpof 
    7175      REAL(wp) :: zgrazn, zgrazpoc, zgraznf, zgrazf 
    7276      REAL(wp) :: zgrazfffp, zgrazfffg, zgrazffep, zgrazffeg 
     77      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing2, zfezoo2, zz2ligprod 
    7378      CHARACTER (len=25) :: charout 
    74       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo2 
    75       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zw3d, zz2ligprod 
    7679      !!--------------------------------------------------------------------- 
    7780      ! 
    7881      IF( ln_timing )   CALL timing_start('p4z_meso') 
    7982      ! 
    80       zgrazing(:,:,:) = 0._wp 
    81       zfezoo2 (:,:,:) = 0._wp 
    82       ! 
    83       IF (ln_ligand) THEN 
    84          ALLOCATE( zz2ligprod(jpi,jpj,jpk) ) 
    85          zz2ligprod(:,:,:) = 0._wp 
     83      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     84         zcompam   = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - 1.e-9 ), 0.e0 ) 
     85         zfact     = xstep * tgfunc2(ji,jj,jk) * zcompam 
     86 
     87         !  Respiration rates of both zooplankton 
     88         !  ------------------------------------- 
     89         zrespz    = resrat2 * zfact * ( tr(ji,jj,jk,jpmes,Kbb) / ( xkmort + tr(ji,jj,jk,jpmes,Kbb) )  & 
     90         &           + 3. * nitrfac(ji,jj,jk) ) 
     91 
     92         !  Zooplankton mortality. A square function has been selected with 
     93         !  no real reason except that it seems to be more stable and may mimic predation 
     94         !  --------------------------------------------------------------- 
     95         ztortz    = mzrat2 * 1.e6 * zfact * tr(ji,jj,jk,jpmes,Kbb)  * (1. - nitrfac(ji,jj,jk) ) 
     96         ! 
     97         zcompadi  = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthresh2dia ), 0.e0 ) 
     98         zcompaz   = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - xthresh2zoo ), 0.e0 ) 
     99         zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthresh2poc ), 0.e0 ) 
     100         ! Size effect of nanophytoplankton on grazing : the smaller it is, the less prone 
     101         ! it is to predation by mesozooplankton 
     102         ! ------------------------------------------------------------------------------- 
     103         zcompaph  = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthresh2phy ), 0.e0 ) & 
     104            &      * MIN(1., MAX( 0., ( quotan(ji,jj,jk) - 0.2) / 0.3 ) ) 
     105 
     106         !   Mesozooplankton grazing 
     107         !   ------------------------ 
     108         zfood     = xpref2d * zcompadi + xpref2z * zcompaz + xpref2n * zcompaph + xpref2c * zcompapoc  
     109         zfoodlim  = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) ) 
     110         zdenom    = zfoodlim / ( xkgraz2 + zfoodlim ) 
     111         zdenom2   = zdenom / ( zfood + rtrn ) 
     112         zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpmes,Kbb) * (1. - nitrfac(ji,jj,jk))  
     113 
     114         zgrazd    = zgraze2  * xpref2d  * zcompadi  * zdenom2  
     115         zgrazz    = zgraze2  * xpref2z  * zcompaz   * zdenom2  
     116         zgrazn    = zgraze2  * xpref2n  * zcompaph  * zdenom2  
     117         zgrazpoc  = zgraze2  * xpref2c  * zcompapoc * zdenom2  
     118 
     119         zgraznf   = zgrazn   * tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
     120         zgrazf    = zgrazd   * tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
     121         zgrazpof  = zgrazpoc * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
     122 
     123         !  Mesozooplankton flux feeding on GOC 
     124         !  ---------------------------------- 
     125         zgrazffeg = grazflux  * xstep * wsbio4(ji,jj,jk)      & 
     126         &           * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 
     127         &           * (1. - nitrfac(ji,jj,jk)) 
     128         zgrazfffg = zgrazffeg * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 
     129         zgrazffep = grazflux  * xstep *  wsbio3(ji,jj,jk)     & 
     130         &           * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 
     131         &           * (1. - nitrfac(ji,jj,jk)) 
     132         zgrazfffp = zgrazffep * tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
     133         ! 
     134         zgraztotc = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg 
     135         ! Compute the proportion of filter feeders 
     136         zproport  = (zgrazffep + zgrazffeg)/(rtrn + zgraztotc) 
     137         ! Compute fractionation of aggregates. It is assumed that  
     138         ! diatoms based aggregates are more prone to fractionation 
     139         ! since they are more porous (marine snow instead of fecal pellets) 
     140         zratio    = tr(ji,jj,jk,jpgsi,Kbb) / ( tr(ji,jj,jk,jpgoc,Kbb) + rtrn ) 
     141         zratio2   = zratio * zratio 
     142         zfrac     = zproport * grazflux  * xstep * wsbio4(ji,jj,jk)      & 
     143         &          * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb)          & 
     144         &          * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) ) 
     145         zfracfe   = zfrac * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 
     146 
     147         zgrazffep = zproport * zgrazffep 
     148         zgrazffeg = zproport * zgrazffeg 
     149         zgrazfffp = zproport * zgrazfffp 
     150         zgrazfffg = zproport * zgrazfffg 
     151         zgraztotc = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg 
     152         zgraztotn = zgrazd * quotad(ji,jj,jk) + zgrazz + zgrazn * quotan(ji,jj,jk)   & 
     153         &   + zgrazpoc + zgrazffep + zgrazffeg 
     154         zgraztotf = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfffp + zgrazfffg 
     155 
     156         ! Total grazing ( grazing by microzoo is already computed in p4zmicro ) 
     157         zgrazing2(ji,jj,jk) = zgraztotc 
     158 
     159         ! Mesozooplankton efficiency.  
     160         ! We adopt a formulation proposed by Mitra et al. (2007) 
     161         ! The gross growth efficiency is controled by the most limiting nutrient. 
     162         ! Growth is also further decreased when the food quality is poor. This is currently 
     163         ! hard coded : it can be decreased by up to 50% (zepsherq) 
     164         ! GGE can also be decreased when food quantity is high, zepsherf (Montagnes and  
     165         ! Fulton, 2012) 
     166         ! ----------------------------------------------------------------------------------- 
     167         zgrasrat  =  ( zgraztotf + rtrn )/ ( zgraztotc + rtrn ) 
     168         zgrasratn =  ( zgraztotn + rtrn )/ ( zgraztotc + rtrn ) 
     169         zepshert  = MIN( 1., zgrasratn, zgrasrat / ferat3) 
     170         zbeta     = MAX(0., (epsher2 - epsher2min) ) 
     171         zepsherf  = epsher2min + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta )  
     172         zepsherq  = 0.5 + (1.0 - 0.5) * zepshert * ( 1.0 + 1.0 ) / ( zepshert + 1.0 ) 
     173         zepsherv  = zepsherf * zepshert * zepsherq  
     174 
     175         zgrarem2  = zgraztotc * ( 1. - zepsherv - unass2 ) & 
     176         &         + ( 1. - epsher2 - unass2 ) / ( 1. - epsher2 ) * ztortz 
     177         zgrafer2  = zgraztotc * MAX( 0. , ( 1. - unass2 ) * zgrasrat - ferat3 * zepsherv )    & 
     178         &         + ferat3 * ( ( 1. - epsher2 - unass2 ) /( 1. - epsher2 ) * ztortz ) 
     179         zgrapoc2  = zgraztotc * unass2 
     180 
     181 
     182         !   Update the arrays TRA which contain the biological sources and sinks 
     183         zgrarsig  = zgrarem2 * sigma2 
     184         tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarsig 
     185         tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgrarsig 
     186         tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgrarem2 - zgrarsig 
     187         ! 
     188         IF( ln_ligand ) THEN  
     189            tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + (zgrarem2 - zgrarsig) * ldocz 
     190            zz2ligprod(ji,jj,jk) = (zgrarem2 - zgrarsig) * ldocz 
     191         ENDIF 
     192         ! 
     193         tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarsig 
     194         tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgrafer2 
     195         zfezoo2(ji,jj,jk)   = zgrafer2 
     196         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarsig 
     197         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zgrarsig               
     198 
     199         zmortz = ztortz + zrespz 
     200         zmortzgoc = unass2 / ( 1. - epsher2 ) * ztortz + zrespz 
     201         tr(ji,jj,jk,jpmes,Krhs) = tr(ji,jj,jk,jpmes,Krhs) - zmortz + zepsherv * zgraztotc  
     202         tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazd 
     203         tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) - zgrazz 
     204         tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgrazn 
     205         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 ) 
     206         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 ) 
     207         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 ) 
     208         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 ) 
     209         tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgraznf 
     210         tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazf 
     211 
     212         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zgrazpoc - zgrazffep + zfrac 
     213         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfrac 
     214         conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep 
     215         tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zmortzgoc - zgrazffeg + zgrapoc2 - zfrac 
     216         prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zmortzgoc + zgrapoc2 
     217         consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfrac 
     218         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zgrazpof - zgrazfffp + zfracfe 
     219         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + ferat3 * zmortzgoc - zgrazfffg     & 
     220           &                + zgraztotf * unass2 - zfracfe 
     221         zfracal = tr(ji,jj,jk,jpcal,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + tr(ji,jj,jk,jpgoc,Kbb) + rtrn ) 
     222         zgrazcal = (zgrazffeg + zgrazpoc) * (1. - part2) * zfracal 
     223         ! calcite production 
     224         zprcaca = xfracal(ji,jj,jk) * zgrazn 
     225         prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
     226         ! 
     227         zprcaca = part2 * zprcaca 
     228         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrazcal - zprcaca 
     229         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * ( zgrazcal + zprcaca ) 
     230         tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) - zgrazcal + zprcaca 
     231      END_3D 
     232      ! 
     233      IF( lk_iomput .AND. knt == nrdttrc ) THEN 
     234        CALL iom_put( "PCAL"  , prodcal(:,:,:) * 1.e+3  * rfact2r * tmask(:,:,:) )  !  Calcite production  
     235        IF( iom_use("GRAZ2") ) THEN  !   Total grazing of phyto by zooplankton 
     236           zgrazing2(:,:,jpk) = 0._wp ;  CALL iom_put( "GRAZ2" , zgrazing2(:,:,:) * 1.e+3  * rfact2r * tmask(:,:,:) )  
     237         ENDIF 
     238         IF( iom_use("FEZOO2") ) THEN   
     239           zfezoo2 (:,:,jpk) = 0._wp ; CALL iom_put( "FEZOO2", zfezoo2(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) ) 
     240         ENDIF 
     241         IF( ln_ligand ) THEN 
     242            zz2ligprod(:,:,jpk) = 0._wp ; CALL iom_put( "LPRODZ2", zz2ligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:)  ) 
     243         ENDIF 
    86244      ENDIF 
    87245      ! 
    88       DO jk = 1, jpkm1 
    89          DO jj = 1, jpj 
    90             DO ji = 1, jpi 
    91                zcompam   = MAX( ( trb(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 ) 
    92                zfact     = xstep * tgfunc2(ji,jj,jk) * zcompam 
    93  
    94                !  Respiration rates of both zooplankton 
    95                !  ------------------------------------- 
    96                zrespz    = resrat2 * zfact * ( trb(ji,jj,jk,jpmes) / ( xkmort + trb(ji,jj,jk,jpmes) )  & 
    97                &           + 3. * nitrfac(ji,jj,jk) ) 
    98  
    99                !  Zooplankton mortality. A square function has been selected with 
    100                !  no real reason except that it seems to be more stable and may mimic predation 
    101                !  --------------------------------------------------------------- 
    102                ztortz    = mzrat2 * 1.e6 * zfact * trb(ji,jj,jk,jpmes)  * (1. - nitrfac(ji,jj,jk) ) 
    103                ! 
    104                zcompadi  = MAX( ( trb(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 ) 
    105                zcompaz   = MAX( ( trb(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 ) 
    106                zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 ) 
    107                ! Size effect of nanophytoplankton on grazing : the smaller it is, the less prone 
    108                ! it is to predation by mesozooplankton 
    109                ! ------------------------------------------------------------------------------- 
    110                zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) & 
    111                   &      * MIN(1., MAX( 0., ( quotan(ji,jj,jk) - 0.2) / 0.3 ) ) 
    112  
    113                !   Mesozooplankton grazing 
    114                !   ------------------------ 
    115                zfood     = xpref2d * zcompadi + xpref2z * zcompaz + xpref2n * zcompaph + xpref2c * zcompapoc  
    116                zfoodlim  = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) ) 
    117                zdenom    = zfoodlim / ( xkgraz2 + zfoodlim ) 
    118                zdenom2   = zdenom / ( zfood + rtrn ) 
    119                zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes) * (1. - nitrfac(ji,jj,jk))  
    120  
    121                zgrazd    = zgraze2  * xpref2d  * zcompadi  * zdenom2  
    122                zgrazz    = zgraze2  * xpref2z  * zcompaz   * zdenom2  
    123                zgrazn    = zgraze2  * xpref2n  * zcompaph  * zdenom2  
    124                zgrazpoc  = zgraze2  * xpref2c  * zcompapoc * zdenom2  
    125  
    126                zgraznf   = zgrazn   * trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn) 
    127                zgrazf    = zgrazd   * trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn) 
    128                zgrazpof  = zgrazpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn) 
    129  
    130                !  Mesozooplankton flux feeding on GOC 
    131                !  ---------------------------------- 
    132                zgrazffeg = grazflux  * xstep * wsbio4(ji,jj,jk)      & 
    133                &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes) & 
    134                &           * (1. - nitrfac(ji,jj,jk)) 
    135                zgrazfffg = zgrazffeg * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn) 
    136                zgrazffep = grazflux  * xstep *  wsbio3(ji,jj,jk)     & 
    137                &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpmes) & 
    138                &           * (1. - nitrfac(ji,jj,jk)) 
    139                zgrazfffp = zgrazffep * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn) 
    140                ! 
    141                zgraztotc = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg 
    142                ! Compute the proportion of filter feeders 
    143                zproport  = (zgrazffep + zgrazffeg)/(rtrn + zgraztotc) 
    144                ! Compute fractionation of aggregates. It is assumed that  
    145                ! diatoms based aggregates are more prone to fractionation 
    146                ! since they are more porous (marine snow instead of fecal pellets) 
    147                zratio    = trb(ji,jj,jk,jpgsi) / ( trb(ji,jj,jk,jpgoc) + rtrn ) 
    148                zratio2   = zratio * zratio 
    149                zfrac     = zproport * grazflux  * xstep * wsbio4(ji,jj,jk)      & 
    150                &          * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)          & 
    151                &          * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) ) 
    152                zfracfe   = zfrac * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn) 
    153  
    154                zgrazffep = zproport * zgrazffep 
    155                zgrazffeg = zproport * zgrazffeg 
    156                zgrazfffp = zproport * zgrazfffp 
    157                zgrazfffg = zproport * zgrazfffg 
    158                zgraztotc = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg 
    159                zgraztotn = zgrazd * quotad(ji,jj,jk) + zgrazz + zgrazn * quotan(ji,jj,jk)   & 
    160                &   + zgrazpoc + zgrazffep + zgrazffeg 
    161                zgraztotf = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfffp + zgrazfffg 
    162  
    163                ! Total grazing ( grazing by microzoo is already computed in p4zmicro ) 
    164                zgrazing(ji,jj,jk) = zgraztotc 
    165  
    166                !    Mesozooplankton efficiency 
    167                !    -------------------------- 
    168                zgrasrat  =  ( zgraztotf + rtrn )/ ( zgraztotc + rtrn ) 
    169                zgrasratn =  ( zgraztotn + rtrn )/ ( zgraztotc + rtrn ) 
    170                zepshert  = MIN( 1., zgrasratn, zgrasrat / ferat3) 
    171                zbeta     = MAX(0., (epsher2 - epsher2min) ) 
    172                zepsherf  = epsher2min + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta )  
    173                zepsherv  = zepsherf * zepshert  
    174  
    175                zgrarem2  = zgraztotc * ( 1. - zepsherv - unass2 ) & 
    176                &         + ( 1. - epsher2 - unass2 ) / ( 1. - epsher2 ) * ztortz 
    177                zgrafer2  = zgraztotc * MAX( 0. , ( 1. - unass2 ) * zgrasrat - ferat3 * zepsherv )    & 
    178                &         + ferat3 * ( ( 1. - epsher2 - unass2 ) /( 1. - epsher2 ) * ztortz ) 
    179                zgrapoc2  = zgraztotc * unass2 
    180  
    181                !   Update the arrays TRA which contain the biological sources and sinks 
    182                zgrarsig  = zgrarem2 * sigma2 
    183                tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig 
    184                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 
    185                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 - zgrarsig 
    186                ! 
    187                IF( ln_ligand ) THEN  
    188                   tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + (zgrarem2 - zgrarsig) * ldocz 
    189                   zz2ligprod(ji,jj,jk) = (zgrarem2 - zgrarsig) * ldocz 
    190                ENDIF 
    191                ! 
    192                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 
    193                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2 
    194                zfezoo2(ji,jj,jk)   = zgrafer2 
    195                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig 
    196                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig               
    197  
    198                zmortz = ztortz + zrespz 
    199                zmortzgoc = unass2 / ( 1. - epsher2 ) * ztortz + zrespz 
    200                tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz + zepsherv * zgraztotc  
    201                tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazd 
    202                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz 
    203                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazn 
    204                tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn * trb(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpphy) + rtrn ) 
    205                tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd * trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    206                tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    207                tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    208                tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf 
    209                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf 
    210  
    211                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc - zgrazffep + zfrac 
    212                prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfrac 
    213                conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep 
    214                tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortzgoc - zgrazffeg + zgrapoc2 - zfrac 
    215                prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zmortzgoc + zgrapoc2 
    216                consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfrac 
    217                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof - zgrazfffp + zfracfe 
    218                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortzgoc - zgrazfffg     & 
    219                  &                + zgraztotf * unass2 - zfracfe 
    220                zfracal = trb(ji,jj,jk,jpcal) / (trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + rtrn ) 
    221                zgrazcal = (zgrazffeg + zgrazpoc) * (1. - part2) * zfracal 
    222                ! calcite production 
    223                zprcaca = xfracal(ji,jj,jk) * zgrazn 
    224                prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    225                ! 
    226                zprcaca = part2 * zprcaca 
    227                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrazcal - zprcaca 
    228                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * ( zgrazcal + zprcaca ) 
    229                tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) - zgrazcal + zprcaca 
    230             END DO 
    231          END DO 
    232       END DO 
    233       ! 
    234       IF( lk_iomput .AND. knt == nrdttrc ) THEN 
    235          ALLOCATE( zw3d(jpi,jpj,jpk) ) 
    236          IF( iom_use( "GRAZ2" ) ) THEN 
    237             zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)  !   Total grazing of phyto by zooplankton 
    238             CALL iom_put( "GRAZ2", zw3d ) 
    239          ENDIF 
    240          IF( iom_use( "PCAL" ) ) THEN 
    241             zw3d(:,:,:) = prodcal(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)   !  Calcite production 
    242             CALL iom_put( "PCAL", zw3d )   
    243          ENDIF 
    244          IF( iom_use( "FEZOO2" ) ) THEN 
    245             zw3d(:,:,:) = zfezoo2(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:)   ! 
    246             CALL iom_put( "FEZOO2", zw3d ) 
    247          ENDIF 
    248          IF( iom_use( "LPRODZ2" ) .AND. ln_ligand )  THEN 
    249             zw3d(:,:,:) = zz2ligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) 
    250             CALL iom_put( "LPRODZ2"  , zw3d ) 
    251          ENDIF 
    252          DEALLOCATE( zw3d ) 
    253       ENDIF 
    254       ! 
    255       IF (ln_ligand)  DEALLOCATE( zz2ligprod ) 
    256       ! 
    257       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     246      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    258247        WRITE(charout, FMT="('meso')") 
    259         CALL prt_ctl_trc_info(charout) 
    260         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     248        CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     249        CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    261250      ENDIF 
    262251      ! 
    … …  
    290279      ENDIF 
    291280      ! 
    292       REWIND( numnatp_ref )              ! Namelist nampismes in reference namelist : Pisces mesozooplankton 
    293281      READ  ( numnatp_ref, namp4zmes, IOSTAT = ios, ERR = 901) 
    294 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zmes in reference namelist', lwp ) 
    295       REWIND( numnatp_cfg )              ! Namelist nampismes in configuration namelist : Pisces mesozooplankton 
     282901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zmes in reference namelist' ) 
    296283      READ  ( numnatp_cfg, namp4zmes, IOSTAT = ios, ERR = 902 ) 
    297 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zmes in configuration namelist', lwp ) 
     284902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zmes in configuration namelist' ) 
    298285      IF(lwm) WRITE( numonp, namp4zmes ) 
    299286      ! 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p4zmicro.F90

    r10374 r13463  
    1717   USE p4zprod         ! production 
    1818   USE iom             ! I/O manager 
    19    USE prtctl_trc      ! print control for debugging 
     19   USE prtctl          ! print control for debugging 
    2020 
    2121   IMPLICIT NONE 
    … …  
    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 
    … …  
    6467      REAL(wp) :: zgraze  , zdenom, zdenom2 
    6568      REAL(wp) :: zfact   , zfood, zfoodlim, zbeta 
    66       REAL(wp) :: zepsherf, zepshert, zepsherv, zgrarsig, zgraztotc, zgraztotn, zgraztotf 
     69      REAL(wp) :: zepsherf, zepshert, zepsherv, zepsherq 
     70      REAL(wp) :: zgrarsig, zgraztotc, zgraztotn, zgraztotf 
    6771      REAL(wp) :: zgrarem, zgrafer, zgrapoc, zprcaca, zmortz 
    6872      REAL(wp) :: zrespz, ztortz, zgrasrat, zgrasratn 
    6973      REAL(wp) :: zgrazp, zgrazm, zgrazsd 
    7074      REAL(wp) :: zgrazmf, zgrazsf, zgrazpf 
    71       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo 
    72       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d, zzligprod 
     75      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo, zzligprod 
    7376      CHARACTER (len=25) :: charout 
    7477      !!--------------------------------------------------------------------- 
    … …  
    7679      IF( ln_timing )   CALL timing_start('p4z_micro') 
    7780      ! 
    78       IF (ln_ligand) THEN 
    79          ALLOCATE( zzligprod(jpi,jpj,jpk) ) 
    80          zzligprod(:,:,:) = 0._wp 
    81       ENDIF 
    82       ! 
    83       DO jk = 1, jpkm1 
    84          DO jj = 1, jpj 
    85             DO ji = 1, jpi 
    86                zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 ) 
    87                zfact   = xstep * tgfunc2(ji,jj,jk) * zcompaz 
    88  
    89                !  Respiration rates of both zooplankton 
    90                !  ------------------------------------- 
    91                zrespz = resrat * zfact * trb(ji,jj,jk,jpzoo) / ( xkmort + trb(ji,jj,jk,jpzoo) )  & 
    92                   &   + resrat * zfact * 3. * nitrfac(ji,jj,jk) 
    93  
    94                !  Zooplankton mortality. A square function has been selected with 
    95                !  no real reason except that it seems to be more stable and may mimic predation. 
    96                !  --------------------------------------------------------------- 
    97                ztortz = mzrat * 1.e6 * zfact * trb(ji,jj,jk,jpzoo) * (1. - nitrfac(ji,jj,jk)) 
    98  
    99                zcompadi  = MIN( MAX( ( trb(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia ) 
    100                zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 ) 
    101                zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 ) 
    102                 
    103                !     Microzooplankton grazing 
    104                !     ------------------------ 
    105                zfood     = xprefn * zcompaph + xprefc * zcompapoc + xprefd * zcompadi 
    106                zfoodlim  = MAX( 0. , zfood - min(xthresh,0.5*zfood) ) 
    107                zdenom    = zfoodlim / ( xkgraz + zfoodlim ) 
    108                zdenom2   = zdenom / ( zfood + rtrn ) 
    109                zgraze    = grazrat * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpzoo) * (1. - nitrfac(ji,jj,jk)) 
    110  
    111                zgrazp    = zgraze  * xprefn * zcompaph  * zdenom2  
    112                zgrazm    = zgraze  * xprefc * zcompapoc * zdenom2  
    113                zgrazsd   = zgraze  * xprefd * zcompadi  * zdenom2  
    114  
    115                zgrazpf   = zgrazp  * trb(ji,jj,jk,jpnfe) / (trb(ji,jj,jk,jpphy) + rtrn) 
    116                zgrazmf   = zgrazm  * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn) 
    117                zgrazsf   = zgrazsd * trb(ji,jj,jk,jpdfe) / (trb(ji,jj,jk,jpdia) + rtrn) 
    118                ! 
    119                zgraztotc = zgrazp  + zgrazm  + zgrazsd  
    120                zgraztotf = zgrazpf + zgrazsf + zgrazmf  
    121                zgraztotn = zgrazp * quotan(ji,jj,jk) + zgrazm + zgrazsd * quotad(ji,jj,jk) 
    122  
    123                ! Grazing by microzooplankton 
    124                zgrazing(ji,jj,jk) = zgraztotc 
    125  
    126                !    Various remineralization and excretion terms 
    127                !    -------------------------------------------- 
    128                zgrasrat  = ( zgraztotf + rtrn ) / ( zgraztotc + rtrn ) 
    129                zgrasratn = ( zgraztotn + rtrn ) / ( zgraztotc + rtrn ) 
    130                zepshert  =  MIN( 1., zgrasratn, zgrasrat / ferat3) 
    131                zbeta     = MAX(0., (epsher - epshermin) ) 
    132                zepsherf  = epshermin + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 
    133                zepsherv  = zepsherf * zepshert  
    134  
    135                zgrafer   = zgraztotc * MAX( 0. , ( 1. - unass ) * zgrasrat - ferat3 * zepsherv )  
    136                zgrarem   = zgraztotc * ( 1. - zepsherv - unass ) 
    137                zgrapoc   = zgraztotc * unass 
    138  
    139                !  Update of the TRA arrays 
    140                !  ------------------------ 
    141                zgrarsig  = zgrarem * sigma1 
    142                tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig 
    143                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 
    144                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem - zgrarsig 
    145                ! 
    146                IF( ln_ligand ) THEN 
    147                   tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + (zgrarem - zgrarsig) * ldocz 
    148                   zzligprod(ji,jj,jk) = (zgrarem - zgrarsig) * ldocz 
    149                ENDIF 
    150                ! 
    151                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 
    152                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer 
    153                zfezoo(ji,jj,jk)    = zgrafer 
    154                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc 
    155                prodpoc(ji,jj,jk)   = prodpoc(ji,jj,jk) + zgrapoc 
    156                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zgraztotf * unass 
    157                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig 
    158                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig 
    159                !   Update the arrays TRA which contain the biological sources and sinks 
    160                !   -------------------------------------------------------------------- 
    161                zmortz = ztortz + zrespz 
    162                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz + zepsherv * zgraztotc  
    163                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp 
    164                tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd 
    165                tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp  * trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn) 
    166                tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd * trb(ji,jj,jk,jpdch)/(trb(ji,jj,jk,jpdia)+rtrn) 
    167                tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazsd * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn) 
    168                tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazsd * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn) 
    169                tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgrazpf 
    170                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf 
    171                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm 
    172                prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortz 
    173                conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazm 
    174                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz - zgrazmf 
    175                ! 
    176                ! calcite production 
    177                zprcaca = xfracal(ji,jj,jk) * zgrazp 
    178                prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    179                ! 
    180                zprcaca = part * zprcaca 
    181                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 
    182                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 
    183                tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 
    184             END DO 
    185          END DO 
    186       END DO 
    187       ! 
    188       IF( lk_iomput ) THEN 
    189          IF( knt == nrdttrc ) THEN 
    190            ALLOCATE( zw3d(jpi,jpj,jpk) ) 
    191            IF( iom_use( "GRAZ1" ) ) THEN 
    192               zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)  !  Total grazing of phyto by zooplankton 
    193               CALL iom_put( "GRAZ1", zw3d ) 
    194            ENDIF 
    195            IF( iom_use( "FEZOO" ) ) THEN 
    196               zw3d(:,:,:) = zfezoo(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:)   ! 
    197               CALL iom_put( "FEZOO", zw3d ) 
    198            ENDIF 
    199            IF( iom_use( "LPRODZ" ) .AND. ln_ligand )  THEN 
    200               zw3d(:,:,:) = zzligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) 
    201               CALL iom_put( "LPRODZ"  , zw3d ) 
    202            ENDIF 
    203            DEALLOCATE( zw3d ) 
    204          ENDIF 
    205       ENDIF 
    206       ! 
    207       IF (ln_ligand)  DEALLOCATE( zzligprod ) 
    208       ! 
    209       IF(ln_ctl) THEN      ! print mean trends (used for debugging) 
     81      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     82         zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - 1.e-9 ), 0.e0 ) 
     83         zfact   = xstep * tgfunc2(ji,jj,jk) * zcompaz 
     84 
     85         !  Respiration rates of both zooplankton 
     86         !  ------------------------------------- 
     87         zrespz = resrat * zfact * tr(ji,jj,jk,jpzoo,Kbb) / ( xkmort + tr(ji,jj,jk,jpzoo,Kbb) )  & 
     88            &   + resrat * zfact * 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 = mzrat * 1.e6 * zfact * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk)) 
     94 
     95         zcompadi  = MIN( MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthreshdia ), 0.e0 ), xsizedia ) 
     96         zcompaph  = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthreshphy ), 0.e0 ) 
     97         zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthreshpoc ), 0.e0 ) 
     98          
     99         !     Microzooplankton grazing 
     100         !     ------------------------ 
     101         zfood     = xprefn * zcompaph + xprefc * zcompapoc + xprefd * zcompadi 
     102         zfoodlim  = MAX( 0. , zfood - min(xthresh,0.5*zfood) ) 
     103         zdenom    = zfoodlim / ( xkgraz + zfoodlim ) 
     104         zdenom2   = zdenom / ( zfood + rtrn ) 
     105         zgraze    = grazrat * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk)) 
     106 
     107         zgrazp    = zgraze  * xprefn * zcompaph  * zdenom2  
     108         zgrazm    = zgraze  * xprefc * zcompapoc * zdenom2  
     109         zgrazsd   = zgraze  * xprefd * zcompadi  * zdenom2  
     110 
     111         zgrazpf   = zgrazp  * tr(ji,jj,jk,jpnfe,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
     112         zgrazmf   = zgrazm  * tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
     113         zgrazsf   = zgrazsd * tr(ji,jj,jk,jpdfe,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
     114         ! 
     115         zgraztotc = zgrazp  + zgrazm  + zgrazsd  
     116         zgraztotf = zgrazpf + zgrazsf + zgrazmf  
     117         zgraztotn = zgrazp * quotan(ji,jj,jk) + zgrazm + zgrazsd * quotad(ji,jj,jk) 
     118 
     119         ! Grazing by microzooplankton 
     120         zgrazing(ji,jj,jk) = zgraztotc 
     121 
     122 
     123         ! Microzooplankton efficiency.  
     124         ! We adopt a formulation proposed by Mitra et al. (2007) 
     125         ! The gross growth efficiency is controled by the most limiting nutrient. 
     126         ! Growth is also further decreased when the food quality is poor. This is currently 
     127         ! hard coded : it can be decreased by up to 50% (zepsherq) 
     128         ! GGE can also be decreased when food quantity is high, zepsherf (Montagnes and  
     129         ! Fulton, 2012) 
     130         ! ----------------------------------------------------------------------------- 
     131         zgrasrat  = ( zgraztotf + rtrn ) / ( zgraztotc + rtrn ) 
     132         zgrasratn = ( zgraztotn + rtrn ) / ( zgraztotc + rtrn ) 
     133         zepshert  =  MIN( 1., zgrasratn, zgrasrat / ferat3) 
     134         zbeta     = MAX(0., (epsher - epshermin) ) 
     135         zepsherf  = epshermin + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 
     136         zepsherq  = 0.5 + (1.0 - 0.5) * zepshert * ( 1.0 + 1.0 ) / ( zepshert + 1.0 ) 
     137         zepsherv  = zepsherf * zepshert * zepsherq  
     138 
     139         zgrafer   = zgraztotc * MAX( 0. , ( 1. - unass ) * zgrasrat - ferat3 * zepsherv )  
     140         zgrarem   = zgraztotc * ( 1. - zepsherv - unass ) 
     141         zgrapoc   = zgraztotc * unass 
     142 
     143         !  Update of the TRA arrays 
     144         !  ------------------------ 
     145         zgrarsig  = zgrarem * sigma1 
     146         tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarsig 
     147         tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgrarsig 
     148         tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgrarem - zgrarsig 
     149         ! 
     150         IF( ln_ligand ) THEN 
     151            tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + (zgrarem - zgrarsig) * ldocz 
     152            zzligprod(ji,jj,jk) = (zgrarem - zgrarsig) * ldocz 
     153         ENDIF 
     154         ! 
     155         tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarsig 
     156         tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgrafer 
     157         zfezoo(ji,jj,jk)    = zgrafer 
     158         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zgrapoc 
     159         prodpoc(ji,jj,jk)   = prodpoc(ji,jj,jk) + zgrapoc 
     160         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zgraztotf * unass 
     161         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarsig 
     162         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zgrarsig 
     163         !   Update the arrays TRA which contain the biological sources and sinks 
     164         !   -------------------------------------------------------------------- 
     165         zmortz = ztortz + zrespz 
     166         tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) - zmortz + zepsherv * zgraztotc  
     167         tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgrazp 
     168         tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazsd 
     169         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) 
     170         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) 
     171         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) 
     172         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) 
     173         tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgrazpf 
     174         tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazsf 
     175         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortz - zgrazm 
     176         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortz 
     177         conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazm 
     178         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ferat3 * zmortz - zgrazmf 
     179         ! 
     180         ! calcite production 
     181         zprcaca = xfracal(ji,jj,jk) * zgrazp 
     182         prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
     183         ! 
     184         zprcaca = part * zprcaca 
     185         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprcaca 
     186         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca 
     187         tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca 
     188      END_3D 
     189      ! 
     190      IF( lk_iomput .AND. knt == nrdttrc ) THEN 
     191        IF( iom_use("GRAZ1") ) THEN  !   Total grazing of phyto by zooplankton 
     192           zgrazing(:,:,jpk) = 0._wp   ; CALL iom_put( "GRAZ1" , zgrazing(:,:,:) * 1.e+3  * rfact2r * tmask(:,:,:) )  
     193         ENDIF 
     194         IF( iom_use("FEZOO") ) THEN   
     195           zfezoo (:,:,jpk) = 0._wp    ; CALL iom_put( "FEZOO", zfezoo(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) ) 
     196         ENDIF 
     197         IF( ln_ligand ) THEN 
     198            zzligprod(:,:,jpk) = 0._wp ; CALL iom_put( "LPRODZ", zzligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:)) 
     199         ENDIF 
     200      ENDIF 
     201      ! 
     202      IF(sn_cfctl%l_prttrc) THEN      ! print mean trends (used for debugging) 
    210203         WRITE(charout, FMT="('micro')") 
    211          CALL prt_ctl_trc_info(charout) 
    212          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     204         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     205         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    213206      ENDIF 
    214207      ! 
    … …  
    243236      ENDIF 
    244237      ! 
    245       REWIND( numnatp_ref )              ! Namelist nampiszoo in reference namelist : Pisces microzooplankton 
    246238      READ  ( numnatp_ref, namp4zzoo, IOSTAT = ios, ERR = 901) 
    247 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zzoo in reference namelist', lwp ) 
    248       REWIND( numnatp_cfg )              ! Namelist nampiszoo in configuration namelist : Pisces microzooplankton 
     239901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zzoo in reference namelist' ) 
    249240      READ  ( numnatp_cfg, namp4zzoo, IOSTAT = ios, ERR = 902 ) 
    250 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zzoo in configuration namelist', lwp ) 
     241902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zzoo in configuration namelist' ) 
    251242      IF(lwm) WRITE( numonp, namp4zzoo ) 
    252243      ! 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p4zmort.F90

    r10227 r13463  
    1515   USE p4zprod         ! Primary productivity  
    1616   USE p4zlim          ! Phytoplankton limitation terms 
    17    USE prtctl_trc      ! print control for debugging 
     17   USE prtctl          ! print control for debugging 
    1818 
    1919   IMPLICIT NONE 
    … …  
    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( 1, 1, 1, 1, 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')") 
    122          CALL prt_ctl_trc_info(charout) 
    123          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     122         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     123         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=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( 1, 1, 1, 1, 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')") 
    197          CALL prt_ctl_trc_info(charout) 
    198          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     194         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     195         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=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) 
    231 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zmort in reference namelist', lwp ) 
    232       REWIND( numnatp_cfg )              ! Namelist nampismort in configuration namelist : Pisces phytoplankton 
     227901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zmort in reference namelist' ) 
    233228      READ  ( numnatp_cfg, namp4zmort, IOSTAT = ios, ERR = 902 ) 
    234 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zmort in configuration namelist', lwp ) 
     229902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zmort in configuration namelist' ) 
    235230      IF(lwm) WRITE( numonp, namp4zmort ) 
    236231      ! 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p4zopt.F90

    r10522 r13463  
    1616   USE iom            ! I/O manager 
    1717   USE fldread        !  time interpolation 
    18    USE prtctl_trc     !  print control for debugging 
     18   USE prtctl         !  print control for debugging 
    1919 
    2020   IMPLICIT NONE 
    … …  
    3737   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   par_varsw      ! PAR fraction of shortwave 
    3838   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ekb, ekg, ekr  ! wavelength (Red-Green-Blue) 
    39  
    40    INTEGER  ::   nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m) 
    41  
    42    REAL(wp), DIMENSION(3,61) ::   xkrgb   ! tabulated attenuation coefficients for RGB absorption 
    4339    
     40   !! * Substitutions 
     41#  include "do_loop_substitute.h90" 
     42#  include "domzgr_substitute.h90" 
    4443   !!---------------------------------------------------------------------- 
    4544   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4948CONTAINS 
    5049 
    51    SUBROUTINE p4z_opt( kt, knt ) 
     50   SUBROUTINE p4z_opt( kt, knt, Kbb, Kmm ) 
    5251      !!--------------------------------------------------------------------- 
    5352      !!                     ***  ROUTINE p4z_opt  *** 
    … …  
    5958      !!--------------------------------------------------------------------- 
    6059      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step 
     60      INTEGER, INTENT(in) ::   Kbb, Kmm  ! time level indices 
    6161      ! 
    6262      INTEGER  ::   ji, jj, jk 
    … …  
    7171      ! 
    7272      IF( ln_timing )   CALL timing_start('p4z_opt') 
    73       IF( ln_p5z    )   ALLOCATE( zetmp5(jpi,jpj) ) 
    7473 
    7574      IF( knt == 1 .AND. ln_varpar )   CALL p4z_opt_sbc( kt ) 
    … …  
    8382      !                                        !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 
    8483      !                                        !  -------------------------------------------------------- 
    85                      zchl3d(:,:,:) = trb(:,:,:,jpnch) + trb(:,:,:,jpdch) 
    86       IF( ln_p5z )   zchl3d(:,:,:) = zchl3d(:,:,:)    + trb(:,:,:,jppch) 
    87       ! 
    88       DO jk = 1, jpkm1    
    89          DO jj = 1, jpj 
    90             DO ji = 1, jpi 
    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_n(ji,jj,jk) 
    96                ekg(ji,jj,jk) = xkrgb(2,irgb) * e3t_n(ji,jj,jk) 
    97                ekr(ji,jj,jk) = xkrgb(3,irgb) * e3t_n(ji,jj,jk) 
    98             END DO 
    99          END DO 
    100       END DO 
     84                     zchl3d(:,:,:) = tr(:,:,:,jpnch,Kbb) + tr(:,:,:,jpdch,Kbb) 
     85      IF( ln_p5z )   zchl3d(:,:,:) = zchl3d(:,:,:)    + tr(:,:,:,jppch,Kbb) 
     86      ! 
     87      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     88         zchl = ( zchl3d(ji,jj,jk) + rtrn ) * 1.e6 
     89         zchl = MIN(  10. , MAX( 0.05, zchl )  ) 
     90         irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 
     91         !                                                          
     92         ekb(ji,jj,jk) = rkrgb(1,irgb) * e3t(ji,jj,jk,Kmm) 
     93         ekg(ji,jj,jk) = rkrgb(2,irgb) * e3t(ji,jj,jk,Kmm) 
     94         ekr(ji,jj,jk) = rkrgb(3,irgb) * e3t(ji,jj,jk,Kmm) 
     95      END_3D 
    10196      !                                        !* Photosynthetically Available Radiation (PAR) 
    10297      !                                        !  -------------------------------------- 
    … …  
    105100         zqsr_corr(:,:) = qsr_mean(:,:) / ( 1.-fr_i(:,:) + rtrn ) 
    106101         ! 
    107          CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 )  
    108          ! 
    109          DO jk = 1, nksrp       
     102         CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 )  
     103         ! 
     104         DO jk = 1, nksr       
    110105            etot_ndcy(:,:,jk) =        ze1(:,:,jk) +        ze2(:,:,jk) +       ze3(:,:,jk) 
    111106            enano    (:,:,jk) =  1.85 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.46 * ze3(:,:,jk) 
    … …  
    113108         END DO 
    114109         IF( ln_p5z ) THEN 
    115             DO jk = 1, nksrp       
     110            DO jk = 1, nksr       
    116111              epico  (:,:,jk) =  1.94 * ze1(:,:,jk) + 0.66 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 
    117112            END DO 
    … …  
    120115         zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn ) 
    121116         ! 
    122          CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 )  
    123          ! 
    124          DO jk = 1, nksrp       
     117         CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3 )  
     118         ! 
     119         DO jk = 1, nksr       
    125120            etot(:,:,jk) =  ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 
    126121         END DO 
    … …  
    130125         zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn ) 
    131126         ! 
    132          CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100  )  
    133          ! 
    134          DO jk = 1, nksrp       
     127         CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100  )  
     128         ! 
     129         DO jk = 1, nksr       
    135130            etot (:,:,jk) =        ze1(:,:,jk) +        ze2(:,:,jk) +       ze3(:,:,jk) 
    136131            enano(:,:,jk) =  1.85 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.46 * ze3(:,:,jk) 
    … …  
    138133         END DO 
    139134         IF( ln_p5z ) THEN 
    140             DO jk = 1, nksrp       
     135            DO jk = 1, nksr       
    141136              epico(:,:,jk) =  1.94 * ze1(:,:,jk) + 0.66 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 
    142137            END DO 
    … …  
    148143      IF( ln_qsr_bio ) THEN                    !* heat flux accros w-level (used in the dynamics) 
    149144         !                                     !  ------------------------ 
    150          CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3, pe0=ze0 ) 
     145         CALL p4z_opt_par( kt, Kmm, qsr, ze1, ze2, ze3, pe0=ze0 ) 
    151146         ! 
    152147         etot3(:,:,1) =  qsr(:,:) * tmask(:,:,1) 
    153          DO jk = 2, nksrp + 1 
     148         DO jk = 2, nksr + 1 
    154149            etot3(:,:,jk) =  ( ze0(:,:,jk) + ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) ) * tmask(:,:,jk) 
    155150         END DO 
    … …  
    158153      !                                        !* Euphotic depth and level 
    159154      neln   (:,:) = 1                            !  ------------------------ 
    160       heup   (:,:) = gdepw_n(:,:,2) 
    161       heup_01(:,:) = gdepw_n(:,:,2) 
    162  
    163       DO jk = 2, nksrp 
    164          DO jj = 1, jpj 
    165            DO ji = 1, jpi 
    166               IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >=  zqsr100(ji,jj) )  THEN 
    167                  neln(ji,jj) = jk+1                    ! Euphotic level : 1rst T-level strictly below Euphotic layer 
    168                  !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint 
    169                  heup(ji,jj) = gdepw_n(ji,jj,jk+1)     ! Euphotic layer depth 
    170               ENDIF 
    171               IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.50 )  THEN 
    172                  heup_01(ji,jj) = gdepw_n(ji,jj,jk+1)  ! Euphotic layer depth (light level definition) 
    173               ENDIF 
    174            END DO 
    175         END DO 
    176       END DO 
     155      heup   (:,:) = gdepw(:,:,2,Kmm) 
     156      heup_01(:,:) = gdepw(:,:,2,Kmm) 
     157 
     158      DO_3D( 1, 1, 1, 1, 2, nksr ) 
     159        IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >=  zqsr100(ji,jj) )  THEN 
     160           neln(ji,jj) = jk+1                    ! Euphotic level : 1rst T-level strictly below Euphotic layer 
     161           !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint 
     162           heup(ji,jj) = gdepw(ji,jj,jk+1,Kmm)     ! Euphotic layer depth 
     163        ENDIF 
     164        IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.50 )  THEN 
     165           heup_01(ji,jj) = gdepw(ji,jj,jk+1,Kmm)  ! Euphotic layer depth (light level definition) 
     166        ENDIF 
     167      END_3D 
    177168      ! 
    178169      heup   (:,:) = MIN( 300., heup   (:,:) ) 
    … …  
    183174      zetmp2 (:,:)   = 0.e0 
    184175 
    185       DO jk = 1, nksrp 
    186          DO jj = 1, jpj 
    187             DO ji = 1, jpi 
    188                IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    189                   zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * e3t_n(ji,jj,jk) ! remineralisation 
    190                   zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t_n(ji,jj,jk) ! production 
    191                   zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t_n(ji,jj,jk) 
    192                ENDIF 
    193             END DO 
    194          END DO 
    195       END DO 
     176      DO_3D( 1, 1, 1, 1, 1, nksr ) 
     177         IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
     178            zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! remineralisation 
     179            zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
     180            zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t(ji,jj,jk,Kmm) 
     181         ENDIF 
     182      END_3D 
    196183      ! 
    197184      emoy(:,:,:) = etot(:,:,:)       ! remineralisation 
    198185      zpar(:,:,:) = etot_ndcy(:,:,:)  ! diagnostic : PAR with no diurnal cycle  
    199186      ! 
    200       DO jk = 1, nksrp 
    201          DO jj = 1, jpj 
    202             DO ji = 1, jpi 
    203                IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    204                   z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
    205                   emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep 
    206                   zpar (ji,jj,jk) = zetmp2(ji,jj) * z1_dep 
    207                ENDIF 
    208             END DO 
    209          END DO 
    210       END DO 
     187      DO_3D( 1, 1, 1, 1, 1, nksr ) 
     188         IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
     189            z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
     190            emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep 
     191            zpar (ji,jj,jk) = zetmp2(ji,jj) * z1_dep 
     192         ENDIF 
     193      END_3D 
    211194      ! 
    212195      zdepmoy(:,:)   = 0.e0 
    … …  
    214197      zetmp4 (:,:)   = 0.e0 
    215198      ! 
    216       DO jk = 1, nksrp 
    217          DO jj = 1, jpj 
    218             DO ji = 1, jpi 
    219                IF( gdepw_n(ji,jj,jk+1) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 
    220                   zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * e3t_n(ji,jj,jk) ! production 
    221                   zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat    (ji,jj,jk) * e3t_n(ji,jj,jk) ! production 
    222                   zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t_n(ji,jj,jk) 
    223                ENDIF 
    224             END DO 
    225          END DO 
    226       END DO 
     199      DO_3D( 1, 1, 1, 1, 1, nksr ) 
     200         IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 
     201            zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
     202            zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat    (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
     203            zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t(ji,jj,jk,Kmm) 
     204         ENDIF 
     205      END_3D 
    227206      enanom(:,:,:) = enano(:,:,:) 
    228207      ediatm(:,:,:) = ediat(:,:,:) 
    229208      ! 
    230       DO jk = 1, nksrp 
    231          DO jj = 1, jpj 
    232             DO ji = 1, jpi 
    233                IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    234                   z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
    235                   enanom(ji,jj,jk) = zetmp3(ji,jj) * z1_dep 
    236                   ediatm(ji,jj,jk) = zetmp4(ji,jj) * z1_dep 
    237                ENDIF 
    238             END DO 
    239          END DO 
    240       END DO 
     209      DO_3D( 1, 1, 1, 1, 1, nksr ) 
     210         IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
     211            z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
     212            enanom(ji,jj,jk) = zetmp3(ji,jj) * z1_dep 
     213            ediatm(ji,jj,jk) = zetmp4(ji,jj) * z1_dep 
     214         ENDIF 
     215      END_3D 
    241216      ! 
    242217      IF( ln_p5z ) THEN 
    243          zetmp5 (:,:) = 0.e0 
    244          DO jk = 1, nksrp 
    245             DO jj = 1, jpj 
    246                DO ji = 1, jpi 
    247                   IF( gdepw_n(ji,jj,jk+1) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 
    248                      zetmp5(ji,jj)  = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t_n(ji,jj,jk) ! production 
    249                   ENDIF 
    250                END DO 
    251             END DO 
    252          END DO 
     218         ALLOCATE( zetmp5(jpi,jpj) )  ;   zetmp5 (:,:) = 0.e0 
     219         DO_3D( 1, 1, 1, 1, 1, nksr ) 
     220            IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 
     221               zetmp5(ji,jj)  = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
     222            ENDIF 
     223         END_3D 
    253224         ! 
    254225         epicom(:,:,:) = epico(:,:,:) 
    255226         ! 
    256          DO jk = 1, nksrp 
    257             DO jj = 1, jpj 
    258                DO ji = 1, jpi 
    259                   IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    260                      z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
    261                      epicom(ji,jj,jk) = zetmp5(ji,jj) * z1_dep 
    262                   ENDIF 
    263                END DO 
    264             END DO 
    265          END DO 
    266       ENDIF 
    267       IF( lk_iomput ) THEN 
    268         IF( knt == nrdttrc ) THEN 
    269            IF( iom_use( "Heup"  ) ) CALL iom_put( "Heup" , heup(:,:  ) * tmask(:,:,1) )  ! euphotic layer deptht 
    270            IF( iom_use( "PARDM" ) ) CALL iom_put( "PARDM", zpar(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation 
    271            IF( iom_use( "PAR"   ) ) CALL iom_put( "PAR"  , emoy(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation 
    272         ENDIF 
    273       ENDIF 
    274       ! 
    275       IF( ln_p5z    )   DEALLOCATE( zetmp5 ) 
     227         DO_3D( 1, 1, 1, 1, 1, nksr ) 
     228            IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
     229               z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
     230               epicom(ji,jj,jk) = zetmp5(ji,jj) * z1_dep 
     231            ENDIF 
     232         END_3D 
     233         DEALLOCATE( zetmp5 ) 
     234      ENDIF 
     235      ! 
     236      IF( lk_iomput .AND.  knt == nrdttrc ) THEN 
     237         CALL iom_put( "Heup" , heup(:,:  ) * tmask(:,:,1) )  ! euphotic layer deptht 
     238         CALL iom_put( "PARDM", zpar(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation 
     239         CALL iom_put( "PAR"  , emoy(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation 
     240      ENDIF 
     241      ! 
    276242      IF( ln_timing )   CALL timing_stop('p4z_opt') 
    277243      ! 
    … …  
    279245 
    280246 
    281    SUBROUTINE p4z_opt_par( kt, pqsr, pe1, pe2, pe3, pe0, pqsr100 )  
     247   SUBROUTINE p4z_opt_par( kt, Kmm, pqsr, pe1, pe2, pe3, pe0, pqsr100 )  
    282248      !!---------------------------------------------------------------------- 
    283249      !!                  ***  routine p4z_opt_par  *** 
    … …  
    288254      !!---------------------------------------------------------------------- 
    289255      INTEGER                         , INTENT(in)              ::   kt                ! ocean time-step 
     256      INTEGER                         , INTENT(in)              ::   Kmm               ! ocean time-index 
    290257      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in   )           ::   pqsr              ! shortwave 
    291258      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pe1 , pe2 , pe3   ! PAR ( R-G-B) 
    … …  
    312279         pe3(:,:,1) = zqsr(:,:) 
    313280         ! 
    314          DO jk = 2, nksrp + 1 
     281         DO jk = 2, nksr + 1 
    315282            DO jj = 1, jpj 
    316283               DO ji = 1, jpi 
    317                   pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t_n(ji,jj,jk-1) * xsi0r ) 
     284                  pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t(ji,jj,jk-1,Kmm) * xsi0r ) 
    318285                  pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb  (ji,jj,jk-1 )        ) 
    319286                  pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg  (ji,jj,jk-1 )        ) 
    … …  
    331298        pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) ) 
    332299        ! 
    333         DO jk = 2, nksrp       
    334            DO jj = 1, jpj 
    335               DO ji = 1, jpi 
    336                  pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) 
    337                  pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) ) 
    338                  pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) ) 
    339               END DO 
    340            END DO 
    341         END DO     
     300        DO_3D( 1, 1, 1, 1, 2, nksr ) 
     301           pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) 
     302           pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) ) 
     303           pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) ) 
     304        END_3D 
    342305        ! 
    343306      ENDIF 
    … …  
    400363         WRITE(numout,*) '~~~~~~~~~~~~ ' 
    401364      ENDIF 
    402       REWIND( numnatp_ref )              ! Namelist nampisopt in reference namelist : Pisces attenuation coef. and PAR 
    403365      READ  ( numnatp_ref, nampisopt, IOSTAT = ios, ERR = 901) 
    404 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisopt in reference namelist', lwp ) 
    405       REWIND( numnatp_cfg )              ! Namelist nampisopt in configuration namelist : Pisces attenuation coef. and PAR 
     366901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisopt in reference namelist' ) 
    406367      READ  ( numnatp_cfg, nampisopt, IOSTAT = ios, ERR = 902 ) 
    407 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisopt in configuration namelist', lwp ) 
     368902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisopt in configuration namelist' ) 
    408369      IF(lwm) WRITE ( numonp, nampisopt ) 
    409370 
    … …  
    435396         ntimes_par = iom_getszuld( numpar )   ! get number of record in file 
    436397      ENDIF 
    437       ! 
    438       CALL trc_oce_rgb( xkrgb )                  ! tabulated attenuation coefficients 
    439       nksrp = trc_oce_ext_lev( r_si2, 0.33e2 )     ! max level of light extinction (Blue Chl=0.01) 
    440       ! 
    441       IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksrp, ' ref depth = ', gdepw_1d(nksrp+1), ' m' 
    442398      ! 
    443399                         ekr      (:,:,:) = 0._wp 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p4zpoc.F90

    r11114 r13463  
    1515   USE trc             !  passive tracers common variables  
    1616   USE sms_pisces      !  PISCES Source Minus Sink variables 
    17    USE prtctl_trc      !  print control for debugging 
     17   USE prtctl          !  print control for debugging 
    1818   USE iom             !  I/O manager 
    1919 
    … …  
    3737 
    3838 
     39   !! * Substitutions 
     40#  include "do_loop_substitute.h90" 
     41#  include "domzgr_substitute.h90" 
    3942   !!---------------------------------------------------------------------- 
    4043   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4447CONTAINS 
    4548 
    46    SUBROUTINE p4z_poc( kt, knt ) 
     49   SUBROUTINE p4z_poc( kt, knt, Kbb, Kmm, Krhs ) 
    4750      !!--------------------------------------------------------------------- 
    4851      !!                     ***  ROUTINE p4z_poc  *** 
    … …  
    5255      !! ** Method  : - ??? 
    5356      !!--------------------------------------------------------------------- 
    54       INTEGER, INTENT(in) ::   kt, knt   ! ocean time step and ??? 
     57      INTEGER, INTENT(in) ::   kt, knt         ! ocean time step and ??? 
     58      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices 
    5559      ! 
    5660      INTEGER  ::   ji, jj, jk, jn 
    … …  
    103107     ! ----------------------------------------------------------------------- 
    104108     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 
     109     DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 
     110        IF (tmask(ji,jj,jk) == 1.) THEN 
     111          zdep = hmld(ji,jj) 
     112          ! 
     113          ! In the case of GOC, lability is constant in the mixed layer  
     114          ! It is computed only below the mixed layer depth 
     115          ! ------------------------------------------------------------ 
     116          ! 
     117          IF( gdept(ji,jj,jk,Kmm) > zdep ) THEN 
     118            alphat = 0. 
     119            remint = 0. 
     120            ! 
     121            zsizek1  = e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 
     122            zsizek = e3t(ji,jj,jk,Kmm) / 2. / (wsbio4(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 
     123            ! 
     124            IF ( gdept(ji,jj,jk-1,Kmm) <= zdep ) THEN 
     125              !  
     126              ! The first level just below the mixed layer needs a  
     127              ! specific treatment because lability is supposed constant 
     128              ! everywhere within the mixed layer. This means that  
     129              ! change in lability in the bottom part of the previous cell 
     130              ! should not be computed 
     131              ! ---------------------------------------------------------- 
     132              ! 
     133              ! POC concentration is computed using the lagrangian  
     134              ! framework. It is only used for the lability param 
     135              zpoc = tr(ji,jj,jk-1,jpgoc,Kbb) + consgoc(ji,jj,jk) * rday / rfact2               & 
     136              &   * e3t(ji,jj,jk,Kmm) / 2. / (wsbio4(ji,jj,jk) + rtrn) 
     137              zpoc = MAX(0., zpoc) 
     138              ! 
     139              DO jn = 1, jcpoc 
     140                 ! 
     141                 ! Lagrangian based algorithm. The fraction of each  
     142                 ! lability class is computed starting from the previous 
     143                 ! level 
     144                 ! ----------------------------------------------------- 
     145                 ! 
     146                 ! the concentration of each lability class is calculated 
     147                 ! as the sum of the different sources and sinks 
     148                 ! Please note that production of new GOC experiences 
     149                 ! degradation  
     150                 alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc & 
     151                 &   + prodgoc(ji,jj,jk) * alphan(jn) / tgfunc(ji,jj,jk) / reminp(jn)             & 
     152                 &   * ( 1. - exp( -reminp(jn) * zsizek ) ) * rday / rfact2  
     153                 alphat = alphat + alphag(ji,jj,jk,jn) 
     154                 remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) 
     155              END DO 
     156            ELSE 
     157              ! 
     158              ! standard algorithm in the rest of the water column 
     159              ! See the comments in the previous block. 
     160              ! --------------------------------------------------- 
     161              ! 
     162              zpoc = tr(ji,jj,jk-1,jpgoc,Kbb) + consgoc(ji,jj,jk-1) * rday / rfact2               & 
     163              &   * e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) + consgoc(ji,jj,jk)   & 
     164              &   * rday / rfact2 * e3t(ji,jj,jk,Kmm) / 2. / (wsbio4(ji,jj,jk) + rtrn) 
     165              zpoc = max(0., zpoc) 
     166              ! 
     167              DO jn = 1, jcpoc 
     168                 alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * ( zsizek              & 
     169                 &   + zsizek1 ) ) * zpoc + ( prodgoc(ji,jj,jk-1) / tgfunc(ji,jj,jk-1) * ( 1.           & 
     170                 &   - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn) * zsizek ) + prodgoc(ji,jj,jk) & 
     171                 &   / tgfunc(ji,jj,jk) * ( 1. - exp( -reminp(jn) * zsizek ) ) ) * rday / rfact2 / reminp(jn) * alphan(jn)  
     172                 alphat = alphat + alphag(ji,jj,jk,jn) 
     173                 remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) 
     174              END DO 
     175            ENDIF 
     176            ! 
     177            DO jn = 1, jcpoc 
     178               ! The contribution of each lability class at the current 
     179               ! level is computed 
     180               alphag(ji,jj,jk,jn) = alphag(ji,jj,jk,jn) / ( alphat + rtrn) 
    185181            END DO 
    186          END DO 
    187       END DO 
     182            ! Computation of the mean remineralisation rate 
     183            ztremint(ji,jj,jk) =  MAX(0., remint / ( alphat + rtrn) ) 
     184            ! 
     185          ENDIF 
     186        ENDIF 
     187     END_3D 
    188188 
    189189      IF( ln_p4z ) THEN   ;   zremigoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 
    … …  
    192192 
    193193      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 
     194         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     195            ! POC disaggregation by turbulence and bacterial activity.  
     196            ! -------------------------------------------------------- 
     197            zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
     198            zorem2  = zremig * tr(ji,jj,jk,jpgoc,Kbb) 
     199            orem(ji,jj,jk)      = zorem2 
     200            zorem3(ji,jj,jk) = zremig * solgoc * tr(ji,jj,jk,jpgoc,Kbb) 
     201            zofer2 = zremig * tr(ji,jj,jk,jpbfe,Kbb) 
     202            zofer3 = zremig * solgoc * tr(ji,jj,jk,jpbfe,Kbb) 
     203 
     204            ! ------------------------------------- 
     205            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zorem3(ji,jj,jk) 
     206            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) - zorem2 - zorem3(ji,jj,jk) 
     207            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zofer3 
     208            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zofer2 - zofer3 
     209            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zorem2 
     210            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer2 
     211            zfolimi(ji,jj,jk)   = zofer2 
     212         END_3D 
    217213      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 
     214         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     215             ! POC disaggregation by turbulence and bacterial activity.  
     216            ! -------------------------------------------------------- 
     217            zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
     218            zopoc2 = zremig  * tr(ji,jj,jk,jpgoc,Kbb) 
     219            orem(ji,jj,jk) = zopoc2 
     220            zorem3(ji,jj,jk) = zremig * solgoc * tr(ji,jj,jk,jpgoc,Kbb) 
     221            zopon2 = xremipn / xremipc * zremig * tr(ji,jj,jk,jpgon,Kbb) 
     222            zopop2 = xremipp / xremipc * zremig * tr(ji,jj,jk,jpgop,Kbb) 
     223            zofer2 = xremipn / xremipc * zremig * tr(ji,jj,jk,jpbfe,Kbb) 
     224 
     225            ! ------------------------------------- 
     226            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zorem3(ji,jj,jk) 
     227            tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + solgoc * zopon2  
     228            tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + solgoc * zopop2 
     229            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + solgoc * zofer2 
     230            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zopoc2 
     231            tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zopon2 
     232            tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zopop2 
     233            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer2 
     234            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) - zopoc2 - zorem3(ji,jj,jk) 
     235            tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) - zopon2 * (1. + solgoc) 
     236            tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) - zopop2 * (1. + solgoc) 
     237            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zofer2 * (1. + solgoc) 
     238            zfolimi(ji,jj,jk)   = zofer2 
     239         END_3D 
    248240      ENDIF 
    249241 
    250      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     242     IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    251243        WRITE(charout, FMT="('poc1')") 
    252         CALL prt_ctl_trc_info(charout) 
    253         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     244        CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     245        CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    254246     ENDIF 
    255247 
    … …  
    268260     ! ---------------------------------------------------------------- 
    269261     !  
    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 
     262     DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     263        zdep = hmld(ji,jj) 
     264        IF (tmask(ji,jj,jk) == 1. .AND. gdept(ji,jj,jk,Kmm) <= zdep ) THEN 
     265          totprod(ji,jj) = totprod(ji,jj) + prodpoc(ji,jj,jk) * e3t(ji,jj,jk,Kmm) * rday/ rfact2 
     266          ! The temperature effect is included here 
     267          totthick(ji,jj) = totthick(ji,jj) + e3t(ji,jj,jk,Kmm)* tgfunc(ji,jj,jk) 
     268          totcons(ji,jj) = totcons(ji,jj) - conspoc(ji,jj,jk) * e3t(ji,jj,jk,Kmm) * rday/ rfact2    & 
     269          &                / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 
     270        ENDIF 
     271     END_3D 
    284272 
    285273     ! Computation of the lability spectrum in the mixed layer. In the mixed  
    … …  
    287275     ! --------------------------------------------------------------------- 
    288276     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 
     277     DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     278        IF (tmask(ji,jj,jk) == 1.) THEN 
     279          zdep = hmld(ji,jj) 
     280          alphat = 0.0 
     281          remint = 0.0 
     282          IF( gdept(ji,jj,jk,Kmm) <= zdep ) THEN 
     283             DO jn = 1, jcpoc 
     284                ! For each lability class, the system is supposed to be  
     285                ! at equilibrium: Prod - Sink - w alphap = 0. 
     286                alphap(ji,jj,jk,jn) = totprod(ji,jj) * alphan(jn) / ( reminp(jn)    & 
     287                &                     * totthick(ji,jj) + totcons(ji,jj) + wsbio + rtrn ) 
     288                alphat = alphat + alphap(ji,jj,jk,jn) 
     289             END DO 
     290             DO jn = 1, jcpoc 
     291                alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 
     292                remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 
     293             END DO 
     294             ! Mean remineralization rate in the mixed layer 
     295             ztremint(ji,jj,jk) =  MAX( 0., remint ) 
     296          ENDIF 
     297        ENDIF 
     298     END_3D 
    315299     ! 
    316300     IF( ln_p4z ) THEN   ;  zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 
    … …  
    326310     ! ----------------------------------------------------------------------- 
    327311     ! 
    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 
     312     DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 
     313        IF (tmask(ji,jj,jk) == 1.) THEN 
     314          zdep = hmld(ji,jj) 
     315          IF( gdept(ji,jj,jk,Kmm) > zdep ) THEN 
     316            alphat = 0. 
     317            remint = 0. 
     318            ! 
     319            ! the scale factors are corrected with temperature 
     320            zsizek1  = e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 
     321            zsizek = e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 
     322            ! 
     323            ! Special treatment of the level just below the MXL 
     324            ! See the comments in the GOC section 
     325            ! --------------------------------------------------- 
     326            ! 
     327            IF ( gdept(ji,jj,jk-1,Kmm) <= zdep ) THEN 
     328              ! 
     329              ! Computation of the POC concentration using the  
     330              ! lagrangian algorithm 
     331              zpoc = tr(ji,jj,jk-1,jppoc,Kbb) + conspoc(ji,jj,jk) * rday / rfact2               & 
     332              &   * e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn) 
     333              zpoc = max(0., zpoc) 
     334              !  
     335              DO jn = 1, jcpoc 
     336                 ! computation of the lability spectrum applying the  
     337                 ! different sources and sinks 
     338                 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc  & 
     339                 &   + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk) * alphag(ji,jj,jk,jn) ) & 
     340                 &   / tgfunc(ji,jj,jk) / reminp(jn) * rday / rfact2 * ( 1. - exp( -reminp(jn)     & 
     341                 &   * zsizek ) ) 
     342                 alphap(ji,jj,jk,jn) = MAX( 0., alphap(ji,jj,jk,jn) ) 
     343                 alphat = alphat + alphap(ji,jj,jk,jn) 
     344              END DO 
     345            ELSE 
     346              ! 
     347              ! Lability parameterization for the interior of the ocean 
     348              ! This is very similar to what is done in the previous  
     349              ! block 
     350              ! -------------------------------------------------------- 
     351              ! 
     352              zpoc = tr(ji,jj,jk-1,jppoc,Kbb) + conspoc(ji,jj,jk-1) * rday / rfact2               & 
     353              &   * e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) + conspoc(ji,jj,jk)   & 
     354              &   * rday / rfact2 * e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn) 
     355              zpoc = max(0., zpoc) 
     356              ! 
     357              DO jn = 1, jcpoc 
     358                 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn)                       & 
     359                 &   * ( zsizek + zsizek1 ) ) * zpoc + ( prodpoc(ji,jj,jk-1) * alphan(jn)             &  
     360                 &   + zorem3(ji,jj,jk-1) * alphag(ji,jj,jk-1,jn) ) * rday / rfact2 / reminp(jn)      & 
     361                 &   / tgfunc(ji,jj,jk-1) * ( 1. - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn)  & 
     362                 &   * zsizek ) + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk)                 & 
     363                 &   * alphag(ji,jj,jk,jn) ) * rday / rfact2 / reminp(jn) / tgfunc(ji,jj,jk) * ( 1.   & 
     364                 &   - exp( -reminp(jn) * zsizek ) ) 
     365                 alphap(ji,jj,jk,jn) = max(0., alphap(ji,jj,jk,jn) ) 
     366                 alphat = alphat + alphap(ji,jj,jk,jn) 
     367              END DO 
     368            ENDIF 
     369            ! Normalization of the lability spectrum so that the  
     370            ! integral is equal to 1 
     371            DO jn = 1, jcpoc 
     372               alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 
     373               remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 
    397374            END DO 
    398          END DO 
    399       END DO 
     375            ! Mean remineralization rate in the water column 
     376            ztremint(ji,jj,jk) =  MAX( 0., remint ) 
     377          ENDIF 
     378        ENDIF 
     379     END_3D 
    400380 
    401381     IF( ln_p4z ) THEN   ;   zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 
    … …  
    404384 
    405385     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 
     386         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     387            IF (tmask(ji,jj,jk) == 1.) THEN 
     388              ! POC disaggregation by turbulence and bacterial activity.  
     389              ! -------------------------------------------------------- 
     390              zremip          = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
     391              zorem           = zremip * tr(ji,jj,jk,jppoc,Kbb) 
     392              zofer           = zremip * tr(ji,jj,jk,jpsfe,Kbb) 
     393 
     394              tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zorem 
     395              orem(ji,jj,jk)      = orem(ji,jj,jk) + zorem 
     396              tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer 
     397              tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zorem 
     398              tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zofer 
     399              zfolimi(ji,jj,jk)   = zfolimi(ji,jj,jk) + zofer 
     400            ENDIF 
     401         END_3D 
    426402     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 
     403       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     404          ! POC disaggregation by turbulence and bacterial activity.  
     405          ! -------------------------------------------------------- 
     406          zremip = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
     407          zopoc  = zremip * tr(ji,jj,jk,jppoc,Kbb) 
     408          orem(ji,jj,jk)  = orem(ji,jj,jk) + zopoc 
     409          zopon  = xremipn / xremipc * zremip * tr(ji,jj,jk,jppon,Kbb) 
     410          zopop  = xremipp / xremipc * zremip * tr(ji,jj,jk,jppop,Kbb) 
     411          zofer  = xremipn / xremipc * zremip * tr(ji,jj,jk,jpsfe,Kbb) 
     412 
     413          tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zopoc 
     414          tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) - zopon 
     415          tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) - zopop 
     416          tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zofer 
     417          tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zopoc 
     418          tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zopon  
     419          tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zopop  
     420          tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer  
     421          zfolimi(ji,jj,jk)   = zfolimi(ji,jj,jk) + zofer 
     422       END_3D 
    451423     ENDIF 
    452424 
    … …  
    460432     ENDIF 
    461433 
    462       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     434      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    463435         WRITE(charout, FMT="('poc2')") 
    464          CALL prt_ctl_trc_info(charout) 
    465          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     436         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     437         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    466438      ENDIF 
    467439      ! 
    … …  
    497469      ENDIF 
    498470      ! 
    499       REWIND( numnatp_ref )              ! Namelist nampisrem in reference namelist : Pisces remineralization 
    500471      READ  ( numnatp_ref, nampispoc, IOSTAT = ios, ERR = 901) 
    501 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampispoc in reference namelist', lwp ) 
    502       REWIND( numnatp_cfg )              ! Namelist nampisrem in configuration namelist : Pisces remineralization 
     472901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampispoc in reference namelist' ) 
    503473      READ  ( numnatp_cfg, nampispoc, IOSTAT = ios, ERR = 902 ) 
    504 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampispoc in configuration namelist', lwp ) 
     474902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampispoc in configuration namelist' ) 
    505475      IF(lwm) WRITE( numonp, nampispoc ) 
    506476 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p4zprod.F90

    r11118 r13463  
    1616   USE sms_pisces      ! PISCES Source Minus Sink variables 
    1717   USE p4zlim          ! Co-limitations of differents nutrients 
    18    USE prtctl_trc      ! print control for debugging 
     18   USE prtctl          ! print control for debugging 
    1919   USE iom             ! I/O manager 
    2020 
    … …  
    4646   REAL(wp) ::   texcretd   ! 1 - excretd         
    4747 
     48   !! * Substitutions 
     49#  include "do_loop_substitute.h90" 
     50#  include "domzgr_substitute.h90" 
    4851   !!---------------------------------------------------------------------- 
    4952   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    5356CONTAINS 
    5457 
    55    SUBROUTINE p4z_prod( kt , knt ) 
     58   SUBROUTINE p4z_prod( kt , knt, Kbb, Kmm, Krhs ) 
    5659      !!--------------------------------------------------------------------- 
    5760      !!                     ***  ROUTINE p4z_prod  *** 
    … …  
    6366      !!--------------------------------------------------------------------- 
    6467      INTEGER, INTENT(in) ::   kt, knt   ! 
     68      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices 
    6569      ! 
    6670      INTEGER  ::   ji, jj, jk 
    … …  
    8993      !  Allocate temporary workspace 
    9094      ! 
    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  
     95      zprorcan  (:,:,:) = 0._wp ; zprorcad  (:,:,:) = 0._wp ; zprofed (:,:,:) = 0._wp 
     96      zprofen   (:,:,:) = 0._wp ; zysopt    (:,:,:) = 0._wp 
     97      zpronewn  (:,:,:) = 0._wp ; zpronewd  (:,:,:) = 0._wp ; zprdia  (:,:,:) = 0._wp 
     98      zprbio    (:,:,:) = 0._wp ; zprdch    (:,:,:) = 0._wp ; zprnch  (:,:,:) = 0._wp  
     99      zmxl_fac  (:,:,:) = 0._wp ; zmxl_chl  (:,:,:) = 0._wp  
     100      zpligprod1(:,:,:) = 0._wp ; zpligprod2(:,:,:) = 0._wp  
    96101 
    97102      ! Computation of the optimal production 
    … …  
    105110      ! day length in hours 
    106111      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 
     112      DO_2D( 1, 1, 1, 1 ) 
     113         zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 
     114         zargu = MAX( -1., MIN(  1., zargu ) ) 
     115         zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 
     116      END_2D 
    114117 
    115118      ! 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 
     119      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     120         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     121            zval = MAX( 1., zstrn(ji,jj) ) 
     122            IF( gdept(ji,jj,jk,Kmm) <= hmld(ji,jj) ) THEN 
     123               zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 
     124            ENDIF 
     125            zmxl_chl(ji,jj,jk) = zval / 24. 
     126            zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval ) 
     127         ENDIF 
     128      END_3D 
    130129 
    131130      zprbio(:,:,:) = zprmaxn(:,:,:) * zmxl_fac(:,:,:) 
    … …  
    136135 
    137136      ! 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 
     137      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     138         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     139            ztn         = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. ) 
     140            zadap       = xadap * ztn / ( 2.+ ztn ) 
     141            zconctemp   = MAX( 0.e0 , tr(ji,jj,jk,jpdia,Kbb) - xsizedia ) 
     142            zconctemp2  = tr(ji,jj,jk,jpdia,Kbb) - zconctemp 
     143            ! 
     144            zpislopeadn(ji,jj,jk) = pislopen * ( 1.+ zadap  * EXP( -0.25 * enano(ji,jj,jk) ) )  & 
     145            &                   * tr(ji,jj,jk,jpnch,Kbb) /( tr(ji,jj,jk,jpphy,Kbb) * 12. + rtrn) 
     146            ! 
     147            zpislopeadd(ji,jj,jk) = (pislopen * zconctemp2 + pisloped * zconctemp) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )   & 
     148            &                   * tr(ji,jj,jk,jpdch,Kbb) /( tr(ji,jj,jk,jpdia,Kbb) * 12. + rtrn) 
     149         ENDIF 
     150      END_3D 
     151 
     152      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     153         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     154             ! Computation of production function for Carbon 
     155             !  --------------------------------------------- 
     156             zpislopen = zpislopeadn(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 
     157             &            * zmxl_fac(ji,jj,jk) * rday + rtrn) 
     158             zpisloped = zpislopeadd(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 
     159             &            * zmxl_fac(ji,jj,jk) * rday + rtrn) 
     160             zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) )  ) 
     161             zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) )  ) 
     162             !  Computation of production function for Chlorophyll 
     163             !-------------------------------------------------- 
     164             zpislopen = zpislopeadn(ji,jj,jk) / ( zprmaxn(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 
     165             zpisloped = zpislopeadd(ji,jj,jk) / ( zprmaxd(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 
     166             zprnch(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) ) ) 
     167             zprdch(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) ) ) 
     168         ENDIF 
     169      END_3D 
    179170 
    180171      !  Computation of a proxy of the N/C ratio 
    181172      !  --------------------------------------- 
    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 
     173      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     174          zval = MIN( xnanopo4(ji,jj,jk), ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) )   & 
     175          &      * zprmaxn(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn ) 
     176          quotan(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval ) 
     177          zval = MIN( xdiatpo4(ji,jj,jk), ( xdiatnh4(ji,jj,jk) + xdiatno3(ji,jj,jk) ) )   & 
     178          &      * zprmaxd(ji,jj,jk) / ( zprdia(ji,jj,jk) + rtrn ) 
     179          quotad(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval ) 
     180      END_3D 
     181 
     182 
     183      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     184 
     185          IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     186             !    Si/C of diatoms 
     187             !    ------------------------ 
     188             !    Si/C increases with iron stress and silicate availability 
     189             !    Si/C is arbitrariliy increased for very high Si concentrations 
     190             !    to mimic the very high ratios observed in the Southern Ocean (silpot2) 
     191            zlim  = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi1 ) 
     192            zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 
     193            zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0 
     194            zsiborn = tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) 
     195            IF (gphit(ji,jj) < -30 ) THEN 
     196              zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 ) 
     197            ELSE 
     198              zsilfac2 = 1. +      zsiborn / ( zsiborn + xksi2**3 ) 
     199            ENDIF 
     200            zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2 
     201        ENDIF 
     202      END_3D 
    220203 
    221204      !  Mixed-layer effect on production  
    222205      !  Sea-ice effect on production 
    223206 
    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 
     207      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     208         zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
     209         zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
     210      END_3D 
    232211 
    233212      ! 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 
     213      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     214         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     215            !  production terms for nanophyto. (C) 
     216            zprorcan(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * tr(ji,jj,jk,jpphy,Kbb) * rfact2 
     217            zpronewn(ji,jj,jk)  = zprorcan(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 
     218            ! 
     219            zratio = tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) * fecnm + rtrn ) 
     220            zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )  
     221            zprofen(ji,jj,jk) = fecnm * zprmaxn(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) )  & 
     222            &             * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) )    & 
     223            &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) )  & 
     224            &             * zmax * tr(ji,jj,jk,jpphy,Kbb) * rfact2 
     225            !  production terms for diatoms (C) 
     226            zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr(ji,jj,jk,jpdia,Kbb) * rfact2 
     227            zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 
     228            ! 
     229            zratio = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) * fecdm + rtrn ) 
     230            zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )  
     231            zprofed(ji,jj,jk) = fecdm * zprmaxd(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) )  & 
     232            &             * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) )    & 
     233            &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) )  & 
     234            &             * zmax * tr(ji,jj,jk,jpdia,Kbb) * rfact2 
     235         ENDIF 
     236      END_3D 
    262237 
    263238      ! 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 
     239      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     240         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     241            !  production terms for nanophyto. ( chlorophyll ) 
     242            znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     243            zprod    = rday * zprorcan(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 
     244            zprochln = chlcmin * 12. * zprorcan (ji,jj,jk) 
     245            chlcnm_n   = MIN ( chlcnm, ( chlcnm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm))) * (1. - 1.14 / 43.4 * 20.)) 
     246            zprochln = zprochln + (chlcnm_n-chlcmin) * 12. * zprod / & 
     247                                  & (  zpislopeadn(ji,jj,jk) * znanotot +rtrn) 
     248            !  production terms for diatoms ( chlorophyll ) 
     249            zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     250            zprod    = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 
     251            zprochld = chlcmin * 12. * zprorcad(ji,jj,jk) 
     252            chlcdm_n   = MIN ( chlcdm, ( chlcdm / (1. - 1.14 / 43.4 * ts(ji,jj,jk,jp_tem,Kmm))) * (1. - 1.14 / 43.4 * 20.)) 
     253            zprochld = zprochld + (chlcdm_n-chlcmin) * 12. * zprod / & 
     254                                  & ( zpislopeadd(ji,jj,jk) * zdiattot +rtrn ) 
     255            !   Update the arrays TRA which contain the Chla sources and sinks 
     256            tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) + zprochln * texcretn 
     257            tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) + zprochld * texcretd 
     258         ENDIF 
     259      END_3D 
    289260 
    290261      !   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 
     262      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     263        IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     264           zproreg  = zprorcan(ji,jj,jk) - zpronewn(ji,jj,jk) 
     265           zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk) 
     266           zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 
     267           tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 
     268           tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk) 
     269           tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zproreg - zproreg2 
     270           tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zprorcan(ji,jj,jk) * texcretn 
     271           tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) + zprofen(ji,jj,jk) * texcretn 
     272           tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) + zprorcad(ji,jj,jk) * texcretd 
     273           tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) + zprofed(ji,jj,jk) * texcretd 
     274           tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 
     275           tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zdocprod 
     276           tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + o2ut * ( zproreg + zproreg2) & 
     277           &                   + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) 
     278           ! 
     279           zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 
     280           tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zfeup 
     281           tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 
     282           tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 
     283           tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 
     284           &                                         - rno3 * ( zproreg + zproreg2 ) 
     285        ENDIF 
     286      END_3D 
    320287     ! 
    321288     IF( ln_ligand ) THEN 
    322289         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 
     290         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     291           IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     292              zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 
     293              zfeup    = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 
     294              tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 
     295              zpligprod1(ji,jj,jk) = zdocprod * ldocp 
     296              zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet 
     297           ENDIF 
     298         END_3D 
    336299     ENDIF 
    337300 
    … …  
    341304         & tpp = glob_sum( 'p4zprod', ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) ) 
    342305 
    343     IF( lk_iomput ) THEN 
    344        IF( knt == nrdttrc ) THEN 
    345           ALLOCATE( zw2d(jpi,jpj), zw3d(jpi,jpj,jpk) ) 
    346           zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s 
    347           ! 
    348           IF( iom_use( "PPPHYN" ) .OR. iom_use( "PPPHYD" ) )  THEN 
    349               zw3d(:,:,:) = zprorcan(:,:,:) * zfact * tmask(:,:,:)  ! primary production by nanophyto 
    350               CALL iom_put( "PPPHYN"  , zw3d ) 
    351               ! 
    352               zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:)  ! primary production by diatomes 
    353               CALL iom_put( "PPPHYD"  , zw3d ) 
    354           ENDIF 
    355           IF( iom_use( "PPNEWN" ) .OR. iom_use( "PPNEWD" ) )  THEN 
    356               zw3d(:,:,:) = zpronewn(:,:,:) * zfact * tmask(:,:,:)  ! new primary production by nanophyto 
    357               CALL iom_put( "PPNEWN"  , zw3d ) 
    358               ! 
    359               zw3d(:,:,:) = zpronewd(:,:,:) * zfact * tmask(:,:,:)  ! new primary production by diatomes 
    360               CALL iom_put( "PPNEWD"  , zw3d ) 
    361           ENDIF 
    362           IF( iom_use( "PBSi" ) )  THEN 
    363               zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:) ! biogenic silica production 
    364               CALL iom_put( "PBSi"  , zw3d ) 
    365           ENDIF 
    366           IF( iom_use( "PFeN" ) .OR. iom_use( "PFeD" ) )  THEN 
    367               zw3d(:,:,:) = zprofen(:,:,:) * zfact * tmask(:,:,:)  ! biogenic iron production by nanophyto 
    368               CALL iom_put( "PFeN"  , zw3d ) 
    369               ! 
    370               zw3d(:,:,:) = zprofed(:,:,:) * zfact * tmask(:,:,:)  ! biogenic iron production by  diatomes 
    371               CALL iom_put( "PFeD"  , zw3d ) 
    372           ENDIF 
    373           IF( iom_use( "LPRODP" ) )  THEN 
    374               zw3d(:,:,:) = zpligprod1(:,:,:) * 1e9 * zfact * tmask(:,:,:) 
    375               CALL iom_put( "LPRODP"  , zw3d ) 
    376           ENDIF 
    377           IF( iom_use( "LDETP" ) )  THEN 
    378               zw3d(:,:,:) = zpligprod2(:,:,:) * 1e9 * zfact * tmask(:,:,:) 
    379               CALL iom_put( "LDETP"  , zw3d ) 
    380           ENDIF 
    381           IF( iom_use( "Mumax" ) )  THEN 
    382               zw3d(:,:,:) = zprmaxn(:,:,:) * tmask(:,:,:)   ! Maximum growth rate 
    383               CALL iom_put( "Mumax"  , zw3d ) 
    384           ENDIF 
    385           IF( iom_use( "MuN" ) .OR. iom_use( "MuD" ) )  THEN 
    386               zw3d(:,:,:) = zprbio(:,:,:) * xlimphy(:,:,:) * tmask(:,:,:)  ! Realized growth rate for nanophyto 
    387               CALL iom_put( "MuN"  , zw3d ) 
    388               ! 
    389               zw3d(:,:,:) =  zprdia(:,:,:) * xlimdia(:,:,:) * tmask(:,:,:)  ! Realized growth rate for diatoms 
    390               CALL iom_put( "MuD"  , zw3d ) 
    391           ENDIF 
    392           IF( iom_use( "LNlight" ) .OR. iom_use( "LDlight" ) )  THEN 
    393               zw3d(:,:,:) = zprbio (:,:,:) / (zprmaxn(:,:,:) + rtrn) * tmask(:,:,:) ! light limitation term 
    394               CALL iom_put( "LNlight"  , zw3d ) 
    395               ! 
    396               zw3d(:,:,:) = zprdia (:,:,:) / (zprmaxd(:,:,:) + rtrn) * tmask(:,:,:)  ! light limitation term 
    397               CALL iom_put( "LDlight"  , zw3d ) 
    398           ENDIF 
    399           IF( iom_use( "TPP" ) )  THEN 
    400               zw3d(:,:,:) = ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:)  ! total primary production 
    401               CALL iom_put( "TPP"  , zw3d ) 
    402           ENDIF 
    403           IF( iom_use( "TPNEW" ) )  THEN 
    404               zw3d(:,:,:) = ( zpronewn(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:)  ! total new production 
    405               CALL iom_put( "TPNEW"  , zw3d ) 
    406           ENDIF 
    407           IF( iom_use( "TPBFE" ) )  THEN 
    408               zw3d(:,:,:) = ( zprofen(:,:,:) + zprofed(:,:,:) ) * zfact * tmask(:,:,:)  ! total biogenic iron production 
    409               CALL iom_put( "TPBFE"  , zw3d ) 
    410           ENDIF 
    411           IF( iom_use( "INTPPPHYN" ) .OR. iom_use( "INTPPPHYD" ) ) THEN   
    412              zw2d(:,:) = 0. 
    413              DO jk = 1, jpkm1 
    414                zw2d(:,:) = zw2d(:,:) + zprorcan(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated  primary produc. by nano 
    415              ENDDO 
    416              CALL iom_put( "INTPPPHYN" , zw2d ) 
    417              ! 
    418              zw2d(:,:) = 0. 
    419              DO jk = 1, jpkm1 
    420                 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated  primary produc. by diatom 
    421              ENDDO 
    422              CALL iom_put( "INTPPPHYD" , zw2d ) 
    423           ENDIF 
    424           IF( iom_use( "INTPP" ) ) THEN    
    425              zw2d(:,:) = 0. 
    426              DO jk = 1, jpkm1 
    427                 zw2d(:,:) = zw2d(:,:) + ( zprorcan(:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp 
    428              ENDDO 
    429              CALL iom_put( "INTPP" , zw2d ) 
    430           ENDIF 
    431           IF( iom_use( "INTPNEW" ) ) THEN     
    432              zw2d(:,:) = 0. 
    433              DO jk = 1, jpkm1 
    434                 zw2d(:,:) = zw2d(:,:) + ( zpronewn(:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated new prod 
    435              ENDDO 
    436              CALL iom_put( "INTPNEW" , zw2d ) 
    437           ENDIF 
    438           IF( iom_use( "INTPBFE" ) ) THEN           !   total biogenic iron production  ( vertically integrated ) 
    439              zw2d(:,:) = 0. 
    440              DO jk = 1, jpkm1 
    441                 zw2d(:,:) = zw2d(:,:) + ( zprofen(:,:,jk) + zprofed(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bfe prod 
    442              ENDDO 
    443             CALL iom_put( "INTPBFE" , zw2d ) 
    444           ENDIF 
    445           IF( iom_use( "INTPBSI" ) ) THEN           !   total biogenic silica production  ( vertically integrated ) 
    446              zw2d(:,:) = 0. 
    447              DO jk = 1, jpkm1 
    448                 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * zysopt(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert integr. bsi prod 
    449              ENDDO 
    450              CALL iom_put( "INTPBSI" , zw2d ) 
    451           ENDIF 
    452           IF( iom_use( "tintpp" ) )  CALL iom_put( "tintpp" , tpp * zfact )  !  global total integrated primary production molC/s 
    453           ! 
    454           DEALLOCATE( zw2d, zw3d ) 
     306    IF( lk_iomput .AND.  knt == nrdttrc ) THEN 
     307       zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s 
     308       ! 
     309       CALL iom_put( "PPPHYN"  , zprorcan(:,:,:) * zfact * tmask(:,:,:) )  ! primary production by nanophyto 
     310       CALL iom_put( "PPPHYD"  , zprorcad(:,:,:) * zfact * tmask(:,:,:)   ) ! primary production by diatomes 
     311       CALL iom_put( "PPNEWN"  , zpronewn(:,:,:) * zfact * tmask(:,:,:)    ) ! new primary production by nanophyto 
     312       CALL iom_put( "PPNEWD"  , zpronewd(:,:,:) * zfact * tmask(:,:,:)   ) ! new primary production by diatomes 
     313       CALL iom_put( "PBSi"    , zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:)  ) ! biogenic silica production 
     314       CALL iom_put( "PFeN"    , zprofen(:,:,:) * zfact * tmask(:,:,:)  ) ! biogenic iron production by nanophyto 
     315       CALL iom_put( "PFeD"    , zprofed(:,:,:) * zfact * tmask(:,:,:)  ) ! biogenic iron production by  diatomes 
     316       IF( ln_ligand ) THEN 
     317         CALL iom_put( "LPRODP"  , zpligprod1(:,:,:) * 1e9 * zfact * tmask(:,:,:) ) 
     318         CALL iom_put( "LDETP"   , zpligprod2(:,:,:) * 1e9 * zfact * tmask(:,:,:) ) 
    455319       ENDIF 
     320       CALL iom_put( "Mumax"   , zprmaxn(:,:,:) * tmask(:,:,:)  ) ! Maximum growth rate 
     321       CALL iom_put( "MuN"     , zprbio(:,:,:) * xlimphy(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for nanophyto 
     322       CALL iom_put( "MuD"     , zprdia(:,:,:) * xlimdia(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for diatoms 
     323       CALL iom_put( "LNlight" , zprbio (:,:,:) / (zprmaxn(:,:,:) + rtrn) * tmask(:,:,:)  )  ! light limitation term 
     324       CALL iom_put( "LDlight" , zprdia (:,:,:) / (zprmaxd(:,:,:) + rtrn) * tmask(:,:,:)   ) 
     325       CALL iom_put( "TPP"     , ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:)  )  ! total primary production 
     326       CALL iom_put( "TPNEW"   , ( zpronewn(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:)  ) ! total new production 
     327       CALL iom_put( "TPBFE"   , ( zprofen(:,:,:) + zprofed(:,:,:) ) * zfact * tmask(:,:,:)  )  ! total biogenic iron production 
     328       CALL iom_put( "tintpp"  , tpp * zfact )  !  global total integrated primary production molC/s 
    456329     ENDIF 
    457330 
    458      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     331     IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    459332         WRITE(charout, FMT="('prod')") 
    460          CALL prt_ctl_trc_info(charout) 
    461          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     333         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     334         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    462335     ENDIF 
    463336      ! 
    … …  
    490363      ENDIF 
    491364      ! 
    492       REWIND( numnatp_ref )              ! Namelist nampisprod in reference namelist : Pisces phytoplankton production 
    493365      READ  ( numnatp_ref, namp4zprod, IOSTAT = ios, ERR = 901) 
    494 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zprod in reference namelist', lwp ) 
    495       REWIND( numnatp_cfg )              ! Namelist nampisprod in configuration namelist : Pisces phytoplankton production 
     366901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zprod in reference namelist' ) 
    496367      READ  ( numnatp_cfg, namp4zprod, IOSTAT = ios, ERR = 902 ) 
    497 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zprod in configuration namelist', lwp ) 
     368902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zprod in configuration namelist' ) 
    498369      IF(lwm) WRITE( numonp, namp4zprod ) 
    499370 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p4zrem.F90

    r10425 r13463  
    1818   USE p4zprod         !  Growth rate of the 2 phyto groups 
    1919   USE p4zlim 
    20    USE prtctl_trc      !  print control for debugging 
     20   USE prtctl          !  print control for debugging 
    2121   USE iom             !  I/O manager 
    2222 
    … …  
    4242   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitr   !: denitrification array 
    4343 
     44   !! * Substitutions 
     45#  include "do_loop_substitute.h90" 
     46#  include "domzgr_substitute.h90" 
    4447   !!---------------------------------------------------------------------- 
    4548   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4952CONTAINS 
    5053 
    51    SUBROUTINE p4z_rem( kt, knt ) 
     54   SUBROUTINE p4z_rem( kt, knt, Kbb, Kmm, Krhs ) 
    5255      !!--------------------------------------------------------------------- 
    5356      !!                     ***  ROUTINE p4z_rem  *** 
    … …  
    5760      !! ** Method  : - ??? 
    5861      !!--------------------------------------------------------------------- 
    59       INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
     62      INTEGER, INTENT(in) ::   kt, knt         ! ocean time step 
     63      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices 
    6064      ! 
    6165      INTEGER  ::   ji, jj, jk 
    … …  
    6872      REAL(wp), DIMENSION(jpi,jpj    ) :: ztempbac 
    6973      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdepbac, zolimi, zdepprod, zfacsi, zfacsib, zdepeff, zfebact 
    70       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d 
    7174      !!--------------------------------------------------------------------- 
    7275      ! 
    … …  
    8689      ! that was modeling explicitely bacteria 
    8790      ! ------------------------------------------------------- 
    88       DO jk = 1, jpkm1 
    89          DO jj = 1, jpj 
    90             DO ji = 1, jpi 
    91                zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 
    92                IF( gdept_n(ji,jj,jk) < zdep ) THEN 
    93                   zdepbac(ji,jj,jk) = MIN( 0.7 * ( trb(ji,jj,jk,jpzoo) + 2.* trb(ji,jj,jk,jpmes) ), 4.e-6 ) 
    94                   ztempbac(ji,jj)   = zdepbac(ji,jj,jk) 
    95                ELSE 
    96                   zdepmin = MIN( 1., zdep / gdept_n(ji,jj,jk) ) 
    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 DO 
    102          END DO 
    103       END DO 
     91      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     92         zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 
     93         IF( gdept(ji,jj,jk,Kmm) < zdep ) THEN 
     94            zdepbac(ji,jj,jk) = MIN( 0.7 * ( tr(ji,jj,jk,jpzoo,Kbb) + 2.* tr(ji,jj,jk,jpmes,Kbb) ), 4.e-6 ) 
     95            ztempbac(ji,jj)   = zdepbac(ji,jj,jk) 
     96         ELSE 
     97            zdepmin = MIN( 1., zdep / gdept(ji,jj,jk,Kmm) ) 
     98            zdepbac (ji,jj,jk) = zdepmin**0.683 * ztempbac(ji,jj) 
     99            zdepprod(ji,jj,jk) = zdepmin**0.273 
     100            zdepeff (ji,jj,jk) = zdepeff(ji,jj,jk) * zdepmin**0.3 
     101         ENDIF 
     102      END_3D 
    104103 
    105104      IF( ln_p4z ) THEN 
    106          DO jk = 1, jpkm1 
    107             DO jj = 1, jpj 
    108                DO ji = 1, jpi 
    109                   ! DOC ammonification. Depends on depth, phytoplankton biomass 
    110                   ! and a limitation term which is supposed to be a parameterization of the bacterial activity.  
    111                   zremik = xremik * xstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk)  
    112                   zremik = MAX( zremik, 2.74e-4 * xstep ) 
    113                   ! Ammonification in oxic waters with oxygen consumption 
    114                   ! ----------------------------------------------------- 
    115                   zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc)  
    116                   zolimi(ji,jj,jk) = MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit )  
    117                   ! Ammonification in suboxic waters with denitrification 
    118                   ! ------------------------------------------------------- 
    119                   zammonic = zremik * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc) 
    120                   denitr(ji,jj,jk)  = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 
    121                   denitr(ji,jj,jk)  = MIN( ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit, denitr(ji,jj,jk) ) 
    122                   zoxyremc          = zammonic - denitr(ji,jj,jk) 
    123                   ! 
    124                   zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) ) 
    125                   denitr (ji,jj,jk) = MAX( 0.e0, denitr (ji,jj,jk) ) 
    126                   zoxyremc          = MAX( 0.e0, zoxyremc ) 
    127  
    128                   ! 
    129                   tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 
    130                   tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 
    131                   tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - denitr (ji,jj,jk) * rdenit 
    132                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zolimi (ji,jj,jk) - denitr(ji,jj,jk) - zoxyremc 
    133                   tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - zolimi (ji,jj,jk) * o2ut 
    134                   tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 
    135                   tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zolimi(ji,jj,jk) + zoxyremc    & 
    136                   &                     + ( rdenit + 1.) * denitr(ji,jj,jk) ) 
    137                END DO 
    138             END DO 
    139          END DO 
     105         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     106            ! DOC ammonification. Depends on depth, phytoplankton biomass 
     107            ! and a limitation term which is supposed to be a parameterization of the bacterial activity.  
     108            zremik = xremik * xstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk)  
     109            zremik = MAX( zremik, 2.74e-4 * xstep ) 
     110            ! Ammonification in oxic waters with oxygen consumption 
     111            ! ----------------------------------------------------- 
     112            zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * tr(ji,jj,jk,jpdoc,Kbb)  
     113            zolimi(ji,jj,jk) = MIN( ( tr(ji,jj,jk,jpoxy,Kbb) - rtrn ) / o2ut, zolimit )  
     114            ! Ammonification in suboxic waters with denitrification 
     115            ! ------------------------------------------------------- 
     116            zammonic = zremik * nitrfac(ji,jj,jk) * tr(ji,jj,jk,jpdoc,Kbb) 
     117            denitr(ji,jj,jk)  = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 
     118            denitr(ji,jj,jk)  = MIN( ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenit, denitr(ji,jj,jk) ) 
     119            zoxyremc          = zammonic - denitr(ji,jj,jk) 
     120            ! 
     121            zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) ) 
     122            denitr (ji,jj,jk) = MAX( 0.e0, denitr (ji,jj,jk) ) 
     123            zoxyremc          = MAX( 0.e0, zoxyremc ) 
     124 
     125            ! 
     126            tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 
     127            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 
     128            tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - denitr (ji,jj,jk) * rdenit 
     129            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zolimi (ji,jj,jk) - denitr(ji,jj,jk) - zoxyremc 
     130            tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - zolimi (ji,jj,jk) * o2ut 
     131            tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 
     132            tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zolimi(ji,jj,jk) + zoxyremc    & 
     133            &                     + ( rdenit + 1.) * denitr(ji,jj,jk) ) 
     134         END_3D 
    140135      ELSE 
    141          DO jk = 1, jpkm1 
    142             DO jj = 1, jpj 
    143                DO ji = 1, jpi 
    144                   ! DOC ammonification. Depends on depth, phytoplankton biomass 
    145                   ! and a limitation term which is supposed to be a parameterization of the bacterial activity.  
    146                   ! ----------------------------------------------------------------- 
    147                   zremik = xstep / 1.e-6 * MAX(0.01, xlimbac(ji,jj,jk)) * zdepbac(ji,jj,jk)  
    148                   zremik = MAX( zremik, 2.74e-4 * xstep / xremikc ) 
    149  
    150                   zremikc = xremikc * zremik 
    151                   zremikn = xremikn / xremikc 
    152                   zremikp = xremikp / xremikc 
    153  
    154                   ! Ammonification in oxic waters with oxygen consumption 
    155                   ! ----------------------------------------------------- 
    156                   zolimit = zremikc * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc)  
    157                   zolimic = MAX( 0.e0, MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit ) )  
    158                   zolimi(ji,jj,jk) = zolimic 
    159                   zolimin = zremikn * zolimic * trb(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 
    160                   zolimip = zremikp * zolimic * trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn )  
    161  
    162                   ! Ammonification in suboxic waters with denitrification 
    163                   ! ------------------------------------------------------- 
    164                   zammonic = zremikc * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc) 
    165                   denitr(ji,jj,jk)  = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 
    166                   denitr(ji,jj,jk)  = MAX(0., MIN(  ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit, denitr(ji,jj,jk) ) ) 
    167                   zoxyremc          = MAX(0., zammonic - denitr(ji,jj,jk)) 
    168                   zdenitrn  = zremikn * denitr(ji,jj,jk) * trb(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 
    169                   zdenitrp  = zremikp * denitr(ji,jj,jk) * trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 
    170                   zoxyremn  = zremikn * zoxyremc * trb(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 
    171                   zoxyremp  = zremikp * zoxyremc * trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 
    172  
    173                   tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zolimip + zdenitrp + zoxyremp 
    174                   tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zolimin + zdenitrn + zoxyremn 
    175                   tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - denitr(ji,jj,jk) * rdenit 
    176                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zolimic - denitr(ji,jj,jk) - zoxyremc 
    177                   tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) - zolimin - zdenitrn - zoxyremn 
    178                   tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) - zolimip - zdenitrp - zoxyremp 
    179                   tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - zolimic * o2ut 
    180                   tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zolimic + denitr(ji,jj,jk) + zoxyremc 
    181                   tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zolimin + zoxyremn + ( rdenit + 1.) * zdenitrn ) 
    182                END DO 
    183             END DO 
    184          END DO 
     136         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     137            ! DOC ammonification. Depends on depth, phytoplankton biomass 
     138            ! and a limitation term which is supposed to be a parameterization of the bacterial activity.  
     139            ! ----------------------------------------------------------------- 
     140            zremik = xstep / 1.e-6 * MAX(0.01, xlimbac(ji,jj,jk)) * zdepbac(ji,jj,jk)  
     141            zremik = MAX( zremik, 2.74e-4 * xstep / xremikc ) 
     142 
     143            zremikc = xremikc * zremik 
     144            zremikn = xremikn / xremikc 
     145            zremikp = xremikp / xremikc 
     146 
     147            ! Ammonification in oxic waters with oxygen consumption 
     148            ! ----------------------------------------------------- 
     149            zolimit = zremikc * ( 1.- nitrfac(ji,jj,jk) ) * tr(ji,jj,jk,jpdoc,Kbb)  
     150            zolimic = MAX( 0.e0, MIN( ( tr(ji,jj,jk,jpoxy,Kbb) - rtrn ) / o2ut, zolimit ) )  
     151            zolimi(ji,jj,jk) = zolimic 
     152            zolimin = zremikn * zolimic * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
     153            zolimip = zremikp * zolimic * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn )  
     154 
     155            ! Ammonification in suboxic waters with denitrification 
     156            ! ------------------------------------------------------- 
     157            zammonic = zremikc * nitrfac(ji,jj,jk) * tr(ji,jj,jk,jpdoc,Kbb) 
     158            denitr(ji,jj,jk)  = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 
     159            denitr(ji,jj,jk)  = MAX(0., MIN(  ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenit, denitr(ji,jj,jk) ) ) 
     160            zoxyremc          = MAX(0., zammonic - denitr(ji,jj,jk)) 
     161            zdenitrn  = zremikn * denitr(ji,jj,jk) * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
     162            zdenitrp  = zremikp * denitr(ji,jj,jk) * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
     163            zoxyremn  = zremikn * zoxyremc * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
     164            zoxyremp  = zremikp * zoxyremc * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
     165 
     166            tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zolimip + zdenitrp + zoxyremp 
     167            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zolimin + zdenitrn + zoxyremn 
     168            tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - denitr(ji,jj,jk) * rdenit 
     169            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zolimic - denitr(ji,jj,jk) - zoxyremc 
     170            tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) - zolimin - zdenitrn - zoxyremn 
     171            tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) - zolimip - zdenitrp - zoxyremp 
     172            tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - zolimic * o2ut 
     173            tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zolimic + denitr(ji,jj,jk) + zoxyremc 
     174            tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zolimin + zoxyremn + ( rdenit + 1.) * zdenitrn ) 
     175         END_3D 
    185176         ! 
    186177      ENDIF 
    187178 
    188179 
    189       DO jk = 1, jpkm1 
    190          DO jj = 1, jpj 
    191             DO ji = 1, jpi 
    192                ! NH4 nitrification to NO3. Ceased for oxygen concentrations 
    193                ! below 2 umol/L. Inhibited at strong light  
    194                ! ---------------------------------------------------------- 
    195                zonitr  = nitrif * xstep * trb(ji,jj,jk,jpnh4) * ( 1.- nitrfac(ji,jj,jk) )  & 
    196                &         / ( 1.+ emoy(ji,jj,jk) ) * ( 1. + fr_i(ji,jj) * emoy(ji,jj,jk) )  
    197                zdenitnh4 = nitrif * xstep * trb(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk) 
    198                zdenitnh4 = MIN(  ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenita, zdenitnh4 )  
    199                ! Update of the tracers trends 
    200                ! ---------------------------- 
    201                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr - zdenitnh4 
    202                tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr - rdenita * zdenitnh4 
    203                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr 
    204                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * zdenitnh4 
    205             END DO 
    206          END DO 
    207       END DO 
    208  
    209        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     180      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     181         ! NH4 nitrification to NO3. Ceased for oxygen concentrations 
     182         ! below 2 umol/L. Inhibited at strong light  
     183         ! ---------------------------------------------------------- 
     184         zonitr  = nitrif * xstep * tr(ji,jj,jk,jpnh4,Kbb) * ( 1.- nitrfac(ji,jj,jk) )  & 
     185         &         / ( 1.+ emoy(ji,jj,jk) ) * ( 1. + fr_i(ji,jj) * emoy(ji,jj,jk) )  
     186         zdenitnh4 = nitrif * xstep * tr(ji,jj,jk,jpnh4,Kbb) * nitrfac(ji,jj,jk) 
     187         zdenitnh4 = MIN(  ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenita, zdenitnh4 )  
     188         ! Update of the tracers trends 
     189         ! ---------------------------- 
     190         tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zonitr - zdenitnh4 
     191         tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + zonitr - rdenita * zdenitnh4 
     192         tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2nit * zonitr 
     193         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * zdenitnh4 
     194      END_3D 
     195 
     196       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    210197         WRITE(charout, FMT="('rem1')") 
    211          CALL prt_ctl_trc_info(charout) 
    212          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     198         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     199         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    213200       ENDIF 
    214201 
    215       DO jk = 1, jpkm1 
    216          DO jj = 1, jpj 
    217             DO ji = 1, jpi 
    218  
    219                ! Bacterial uptake of iron. No iron is available in DOC. So 
    220                ! Bacteries are obliged to take up iron from the water. Some 
    221                ! studies (especially at Papa) have shown this uptake to be significant 
    222                ! ---------------------------------------------------------- 
    223                zbactfer = feratb *  rfact2 * 0.6_wp / rday * tgfunc(ji,jj,jk) * xlimbacl(ji,jj,jk)     & 
    224                   &              * trb(ji,jj,jk,jpfer) / ( xkferb + trb(ji,jj,jk,jpfer) )    & 
    225                   &              * zdepprod(ji,jj,jk) * zdepeff(ji,jj,jk) * zdepbac(ji,jj,jk) 
    226                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zbactfer*0.33 
    227                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zbactfer*0.25 
    228                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zbactfer*0.08 
    229                zfebact(ji,jj,jk)   = zbactfer * 0.33 
    230                blim(ji,jj,jk)      = xlimbacl(ji,jj,jk)  * zdepbac(ji,jj,jk) / 1.e-6 * zdepprod(ji,jj,jk) 
    231             END DO 
    232          END DO 
    233       END DO 
    234  
    235        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     202      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     203 
     204         ! Bacterial uptake of iron. No iron is available in DOC. So 
     205         ! Bacteries are obliged to take up iron from the water. Some 
     206         ! studies (especially at Papa) have shown this uptake to be significant 
     207         ! ---------------------------------------------------------- 
     208         zbactfer = feratb *  rfact2 * 0.6_wp / rday * tgfunc(ji,jj,jk) * xlimbacl(ji,jj,jk)     & 
     209            &              * tr(ji,jj,jk,jpfer,Kbb) / ( xkferb + tr(ji,jj,jk,jpfer,Kbb) )    & 
     210            &              * zdepprod(ji,jj,jk) * zdepeff(ji,jj,jk) * zdepbac(ji,jj,jk) 
     211         tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zbactfer*0.33 
     212         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zbactfer*0.25 
     213         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zbactfer*0.08 
     214         zfebact(ji,jj,jk)   = zbactfer * 0.33 
     215         blim(ji,jj,jk)      = xlimbacl(ji,jj,jk)  * zdepbac(ji,jj,jk) / 1.e-6 * zdepprod(ji,jj,jk) 
     216      END_3D 
     217 
     218       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    236219         WRITE(charout, FMT="('rem2')") 
    237          CALL prt_ctl_trc_info(charout) 
    238          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     220         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     221         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    239222       ENDIF 
    240223 
    … …  
    243226      ! --------------------------------------------------------------- 
    244227 
    245       DO jk = 1, jpkm1 
    246          DO jj = 1, jpj 
    247             DO ji = 1, jpi 
    248                zdep     = MAX( hmld(ji,jj), heup_01(ji,jj) ) 
    249                zsatur   = MAX( rtrn, ( sio3eq(ji,jj,jk) - trb(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) ) 
    250                zsatur2  = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**37 
    251                znusil   = 0.225  * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25 
    252                ! Remineralization rate of BSi depedant on T and saturation 
    253                ! --------------------------------------------------------- 
    254                IF ( gdept_n(ji,jj,jk) > zdep ) THEN 
    255                   zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk-1) * EXP( -0.5 * ( xsiremlab - xsirem )  & 
    256                   &                   * znusil * e3t_n(ji,jj,jk) / wsbio4(ji,jj,jk) ) 
    257                   zfacsi(ji,jj,jk)  = zfacsib(ji,jj,jk) / ( 1.0 + zfacsib(ji,jj,jk) ) 
    258                   zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk) * EXP( -0.5 * ( xsiremlab - xsirem )    & 
    259                   &                   * znusil * e3t_n(ji,jj,jk) / wsbio4(ji,jj,jk) ) 
    260                ENDIF 
    261                zsiremin = ( xsiremlab * zfacsi(ji,jj,jk) + xsirem * ( 1. - zfacsi(ji,jj,jk) ) ) * xstep * znusil 
    262                zosil    = zsiremin * trb(ji,jj,jk,jpgsi) 
    263                ! 
    264                tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) - zosil 
    265                tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + zosil 
    266             END DO 
    267          END DO 
    268       END DO 
    269  
    270       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     228      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     229         zdep     = MAX( hmld(ji,jj), heup_01(ji,jj) ) 
     230         zsatur   = MAX( rtrn, ( sio3eq(ji,jj,jk) - tr(ji,jj,jk,jpsil,Kbb) ) / ( sio3eq(ji,jj,jk) + rtrn ) ) 
     231         zsatur2  = ( 1. + ts(ji,jj,jk,jp_tem,Kmm) / 400.)**37 
     232         znusil   = 0.225  * ( 1. + ts(ji,jj,jk,jp_tem,Kmm) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25 
     233         ! Remineralization rate of BSi depedant on T and saturation 
     234         ! --------------------------------------------------------- 
     235         IF ( gdept(ji,jj,jk,Kmm) > zdep ) THEN 
     236            zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk-1) * EXP( -0.5 * ( xsiremlab - xsirem )  & 
     237            &                   * znusil * e3t(ji,jj,jk,Kmm) / wsbio4(ji,jj,jk) ) 
     238            zfacsi(ji,jj,jk)  = zfacsib(ji,jj,jk) / ( 1.0 + zfacsib(ji,jj,jk) ) 
     239            zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk) * EXP( -0.5 * ( xsiremlab - xsirem )    & 
     240            &                   * znusil * e3t(ji,jj,jk,Kmm) / wsbio4(ji,jj,jk) ) 
     241         ENDIF 
     242         zsiremin = ( xsiremlab * zfacsi(ji,jj,jk) + xsirem * ( 1. - zfacsi(ji,jj,jk) ) ) * xstep * znusil 
     243         zosil    = zsiremin * tr(ji,jj,jk,jpgsi,Kbb) 
     244         ! 
     245         tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) - zosil 
     246         tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) + zosil 
     247      END_3D 
     248 
     249      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    271250         WRITE(charout, FMT="('rem3')") 
    272          CALL prt_ctl_trc_info(charout) 
    273          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     251         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     252         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    274253       ENDIF 
    275254 
    276255      IF( knt == nrdttrc ) THEN 
    277           zrfact2 = 1.e3 * rfact2r 
    278           ALLOCATE( zw3d(jpi,jpj,jpk) ) 
    279           zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s 
     256          zrfact2 = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s 
    280257          ! 
    281           IF( iom_use( "REMIN" ) )  THEN 
    282               zw3d(:,:,:) = zolimi(:,:,:) * tmask(:,:,:) * zfact !  Remineralisation rate 
    283               CALL iom_put( "REMIN"  , zw3d ) 
     258          IF( iom_use( "REMIN" ) )  THEN !  Remineralisation rate 
     259             zolimi(:,:,jpk) = 0. ; CALL iom_put( "REMIN"  , zolimi(:,:,:) * tmask(:,:,:) * zrfact2  ) 
    284260          ENDIF 
    285           IF( iom_use( "DENIT" ) )  THEN 
    286               zw3d(:,:,:) = denitr(:,:,:) * rdenit * rno3 * tmask(:,:,:) * zfact ! Denitrification 
    287               CALL iom_put( "DENIT"  , zw3d ) 
     261          CALL iom_put( "DENIT"  , denitr(:,:,:) * rdenit * rno3 * tmask(:,:,:) * zrfact2 ) ! Denitrification  
     262          IF( iom_use( "BACT" ) )  THEN ! Bacterial biomass 
     263             zdepbac(:,:,jpk) = 0.  ;   CALL iom_put( "BACT", zdepbac(:,:,:) * 1.E6 * tmask(:,:,:) ) 
    288264          ENDIF 
    289           IF( iom_use( "BACT" ) )  THEN 
    290                zw3d(:,:,:) = zdepbac(:,:,:) * 1.E6 * tmask(:,:,:)  ! Bacterial biomass 
    291                CALL iom_put( "BACT", zw3d ) 
    292           ENDIF 
    293           IF( iom_use( "FEBACT" ) )  THEN 
    294                zw3d(:,:,:) = zfebact(:,:,:) * 1E9 * tmask(:,:,:) * zrfact2   ! Bacterial iron consumption 
    295                CALL iom_put( "FEBACT" , zw3d ) 
    296           ENDIF 
    297           ! 
    298           DEALLOCATE( zw3d ) 
     265          CALL iom_put( "FEBACT" , zfebact(:,:,:) * 1E9 * tmask(:,:,:) * zrfact2  ) 
    299266       ENDIF 
    300267      ! 
    … …  
    327294      ENDIF 
    328295      ! 
    329       REWIND( numnatp_ref )              ! Namelist nampisrem in reference namelist : Pisces remineralization 
    330296      READ  ( numnatp_ref, nampisrem, IOSTAT = ios, ERR = 901) 
    331 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisrem in reference namelist', lwp ) 
    332       REWIND( numnatp_cfg )              ! Namelist nampisrem in configuration namelist : Pisces remineralization 
     297901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisrem in reference namelist' ) 
    333298      READ  ( numnatp_cfg, nampisrem, IOSTAT = ios, ERR = 902 ) 
    334 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisrem in configuration namelist', lwp ) 
     299902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisrem in configuration namelist' ) 
    335300      IF(lwm) WRITE( numonp, nampisrem ) 
    336301 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p4zsed.F90

    r10788 r13463  
    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 
    2019   USE iom             !  I/O manager 
    21    USE prtctl_trc      !  print control for debugging 
     20   USE prtctl          !  print control for debugging 
    2221 
    2322   IMPLICIT NONE 
    … …  
    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" 
     41#  include "domzgr_substitute.h90" 
    3442   !!---------------------------------------------------------------------- 
    3543   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    3947CONTAINS 
    4048 
    41    SUBROUTINE p4z_sed( kt, knt ) 
     49   SUBROUTINE p4z_sed( kt, knt, Kbb, Kmm, Krhs ) 
    4250      !!--------------------------------------------------------------------- 
    4351      !!                     ***  ROUTINE p4z_sed  *** 
    … …  
    5159      ! 
    5260      INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
     61      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices 
    5362      INTEGER  ::  ji, jj, jk, ikt 
    5463      REAL(wp) ::  zrivalk, zrivsil, zrivno3 
    55       REAL(wp) ::  zwflux, zlim, zfact, zfactcal 
     64      REAL(wp) ::  zlim, zfact, zfactcal 
    5665      REAL(wp) ::  zo2, zno3, zflx, zpdenit, z1pdenit, zolimit 
    5766      REAL(wp) ::  zsiloss, zcaloss, zws3, zws4, zwsc, zdep 
    … …  
    6675      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zsoufer, zlight 
    6776      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrpo4, ztrdop, zirondep, zpdep 
    68       REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) :: zsidep, zironice 
    6977      !!--------------------------------------------------------------------- 
    7078      ! 
    7179      IF( ln_timing )  CALL timing_start('p4z_sed') 
    7280      ! 
    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       ! 
     81 
    8482      ! Allocate temporary workspace 
    8583      ALLOCATE( ztrpo4(jpi,jpj,jpk) ) 
    … …  
    9391      zsedc   (:,:) = 0.e0 
    9492 
    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 .AND. iom_use( "Ironice" ) )   & 
    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 ) THEN 
    146             IF( knt == nrdttrc ) THEN 
    147                 IF( iom_use( "Irondep" ) )   & 
    148                 &  CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron 
    149                 IF( iom_use( "pdust" ) )   & 
    150                 &  CALL iom_put( "pdust"  , dust(:,:) / ( wdust * rday )  * tmask(:,:,1) ) ! dust concentration at surface 
    151             ENDIF 
    152          ENDIF 
    153          DEALLOCATE( zsidep, zpdep, zirondep ) 
    154          !                                               
    155       ENDIF 
    156       
    157       ! Add the external input of nutrients from river 
    158       ! ---------------------------------------------------------- 
    159       IF( ln_river ) THEN 
    160          DO jj = 1, jpj 
    161             DO ji = 1, jpi 
    162                DO jk = 1, nk_rnf(ji,jj) 
    163                   tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) +  rivdip(ji,jj) * rfact2 
    164                   tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) +  rivdin(ji,jj) * rfact2 
    165                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) +  rivdic(ji,jj) * 5.e-5 * rfact2 
    166                   tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) +  rivdsi(ji,jj) * rfact2 
    167                   tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +  rivdic(ji,jj) * rfact2 
    168                   tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) +  ( rivalk(ji,jj) - rno3 * rivdin(ji,jj) ) * rfact2 
    169                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) +  rivdoc(ji,jj) * rfact2 
    170                ENDDO 
    171             ENDDO 
    172          ENDDO 
    173          IF (ln_ligand) THEN 
    174             DO jj = 1, jpj 
    175                DO ji = 1, jpi 
    176                   DO jk = 1, nk_rnf(ji,jj) 
    177                      tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) +  rivdic(ji,jj) * 5.e-5 * rfact2 
    178                   ENDDO 
    179                ENDDO 
    180             ENDDO 
    181          ENDIF 
    182          IF( ln_p5z ) THEN 
    183             DO jj = 1, jpj 
    184                DO ji = 1, jpi 
    185                   DO jk = 1, nk_rnf(ji,jj) 
    186                      tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + rivdop(ji,jj) * rfact2 
    187                      tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + rivdon(ji,jj) * rfact2 
    188                   ENDDO 
    189                ENDDO 
    190             ENDDO 
    191          ENDIF 
    192       ENDIF 
    193        
    194       ! Add the external input of nutrients from nitrogen deposition 
    195       ! ---------------------------------------------------------- 
    196       IF( ln_ndepo ) THEN 
    197          tra(:,:,1,jpno3) = tra(:,:,1,jpno3) + nitdep(:,:) * rfact2 
    198          tra(:,:,1,jptal) = tra(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2 
    199       ENDIF 
    200  
    201       ! Add the external input of iron from hydrothermal vents 
    202       ! ------------------------------------------------------ 
    203       IF( ln_hydrofe ) THEN 
    204             tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2 
    205          IF( ln_ligand ) THEN 
    206             tra(:,:,:,jplgw) = tra(:,:,:,jplgw) + ( hydrofe(:,:,:) * lgw_rath ) * rfact2 
    207          ENDIF 
    208          ! 
    209          IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "HYDR" ) )   & 
    210             &   CALL iom_put( "HYDR", hydrofe(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! hydrothermal iron input 
    211       ENDIF 
    212  
    213       ! OA: Warning, the following part is necessary to avoid CFL problems above the sediments 
    214       ! -------------------------------------------------------------------- 
    215       DO jj = 1, jpj 
    216          DO ji = 1, jpi 
     93      IF( .NOT.lk_sed ) THEN 
     94         ! OA: Warning, the following part is necessary to avoid CFL problems above the sediments 
     95         ! -------------------------------------------------------------------- 
     96         DO_2D( 1, 1, 1, 1 ) 
    21797            ikt  = mbkt(ji,jj) 
    218             zdep = e3t_n(ji,jj,ikt) / xstep 
     98            zdep = e3t(ji,jj,ikt,Kmm) / xstep 
    21999            zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) ) 
    220100            zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) ) 
    221          END DO 
    222       END DO 
    223       ! 
    224       IF( .NOT.lk_sed ) THEN 
    225 ! 
    226          ! Add the external input of iron from sediment mobilization 
    227          ! ------------------------------------------------------ 
    228          IF( ln_ironsed ) THEN 
    229                             tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2 
    230             ! 
    231             IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) )   & 
    232                &   CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! iron inputs from sediments 
    233          ENDIF 
     101         END_2D 
    234102 
    235103         ! Computation of the sediment denitrification proportion: The metamodel from midlleburg (2006) is being used 
    236104         ! Computation of the fraction of organic matter that is permanently buried from Dunne's model 
    237105         ! ------------------------------------------------------- 
    238          DO jj = 1, jpj 
    239             DO ji = 1, jpi 
    240               IF( tmask(ji,jj,1) == 1 ) THEN 
    241                  ikt = mbkt(ji,jj) 
    242                  zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   & 
    243                    &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) )  * 1E3 * 1E6 / 1E4 
    244                  zflx  = LOG10( MAX( 1E-3, zflx ) ) 
    245                  zo2   = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) ) 
    246                  zno3  = LOG10( MAX( 1.  , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) ) 
    247                  zdep  = LOG10( gdepw_n(ji,jj,ikt+1) ) 
    248                  zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3    & 
    249                    &                + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2 
    250                  zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) ) 
    251                    ! 
    252                  zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   & 
    253                    &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6 
    254                  zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2 
    255               ENDIF 
    256             END DO 
    257          END DO  
     106         DO_2D( 1, 1, 1, 1 ) 
     107           IF( tmask(ji,jj,1) == 1 ) THEN 
     108              ikt = mbkt(ji,jj) 
     109              zflx = (  tr(ji,jj,ikt,jpgoc,Kbb) * zwsbio4(ji,jj)   & 
     110                &     + tr(ji,jj,ikt,jppoc,Kbb) * zwsbio3(ji,jj) )  * 1E3 * 1E6 / 1E4 
     111              zflx  = LOG10( MAX( 1E-3, zflx ) ) 
     112              zo2   = LOG10( MAX( 10. , tr(ji,jj,ikt,jpoxy,Kbb) * 1E6 ) ) 
     113              zno3  = LOG10( MAX( 1.  , tr(ji,jj,ikt,jpno3,Kbb) * 1E6 * rno3 ) ) 
     114              zdep  = LOG10( gdepw(ji,jj,ikt+1,Kmm) ) 
     115              zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3    & 
     116                &                + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2 
     117              zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) ) 
     118                ! 
     119              zflx = (  tr(ji,jj,ikt,jpgoc,Kbb) * zwsbio4(ji,jj)   & 
     120                &     + tr(ji,jj,ikt,jppoc,Kbb) * zwsbio3(ji,jj) ) * 1E6 
     121              zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2 
     122           ENDIF 
     123         END_2D 
    258124         ! 
    259125      ENDIF 
    … …  
    264130      IF( .NOT.lk_sed )  zrivsil = 1._wp - sedsilfrac 
    265131 
    266       DO jj = 1, jpj 
    267          DO ji = 1, jpi 
     132      DO_2D( 1, 1, 1, 1 ) 
     133         ikt  = mbkt(ji,jj) 
     134         zdep = xstep / e3t(ji,jj,ikt,Kmm)  
     135         zwsc = zwsbio4(ji,jj) * zdep 
     136         zsiloss = tr(ji,jj,ikt,jpgsi,Kbb) * zwsc 
     137         zcaloss = tr(ji,jj,ikt,jpcal,Kbb) * zwsc 
     138         ! 
     139         tr(ji,jj,ikt,jpgsi,Krhs) = tr(ji,jj,ikt,jpgsi,Krhs) - zsiloss 
     140         tr(ji,jj,ikt,jpcal,Krhs) = tr(ji,jj,ikt,jpcal,Krhs) - zcaloss 
     141      END_2D 
     142      ! 
     143      IF( .NOT.lk_sed ) THEN 
     144         DO_2D( 1, 1, 1, 1 ) 
    268145            ikt  = mbkt(ji,jj) 
    269             zdep = xstep / e3t_n(ji,jj,ikt)  
     146            zdep = xstep / e3t(ji,jj,ikt,Kmm)  
    270147            zwsc = zwsbio4(ji,jj) * zdep 
    271             zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc 
    272             zcaloss = trb(ji,jj,ikt,jpcal) * zwsc 
     148            zsiloss = tr(ji,jj,ikt,jpgsi,Kbb) * zwsc 
     149            zcaloss = tr(ji,jj,ikt,jpcal,Kbb) * zwsc 
     150            tr(ji,jj,ikt,jpsil,Krhs) = tr(ji,jj,ikt,jpsil,Krhs) + zsiloss * zrivsil  
    273151            ! 
    274             tra(ji,jj,ikt,jpgsi) = tra(ji,jj,ikt,jpgsi) - zsiloss 
    275             tra(ji,jj,ikt,jpcal) = tra(ji,jj,ikt,jpcal) - zcaloss 
    276          END DO 
    277       END DO 
    278       ! 
    279       IF( .NOT.lk_sed ) THEN 
    280          DO jj = 1, jpj 
    281             DO ji = 1, jpi 
    282                ikt  = mbkt(ji,jj) 
    283                zdep = xstep / e3t_n(ji,jj,ikt)  
    284                zwsc = zwsbio4(ji,jj) * zdep 
    285                zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc 
    286                zcaloss = trb(ji,jj,ikt,jpcal) * zwsc 
    287                tra(ji,jj,ikt,jpsil) = tra(ji,jj,ikt,jpsil) + zsiloss * zrivsil  
    288                ! 
    289                zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 
    290                zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 
    291                zrivalk  = sedcalfrac * zfactcal 
    292                tra(ji,jj,ikt,jptal) =  tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0 
    293                tra(ji,jj,ikt,jpdic) =  tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk 
    294                zsedcal(ji,jj) = (1.0 - zrivalk) * zcaloss * e3t_n(ji,jj,ikt)  
    295                zsedsi (ji,jj) = (1.0 - zrivsil) * zsiloss * e3t_n(ji,jj,ikt)  
    296             END DO 
    297          END DO 
    298       ENDIF 
    299       ! 
    300       DO jj = 1, jpj 
    301          DO ji = 1, jpi 
     152            zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 
     153            zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 
     154            zrivalk  = sedcalfrac * zfactcal 
     155            tr(ji,jj,ikt,jptal,Krhs) =  tr(ji,jj,ikt,jptal,Krhs) + zcaloss * zrivalk * 2.0 
     156            tr(ji,jj,ikt,jpdic,Krhs) =  tr(ji,jj,ikt,jpdic,Krhs) + zcaloss * zrivalk 
     157            zsedcal(ji,jj) = (1.0 - zrivalk) * zcaloss * e3t(ji,jj,ikt,Kmm)  
     158            zsedsi (ji,jj) = (1.0 - zrivsil) * zsiloss * e3t(ji,jj,ikt,Kmm)  
     159         END_2D 
     160      ENDIF 
     161      ! 
     162      DO_2D( 1, 1, 1, 1 ) 
     163         ikt  = mbkt(ji,jj) 
     164         zdep = xstep / e3t(ji,jj,ikt,Kmm)  
     165         zws4 = zwsbio4(ji,jj) * zdep 
     166         zws3 = zwsbio3(ji,jj) * zdep 
     167         tr(ji,jj,ikt,jpgoc,Krhs) = tr(ji,jj,ikt,jpgoc,Krhs) - tr(ji,jj,ikt,jpgoc,Kbb) * zws4  
     168         tr(ji,jj,ikt,jppoc,Krhs) = tr(ji,jj,ikt,jppoc,Krhs) - tr(ji,jj,ikt,jppoc,Kbb) * zws3 
     169         tr(ji,jj,ikt,jpbfe,Krhs) = tr(ji,jj,ikt,jpbfe,Krhs) - tr(ji,jj,ikt,jpbfe,Kbb) * zws4 
     170         tr(ji,jj,ikt,jpsfe,Krhs) = tr(ji,jj,ikt,jpsfe,Krhs) - tr(ji,jj,ikt,jpsfe,Kbb) * zws3 
     171      END_2D 
     172      ! 
     173      IF( ln_p5z ) THEN 
     174         DO_2D( 1, 1, 1, 1 ) 
    302175            ikt  = mbkt(ji,jj) 
    303             zdep = xstep / e3t_n(ji,jj,ikt)  
     176            zdep = xstep / e3t(ji,jj,ikt,Kmm)  
    304177            zws4 = zwsbio4(ji,jj) * zdep 
    305178            zws3 = zwsbio3(ji,jj) * zdep 
    306             tra(ji,jj,ikt,jpgoc) = tra(ji,jj,ikt,jpgoc) - trb(ji,jj,ikt,jpgoc) * zws4  
    307             tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3 
    308             tra(ji,jj,ikt,jpbfe) = tra(ji,jj,ikt,jpbfe) - trb(ji,jj,ikt,jpbfe) * zws4 
    309             tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3 
    310          END DO 
    311       END DO 
    312       ! 
    313       IF( ln_p5z ) THEN 
    314          DO jj = 1, jpj 
    315             DO ji = 1, jpi 
    316                ikt  = mbkt(ji,jj) 
    317                zdep = xstep / e3t_n(ji,jj,ikt)  
    318                zws4 = zwsbio4(ji,jj) * zdep 
    319                zws3 = zwsbio3(ji,jj) * zdep 
    320                tra(ji,jj,ikt,jpgon) = tra(ji,jj,ikt,jpgon) - trb(ji,jj,ikt,jpgon) * zws4 
    321                tra(ji,jj,ikt,jppon) = tra(ji,jj,ikt,jppon) - trb(ji,jj,ikt,jppon) * zws3 
    322                tra(ji,jj,ikt,jpgop) = tra(ji,jj,ikt,jpgop) - trb(ji,jj,ikt,jpgop) * zws4 
    323                tra(ji,jj,ikt,jppop) = tra(ji,jj,ikt,jppop) - trb(ji,jj,ikt,jppop) * zws3 
    324             END DO 
    325          END DO 
     179            tr(ji,jj,ikt,jpgon,Krhs) = tr(ji,jj,ikt,jpgon,Krhs) - tr(ji,jj,ikt,jpgon,Kbb) * zws4 
     180            tr(ji,jj,ikt,jppon,Krhs) = tr(ji,jj,ikt,jppon,Krhs) - tr(ji,jj,ikt,jppon,Kbb) * zws3 
     181            tr(ji,jj,ikt,jpgop,Krhs) = tr(ji,jj,ikt,jpgop,Krhs) - tr(ji,jj,ikt,jpgop,Kbb) * zws4 
     182            tr(ji,jj,ikt,jppop,Krhs) = tr(ji,jj,ikt,jppop,Krhs) - tr(ji,jj,ikt,jppop,Kbb) * zws3 
     183         END_2D 
    326184      ENDIF 
    327185 
    … …  
    329187         ! The 0.5 factor in zpdenit is to avoid negative NO3 concentration after 
    330188         ! denitrification in the sediments. Not very clever, but simpliest option. 
    331          DO jj = 1, jpj 
    332             DO ji = 1, jpi 
    333                ikt  = mbkt(ji,jj) 
    334                zdep = xstep / e3t_n(ji,jj,ikt)  
    335                zws4 = zwsbio4(ji,jj) * zdep 
    336                zws3 = zwsbio3(ji,jj) * zdep 
    337                zrivno3 = 1. - zbureff(ji,jj) 
    338                zwstpoc = trb(ji,jj,ikt,jpgoc) * zws4 + trb(ji,jj,ikt,jppoc) * zws3 
    339                zpdenit  = MIN( 0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 ) 
    340                z1pdenit = zwstpoc * zrivno3 - zpdenit 
    341                zolimit = MIN( ( trb(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) ) 
    342                tra(ji,jj,ikt,jpdoc) = tra(ji,jj,ikt,jpdoc) + z1pdenit - zolimit 
    343                tra(ji,jj,ikt,jppo4) = tra(ji,jj,ikt,jppo4) + zpdenit + zolimit 
    344                tra(ji,jj,ikt,jpnh4) = tra(ji,jj,ikt,jpnh4) + zpdenit + zolimit 
    345                tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) - rdenit * zpdenit 
    346                tra(ji,jj,ikt,jpoxy) = tra(ji,jj,ikt,jpoxy) - zolimit * o2ut 
    347                tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * zpdenit ) 
    348                tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit  
    349                sdenit(ji,jj) = rdenit * zpdenit * e3t_n(ji,jj,ikt) 
    350                zsedc(ji,jj)   = (1. - zrivno3) * zwstpoc * e3t_n(ji,jj,ikt) 
    351                IF( ln_p5z ) THEN 
    352                   zwstpop              = trb(ji,jj,ikt,jpgop) * zws4 + trb(ji,jj,ikt,jppop) * zws3 
    353                   zwstpon              = trb(ji,jj,ikt,jpgon) * zws4 + trb(ji,jj,ikt,jppon) * zws3 
    354                   tra(ji,jj,ikt,jpdon) = tra(ji,jj,ikt,jpdon) + ( z1pdenit - zolimit ) * zwstpon / (zwstpoc + rtrn) 
    355                   tra(ji,jj,ikt,jpdop) = tra(ji,jj,ikt,jpdop) + ( z1pdenit - zolimit ) * zwstpop / (zwstpoc + rtrn) 
    356                ENDIF 
    357             END DO 
    358          END DO 
     189         DO_2D( 1, 1, 1, 1 ) 
     190            ikt  = mbkt(ji,jj) 
     191            zdep = xstep / e3t(ji,jj,ikt,Kmm)  
     192            zws4 = zwsbio4(ji,jj) * zdep 
     193            zws3 = zwsbio3(ji,jj) * zdep 
     194            zrivno3 = 1. - zbureff(ji,jj) 
     195            zwstpoc = tr(ji,jj,ikt,jpgoc,Kbb) * zws4 + tr(ji,jj,ikt,jppoc,Kbb) * zws3 
     196            zpdenit  = MIN( 0.5 * ( tr(ji,jj,ikt,jpno3,Kbb) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 ) 
     197            z1pdenit = zwstpoc * zrivno3 - zpdenit 
     198            zolimit = MIN( ( tr(ji,jj,ikt,jpoxy,Kbb) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) ) 
     199            tr(ji,jj,ikt,jpdoc,Krhs) = tr(ji,jj,ikt,jpdoc,Krhs) + z1pdenit - zolimit 
     200            tr(ji,jj,ikt,jppo4,Krhs) = tr(ji,jj,ikt,jppo4,Krhs) + zpdenit + zolimit 
     201            tr(ji,jj,ikt,jpnh4,Krhs) = tr(ji,jj,ikt,jpnh4,Krhs) + zpdenit + zolimit 
     202            tr(ji,jj,ikt,jpno3,Krhs) = tr(ji,jj,ikt,jpno3,Krhs) - rdenit * zpdenit 
     203            tr(ji,jj,ikt,jpoxy,Krhs) = tr(ji,jj,ikt,jpoxy,Krhs) - zolimit * o2ut 
     204            tr(ji,jj,ikt,jptal,Krhs) = tr(ji,jj,ikt,jptal,Krhs) + rno3 * (zolimit + (1.+rdenit) * zpdenit ) 
     205            tr(ji,jj,ikt,jpdic,Krhs) = tr(ji,jj,ikt,jpdic,Krhs) + zpdenit + zolimit  
     206            sdenit(ji,jj) = rdenit * zpdenit * e3t(ji,jj,ikt,Kmm) 
     207            zsedc(ji,jj)   = (1. - zrivno3) * zwstpoc * e3t(ji,jj,ikt,Kmm) 
     208            IF( ln_p5z ) THEN 
     209               zwstpop              = tr(ji,jj,ikt,jpgop,Kbb) * zws4 + tr(ji,jj,ikt,jppop,Kbb) * zws3 
     210               zwstpon              = tr(ji,jj,ikt,jpgon,Kbb) * zws4 + tr(ji,jj,ikt,jppon,Kbb) * zws3 
     211               tr(ji,jj,ikt,jpdon,Krhs) = tr(ji,jj,ikt,jpdon,Krhs) + ( z1pdenit - zolimit ) * zwstpon / (zwstpoc + rtrn) 
     212               tr(ji,jj,ikt,jpdop,Krhs) = tr(ji,jj,ikt,jpdop,Krhs) + ( z1pdenit - zolimit ) * zwstpop / (zwstpoc + rtrn) 
     213            ENDIF 
     214         END_2D 
    359215       ENDIF 
    360216 
    … …  
    368224      ENDDO 
    369225      IF( ln_p4z ) THEN 
    370          DO jk = 1, jpkm1 
    371             DO jj = 1, jpj 
    372                DO ji = 1, jpi 
    373                   !                      ! Potential nitrogen fixation dependant on temperature and iron 
    374                   ztemp = tsn(ji,jj,jk,jp_tem) 
    375                   zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 
    376                   !       Potential nitrogen fixation dependant on temperature and iron 
    377                   xdianh4 = trb(ji,jj,jk,jpnh4) / ( concnnh4 + trb(ji,jj,jk,jpnh4) ) 
    378                   xdiano3 = trb(ji,jj,jk,jpno3) / ( concnno3 + trb(ji,jj,jk,jpno3) ) * (1. - xdianh4) 
    379                   zlim = ( 1.- xdiano3 - xdianh4 ) 
    380                   IF( zlim <= 0.1 )   zlim = 0.01 
    381                   zfact = zlim * rfact2 
    382                   ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 
    383                   ztrpo4(ji,jj,jk) = trb(ji,jj,jk,jppo4) / ( 1E-6 + trb(ji,jj,jk,jppo4) ) 
    384                   ztrdp = ztrpo4(ji,jj,jk) 
    385                   nitrpot(ji,jj,jk) =  zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 
    386                END DO 
    387             END DO 
    388          END DO 
     226         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     227            !                      ! Potential nitrogen fixation dependant on temperature and iron 
     228            ztemp = ts(ji,jj,jk,jp_tem,Kmm) 
     229            zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 
     230            !       Potential nitrogen fixation dependant on temperature and iron 
     231            xdianh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 
     232            xdiano3 = tr(ji,jj,jk,jpno3,Kbb) / ( concnno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - xdianh4) 
     233            zlim = ( 1.- xdiano3 - xdianh4 ) 
     234            IF( zlim <= 0.1 )   zlim = 0.01 
     235            zfact = zlim * rfact2 
     236            ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 
     237            ztrpo4(ji,jj,jk) = tr(ji,jj,jk,jppo4,Kbb) / ( 1E-6 + tr(ji,jj,jk,jppo4,Kbb) ) 
     238            ztrdp = ztrpo4(ji,jj,jk) 
     239            nitrpot(ji,jj,jk) =  zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 
     240         END_3D 
    389241      ELSE       ! p5z 
    390          DO jk = 1, jpkm1 
    391             DO jj = 1, jpj 
    392                DO ji = 1, jpi 
    393                   !                      ! Potential nitrogen fixation dependant on temperature and iron 
    394                   ztemp = tsn(ji,jj,jk,jp_tem) 
    395                   zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 
    396                   !       Potential nitrogen fixation dependant on temperature and iron 
    397                   xdianh4 = trb(ji,jj,jk,jpnh4) / ( concnnh4 + trb(ji,jj,jk,jpnh4) ) 
    398                   xdiano3 = trb(ji,jj,jk,jpno3) / ( concnno3 + trb(ji,jj,jk,jpno3) ) * (1. - xdianh4) 
    399                   zlim = ( 1.- xdiano3 - xdianh4 ) 
    400                   IF( zlim <= 0.1 )   zlim = 0.01 
    401                   zfact = zlim * rfact2 
    402                   ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 
    403                   ztrpo4(ji,jj,jk) = trb(ji,jj,jk,jppo4) / ( 1E-6 + trb(ji,jj,jk,jppo4) ) 
    404                   ztrdop(ji,jj,jk) = trb(ji,jj,jk,jpdop) / ( 1E-6 + trb(ji,jj,jk,jpdop) ) * (1. - ztrpo4(ji,jj,jk)) 
    405                   ztrdp = ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) 
    406                   nitrpot(ji,jj,jk) =  zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 
    407                END DO 
    408             END DO 
    409          END DO 
     242         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     243            !                      ! Potential nitrogen fixation dependant on temperature and iron 
     244            ztemp = ts(ji,jj,jk,jp_tem,Kmm) 
     245            zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 
     246            !       Potential nitrogen fixation dependant on temperature and iron 
     247            xdianh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 
     248            xdiano3 = tr(ji,jj,jk,jpno3,Kbb) / ( concnno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - xdianh4) 
     249            zlim = ( 1.- xdiano3 - xdianh4 ) 
     250            IF( zlim <= 0.1 )   zlim = 0.01 
     251            zfact = zlim * rfact2 
     252            ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 
     253            ztrpo4(ji,jj,jk) = tr(ji,jj,jk,jppo4,Kbb) / ( 1E-6 + tr(ji,jj,jk,jppo4,Kbb) ) 
     254            ztrdop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( 1E-6 + tr(ji,jj,jk,jpdop,Kbb) ) * (1. - ztrpo4(ji,jj,jk)) 
     255            ztrdp = ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) 
     256            nitrpot(ji,jj,jk) =  zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 
     257         END_3D 
    410258      ENDIF 
    411259 
    … …  
    413261      ! ---------------------------------------- 
    414262      IF( ln_p4z ) THEN 
    415          DO jk = 1, jpkm1 
    416             DO jj = 1, jpj 
    417                DO ji = 1, jpi 
    418                   zfact = nitrpot(ji,jj,jk) * nitrfix 
    419                   tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zfact / 3.0 
    420                   tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zfact / 3.0 
    421                   tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zfact * 2.0 / 3.0 
    422                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zfact * 1.0 / 3.0 
    423                   tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zfact * 1.0 / 3.0 * 2.0 / 3.0 
    424                   tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfact * 1.0 / 3.0 * 1.0 / 3.0 
    425                   tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 
    426                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - 30E-6 * zfact * 1.0 / 3.0 
    427                   tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 
    428                   tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 
    429                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 
    430                   tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trb(ji,jj,jk,jppo4) ) & 
    431                   &                     * 0.001 * trb(ji,jj,jk,jpdoc) * xstep 
    432               END DO 
    433             END DO  
    434          END DO 
     263         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     264            zfact = nitrpot(ji,jj,jk) * nitrfix 
     265            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0 
     266            tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zfact / 3.0 
     267            tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zfact * 2.0 / 3.0 
     268            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zfact * 1.0 / 3.0 
     269            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zfact * 1.0 / 3.0 * 2.0 / 3.0 
     270            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfact * 1.0 / 3.0 * 1.0 / 3.0 
     271            tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 
     272            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - 30E-6 * zfact * 1.0 / 3.0 
     273            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 
     274            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 
     275            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 
     276            tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + concdnh4 / ( concdnh4 + tr(ji,jj,jk,jppo4,Kbb) ) & 
     277            &                     * 0.001 * tr(ji,jj,jk,jpdoc,Kbb) * xstep 
     278         END_3D 
    435279      ELSE    ! p5z 
    436          DO jk = 1, jpkm1 
    437             DO jj = 1, jpj 
    438                DO ji = 1, jpi 
    439                   zfact = nitrpot(ji,jj,jk) * nitrfix 
    440                   tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zfact / 3.0 
    441                   tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zfact / 3.0 
    442                   tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - 16.0 / 46.0 * zfact * ( 1.0 - 1.0 / 3.0 ) & 
    443                   &                     * ztrpo4(ji,jj,jk) / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 
    444                   tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zfact * 1.0 / 3.0 
    445                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zfact * 1.0 / 3.0 
    446                   tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + 16.0 / 46.0 * zfact / 3.0  & 
    447                   &                     - 16.0 / 46.0 * zfact * ztrdop(ji,jj,jk)   & 
    448                   &                     / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 
    449                   tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zfact * 1.0 / 3.0 * 2.0 / 3.0 
    450                   tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zfact * 1.0 / 3.0 * 2.0 /3.0 
    451                   tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 2.0 /3.0 
    452                   tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfact * 1.0 / 3.0 * 1.0 / 3.0 
    453                   tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zfact * 1.0 / 3.0 * 1.0 /3.0 
    454                   tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 1.0 /3.0 
    455                   tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 
    456                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - 30E-6 * zfact * 1.0 / 3.0  
    457                   tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 
    458                   tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 
    459                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 
    460               END DO 
    461             END DO  
    462          END DO 
     280         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     281            zfact = nitrpot(ji,jj,jk) * nitrfix 
     282            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0 
     283            tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zfact / 3.0 
     284            tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - 16.0 / 46.0 * zfact * ( 1.0 - 1.0 / 3.0 ) & 
     285            &                     * ztrpo4(ji,jj,jk) / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 
     286            tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zfact * 1.0 / 3.0 
     287            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zfact * 1.0 / 3.0 
     288            tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + 16.0 / 46.0 * zfact / 3.0  & 
     289            &                     - 16.0 / 46.0 * zfact * ztrdop(ji,jj,jk)   & 
     290            &                     / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 
     291            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zfact * 1.0 / 3.0 * 2.0 / 3.0 
     292            tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zfact * 1.0 / 3.0 * 2.0 /3.0 
     293            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 
     294            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfact * 1.0 / 3.0 * 1.0 / 3.0 
     295            tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zfact * 1.0 / 3.0 * 1.0 /3.0 
     296            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 
     297            tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 
     298            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - 30E-6 * zfact * 1.0 / 3.0  
     299            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 
     300            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 
     301            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 
     302         END_3D 
    463303         ! 
    464304      ENDIF 
    465305 
    466       IF( lk_iomput ) THEN 
    467          IF( knt == nrdttrc ) THEN 
    468             zfact = 1.e+3 * rfact2r !  conversion from molC/l/kt  to molN/m3/s 
    469             IF( iom_use("Nfix"   ) ) CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * rno3 * zfact * tmask(:,:,:) )  ! nitrogen fixation  
    470             IF( iom_use("INTNFIX") ) THEN   ! nitrogen fixation rate in ocean ( vertically integrated ) 
    471                zwork(:,:) = 0. 
    472                DO jk = 1, jpkm1 
    473                  zwork(:,:) = zwork(:,:) + nitrpot(:,:,jk) * nitrfix * rno3 * zfact * e3t_n(:,:,jk) * tmask(:,:,jk) 
    474                ENDDO 
    475                CALL iom_put( "INTNFIX" , zwork )  
    476             ENDIF 
    477             IF( iom_use("SedCal" ) ) CALL iom_put( "SedCal", zsedcal(:,:) * zfact ) 
    478             IF( iom_use("SedSi" ) )  CALL iom_put( "SedSi",  zsedsi (:,:) * zfact ) 
    479             IF( iom_use("SedC" ) )   CALL iom_put( "SedC",   zsedc  (:,:) * zfact ) 
    480             IF( iom_use("Sdenit" ) ) CALL iom_put( "Sdenit", sdenit (:,:) * zfact * rno3 ) 
    481          ENDIF 
    482       ENDIF 
    483       ! 
    484       IF(ln_ctl) THEN  ! print mean trends (USEd for debugging) 
     306      IF( lk_iomput .AND. knt == nrdttrc ) THEN 
     307         zfact = 1.e+3 * rfact2r !  conversion from molC/l/kt  to molN/m3/s 
     308         CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * rno3 * zfact * tmask(:,:,:) )  ! nitrogen fixation  
     309         CALL iom_put( "SedCal", zsedcal(:,:) * zfact ) 
     310         CALL iom_put( "SedSi" , zsedsi (:,:) * zfact ) 
     311         CALL iom_put( "SedC"  , zsedc  (:,:) * zfact ) 
     312         CALL iom_put( "Sdenit", sdenit (:,:) * zfact * rno3 ) 
     313      ENDIF 
     314      ! 
     315      IF(sn_cfctl%l_prttrc) THEN  ! print mean trends (USEd for debugging) 
    485316         WRITE(charout, fmt="('sed ')") 
    486          CALL prt_ctl_trc_info(charout) 
    487          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     317         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     318         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    488319      ENDIF 
    489320      ! 
    … …  
    494325   END SUBROUTINE p4z_sed 
    495326 
     327   SUBROUTINE p4z_sed_init 
     328      !!---------------------------------------------------------------------- 
     329      !!                  ***  routine p4z_sed_init  *** 
     330      !! 
     331      !! ** purpose :   initialization of some parameters 
     332      !! 
     333      !!---------------------------------------------------------------------- 
     334      !!---------------------------------------------------------------------- 
     335      INTEGER  :: ji, jj, jk, jm 
     336      INTEGER  :: ios                 ! Local integer output status for namelist read 
     337      ! 
     338      !! 
     339      NAMELIST/nampissed/ nitrfix, diazolight, concfediaz 
     340      !!---------------------------------------------------------------------- 
     341      ! 
     342      IF(lwp) THEN 
     343         WRITE(numout,*) 
     344         WRITE(numout,*) 'p4z_sed_init : initialization of sediment mobilisation ' 
     345         WRITE(numout,*) '~~~~~~~~~~~~ ' 
     346      ENDIF 
     347      !                            !* set file information 
     348      READ  ( numnatp_ref, nampissed, IOSTAT = ios, ERR = 901) 
     349901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampissed in reference namelist' ) 
     350      READ  ( numnatp_cfg, nampissed, IOSTAT = ios, ERR = 902 ) 
     351902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampissed in configuration namelist' ) 
     352      IF(lwm) WRITE ( numonp, nampissed ) 
     353 
     354      IF(lwp) THEN 
     355         WRITE(numout,*) '   Namelist : nampissed ' 
     356         WRITE(numout,*) '      nitrogen fixation rate                       nitrfix = ', nitrfix 
     357         WRITE(numout,*) '      nitrogen fixation sensitivty to light    diazolight  = ', diazolight 
     358         WRITE(numout,*) '      Fe half-saturation cste for diazotrophs  concfediaz  = ', concfediaz 
     359      ENDIF 
     360      ! 
     361      r1_rday  = 1. / rday 
     362      ! 
     363      sedsilfrac = 0.03     ! percentage of silica loss in the sediments 
     364      sedcalfrac = 0.6      ! percentage of calcite loss in the sediments 
     365      ! 
     366      lk_sed = ln_sediment .AND. ln_sed_2way  
     367      ! 
     368   END SUBROUTINE p4z_sed_init 
    496369 
    497370   INTEGER FUNCTION p4z_sed_alloc() 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p4zsink.F90

    r10425 r13463  
    1717   USE sms_pisces      !  PISCES Source Minus Sink variables 
    1818   USE trcsink         !  General routine to compute sedimentation 
    19    USE prtctl_trc      !  print control for debugging 
     19   USE prtctl          !  print control for debugging 
    2020   USE iom             !  I/O manager 
    2121   USE lib_mpp 
    … …  
    3838   INTEGER  :: ik100 
    3939 
     40   !! * Substitutions 
     41#  include "do_loop_substitute.h90" 
     42#  include "domzgr_substitute.h90" 
    4043   !!---------------------------------------------------------------------- 
    4144   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4952   !!---------------------------------------------------------------------- 
    5053 
    51    SUBROUTINE p4z_sink ( kt, knt ) 
     54   SUBROUTINE p4z_sink ( kt, knt, Kbb, Kmm, Krhs ) 
    5255      !!--------------------------------------------------------------------- 
    5356      !!                     ***  ROUTINE p4z_sink  *** 
    … …  
    5962      !!--------------------------------------------------------------------- 
    6063      INTEGER, INTENT(in) :: kt, knt 
     64      INTEGER, INTENT(in) :: Kbb, Kmm, Krhs  ! time level indices 
    6165      INTEGER  ::   ji, jj, jk 
    6266      CHARACTER (len=25) :: charout 
    6367      REAL(wp) :: zmax, zfact 
    64       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d 
    65       REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) :: zw2d 
    6668      !!--------------------------------------------------------------------- 
    6769      ! 
    … …  
    7981      !    by data and from the coagulation theory 
    8082      !    ----------------------------------------------------------- 
    81       DO jk = 1, jpkm1 
    82          DO jj = 1, jpj 
    83             DO ji = 1,jpi 
    84                zmax  = MAX( heup_01(ji,jj), hmld(ji,jj) ) 
    85                zfact = MAX( 0., gdepw_n(ji,jj,jk+1) - zmax ) / wsbio2scale 
    86                wsbio4(ji,jj,jk) = wsbio2 + MAX(0., ( wsbio2max - wsbio2 )) * zfact 
    87             END DO 
    88          END DO 
    89       END DO 
     83      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     84         zmax  = MAX( heup_01(ji,jj), hmld(ji,jj) ) 
     85         zfact = MAX( 0., gdepw(ji,jj,jk+1,Kmm) - zmax ) / wsbio2scale 
     86         wsbio4(ji,jj,jk) = wsbio2 + MAX(0., ( wsbio2max - wsbio2 )) * zfact 
     87      END_3D 
    9088 
    9189      ! limit the values of the sinking speeds to avoid numerical instabilities   
    … …  
    104102      !   Compute the sedimentation term using p4zsink2 for all the sinking particles 
    105103      !   ----------------------------------------------------- 
    106       CALL trc_sink( kt, wsbio3, sinking , jppoc, rfact2 ) 
    107       CALL trc_sink( kt, wsbio3, sinkfer , jpsfe, rfact2 ) 
    108       CALL trc_sink( kt, wsbio4, sinking2, jpgoc, rfact2 ) 
    109       CALL trc_sink( kt, wsbio4, sinkfer2, jpbfe, rfact2 ) 
    110       CALL trc_sink( kt, wsbio4, sinksil , jpgsi, rfact2 ) 
    111       CALL trc_sink( kt, wsbio4, sinkcal , jpcal, rfact2 ) 
     104      CALL trc_sink( kt, Kbb, Kmm, wsbio3, sinking , jppoc, rfact2 ) 
     105      CALL trc_sink( kt, Kbb, Kmm, wsbio3, sinkfer , jpsfe, rfact2 ) 
     106      CALL trc_sink( kt, Kbb, Kmm, wsbio4, sinking2, jpgoc, rfact2 ) 
     107      CALL trc_sink( kt, Kbb, Kmm, wsbio4, sinkfer2, jpbfe, rfact2 ) 
     108      CALL trc_sink( kt, Kbb, Kmm, wsbio4, sinksil , jpgsi, rfact2 ) 
     109      CALL trc_sink( kt, Kbb, Kmm, wsbio4, sinkcal , jpcal, rfact2 ) 
    112110 
    113111      IF( ln_p5z ) THEN 
    … …  
    119117         !   Compute the sedimentation term using p4zsink2 for all the sinking particles 
    120118         !   ----------------------------------------------------- 
    121          CALL trc_sink( kt, wsbio3, sinkingn , jppon, rfact2 ) 
    122          CALL trc_sink( kt, wsbio3, sinkingp , jppop, rfact2 ) 
    123          CALL trc_sink( kt, wsbio4, sinking2n, jpgon, rfact2 ) 
    124          CALL trc_sink( kt, wsbio4, sinking2p, jpgop, rfact2 ) 
     119         CALL trc_sink( kt, Kbb, Kmm, wsbio3, sinkingn , jppon, rfact2 ) 
     120         CALL trc_sink( kt, Kbb, Kmm, wsbio3, sinkingp , jppop, rfact2 ) 
     121         CALL trc_sink( kt, Kbb, Kmm, wsbio4, sinking2n, jpgon, rfact2 ) 
     122         CALL trc_sink( kt, Kbb, Kmm, wsbio4, sinking2p, jpgop, rfact2 ) 
    125123      ENDIF 
    126124 
    … …  
    129127        &   t_oce_co2_exp = glob_sum( 'p4zsink', ( sinking(:,:,ik100) + sinking2(:,:,ik100) ) * e1e2t(:,:) * tmask(:,:,1) ) 
    130128     ! 
    131      IF( lk_iomput ) THEN 
    132        IF( knt == nrdttrc ) THEN 
    133           ALLOCATE( zw2d(jpi,jpj), zw3d(jpi,jpj,jpk) ) 
    134           zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s 
    135           ! 
    136           IF( iom_use( "EPC100" ) )  THEN 
    137               zw2d(:,:) = ( sinking(:,:,ik100) + sinking2(:,:,ik100) ) * zfact * tmask(:,:,1) ! Export of carbon at 100m 
    138               CALL iom_put( "EPC100"  , zw2d ) 
    139           ENDIF 
    140           IF( iom_use( "EPFE100" ) )  THEN 
    141               zw2d(:,:) = ( sinkfer(:,:,ik100) + sinkfer2(:,:,ik100) ) * zfact * tmask(:,:,1) ! Export of iron at 100m 
    142               CALL iom_put( "EPFE100"  , zw2d ) 
    143           ENDIF 
    144           IF( iom_use( "EPCAL100" ) )  THEN 
    145               zw2d(:,:) = sinkcal(:,:,ik100) * zfact * tmask(:,:,1) ! Export of calcite at 100m 
    146               CALL iom_put( "EPCAL100"  , zw2d ) 
    147           ENDIF 
    148           IF( iom_use( "EPSI100" ) )  THEN 
    149               zw2d(:,:) =  sinksil(:,:,ik100) * zfact * tmask(:,:,1) ! Export of bigenic silica at 100m 
    150               CALL iom_put( "EPSI100"  , zw2d ) 
    151           ENDIF 
    152           IF( iom_use( "EXPC" ) )  THEN 
    153               zw3d(:,:,:) = ( sinking(:,:,:) + sinking2(:,:,:) ) * zfact * tmask(:,:,:) ! Export of carbon in the water column 
    154               CALL iom_put( "EXPC"  , zw3d ) 
    155           ENDIF 
    156           IF( iom_use( "EXPFE" ) )  THEN 
    157               zw3d(:,:,:) = ( sinkfer(:,:,:) + sinkfer2(:,:,:) ) * zfact * tmask(:,:,:) ! Export of iron  
    158               CALL iom_put( "EXPFE"  , zw3d ) 
    159           ENDIF 
    160           IF( iom_use( "EXPCAL" ) )  THEN 
    161               zw3d(:,:,:) = sinkcal(:,:,:) * zfact * tmask(:,:,:) ! Export of calcite  
    162               CALL iom_put( "EXPCAL"  , zw3d ) 
    163           ENDIF 
    164           IF( iom_use( "EXPSI" ) )  THEN 
    165               zw3d(:,:,:) = sinksil(:,:,:) * zfact * tmask(:,:,:) ! Export of bigenic silica 
    166               CALL iom_put( "EXPSI"  , zw3d ) 
    167           ENDIF 
    168           IF( iom_use( "tcexp" ) )  CALL iom_put( "tcexp" , t_oce_co2_exp * zfact )   ! molC/s 
    169           !  
    170           DEALLOCATE( zw2d, zw3d ) 
    171         ENDIF 
     129     IF( lk_iomput .AND.  knt == nrdttrc ) THEN 
     130       zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s 
     131       ! 
     132       CALL iom_put( "EPC100"  , ( sinking(:,:,ik100) + sinking2(:,:,ik100) ) * zfact * tmask(:,:,1) ) ! Export of carbon at 100m  
     133       CALL iom_put( "EPFE100" , ( sinkfer(:,:,ik100) + sinkfer2(:,:,ik100) ) * zfact * tmask(:,:,1) ) ! Export of iron at 100m  
     134       CALL iom_put( "EPCAL100", sinkcal(:,:,ik100) * zfact * tmask(:,:,1) )      ! Export of calcite at 100m  
     135       CALL iom_put( "EPSI100" , sinksil(:,:,ik100) * zfact * tmask(:,:,1) )          ! Export of bigenic silica at 100m  
     136       CALL iom_put( "EXPC"    , ( sinking(:,:,:) + sinking2(:,:,:) ) * zfact * tmask(:,:,:) ) ! Export of carbon in the water column  
     137       CALL iom_put( "EXPFE"   , ( sinkfer(:,:,:) + sinkfer2(:,:,:) ) * zfact * tmask(:,:,:) ) ! Export of iron   
     138       CALL iom_put( "EXPCAL"  , sinkcal(:,:,:) * zfact * tmask(:,:,:) )      ! Export of calcite  
     139       CALL iom_put( "EXPSI"   , sinksil(:,:,:) * zfact * tmask(:,:,:) )      ! Export of bigenic silica 
     140       CALL iom_put( "tcexp"   , t_oce_co2_exp * zfact )   ! molC/s 
     141       !  
    172142      ENDIF 
    173143      ! 
    174       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     144      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    175145         WRITE(charout, FMT="('sink')") 
    176          CALL prt_ctl_trc_info(charout) 
    177          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     146         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     147         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    178148      ENDIF 
    179149      ! 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p4zsms.F90

    r10425 r13463  
    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 
    … …  
    2525   USE trdtrc          ! TOP trends variables 
    2626   USE sedmodel        ! Sediment model 
    27    USE prtctl_trc      ! print control for debugging 
     27   USE prtctl          ! print control for debugging 
    2828 
    2929   IMPLICIT NONE 
    … …  
    3535   INTEGER ::    numco2, numnut, numnit      ! logical unit for co2 budget 
    3636   REAL(wp) ::   alkbudget, no3budget, silbudget, ferbudget, po4budget 
    37    REAL(wp) ::   xfact1, xfact2, xfact3 
     37   REAL(wp) ::   xfact, xfact1, xfact2, xfact3 
    3838 
    3939   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xnegtr     ! Array used to indicate negative tracer values 
    4040 
     41   !! * Substitutions 
     42#  include "do_loop_substitute.h90" 
     43#  include "domzgr_substitute.h90" 
    4144   !!---------------------------------------------------------------------- 
    4245   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4649CONTAINS 
    4750 
    48    SUBROUTINE p4z_sms( kt ) 
     51   SUBROUTINE p4z_sms( kt, Kbb, Kmm, Krhs ) 
    4952      !!--------------------------------------------------------------------- 
    5053      !!                     ***  ROUTINE p4z_sms  *** 
    … …  
    5861      !!--------------------------------------------------------------------- 
    5962      ! 
    60       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     63      INTEGER, INTENT( in ) ::   kt              ! ocean time-step index       
     64      INTEGER, INTENT( in ) ::   Kbb, Kmm, Krhs  ! time level index 
    6165      !! 
    6266      INTEGER ::   ji, jj, jk, jnt, jn, jl 
    6367      REAL(wp) ::  ztra 
    6468      CHARACTER (len=25) :: charout 
     69      REAL(wp), ALLOCATABLE, DIMENSION(:,:    ) :: zw2d 
     70      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:  ) :: zw3d 
     71      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ztrdt   ! 4D workspace 
     72 
    6573      !!--------------------------------------------------------------------- 
    6674      ! 
    … …  
    7280        ! 
    7381        IF( .NOT. ln_rsttr ) THEN 
    74             CALL p4z_che                              ! initialize the chemical constants 
    75             CALL ahini_for_at(hi)   !  set PH at kt=nit000 
     82            CALL p4z_che( Kbb, Kmm )                  ! initialize the chemical constants 
     83            CALL ahini_for_at( hi, Kbb )              !  set PH at kt=nit000 
    7684            t_oce_co2_flx_cum = 0._wp 
    7785        ELSE 
    78             CALL p4z_rst( nittrc000, 'READ' )  !* read or initialize all required fields 
     86            CALL p4z_rst( nittrc000, Kbb, Kmm,  'READ' )  !* read or initialize all required fields 
    7987        ENDIF 
    8088        ! 
    8189      ENDIF 
    8290      ! 
    83       IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 )   CALL p4z_dmp( kt )      ! Relaxation of some tracers 
    84       ! 
    85       rfact = r2dttrc 
    86       ! 
    87       IF( ( ln_top_euler .AND. kt == nittrc000 )  .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + nn_dttrc ) ) THEN 
     91      IF( ln_pisdmp .AND. MOD( kt - 1, nn_pisdmp ) == 0 )   CALL p4z_dmp( kt, Kbb, Kmm )      ! Relaxation of some tracers 
     92      ! 
     93      rfact = rDt_trc 
     94      ! 
     95      ! trends computation initialisation 
     96      IF( l_trdtrc )  THEN 
     97         ALLOCATE( ztrdt(jpi,jpj,jpk,jp_pisces) )  !* store now fields before applying the Asselin filter 
     98         ztrdt(:,:,:,:)  = tr(:,:,:,:,Kmm) 
     99      ENDIF 
     100      ! 
     101 
     102      IF( ( ln_top_euler .AND. kt == nittrc000 )  .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + 1 ) ) THEN 
    88103         rfactr  = 1. / rfact 
    89104         rfact2  = rfact / REAL( nrdttrc, wp ) 
    90105         rfact2r = 1. / rfact2 
    91106         xstep = rfact2 / rday         ! Time step duration for biology 
     107         xfact = 1.e+3 * rfact2r 
    92108         IF(lwp) WRITE(numout,*)  
    93          IF(lwp) WRITE(numout,*) '    Passive Tracer  time step    rfact  = ', rfact, ' rdt = ', rdt 
     109         IF(lwp) WRITE(numout,*) '    Passive Tracer  time step    rfact  = ', rfact, ' rn_Dt = ', rn_Dt 
    94110         IF(lwp) write(numout,*) '    PISCES  Biology time step    rfact2 = ', rfact2 
    95111         IF(lwp) WRITE(numout,*) 
    96112      ENDIF 
    97113 
    98       IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN 
     114      IF( l_1st_euler .OR. ln_top_euler ) THEN 
    99115         DO jn = jp_pcs0, jp_pcs1              !   SMS on tracer without Asselin time-filter 
    100             trb(:,:,:,jn) = trn(:,:,:,jn) 
     116            tr(:,:,:,jn,Kbb) = tr(:,:,:,jn,Kmm) 
    101117         END DO 
    102118      ENDIF 
    103119      ! 
    104       IF( ll_sbc ) CALL p4z_sbc( kt )   ! external sources of nutrients  
     120      IF( ll_bc )    CALL p4z_bc( kt, Kbb, Kmm, Krhs )   ! external sources of nutrients  
    105121      ! 
    106122#if ! defined key_sed_off 
    107       CALL p4z_che              ! computation of chemical constants 
    108       CALL p4z_int( kt )        ! computation of various rates for biogeochemistry 
     123      CALL p4z_che(     Kbb, Kmm       ) ! computation of chemical constants 
     124      CALL p4z_int( kt, Kbb, Kmm       ) ! computation of various rates for biogeochemistry 
    109125      ! 
    110126      DO jnt = 1, nrdttrc          ! Potential time splitting if requested 
    111127         ! 
    112          CALL p4z_bio( kt, jnt )   ! Biology 
    113          CALL p4z_lys( kt, jnt )   ! Compute CaCO3 saturation 
    114          CALL p4z_sed( kt, jnt )   ! Surface and Bottom boundary conditions 
    115          CALL p4z_flx( kt, jnt )   ! Compute surface fluxes 
     128         CALL p4z_bio( kt, jnt, Kbb, Kmm, Krhs )   ! Biology 
     129         CALL p4z_lys( kt, jnt, Kbb,      Krhs )   ! Compute CaCO3 saturation 
     130         CALL p4z_sed( kt, jnt, Kbb, Kmm, Krhs )   ! Surface and Bottom boundary conditions 
     131         CALL p4z_flx( kt, jnt, Kbb, Kmm, Krhs )   ! Compute surface fluxes 
    116132         ! 
    117133         xnegtr(:,:,:) = 1.e0 
    118134         DO jn = jp_pcs0, jp_pcs1 
    119             DO jk = 1, jpk 
    120                DO jj = 1, jpj 
    121                   DO ji = 1, jpi 
    122                      IF( ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN 
    123                         ztra             = ABS( trb(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn ) 
    124                         xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk),  ztra ) 
    125                      ENDIF 
    126                  END DO 
    127                END DO 
    128             END DO 
     135            DO_3D( 1, 1, 1, 1, 1, jpk ) 
     136               IF( ( tr(ji,jj,jk,jn,Kbb) + tr(ji,jj,jk,jn,Krhs) ) < 0.e0 ) THEN 
     137                  ztra             = ABS( tr(ji,jj,jk,jn,Kbb) ) / ( ABS( tr(ji,jj,jk,jn,Krhs) ) + rtrn ) 
     138                  xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk),  ztra ) 
     139               ENDIF 
     140            END_3D 
    129141         END DO 
    130142         !                                ! where at least 1 tracer concentration becomes negative 
    131143         !                                !  
    132144         DO jn = jp_pcs0, jp_pcs1 
    133            trb(:,:,:,jn) = trb(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn) 
     145           tr(:,:,:,jn,Kbb) = tr(:,:,:,jn,Kbb) + xnegtr(:,:,:) * tr(:,:,:,jn,Krhs) 
    134146         END DO 
    135147        ! 
     148        IF(  iom_use( 'INTdtAlk' ) .OR. iom_use( 'INTdtDIC' ) .OR. iom_use( 'INTdtFer' ) .OR.  & 
     149          &  iom_use( 'INTdtDIN' ) .OR. iom_use( 'INTdtDIP' ) .OR. iom_use( 'INTdtSil' ) )  THEN 
     150          ! 
     151          ALLOCATE( zw3d(jpi,jpj,jpk), zw2d(jpi,jpj) ) 
     152          zw3d(:,:,jpk) = 0. 
     153          DO jk = 1, jpkm1 
     154              zw3d(:,:,jk) = xnegtr(:,:,jk) * xfact * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
     155          ENDDO 
     156          ! 
     157          zw2d(:,:) = 0. 
     158          DO jk = 1, jpkm1 
     159             zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jptal,Krhs) 
     160          ENDDO 
     161          CALL iom_put( 'INTdtAlk', zw2d ) 
     162          ! 
     163          zw2d(:,:) = 0. 
     164          DO jk = 1, jpkm1 
     165             zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpdic,Krhs) 
     166          ENDDO 
     167          CALL iom_put( 'INTdtDIC', zw2d ) 
     168          ! 
     169          zw2d(:,:) = 0. 
     170          DO jk = 1, jpkm1 
     171             zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * rno3 * ( tr(:,:,jk,jpno3,Krhs) + tr(:,:,jk,jpnh4,Krhs) ) 
     172          ENDDO 
     173          CALL iom_put( 'INTdtDIN', zw2d ) 
     174          ! 
     175          zw2d(:,:) = 0. 
     176          DO jk = 1, jpkm1 
     177             zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * po4r * tr(:,:,jk,jppo4,Krhs) 
     178          ENDDO 
     179          CALL iom_put( 'INTdtDIP', zw2d ) 
     180          ! 
     181          zw2d(:,:) = 0. 
     182          DO jk = 1, jpkm1 
     183             zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpfer,Krhs) 
     184          ENDDO 
     185          CALL iom_put( 'INTdtFer', zw2d ) 
     186          ! 
     187          zw2d(:,:) = 0. 
     188          DO jk = 1, jpkm1 
     189             zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpsil,Krhs) 
     190          ENDDO 
     191          CALL iom_put( 'INTdtSil', zw2d ) 
     192          ! 
     193          DEALLOCATE( zw3d, zw2d ) 
     194        ENDIF 
     195        ! 
    136196         DO jn = jp_pcs0, jp_pcs1 
    137             tra(:,:,:,jn) = 0._wp 
     197            tr(:,:,:,jn,Krhs) = 0._wp 
    138198         END DO 
    139199         ! 
    140200         IF( ln_top_euler ) THEN 
    141201            DO jn = jp_pcs0, jp_pcs1 
    142                trn(:,:,:,jn) = trb(:,:,:,jn) 
     202               tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 
    143203            END DO 
    144204         ENDIF 
    145205      END DO 
    146  
    147206      ! 
    148207      IF( l_trdtrc ) THEN 
    149208         DO jn = jp_pcs0, jp_pcs1 
    150            CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends 
     209           ztrdt(:,:,:,jn) = ( tr(:,:,:,jn,Kbb) - ztrdt(:,:,:,jn) ) * rfactr  
     210           CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm )   ! save trends 
    151211         END DO 
     212         DEALLOCATE( ztrdt )  
    152213      END IF 
    153214#endif 
    … …  
    155216      IF( ln_sediment ) THEN  
    156217         ! 
    157          CALL sed_model( kt )     !  Main program of Sediment model 
     218         CALL sed_model( kt, Kbb, Kmm, Krhs )     !  Main program of Sediment model 
    158219         ! 
    159220         IF( ln_top_euler ) THEN 
    160221            DO jn = jp_pcs0, jp_pcs1 
    161                trn(:,:,:,jn) = trb(:,:,:,jn) 
     222               tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 
    162223            END DO 
    163224         ENDIF 
    … …  
    165226      ENDIF 
    166227      ! 
    167       IF( lrst_trc )  CALL p4z_rst( kt, 'WRITE' )  !* Write PISCES informations in restart file  
    168       ! 
    169  
    170       IF( lk_iomput .OR. ln_check_mass )  CALL p4z_chk_mass( kt )    ! Mass conservation checking 
    171  
    172       IF( lwm .AND. kt == nittrc000    )  CALL FLUSH( numonp )       ! flush output namelist PISCES 
     228      IF( lrst_trc )  CALL p4z_rst( kt, Kbb, Kmm,  'WRITE' )           !* Write PISCES informations in restart file  
     229      ! 
     230 
     231      IF( lk_iomput .OR. ln_check_mass )  CALL p4z_chk_mass( kt, Kmm ) ! Mass conservation checking 
     232 
     233      IF( lwm .AND. kt == nittrc000    )  CALL FLUSH( numonp )         ! flush output namelist PISCES 
    173234      ! 
    174235      IF( ln_timing )  CALL timing_stop('p4z_sms') 
    … …  
    201262      ENDIF 
    202263 
    203       REWIND( numnatp_ref )              ! Namelist nampisbio in reference namelist : Pisces variables 
    204264      READ  ( numnatp_ref, nampisbio, IOSTAT = ios, ERR = 901) 
    205 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisbio in reference namelist', lwp ) 
    206       REWIND( numnatp_cfg )              ! Namelist nampisbio in configuration namelist : Pisces variables 
     265901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisbio in reference namelist' ) 
    207266      READ  ( numnatp_cfg, nampisbio, IOSTAT = ios, ERR = 902 ) 
    208 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisbio in configuration namelist', lwp ) 
     267902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisbio in configuration namelist' ) 
    209268      IF(lwm) WRITE( numonp, nampisbio ) 
    210269      ! 
    … …  
    232291 
    233292 
    234       REWIND( numnatp_ref )              ! Namelist nampisdmp in reference namelist : Pisces damping 
    235293      READ  ( numnatp_ref, nampisdmp, IOSTAT = ios, ERR = 905) 
    236 905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisdmp in reference namelist', lwp ) 
    237       REWIND( numnatp_cfg )              ! Namelist nampisdmp in configuration namelist : Pisces damping 
     294905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisdmp in reference namelist' ) 
    238295      READ  ( numnatp_cfg, nampisdmp, IOSTAT = ios, ERR = 906 ) 
    239 906   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisdmp in configuration namelist', lwp ) 
     296906   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisdmp in configuration namelist' ) 
    240297      IF(lwm) WRITE( numonp, nampisdmp ) 
    241298      ! 
    … …  
    247304      ENDIF 
    248305 
    249       REWIND( numnatp_ref )              ! Namelist nampismass in reference namelist : Pisces mass conservation check 
    250306      READ  ( numnatp_ref, nampismass, IOSTAT = ios, ERR = 907) 
    251 907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampismass in reference namelist', lwp ) 
    252       REWIND( numnatp_cfg )              ! Namelist nampismass in configuration namelist : Pisces mass conservation check  
     307907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampismass in reference namelist' ) 
    253308      READ  ( numnatp_cfg, nampismass, IOSTAT = ios, ERR = 908 ) 
    254 908   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampismass in configuration namelist', lwp ) 
     309908   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampismass in configuration namelist' ) 
    255310      IF(lwm) WRITE( numonp, nampismass ) 
    256311 
    … …  
    264319 
    265320 
    266    SUBROUTINE p4z_rst( kt, cdrw ) 
     321   SUBROUTINE p4z_rst( kt, Kbb, Kmm, cdrw ) 
    267322      !!--------------------------------------------------------------------- 
    268323      !!                   ***  ROUTINE p4z_rst  *** 
    … …  
    275330      !!--------------------------------------------------------------------- 
    276331      INTEGER         , INTENT(in) ::   kt         ! ocean time-step 
     332      INTEGER         , INTENT(in) ::   Kbb, Kmm   ! time level indices 
    277333      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
    278334      !!--------------------------------------------------------------------- 
    … …  
    285341         !  
    286342         IF( iom_varid( numrtr, 'PH', ldstop = .FALSE. ) > 0 ) THEN 
    287             CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:)  ) 
     343            CALL iom_get( numrtr, jpdom_auto, 'PH' , hi(:,:,:)  ) 
    288344         ELSE 
    289             CALL p4z_che                              ! initialize the chemical constants 
    290             CALL ahini_for_at(hi) 
    291          ENDIF 
    292          CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) ) 
     345            CALL p4z_che( Kbb, Kmm )                  ! initialize the chemical constants 
     346            CALL ahini_for_at( hi, Kbb ) 
     347         ENDIF 
     348         CALL iom_get( numrtr, jpdom_auto, 'Silicalim', xksi(:,:) ) 
    293349         IF( iom_varid( numrtr, 'Silicamax', ldstop = .FALSE. ) > 0 ) THEN 
    294             CALL iom_get( numrtr, jpdom_autoglo, 'Silicamax' , xksimax(:,:)  ) 
     350            CALL iom_get( numrtr, jpdom_auto, 'Silicamax' , xksimax(:,:)  ) 
    295351         ELSE 
    296352            xksimax(:,:) = xksi(:,:) 
    … …  
    305361         IF( ln_p5z ) THEN 
    306362            IF( iom_varid( numrtr, 'sized', ldstop = .FALSE. ) > 0 ) THEN 
    307                CALL iom_get( numrtr, jpdom_autoglo, 'sizep' , sizep(:,:,:)  ) 
    308                CALL iom_get( numrtr, jpdom_autoglo, 'sizen' , sizen(:,:,:)  ) 
    309                CALL iom_get( numrtr, jpdom_autoglo, 'sized' , sized(:,:,:)  ) 
     363               CALL iom_get( numrtr, jpdom_auto, 'sizep' , sizep(:,:,:)  ) 
     364               CALL iom_get( numrtr, jpdom_auto, 'sizen' , sizen(:,:,:)  ) 
     365               CALL iom_get( numrtr, jpdom_auto, 'sized' , sized(:,:,:)  ) 
    310366            ELSE 
    311367               sizep(:,:,:) = 1. 
    … …  
    335391 
    336392 
    337    SUBROUTINE p4z_dmp( kt ) 
     393   SUBROUTINE p4z_dmp( kt, Kbb, Kmm ) 
    338394      !!---------------------------------------------------------------------- 
    339395      !!                    ***  p4z_dmp  *** 
    … …  
    342398      !!---------------------------------------------------------------------- 
    343399      ! 
    344       INTEGER, INTENT( in )  ::     kt ! time step 
     400      INTEGER, INTENT( in )  ::     kt            ! time step 
     401      INTEGER, INTENT( in )  ::     Kbb, Kmm      ! time level indices 
    345402      ! 
    346403      REAL(wp) ::  alkmean = 2426.     ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) 
    … …  
    363420            zarea          = 1._wp / glob_sum( 'p4zsms', cvol(:,:,:) ) * 1e6               
    364421 
    365             zalksumn = glob_sum( 'p4zsms', trn(:,:,:,jptal) * cvol(:,:,:)  ) * zarea 
    366             zpo4sumn = glob_sum( 'p4zsms', trn(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r 
    367             zno3sumn = glob_sum( 'p4zsms', trn(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3 
    368             zsilsumn = glob_sum( 'p4zsms', trn(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea 
     422            zalksumn = glob_sum( 'p4zsms', tr(:,:,:,jptal,Kmm) * cvol(:,:,:)  ) * zarea 
     423            zpo4sumn = glob_sum( 'p4zsms', tr(:,:,:,jppo4,Kmm) * cvol(:,:,:)  ) * zarea * po4r 
     424            zno3sumn = glob_sum( 'p4zsms', tr(:,:,:,jpno3,Kmm) * cvol(:,:,:)  ) * zarea * rno3 
     425            zsilsumn = glob_sum( 'p4zsms', tr(:,:,:,jpsil,Kmm) * cvol(:,:,:)  ) * zarea 
    369426  
    370427            IF(lwp) WRITE(numout,*) '       TALKN mean : ', zalksumn 
    371             trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn 
     428            tr(:,:,:,jptal,Kmm) = tr(:,:,:,jptal,Kmm) * alkmean / zalksumn 
    372429 
    373430            IF(lwp) WRITE(numout,*) '       PO4N  mean : ', zpo4sumn 
    374             trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn 
     431            tr(:,:,:,jppo4,Kmm) = tr(:,:,:,jppo4,Kmm) * po4mean / zpo4sumn 
    375432 
    376433            IF(lwp) WRITE(numout,*) '       NO3N  mean : ', zno3sumn 
    377             trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn 
     434            tr(:,:,:,jpno3,Kmm) = tr(:,:,:,jpno3,Kmm) * no3mean / zno3sumn 
    378435 
    379436            IF(lwp) WRITE(numout,*) '       SiO3N mean : ', zsilsumn 
    380             trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn ) 
     437            tr(:,:,:,jpsil,Kmm) = MIN( 400.e-6,tr(:,:,:,jpsil,Kmm) * silmean / zsilsumn ) 
    381438            ! 
    382439            ! 
    383440            IF( .NOT. ln_top_euler ) THEN 
    384                zalksumb = glob_sum( 'p4zsms', trb(:,:,:,jptal) * cvol(:,:,:)  ) * zarea 
    385                zpo4sumb = glob_sum( 'p4zsms', trb(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r 
    386                zno3sumb = glob_sum( 'p4zsms', trb(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3 
    387                zsilsumb = glob_sum( 'p4zsms', trb(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea 
     441               zalksumb = glob_sum( 'p4zsms', tr(:,:,:,jptal,Kbb) * cvol(:,:,:)  ) * zarea 
     442               zpo4sumb = glob_sum( 'p4zsms', tr(:,:,:,jppo4,Kbb) * cvol(:,:,:)  ) * zarea * po4r 
     443               zno3sumb = glob_sum( 'p4zsms', tr(:,:,:,jpno3,Kbb) * cvol(:,:,:)  ) * zarea * rno3 
     444               zsilsumb = glob_sum( 'p4zsms', tr(:,:,:,jpsil,Kbb) * cvol(:,:,:)  ) * zarea 
    388445  
    389446               IF(lwp) WRITE(numout,*) ' ' 
    390447               IF(lwp) WRITE(numout,*) '       TALKB mean : ', zalksumb 
    391                trb(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb 
     448               tr(:,:,:,jptal,Kbb) = tr(:,:,:,jptal,Kbb) * alkmean / zalksumb 
    392449 
    393450               IF(lwp) WRITE(numout,*) '       PO4B  mean : ', zpo4sumb 
    394                trb(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb 
     451               tr(:,:,:,jppo4,Kbb) = tr(:,:,:,jppo4,Kbb) * po4mean / zpo4sumb 
    395452 
    396453               IF(lwp) WRITE(numout,*) '       NO3B  mean : ', zno3sumb 
    397                trb(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb 
     454               tr(:,:,:,jpno3,Kbb) = tr(:,:,:,jpno3,Kbb) * no3mean / zno3sumb 
    398455 
    399456               IF(lwp) WRITE(numout,*) '       SiO3B mean : ', zsilsumb 
    400                trb(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb ) 
     457               tr(:,:,:,jpsil,Kbb) = MIN( 400.e-6,tr(:,:,:,jpsil,Kbb) * silmean / zsilsumb ) 
    401458           ENDIF 
    402459        ENDIF 
    … …  
    407464 
    408465 
    409    SUBROUTINE p4z_chk_mass( kt ) 
     466   SUBROUTINE p4z_chk_mass( kt, Kmm ) 
    410467      !!---------------------------------------------------------------------- 
    411468      !!                  ***  ROUTINE p4z_chk_mass  *** 
    … …  
    415472      !!--------------------------------------------------------------------- 
    416473      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     474      INTEGER, INTENT( in ) ::   Kmm     ! time level indices 
    417475      REAL(wp)             ::  zrdenittot, zsdenittot, znitrpottot 
    418476      CHARACTER(LEN=100)   ::   cltxt 
    … …  
    438496         !   Compute the budget of NO3, ALK, Si, Fer 
    439497         IF( ln_p4z ) THEN 
    440             zwork(:,:,:) =    trn(:,:,:,jpno3) + trn(:,:,:,jpnh4)                      & 
    441                &          +   trn(:,:,:,jpphy) + trn(:,:,:,jpdia)                      & 
    442                &          +   trn(:,:,:,jppoc) + trn(:,:,:,jpgoc)  + trn(:,:,:,jpdoc)  &         
    443                &          +   trn(:,:,:,jpzoo) + trn(:,:,:,jpmes)  
     498            zwork(:,:,:) =    tr(:,:,:,jpno3,Kmm) + tr(:,:,:,jpnh4,Kmm)                      & 
     499               &          +   tr(:,:,:,jpphy,Kmm) + tr(:,:,:,jpdia,Kmm)                      & 
     500               &          +   tr(:,:,:,jppoc,Kmm) + tr(:,:,:,jpgoc,Kmm)  + tr(:,:,:,jpdoc,Kmm)  &         
     501               &          +   tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm)  
    444502        ELSE 
    445             zwork(:,:,:) =    trn(:,:,:,jpno3) + trn(:,:,:,jpnh4) + trn(:,:,:,jpnph)   & 
    446                &          +   trn(:,:,:,jpndi) + trn(:,:,:,jpnpi)                      &  
    447                &          +   trn(:,:,:,jppon) + trn(:,:,:,jpgon) + trn(:,:,:,jpdon)   & 
    448                &          + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * no3rat3  
     503            zwork(:,:,:) =    tr(:,:,:,jpno3,Kmm) + tr(:,:,:,jpnh4,Kmm) + tr(:,:,:,jpnph,Kmm)   & 
     504               &          +   tr(:,:,:,jpndi,Kmm) + tr(:,:,:,jpnpi,Kmm)                      &  
     505               &          +   tr(:,:,:,jppon,Kmm) + tr(:,:,:,jpgon,Kmm) + tr(:,:,:,jpdon,Kmm)   & 
     506               &          + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * no3rat3  
    449507        ENDIF 
    450508        ! 
    … …  
    456514      IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
    457515         IF( ln_p4z ) THEN 
    458             zwork(:,:,:) =    trn(:,:,:,jppo4)                                         & 
    459                &          +   trn(:,:,:,jpphy) + trn(:,:,:,jpdia)                      & 
    460                &          +   trn(:,:,:,jppoc) + trn(:,:,:,jpgoc)  + trn(:,:,:,jpdoc)  &         
    461                &          +   trn(:,:,:,jpzoo) + trn(:,:,:,jpmes)  
     516            zwork(:,:,:) =    tr(:,:,:,jppo4,Kmm)                                         & 
     517               &          +   tr(:,:,:,jpphy,Kmm) + tr(:,:,:,jpdia,Kmm)                      & 
     518               &          +   tr(:,:,:,jppoc,Kmm) + tr(:,:,:,jpgoc,Kmm)  + tr(:,:,:,jpdoc,Kmm)  &         
     519               &          +   tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm)  
    462520        ELSE 
    463             zwork(:,:,:) =    trn(:,:,:,jppo4) + trn(:,:,:,jppph)                      & 
    464                &          +   trn(:,:,:,jppdi) + trn(:,:,:,jpppi)                      &  
    465                &          +   trn(:,:,:,jppop) + trn(:,:,:,jpgop) + trn(:,:,:,jpdop)   & 
    466                &          + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * po4rat3  
     521            zwork(:,:,:) =    tr(:,:,:,jppo4,Kmm) + tr(:,:,:,jppph,Kmm)                      & 
     522               &          +   tr(:,:,:,jppdi,Kmm) + tr(:,:,:,jpppi,Kmm)                      &  
     523               &          +   tr(:,:,:,jppop,Kmm) + tr(:,:,:,jpgop,Kmm) + tr(:,:,:,jpdop,Kmm)   & 
     524               &          + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * po4rat3  
    467525        ENDIF 
    468526        ! 
    … …  
    473531      ! 
    474532      IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
    475          zwork(:,:,:) =  trn(:,:,:,jpsil) + trn(:,:,:,jpgsi) + trn(:,:,:,jpdsi)  
     533         zwork(:,:,:) =  tr(:,:,:,jpsil,Kmm) + tr(:,:,:,jpgsi,Kmm) + tr(:,:,:,jpdsi,Kmm)  
    476534         ! 
    477535         silbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:)  )   
    … …  
    481539      ! 
    482540      IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
    483          zwork(:,:,:) =  trn(:,:,:,jpno3) * rno3 + trn(:,:,:,jptal) + trn(:,:,:,jpcal) * 2.               
     541         zwork(:,:,:) =  tr(:,:,:,jpno3,Kmm) * rno3 + tr(:,:,:,jptal,Kmm) + tr(:,:,:,jpcal,Kmm) * 2.               
    484542         ! 
    485543         alkbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:)  )         ! 
    … …  
    489547      ! 
    490548      IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
    491          zwork(:,:,:) =   trn(:,:,:,jpfer) + trn(:,:,:,jpnfe) + trn(:,:,:,jpdfe)   & 
    492             &         +   trn(:,:,:,jpbfe) + trn(:,:,:,jpsfe)                      & 
    493             &         + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) )  * ferat3     
     549         zwork(:,:,:) =   tr(:,:,:,jpfer,Kmm) + tr(:,:,:,jpnfe,Kmm) + tr(:,:,:,jpdfe,Kmm)   & 
     550            &         +   tr(:,:,:,jpbfe,Kmm) + tr(:,:,:,jpsfe,Kmm)                      & 
     551            &         + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) )  * ferat3     
    494552         ! 
    495553         ferbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:)  )   

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p5zlim.F90

    r10425 r13463  
    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( 1, 1, 1, 1, 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) + rtrn ) 
     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( 1, 1, 1, 1, 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( 1, 1, 1, 1, 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( 1, 1, 1, 1, 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 
    408         IF( iom_use( "xfracal" ) ) CALL iom_put( "xfracal", xfracal(:,:,:) * tmask(:,:,:) )  ! euphotic layer deptht 
    409         IF( iom_use( "LNnut"   ) ) CALL iom_put( "LNnut"  , xlimphy(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term 
    410         IF( iom_use( "LPnut"   ) ) CALL iom_put( "LPnut"  , xlimpic(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term 
    411         IF( iom_use( "LDnut"   ) ) CALL iom_put( "LDnut"  , xlimdia(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term 
    412         IF( iom_use( "LNFe"    ) ) CALL iom_put( "LNFe"   , xlimnfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term 
    413         IF( iom_use( "LPFe"    ) ) CALL iom_put( "LPFe"   , xlimpfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term 
    414         IF( iom_use( "LDFe"    ) ) CALL iom_put( "LDFe"   , xlimdfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term 
    415         IF( iom_use( "SIZEN"   ) ) CALL iom_put( "SIZEN"  , sizen(:,:,:) * tmask(:,:,:) )  ! Iron limitation term 
    416         IF( iom_use( "SIZEP"   ) ) CALL iom_put( "SIZEP"  , sizep(:,:,:) * tmask(:,:,:) )  ! Iron limitation term 
    417         IF( iom_use( "SIZED"   ) ) CALL iom_put( "SIZED"  , sized(:,:,:) * tmask(:,:,:) )  ! Iron limitation term 
     395        CALL iom_put( "xfracal", xfracal(:,:,:) * tmask(:,:,:) )  ! euphotic layer deptht 
     396        CALL iom_put( "LNnut"  , xlimphy(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term 
     397        CALL iom_put( "LPnut"  , xlimpic(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term 
     398        CALL iom_put( "LDnut"  , xlimdia(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term 
     399        CALL iom_put( "LNFe"   , xlimnfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term 
     400        CALL iom_put( "LPFe"   , xlimpfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term 
     401        CALL iom_put( "LDFe"   , xlimdfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term 
     402        CALL iom_put( "SIZEN"  , sizen  (:,:,:) * tmask(:,:,:) )  ! Iron limitation term 
     403        CALL iom_put( "SIZEP"  , sizep  (:,:,:) * tmask(:,:,:) )  ! Iron limitation term 
     404        CALL iom_put( "SIZED"  , sized  (:,:,:) * tmask(:,:,:) )  ! Iron limitation term 
    418405      ENDIF 
    419406      ! 
    … …  
    448435      !!---------------------------------------------------------------------- 
    449436      ! 
    450       REWIND( numnatp_ref )              ! Namelist nampislim in reference namelist : Pisces nutrient limitation parameters 
    451437      READ  ( numnatp_ref, namp5zlim, IOSTAT = ios, ERR = 901) 
    452 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampislim in reference namelist', lwp ) 
    453       ! 
    454       REWIND( numnatp_cfg )              ! Namelist nampislim in configuration namelist : Pisces nutrient limitation parameters  
     438901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampislim in reference namelist' ) 
     439      ! 
    455440      READ  ( numnatp_cfg, namp5zlim, IOSTAT = ios, ERR = 902 ) 
    456 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'nampislim in configuration namelist', lwp ) 
     441902   IF( ios >  0 ) CALL ctl_nam ( ios , 'nampislim in configuration namelist' ) 
    457442      IF(lwm) WRITE ( numonp, namp5zlim ) 
    458443      ! 
    … …  
    489474      ENDIF 
    490475 
    491       REWIND( numnatp_ref )              ! Namelist nampislim in reference namelist : Pisces nutrient limitation parameters 
    492476      READ  ( numnatp_ref, namp5zquota, IOSTAT = ios, ERR = 903) 
    493 903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisquota in reference namelist', lwp ) 
    494       ! 
    495       REWIND( numnatp_cfg )              ! Namelist nampislim in configuration namelist : Pisces nutrient limitation parameters  
     477903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisquota in reference namelist' ) 
     478      ! 
    496479      READ  ( numnatp_cfg, namp5zquota, IOSTAT = ios, ERR = 904 ) 
    497 904   IF( ios >  0 ) CALL ctl_nam ( ios , 'nampisquota in configuration namelist', lwp ) 
     480904   IF( ios >  0 ) CALL ctl_nam ( ios , 'nampisquota in configuration namelist' ) 
    498481      IF(lwm) WRITE ( numonp, namp5zquota ) 
    499482      ! 
    … …  
    526509      zpsiuptk = 2.3 * rno3 
    527510      ! 
    528       nitrfac (:,:,:) = 0._wp 
     511      nitrfac(:,:,jpk) = 0._wp 
     512      xfracal(:,:,jpk) = 0._wp 
     513      xlimphy(:,:,jpk) = 0._wp 
     514      xlimpic(:,:,jpk) = 0._wp 
     515      xlimdia(:,:,jpk) = 0._wp 
     516      xlimnfe(:,:,jpk) = 0._wp 
     517      xlimpfe(:,:,jpk) = 0._wp 
     518      xlimdfe(:,:,jpk) = 0._wp 
     519      sizen  (:,:,jpk) = 0._wp 
     520      sizep  (:,:,jpk) = 0._wp 
     521      sized  (:,:,jpk) = 0._wp 
    529522      ! 
    530523   END SUBROUTINE p5z_lim_init 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p5zmeso.F90

    r10362 r13463  
    1515   USE trc             !  passive tracers common variables  
    1616   USE sms_pisces      !  PISCES Source Minus Sink variables 
    17    USE prtctl_trc      !  print control for debugging 
     17   USE prtctl          !  print control for debugging 
    1818   USE iom             !  I/O manager 
    1919 
    … …  
    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) :: zgrazing, zfezoo2 
    89       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d, zz2ligprod 
     91      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo2,  zz2ligprod 
    9092 
    9193      !!--------------------------------------------------------------------- 
    … …  
    9395      IF( ln_timing )   CALL timing_start('p5z_meso') 
    9496      ! 
    95  
    96       zgrazing(:,:,:) = 0._wp 
    97       zfezoo2 (:,:,:) = 0._wp 
    98       ! 
    99       IF (ln_ligand) THEN 
    100          ALLOCATE( zz2ligprod(jpi,jpj,jpk) ) 
    101          zz2ligprod(:,:,:) = 0._wp 
    102       ENDIF 
    103  
    10497      zmetexcess = 0.0 
    10598      IF ( bmetexc2 ) zmetexcess = 1.0 
    10699 
    107       DO jk = 1, jpkm1 
    108          DO jj = 1, jpj 
    109             DO ji = 1, jpi 
    110                zcompam   = MAX( ( trb(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 ) 
    111                zfact     = xstep * tgfunc2(ji,jj,jk) * zcompam 
    112  
    113                !   Michaelis-Menten mortality rates of mesozooplankton 
    114                !   --------------------------------------------------- 
    115                zrespz   = resrat2 * zfact * ( trb(ji,jj,jk,jpmes) / ( xkmort + trb(ji,jj,jk,jpmes) )  & 
    116                &          + 3. * nitrfac(ji,jj,jk) ) 
    117  
    118                !   Zooplankton mortality. A square function has been selected with 
    119                !   no real reason except that it seems to be more stable and may mimic predation 
    120                !   --------------------------------------------------------------- 
    121                ztortz   = mzrat2 * 1.e6 * zfact * trb(ji,jj,jk,jpmes) * (1. - nitrfac(ji,jj,jk)) 
    122  
    123                !   Computation of the abundance of the preys 
    124                !   A threshold can be specified in the namelist 
    125                !   -------------------------------------------- 
    126                zcompadi  = MAX( ( trb(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 ) 
    127                zcompaz   = MAX( ( trb(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 ) 
    128                zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) 
    129                zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 ) 
    130                zcompames = MAX( ( trb(ji,jj,jk,jpmes) - xthresh2mes ), 0.e0 ) 
    131  
    132                !   Mesozooplankton grazing 
    133                !   ------------------------ 
    134                zfood     = xpref2d * zcompadi + xpref2z * zcompaz + xpref2n * zcompaph + xpref2c * zcompapoc   & 
    135                &           + xpref2m * zcompames  
    136                zfoodlim  = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) ) 
    137                zdenom    = zfoodlim / ( xkgraz2 + zfoodlim ) 
    138                zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes) * (1. - nitrfac(ji,jj,jk))  
    139  
    140                !   An active switching parameterization is used here. 
    141                !   We don't use the KTW parameterization proposed by  
    142                !   Vallina et al. because it tends to produce to steady biomass 
    143                !   composition and the variance of Chl is too low as it grazes 
    144                !   too strongly on winning organisms. Thus, instead of a square 
    145                !   a 1.5 power value is used which decreases the pressure on the 
    146                !   most abundant species 
    147                !   ------------------------------------------------------------   
    148                ztmp1 = xpref2n * zcompaph**1.5 
    149                ztmp2 = xpref2m * zcompames**1.5 
    150                ztmp3 = xpref2c * zcompapoc**1.5 
    151                ztmp4 = xpref2d * zcompadi**1.5 
    152                ztmp5 = xpref2z * zcompaz**1.5 
    153                ztmptot = ztmp1 + ztmp2 + ztmp3 + ztmp4 + ztmp5 + rtrn 
    154                ztmp1 = ztmp1 / ztmptot 
    155                ztmp2 = ztmp2 / ztmptot 
    156                ztmp3 = ztmp3 / ztmptot 
    157                ztmp4 = ztmp4 / ztmptot 
    158                ztmp5 = ztmp5 / ztmptot 
    159  
    160                !   Mesozooplankton regular grazing on the different preys 
    161                !   ------------------------------------------------------ 
    162                zgrazdc   = zgraze2 * ztmp4 * zdenom 
    163                zgrazdn   = zgrazdc * trb(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn) 
    164                zgrazdp   = zgrazdc * trb(ji,jj,jk,jppdi) / ( trb(ji,jj,jk,jpdia) + rtrn) 
    165                zgrazdf   = zgrazdc * trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn) 
    166                zgrazz    = zgraze2 * ztmp5 * zdenom 
    167                zgrazm    = zgraze2 * ztmp2 * zdenom 
    168                zgraznc   = zgraze2 * ztmp1 * zdenom 
    169                zgraznn   = zgraznc * trb(ji,jj,jk,jpnph) / ( trb(ji,jj,jk,jpphy) + rtrn) 
    170                zgraznp   = zgraznc * trb(ji,jj,jk,jppph) / ( trb(ji,jj,jk,jpphy) + rtrn) 
    171                zgraznf   = zgraznc * trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn) 
    172                zgrazpoc  = zgraze2 * ztmp3 * zdenom 
    173                zgrazpon  = zgrazpoc * trb(ji,jj,jk,jppon) / ( trb(ji,jj,jk,jppoc) + rtrn) 
    174                zgrazpop  = zgrazpoc * trb(ji,jj,jk,jppop) / ( trb(ji,jj,jk,jppoc) + rtrn) 
    175                zgrazpof  = zgrazpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn) 
    176  
    177                !   Mesozooplankton flux feeding on GOC 
    178                !   ---------------------------------- 
    179                zgrazffeg = grazflux  * xstep * wsbio4(ji,jj,jk)      & 
    180                &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)  & 
    181                &           * (1. - nitrfac(ji,jj,jk)) 
    182                zgrazfffg = zgrazffeg * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn) 
    183                zgrazffng = zgrazffeg * trb(ji,jj,jk,jpgon) / (trb(ji,jj,jk,jpgoc) + rtrn) 
    184                zgrazffpg = zgrazffeg * trb(ji,jj,jk,jpgop) / (trb(ji,jj,jk,jpgoc) + rtrn) 
    185                zgrazffep = grazflux  * xstep *  wsbio3(ji,jj,jk)     & 
    186                &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpmes)   & 
    187                &           * (1. - nitrfac(ji,jj,jk)) 
    188                zgrazfffp = zgrazffep * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn) 
    189                zgrazffnp = zgrazffep * trb(ji,jj,jk,jppon) / (trb(ji,jj,jk,jppoc) + rtrn) 
    190                zgrazffpp = zgrazffep * trb(ji,jj,jk,jppop) / (trb(ji,jj,jk,jppoc) + rtrn) 
    191                ! 
    192                zgraztotc  = zgrazdc + zgrazz + zgraznc + zgrazm + zgrazpoc + zgrazffep + zgrazffeg 
    193  
    194                !   Compute the proportion of filter feeders 
    195                !   ----------------------------------------   
    196                zproport  = (zgrazffep + zgrazffeg)/(rtrn + zgraztotc) 
    197  
    198                !   Compute fractionation of aggregates. It is assumed that  
    199                !   diatoms based aggregates are more prone to fractionation 
    200                !   since they are more porous (marine snow instead of fecal pellets) 
    201                !   ---------------------------------------------------------------- 
    202                zratio    = trb(ji,jj,jk,jpgsi) / ( trb(ji,jj,jk,jpgoc) + rtrn ) 
    203                zratio2   = zratio * zratio 
    204                zfracc    = zproport * grazflux  * xstep * wsbio4(ji,jj,jk)      & 
    205                &          * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)          & 
    206                &          * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) ) 
    207                zfracfe   = zfracc * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn) 
    208                zfracn    = zfracc * trb(ji,jj,jk,jpgon) / (trb(ji,jj,jk,jpgoc) + rtrn) 
    209                zfracp    = zfracc * trb(ji,jj,jk,jpgop) / (trb(ji,jj,jk,jpgoc) + rtrn) 
    210  
    211                zgrazffep = zproport * zgrazffep   ;   zgrazffeg = zproport * zgrazffeg 
    212                zgrazfffp = zproport * zgrazfffp   ;   zgrazfffg = zproport * zgrazfffg 
    213                zgrazffnp = zproport * zgrazffnp   ;   zgrazffng = zproport * zgrazffng 
    214                zgrazffpp = zproport * zgrazffpp   ;   zgrazffpg = zproport * zgrazffpg 
    215  
    216                zgraztotc  = zgrazdc + zgrazz + zgraznc + zgrazm + zgrazpoc + zgrazffep + zgrazffeg 
    217                zgraztotf  = zgrazdf + zgraznf + ( zgrazz + zgrazm ) * ferat3 + zgrazpof & 
    218                &            + zgrazfffp + zgrazfffg 
    219                zgraztotn  = zgrazdn + (zgrazm + zgrazz) * no3rat3 + zgraznn + zgrazpon  & 
    220                &            + zgrazffnp + zgrazffng 
    221                zgraztotp  = zgrazdp + (zgrazz + zgrazm) * po4rat3 + zgraznp + zgrazpop  & 
    222                &            + zgrazffpp + zgrazffpg 
    223  
    224  
    225                ! Total grazing ( grazing by microzoo is already computed in p5zmicro ) 
    226                zgrazing(ji,jj,jk) = zgraztotc 
    227  
    228                !   Stoichiometruc ratios of the food ingested by zooplanton  
    229                !   -------------------------------------------------------- 
    230                zgrasratf  =  (zgraztotf + rtrn) / ( zgraztotc + rtrn ) 
    231                zgrasratn  =  (zgraztotn + rtrn) / ( zgraztotc + rtrn ) 
    232                zgrasratp  =  (zgraztotp + rtrn) / ( zgraztotc + rtrn ) 
    233  
    234                !   Growth efficiency is made a function of the quality  
    235                !   and the quantity of the preys 
    236                !   --------------------------------------------------- 
    237                zepshert  = MIN( 1., zgrasratn/ no3rat3, zgrasratp/ po4rat3, zgrasratf / ferat3) 
    238                zbeta     = MAX(0., (epsher2 - epsher2min) ) 
    239                zepsherf  = epsher2min + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 
    240                zepsherv  = zepsherf * zepshert 
    241  
    242                !   Respiration of mesozooplankton 
    243                !   Excess carbon in the food is used preferentially 
    244                !   ----------------  ------------------------------ 
    245                zexcess  = zgraztotc * zepsherf * (1.0 - zepshert) * zmetexcess  
    246                zbasresb = MAX(0., zrespz - zexcess) 
    247                zbasresi = zexcess + MIN(0., zrespz - zexcess) 
    248                zrespirc = srespir2 * zepsherv * zgraztotc + zbasresb 
    249  
    250                !   When excess carbon is used, the other elements in excess 
    251                !   are also used proportionally to their abundance 
    252                !   -------------------------------------------------------- 
    253                zexcess  = ( zgrasratn/ no3rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 
    254                zbasresn = zbasresi * zexcess * zgrasratn 
    255                zexcess  = ( zgrasratp/ po4rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 
    256                zbasresp = zbasresi * zexcess * zgrasratp 
    257                zexcess  = ( zgrasratf/ ferat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 
    258                zbasresf = zbasresi * zexcess * zgrasratf 
    259  
    260                !   Voiding of the excessive elements as organic matter 
    261                !   -------------------------------------------------------- 
    262                zgradoct = (1. - unass2c - zepsherv) * zgraztotc - zbasresi 
    263                zgradont = (1. - unass2n) * zgraztotn - zepsherv * no3rat3 * zgraztotc - zbasresn 
    264                zgradopt = (1. - unass2p) * zgraztotp - zepsherv * po4rat3 * zgraztotc - zbasresp 
    265                zgrareft = (1. - unass2c) * zgraztotf - zepsherv * ferat3 * zgraztotc - zbasresf 
    266                ztmp1   = ( 1. - epsher2 - unass2c ) /( 1. - 0.8 * epsher2 ) * ztortz 
    267                zgradoc = (zgradoct + ztmp1) * ssigma2 
    268                zgradon = (zgradont + no3rat3 * ztmp1) * ssigma2 
    269                zgradop = (zgradopt + po4rat3 * ztmp1) * ssigma2 
    270                zgratmp = 0.2 * epsher2 /( 1. - 0.8 * epsher2 ) * ztortz 
    271  
    272                !  Since only semilabile DOM is represented in PISCES 
    273                !  part of DOM is in fact labile and is then released 
    274                !  as dissolved inorganic compounds (ssigma2) 
    275                !  -------------------------------------------------- 
    276                zgrarem = zgratmp + ( zgradoct + ztmp1 ) * (1.0 - ssigma2) 
    277                zgraren = no3rat3 * zgratmp + ( zgradont + no3rat3 * ztmp1 ) * (1.0 - ssigma2) 
    278                zgrarep = po4rat3 * zgratmp + ( zgradopt + po4rat3 * ztmp1 ) * (1.0 - ssigma2) 
    279                zgraref = zgrareft + ferat3 * ( ztmp1 + zgratmp ) 
    280  
    281                !   Defecation as a result of non assimilated products 
    282                !   -------------------------------------------------- 
    283                zgrapoc  = zgraztotc * unass2c + unass2c / ( 1. - 0.8 * epsher2 ) * ztortz 
    284                zgrapon  = zgraztotn * unass2n + no3rat3 * unass2n / ( 1. - 0.8 * epsher2 ) * ztortz 
    285                zgrapop  = zgraztotp * unass2p + po4rat3 * unass2p / ( 1. - 0.8 * epsher2 ) * ztortz 
    286                zgrapof  = zgraztotf * unass2c + ferat3  * unass2c / ( 1. - 0.8 * epsher2 ) * ztortz 
    287  
    288                !  Addition of respiration to the release of inorganic nutrients 
    289                !  ------------------------------------------------------------- 
    290                zgrarem = zgrarem + zbasresi + zrespirc 
    291                zgraren = zgraren + zbasresn + zrespirc * no3rat3 
    292                zgrarep = zgrarep + zbasresp + zrespirc * po4rat3 
    293                zgraref = zgraref + zbasresf + zrespirc * ferat3 
    294  
    295                !   Update the arrays TRA which contain the biological sources and 
    296                !   sinks 
    297                !   -------------------------------------------------------------- 
    298                tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarep  
    299                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgraren 
    300                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgradoc 
    301                ! 
    302                IF( ln_ligand ) THEN 
    303                   tra(ji,jj,jk,jplgw)  = tra(ji,jj,jk,jplgw) + zgradoc * ldocz 
    304                   zz2ligprod(ji,jj,jk) = zgradoc * ldocz 
    305                ENDIF 
    306                ! 
    307                tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zgradon 
    308                tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zgradop 
    309                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem 
    310                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgraref 
    311                zfezoo2(ji,jj,jk)   = zgraref 
    312                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem 
    313                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgraren 
    314                tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) + zepsherv * zgraztotc - zrespirc   & 
    315                &                     - ztortz - zgrazm 
    316                tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazdc 
    317                tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) - zgrazdn 
    318                tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) - zgrazdp 
    319                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazdf 
    320                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz 
    321                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgraznc 
    322                tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) - zgraznn 
    323                tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) - zgraznp 
    324                tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf 
    325                tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgraznc * trb(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpphy) + rtrn ) 
    326                tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazdc * trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    327                tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazdc * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    328                tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazdc * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    329  
    330                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc - zgrazffep + zfracc 
    331                prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfracc 
    332                conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep 
    333                tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) - zgrazpon - zgrazffnp + zfracn 
    334                tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) - zgrazpop - zgrazffpp + zfracp 
    335                tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zgrazffeg + zgrapoc - zfracc 
    336                prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zgrapoc 
    337                consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfracc 
    338                tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) - zgrazffng + zgrapon - zfracn 
    339                tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) - zgrazffpg + zgrapop - zfracp 
    340                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof - zgrazfffp + zfracfe 
    341                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zgrazfffg + zgrapof - zfracfe 
    342                zfracal = trb(ji,jj,jk,jpcal) / ( trb(ji,jj,jk,jpgoc) + rtrn ) 
    343                zgrazcal = zgrazffeg * (1. - part2) * zfracal 
    344  
    345                !  calcite production 
    346                !  ------------------ 
    347                zprcaca = xfracal(ji,jj,jk) * zgraznc 
    348                prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    349                zprcaca = part2 * zprcaca 
    350                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrazcal - zprcaca 
    351                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * ( zgrazcal - zprcaca ) 
    352                tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) - zgrazcal + zprcaca 
    353             END DO 
    354          END DO 
    355       END DO 
     100      DO_3D( 1, 1, 1, 1, 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 
    356345      ! 
    357346      IF( lk_iomput .AND. knt == nrdttrc ) THEN 
    358          ALLOCATE( zw3d(jpi,jpj,jpk) ) 
    359          IF( iom_use( "GRAZ2" ) ) THEN 
    360             zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)  !   Total grazing of phyto by zooplankton 
    361             CALL iom_put( "GRAZ2", zw3d ) 
     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(:,:,:) )  
    362350         ENDIF 
    363          IF( iom_use( "PCAL" ) ) THEN 
    364             zw3d(:,:,:) = prodcal(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)   !  Calcite production 
    365             CALL iom_put( "PCAL", zw3d ) 
     351         IF( iom_use("FEZOO2") ) THEN   
     352           zfezoo2 (:,:,jpk) = 0._wp ; CALL iom_put( "FEZOO2", zfezoo2(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) ) 
    366353         ENDIF 
    367          IF( iom_use( "FEZOO2" ) ) THEN 
    368             zw3d(:,:,:) = zfezoo2(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:)   ! 
    369             CALL iom_put( "FEZOO2", zw3d ) 
     354         IF( ln_ligand ) THEN 
     355            zz2ligprod(:,:,jpk) = 0._wp ; CALL iom_put( "LPRODZ2", zz2ligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:)  ) 
    370356         ENDIF 
    371          IF( iom_use( "LPRODZ2" ) .AND. ln_ligand )  THEN 
    372             zw3d(:,:,:) = zz2ligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) 
    373             CALL iom_put( "LPRODZ2"  , zw3d ) 
    374          ENDIF 
    375          DEALLOCATE( zw3d ) 
    376357      ENDIF 
    377358      ! 
    378       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     359      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    379360        WRITE(charout, FMT="('meso')") 
    380         CALL prt_ctl_trc_info(charout) 
    381         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     361        CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     362        CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    382363      ENDIF 
    383364      ! 
    … …  
    407388      !!---------------------------------------------------------------------- 
    408389      ! 
    409       REWIND( numnatp_ref )              ! Namelist nampismes in reference namelist : Pisces mesozooplankton 
    410390      READ  ( numnatp_ref, namp5zmes, IOSTAT = ios, ERR = 901) 
    411 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismes in reference namelist', lwp ) 
    412       ! 
    413       REWIND( numnatp_cfg )              ! Namelist nampismes in configuration namelist : Pisces mesozooplankton 
     391901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismes in reference namelist' ) 
     392      ! 
    414393      READ  ( numnatp_cfg, namp5zmes, IOSTAT = ios, ERR = 902 ) 
    415 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'nampismes in configuration namelist', lwp ) 
     394902   IF( ios >  0 ) CALL ctl_nam ( ios , 'nampismes in configuration namelist' ) 
    416395      IF(lwm) WRITE ( numonp, namp5zmes ) 
    417396      ! 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p5zmicro.F90

    r10362 r13463  
    1818   USE p5zlim          !  Phytoplankton limitation terms 
    1919   USE iom             !  I/O manager 
    20    USE prtctl_trc      !  print control for debugging 
     20   USE prtctl          !  print control for debugging 
    2121 
    2222   IMPLICIT NONE 
    … …  
    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 
    … …  
    8487      REAL(wp) :: zgrazdc, zgrazdn, zgrazdp, zgrazdf, zgraznf, zgrazz 
    8588      REAL(wp) :: zgrazpc, zgrazpn, zgrazpp, zgrazpf, zbeta, zrfact2, zmetexcess 
    86       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo 
    87       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d, zzligprod 
     89      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo, zzligprod 
    8890      CHARACTER (len=25) :: charout 
    8991      !!--------------------------------------------------------------------- 
    … …  
    9193      IF( ln_timing )   CALL timing_start('p5z_micro') 
    9294      ! 
    93       IF (ln_ligand) THEN 
    94          ALLOCATE( zzligprod(jpi,jpj,jpk) ) 
    95          zzligprod(:,:,:) = 0._wp 
    96       ENDIF 
    97       ! 
    9895      zmetexcess = 0.0 
    9996      IF ( bmetexc ) zmetexcess = 1.0 
    10097      ! 
    101       DO jk = 1, jpkm1 
    102          DO jj = 1, jpj 
    103             DO ji = 1, jpi 
    104                zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 ) 
    105                zfact   = xstep * tgfunc2(ji,jj,jk) * zcompaz 
    106  
    107                !   Michaelis-Menten mortality rates of microzooplankton 
    108                !   ----------------------------------------------------- 
    109                zrespz = resrat * zfact * ( trb(ji,jj,jk,jpzoo) / ( xkmort + trb(ji,jj,jk,jpzoo) )  & 
    110                &        + 3. * nitrfac(ji,jj,jk) ) 
    111  
    112                !   Zooplankton mortality. A square function has been selected with 
    113                !   no real reason except that it seems to be more stable and may mimic predation. 
    114                !   ------------------------------------------------------------------------------ 
    115                ztortz = mzrat * 1.e6 * zfact * trb(ji,jj,jk,jpzoo) * (1. - nitrfac(ji,jj,jk)) 
    116  
    117                !   Computation of the abundance of the preys 
    118                !   A threshold can be specified in the namelist 
    119                !   -------------------------------------------- 
    120                zcompadi  = MIN( MAX( ( trb(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia ) 
    121                zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 ) 
    122                zcompaz   = MAX( ( trb(ji,jj,jk,jpzoo) - xthreshzoo ), 0.e0 ) 
    123                zcompapi  = MAX( ( trb(ji,jj,jk,jppic) - xthreshpic ), 0.e0 ) 
    124                zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 ) 
    125                 
    126                !   Microzooplankton grazing 
    127                !   ------------------------ 
    128                zfood     = xprefn * zcompaph + xprefc * zcompapoc + xprefd * zcompadi   & 
    129                &           + xprefz * zcompaz + xprefp * zcompapi 
    130                zfoodlim  = MAX( 0. , zfood - min(xthresh,0.5*zfood) ) 
    131                zdenom    = zfoodlim / ( xkgraz + zfoodlim ) 
    132                zgraze    = grazrat * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpzoo) * (1. - nitrfac(ji,jj,jk))  
    133  
    134                !   An active switching parameterization is used here. 
    135                !   We don't use the KTW parameterization proposed by  
    136                !   Vallina et al. because it tends to produce to steady biomass 
    137                !   composition and the variance of Chl is too low as it grazes 
    138                !   too strongly on winning organisms. Thus, instead of a square 
    139                !   a 1.5 power value is used which decreases the pressure on the 
    140                !   most abundant species 
    141                !   ------------------------------------------------------------   
    142                ztmp1 = xprefn * zcompaph**1.5 
    143                ztmp2 = xprefp * zcompapi**1.5 
    144                ztmp3 = xprefc * zcompapoc**1.5 
    145                ztmp4 = xprefd * zcompadi**1.5 
    146                ztmp5 = xprefz * zcompaz**1.5 
    147                ztmptot = ztmp1 + ztmp2 + ztmp3 + ztmp4 + ztmp5 + rtrn 
    148                ztmp1 = ztmp1 / ztmptot 
    149                ztmp2 = ztmp2 / ztmptot 
    150                ztmp3 = ztmp3 / ztmptot 
    151                ztmp4 = ztmp4 / ztmptot 
    152                ztmp5 = ztmp5 / ztmptot 
    153  
    154                !   Microzooplankton regular grazing on the different preys 
    155                !   ------------------------------------------------------- 
    156                zgraznc   = zgraze  * ztmp1  * zdenom 
    157                zgraznn   = zgraznc * trb(ji,jj,jk,jpnph) / (trb(ji,jj,jk,jpphy) + rtrn) 
    158                zgraznp   = zgraznc * trb(ji,jj,jk,jppph) / (trb(ji,jj,jk,jpphy) + rtrn) 
    159                zgraznf   = zgraznc * trb(ji,jj,jk,jpnfe) / (trb(ji,jj,jk,jpphy) + rtrn) 
    160                zgrazpc   = zgraze  * ztmp2  * zdenom 
    161                zgrazpn   = zgrazpc * trb(ji,jj,jk,jpnpi) / (trb(ji,jj,jk,jppic) + rtrn) 
    162                zgrazpp   = zgrazpc * trb(ji,jj,jk,jpppi) / (trb(ji,jj,jk,jppic) + rtrn) 
    163                zgrazpf   = zgrazpc * trb(ji,jj,jk,jppfe) / (trb(ji,jj,jk,jppic) + rtrn) 
    164                zgrazz    = zgraze  * ztmp5   * zdenom 
    165                zgrazpoc  = zgraze  * ztmp3   * zdenom 
    166                zgrazpon  = zgrazpoc * trb(ji,jj,jk,jppon) / ( trb(ji,jj,jk,jppoc) + rtrn ) 
    167                zgrazpop  = zgrazpoc * trb(ji,jj,jk,jppop) / ( trb(ji,jj,jk,jppoc) + rtrn ) 
    168                zgrazpof  = zgrazpoc* trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn) 
    169                zgrazdc   = zgraze  * ztmp4  * zdenom 
    170                zgrazdn   = zgrazdc * trb(ji,jj,jk,jpndi) / (trb(ji,jj,jk,jpdia) + rtrn) 
    171                zgrazdp   = zgrazdc * trb(ji,jj,jk,jppdi) / (trb(ji,jj,jk,jpdia) + rtrn) 
    172                zgrazdf   = zgrazdc * trb(ji,jj,jk,jpdfe) / (trb(ji,jj,jk,jpdia) + rtrn) 
    173                ! 
    174                zgraztotc = zgraznc + zgrazpoc + zgrazdc + zgrazz + zgrazpc 
    175                zgraztotn = zgraznn + zgrazpn + zgrazpon + zgrazdn + zgrazz * no3rat3 
    176                zgraztotp = zgraznp + zgrazpp + zgrazpop + zgrazdp + zgrazz * po4rat3 
    177                zgraztotf = zgraznf + zgrazpf + zgrazpof + zgrazdf + zgrazz * ferat3 
    178                ! 
    179                ! Grazing by microzooplankton 
    180                zgrazing(ji,jj,jk) = zgraztotc 
    181  
    182                !   Stoichiometruc ratios of the food ingested by zooplanton  
    183                !   -------------------------------------------------------- 
    184                zgrasratf =  (zgraztotf + rtrn) / ( zgraztotc + rtrn ) 
    185                zgrasratn =  (zgraztotn + rtrn) / ( zgraztotc + rtrn ) 
    186                zgrasratp =  (zgraztotp + rtrn) / ( zgraztotc + rtrn ) 
    187  
    188                !   Growth efficiency is made a function of the quality  
    189                !   and the quantity of the preys 
    190                !   --------------------------------------------------- 
    191                zepshert  = MIN( 1., zgrasratn/ no3rat3, zgrasratp/ po4rat3, zgrasratf / ferat3) 
    192                zbeta     = MAX( 0., (epsher - epshermin) ) 
    193                zepsherf  = epshermin + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 
    194                zepsherv  = zepsherf * zepshert 
    195  
    196                !   Respiration of microzooplankton 
    197                !   Excess carbon in the food is used preferentially 
    198                !   ------------------------------------------------ 
    199                zexcess  = zgraztotc * zepsherf * (1.0 - zepshert) * zmetexcess 
    200                zbasresb = MAX(0., zrespz - zexcess) 
    201                zbasresi = zexcess + MIN(0., zrespz - zexcess)   
    202                zrespirc = srespir * zepsherv * zgraztotc + zbasresb 
    203                 
    204                !   When excess carbon is used, the other elements in excess 
    205                !   are also used proportionally to their abundance 
    206                !   -------------------------------------------------------- 
    207                zexcess  = ( zgrasratn/ no3rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 
    208                zbasresn = zbasresi * zexcess * zgrasratn  
    209                zexcess  = ( zgrasratp/ po4rat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 
    210                zbasresp = zbasresi * zexcess * zgrasratp 
    211                zexcess  = ( zgrasratf/ ferat3 - zepshert ) / ( 1.0 - zepshert + rtrn) 
    212                zbasresf = zbasresi * zexcess * zgrasratf 
    213  
    214                !   Voiding of the excessive elements as DOM 
    215                !   ---------------------------------------- 
    216                zgradoct   = (1. - unassc - zepsherv) * zgraztotc - zbasresi   
    217                zgradont   = (1. - unassn) * zgraztotn - zepsherv * no3rat3 * zgraztotc - zbasresn 
    218                zgradopt   = (1. - unassp) * zgraztotp - zepsherv * po4rat3 * zgraztotc - zbasresp 
    219                zgrareft   = (1. - unassc) * zgraztotf - zepsherv * ferat3 * zgraztotc - zbasresf 
    220  
    221                !  Since only semilabile DOM is represented in PISCES 
    222                !  part of DOM is in fact labile and is then released 
    223                !  as dissolved inorganic compounds (ssigma) 
    224                !  -------------------------------------------------- 
    225                zgradoc =  zgradoct * ssigma 
    226                zgradon =  zgradont * ssigma 
    227                zgradop =  zgradopt * ssigma 
    228                zgrarem = (1.0 - ssigma) * zgradoct 
    229                zgraren = (1.0 - ssigma) * zgradont 
    230                zgrarep = (1.0 - ssigma) * zgradopt 
    231                zgraref = zgrareft 
    232  
    233                !   Defecation as a result of non assimilated products 
    234                !   -------------------------------------------------- 
    235                zgrapoc   = zgraztotc * unassc 
    236                zgrapon   = zgraztotn * unassn 
    237                zgrapop   = zgraztotp * unassp 
    238                zgrapof   = zgraztotf * unassc 
    239  
    240                !  Addition of respiration to the release of inorganic nutrients 
    241                !  ------------------------------------------------------------- 
    242                zgrarem = zgrarem + zbasresi + zrespirc 
    243                zgraren = zgraren + zbasresn + zrespirc * no3rat3 
    244                zgrarep = zgrarep + zbasresp + zrespirc * po4rat3 
    245                zgraref = zgraref + zbasresf + zrespirc * ferat3 
    246  
    247                !   Update of the TRA arrays 
    248                !   ------------------------ 
    249                tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarep 
    250                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgraren 
    251                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgradoc 
    252                ! 
    253                IF( ln_ligand ) THEN  
    254                   tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zgradoc * ldocz 
    255                   zzligprod(ji,jj,jk) = zgradoc * ldocz 
    256                ENDIF 
    257                ! 
    258                tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zgradon 
    259                tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zgradop 
    260                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem  
    261                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgraref 
    262                zfezoo(ji,jj,jk)    = zgraref 
    263                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zepsherv * zgraztotc - zrespirc - ztortz - zgrazz 
    264                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgraznc 
    265                tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) - zgraznn 
    266                tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) - zgraznp 
    267                tra(ji,jj,jk,jppic) = tra(ji,jj,jk,jppic) - zgrazpc 
    268                tra(ji,jj,jk,jpnpi) = tra(ji,jj,jk,jpnpi) - zgrazpn 
    269                tra(ji,jj,jk,jpppi) = tra(ji,jj,jk,jpppi) - zgrazpp 
    270                tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazdc 
    271                tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) - zgrazdn 
    272                tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) - zgrazdp 
    273                tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgraznc * trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn) 
    274                tra(ji,jj,jk,jppch) = tra(ji,jj,jk,jppch) - zgrazpc * trb(ji,jj,jk,jppch)/(trb(ji,jj,jk,jppic)+rtrn) 
    275                tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazdc * trb(ji,jj,jk,jpdch)/(trb(ji,jj,jk,jpdia)+rtrn) 
    276                tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazdc * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn) 
    277                tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazdc * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn) 
    278                tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf 
    279                tra(ji,jj,jk,jppfe) = tra(ji,jj,jk,jppfe) - zgrazpf 
    280                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazdf 
    281                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ztortz + zgrapoc - zgrazpoc  
    282                prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ztortz + zgrapoc 
    283                conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc 
    284                tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + no3rat3 * ztortz + zgrapon - zgrazpon 
    285                tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + po4rat3 * ztortz + zgrapop - zgrazpop 
    286                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * ztortz  + zgrapof - zgrazpof 
    287                ! 
    288                ! calcite production 
    289                zprcaca = xfracal(ji,jj,jk) * zgraznc 
    290                prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    291                ! 
    292                zprcaca = part * zprcaca 
    293                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem - zprcaca 
    294                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca     & 
    295                &                     + rno3 * zgraren 
    296                tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 
    297             END DO 
    298          END DO 
    299       END DO 
    300       ! 
    301       IF( lk_iomput ) THEN 
    302          IF( knt == nrdttrc ) THEN 
    303             ALLOCATE( zw3d(jpi,jpj,jpk) ) 
    304             IF( iom_use( "GRAZ1" ) ) THEN 
    305                zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)  !  Total grazing of phyto by zooplankton 
    306                CALL iom_put( "GRAZ1", zw3d ) 
    307             ENDIF 
    308             IF( iom_use( "FEZOO" ) ) THEN 
    309                zw3d(:,:,:) = zfezoo(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:)   ! 
    310                CALL iom_put( "FEZOO", zw3d ) 
    311             ENDIF 
    312             IF( iom_use( "LPRODZ" ) .AND. ln_ligand )  THEN 
    313                zw3d(:,:,:) = zzligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) 
    314                CALL iom_put( "LPRODZ"  , zw3d ) 
    315             ENDIF 
    316             DEALLOCATE( zw3d ) 
     98      DO_3D( 1, 1, 1, 1, 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 
     293      ! 
     294      IF( lk_iomput .AND. knt == nrdttrc ) THEN 
     295       IF( iom_use("GRAZ1") ) THEN  !   Total grazing of phyto by zooplankton 
     296           zgrazing(:,:,jpk) = 0._wp   ; CALL iom_put( "GRAZ1" , zgrazing(:,:,:) * 1.e+3  * rfact2r * tmask(:,:,:) )  
     297         ENDIF 
     298         IF( iom_use("FEZOO") ) THEN   
     299           zfezoo (:,:,jpk) = 0._wp    ; CALL iom_put( "FEZOO" , zfezoo(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) ) 
     300         ENDIF 
     301         IF( ln_ligand ) THEN 
     302            zzligprod(:,:,jpk) = 0._wp ; CALL iom_put( "LPRODZ", zzligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:)) 
    317303         ENDIF 
    318304      ENDIF 
    319305      ! 
    320       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     306      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    321307         WRITE(charout, FMT="('micro')") 
    322          CALL prt_ctl_trc_info(charout) 
    323          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     308         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     309         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    324310      ENDIF 
    325311      ! 
    … …  
    349335      !!---------------------------------------------------------------------- 
    350336      ! 
    351       REWIND( numnatp_ref )              ! Namelist nampiszoo in reference namelist : Pisces microzooplankton 
    352337      READ  ( numnatp_ref, namp5zzoo, IOSTAT = ios, ERR = 901) 
    353 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp5zzoo in reference namelist', lwp ) 
    354       ! 
    355       REWIND( numnatp_cfg )              ! Namelist nampiszoo in configuration namelist : Pisces microzooplankton 
     338901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp5zzoo in reference namelist' ) 
     339      ! 
    356340      READ  ( numnatp_cfg, namp5zzoo, IOSTAT = ios, ERR = 902 ) 
    357 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namp5zzoo in configuration namelist', lwp ) 
     341902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namp5zzoo in configuration namelist' ) 
    358342      IF(lwm) WRITE ( numonp, namp5zzoo ) 
    359343      ! 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p5zmort.F90

    r10362 r13463  
    1616   USE p4zlim 
    1717   USE p5zlim          !  Phytoplankton limitation terms 
    18    USE prtctl_trc      !  print control for debugging 
     18   USE prtctl          !  print control for debugging 
    1919 
    2020   IMPLICIT NONE 
    … …  
    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( 1, 1, 1, 1, 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')") 
    123          CALL prt_ctl_trc_info(charout) 
    124          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     123         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     124         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=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( 1, 1, 1, 1, 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')") 
    184          CALL prt_ctl_trc_info(charout) 
    185          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     181         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     182         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=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( 1, 1, 1, 1, 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')") 
    262          CALL prt_ctl_trc_info(charout) 
    263          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     256         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     257         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=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) 
    290 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp5zmort in reference namelist', lwp ) 
    291  
    292       REWIND( numnatp_cfg )              ! Namelist nampismort in configuration namelist : Pisces phytoplankton 
     283901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp5zmort in reference namelist' ) 
     284 
    293285      READ  ( numnatp_cfg, namp5zmort, IOSTAT = ios, ERR = 902 ) 
    294 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namp5zmort in configuration namelist', lwp ) 
     286902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namp5zmort in configuration namelist' ) 
    295287      IF(lwm) WRITE ( numonp, namp5zmort ) 
    296288 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p5zprod.F90

    r10873 r13463  
    1818   USE p4zlim 
    1919   USE p5zlim          !  Co-limitations of differents nutrients 
    20    USE prtctl_trc      !  print control for debugging 
     20   USE prtctl          !  print control for debugging 
    2121   USE iom             !  I/O manager 
    2222 
    … …  
    5050   REAL(wp) :: texcretd               !: 1 - excret2         
    5151 
     52   !! * Substitutions 
     53#  include "do_loop_substitute.h90" 
     54#  include "domzgr_substitute.h90" 
    5255   !!---------------------------------------------------------------------- 
    5356   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    5760CONTAINS 
    5861 
    59    SUBROUTINE p5z_prod( kt , knt ) 
     62   SUBROUTINE p5z_prod( kt , knt, Kbb, Kmm, Krhs ) 
    6063      !!--------------------------------------------------------------------- 
    6164      !!                     ***  ROUTINE p5z_prod  *** 
    … …  
    6871      ! 
    6972      INTEGER, INTENT(in) :: kt, knt 
     73      INTEGER, INTENT(in) :: Kbb, Kmm, Krhs      ! time level indices 
    7074      ! 
    7175      INTEGER  ::   ji, jj, jk 
    … …  
    9498      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmxl_fac, zmxl_chl 
    9599      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpligprod1, zpligprod2 
    96       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d 
    97       REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) :: zw2d 
    98100      !!--------------------------------------------------------------------- 
    99101      ! 
    … …  
    101103      ! 
    102104      zprorcan(:,:,:) = 0._wp ; zprorcap(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp 
     105      zcroissn(:,:,:) = 0._wp ; zcroissp(:,:,:) = 0._wp ; zcroissd(:,:,:) = 0._wp 
    103106      zprofed (:,:,:) = 0._wp ; zprofep (:,:,:) = 0._wp ; zprofen (:,:,:) = 0._wp 
    104107      zpronewn(:,:,:) = 0._wp ; zpronewp(:,:,:) = 0._wp ; zpronewd(:,:,:) = 0._wp 
    … …  
    107110      zprdia  (:,:,:) = 0._wp ; zprpic  (:,:,:) = 0._wp ; zprbio  (:,:,:) = 0._wp 
    108111      zprodopn(:,:,:) = 0._wp ; zprodopp(:,:,:) = 0._wp ; zprodopd(:,:,:) = 0._wp 
    109       zysopt  (:,:,:) = 0._wp 
     112      zysopt  (:,:,:) = 0._wp  
    110113      zrespn  (:,:,:) = 0._wp ; zrespp  (:,:,:) = 0._wp ; zrespd  (:,:,:) = 0._wp  
    111114 
    … …  
    122125      ! day length in hours 
    123126      zstrn(:,:) = 0. 
    124       DO jj = 1, jpj 
    125          DO ji = 1, jpi 
    126             zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 
    127             zargu = MAX( -1., MIN(  1., zargu ) ) 
    128             zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 
    129          END DO 
    130       END DO 
     127      DO_2D( 1, 1, 1, 1 ) 
     128         zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 
     129         zargu = MAX( -1., MIN(  1., zargu ) ) 
     130         zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 
     131      END_2D 
    131132 
    132133         ! Impact of the day duration on phytoplankton growth 
    133       DO jk = 1, jpkm1 
    134          DO jj = 1 ,jpj 
    135             DO ji = 1, jpi 
    136                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    137                   zval = MAX( 1., zstrn(ji,jj) ) 
    138                   IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    139                      zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 
    140                   ENDIF 
    141                   zmxl_chl(ji,jj,jk) = zval / 24. 
    142                   zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval ) 
    143                ENDIF 
    144             END DO 
    145          END DO 
    146       END DO 
     134      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     135         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     136            zval = MAX( 1., zstrn(ji,jj) ) 
     137            IF( gdepw(ji,jj,jk+1,Kmm) <= 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_3D 
    147144 
    148145      zprbio(:,:,:) = zprmaxn(:,:,:) * zmxl_fac(:,:,:) 
    … …  
    155152      WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 
    156153 
    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 the P-I slope for nanos and diatoms 
    162                   ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
    163                   zadap       = xadap * ztn / ( 2.+ ztn ) 
    164                   ! 
    165                   zpislopeadn(ji,jj,jk) = pislopen * trb(ji,jj,jk,jpnch)    & 
    166                   &                       /( trb(ji,jj,jk,jpphy) * 12. + rtrn) 
    167                   zpislopeadp(ji,jj,jk) = pislopep * ( 1. + zadap * EXP( -0.25 * epico(ji,jj,jk) ) )   & 
    168                   &                       * trb(ji,jj,jk,jppch) /( trb(ji,jj,jk,jppic) * 12. + rtrn) 
    169                   zpislopeadd(ji,jj,jk) = pisloped * trb(ji,jj,jk,jpdch)    & 
    170                      &                    /( trb(ji,jj,jk,jpdia) * 12. + rtrn) 
    171                   ! 
    172                   zpislopen = zpislopeadn(ji,jj,jk) / ( zprbio(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 
    173                   zpislopep = zpislopeadp(ji,jj,jk) / ( zprpic(ji,jj,jk) * rday * xlimpic(ji,jj,jk) + rtrn ) 
    174                   zpisloped = zpislopeadd(ji,jj,jk) / ( zprdia(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 
    175  
    176                   ! Computation of production function for Carbon 
    177                   !  --------------------------------------------- 
    178                   zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) )  ) 
    179                   zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1.- EXP( -zpislopep * epico(ji,jj,jk) )  ) 
    180                   zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) )  ) 
    181  
    182                   ! Computation of production function for Chlorophyll 
    183                   !  ------------------------------------------------- 
    184                   zpislopen = zpislopen * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
    185                   zpisloped = zpisloped * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
    186                   zpislopep = zpislopep * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
    187                   zprchln(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) )  ) 
    188                   zprchlp(ji,jj,jk) = zprmaxp(ji,jj,jk) * ( 1.- EXP( -zpislopep * epicom(ji,jj,jk) )  ) 
    189                   zprchld(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) )  ) 
    190                ENDIF 
    191             END DO 
    192          END DO 
    193       END DO 
    194  
    195       DO jk = 1, jpkm1 
    196          DO jj = 1, jpj 
    197             DO ji = 1, jpi 
    198  
    199                 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    200                   !    Si/C of diatoms 
    201                   !    ------------------------ 
    202                   !    Si/C increases with iron stress and silicate availability 
    203                   !    Si/C is arbitrariliy increased for very high Si concentrations 
    204                   !    to mimic the very high ratios observed in the Southern Ocean (silpot2) 
    205                   zlim  = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi1 ) 
    206                   zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 
    207                   zsilfac = 3.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0 
    208                   zsiborn = trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) 
    209                   IF (gphit(ji,jj) < -30 ) THEN 
    210                     zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 ) 
    211                   ELSE 
    212                     zsilfac2 = 1. +      zsiborn / ( zsiborn + xksi2**3 ) 
    213                   ENDIF 
    214                   zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2 
    215               ENDIF 
    216             END DO 
    217          END DO 
    218       END DO 
     154      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     155         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     156            ! Computation of the P-I slope for nanos and diatoms 
     157            ztn         = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. ) 
     158            zadap       = xadap * ztn / ( 2.+ ztn ) 
     159            ! 
     160            zpislopeadn(ji,jj,jk) = pislopen * tr(ji,jj,jk,jpnch,Kbb)    & 
     161            &                       /( tr(ji,jj,jk,jpphy,Kbb) * 12. + rtrn) 
     162            zpislopeadp(ji,jj,jk) = pislopep * ( 1. + zadap * EXP( -0.25 * epico(ji,jj,jk) ) )   & 
     163            &                       * tr(ji,jj,jk,jppch,Kbb) /( tr(ji,jj,jk,jppic,Kbb) * 12. + rtrn) 
     164            zpislopeadd(ji,jj,jk) = pisloped * tr(ji,jj,jk,jpdch,Kbb)    & 
     165               &                    /( tr(ji,jj,jk,jpdia,Kbb) * 12. + rtrn) 
     166            ! 
     167            zpislopen = zpislopeadn(ji,jj,jk) / ( zprbio(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 
     168            zpislopep = zpislopeadp(ji,jj,jk) / ( zprpic(ji,jj,jk) * rday * xlimpic(ji,jj,jk) + rtrn ) 
     169            zpisloped = zpislopeadd(ji,jj,jk) / ( zprdia(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 
     170 
     171            ! Computation of production function for Carbon 
     172            !  --------------------------------------------- 
     173            zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) )  ) 
     174            zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1.- EXP( -zpislopep * epico(ji,jj,jk) )  ) 
     175            zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) )  ) 
     176 
     177            ! Computation of production function for Chlorophyll 
     178            !  ------------------------------------------------- 
     179            zpislopen = zpislopen * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     180            zpisloped = zpisloped * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     181            zpislopep = zpislopep * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     182            zprchln(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) )  ) 
     183            zprchlp(ji,jj,jk) = zprmaxp(ji,jj,jk) * ( 1.- EXP( -zpislopep * epicom(ji,jj,jk) )  ) 
     184            zprchld(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) )  ) 
     185         ENDIF 
     186      END_3D 
     187 
     188      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     189 
     190          IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     191            !    Si/C of diatoms 
     192            !    ------------------------ 
     193            !    Si/C increases with iron stress and silicate availability 
     194            !    Si/C is arbitrariliy increased for very high Si concentrations 
     195            !    to mimic the very high ratios observed in the Southern Ocean (silpot2) 
     196            zlim  = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi1 ) 
     197            zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 
     198            zsilfac = 3.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0 
     199            zsiborn = tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) 
     200            IF (gphit(ji,jj) < -30 ) THEN 
     201              zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 ) 
     202            ELSE 
     203              zsilfac2 = 1. +      zsiborn / ( zsiborn + xksi2**3 ) 
     204            ENDIF 
     205            zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2 
     206        ENDIF 
     207      END_3D 
    219208 
    220209      !  Sea-ice effect on production                                                                                
    221       DO jk = 1, jpkm1 
    222          DO jj = 1, jpj 
    223             DO ji = 1, jpi 
    224                zprbio(ji,jj,jk)  = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
    225                zprpic(ji,jj,jk)  = zprpic(ji,jj,jk) * ( 1. - fr_i(ji,jj) )  
    226                zprdia(ji,jj,jk)  = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) )  
    227                zprnut(ji,jj,jk)  = zprnut(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
    228             END DO 
    229          END DO 
    230       END DO 
     210      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     211         zprbio(ji,jj,jk)  = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
     212         zprpic(ji,jj,jk)  = zprpic(ji,jj,jk) * ( 1. - fr_i(ji,jj) )  
     213         zprdia(ji,jj,jk)  = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) )  
     214         zprnut(ji,jj,jk)  = zprnut(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
     215      END_3D 
    231216 
    232217      ! Computation of the various production terms of nanophytoplankton  
    233       DO jk = 1, jpkm1 
    234          DO jj = 1, jpj 
    235             DO ji = 1, jpi 
    236                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    237                   !  production terms for nanophyto. 
    238                   zprorcan(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2 
    239                   ! 
    240                   zration = trb(ji,jj,jk,jpnph) / ( trb(ji,jj,jk,jpphy) + rtrn ) 
    241                   zratiop = trb(ji,jj,jk,jppph) / ( trb(ji,jj,jk,jpphy) + rtrn ) 
    242                   zratiof = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn ) 
    243                   zprnutmax = zprnut(ji,jj,jk) * fvnuptk(ji,jj,jk) / rno3 * trb(ji,jj,jk,jpphy) * rfact2 
    244                   ! Uptake of nitrogen 
    245                   zrat = MIN( 1., zration / (xqnnmax(ji,jj,jk) + rtrn) )  
    246                   zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
    247                   zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpnmin(ji,jj,jk) )   & 
    248                   &          / ( xqpnmax(ji,jj,jk) - xqpnmin(ji,jj,jk) + rtrn ), xlimnfe(ji,jj,jk) ) ) 
    249                   zpronewn(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xnanono3(ji,jj,jk) 
    250                   zproregn(ji,jj,jk) = zpronmax * xnanonh4(ji,jj,jk) 
    251                   ! Uptake of phosphorus 
    252                   zrat = MIN( 1., zratiop / (xqpnmax(ji,jj,jk) + rtrn) ) 
    253                   zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
    254                   zpropmax = zprnutmax * zmax * xlimnfe(ji,jj,jk) 
    255                   zpropo4n(ji,jj,jk) = zpropmax * xnanopo4(ji,jj,jk) 
    256                   zprodopn(ji,jj,jk) = zpropmax * xnanodop(ji,jj,jk) 
    257                   ! Uptake of iron 
    258                   zrat = MIN( 1., zratiof / qfnmax ) 
    259                   zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
    260                   zprofmax = zprnutmax * qfnmax * zmax 
    261                   zprofen(ji,jj,jk) = zprofmax * xnanofer(ji,jj,jk) * ( 3. - 2.4 * xlimnfe(ji,jj,jk)    & 
    262                   &          / ( xlimnfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xnanono3(ji,jj,jk) / ( rtrn  & 
    263                   &          + xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) ) * (1. - xnanofer(ji,jj,jk) ) ) 
    264                ENDIF 
    265             END DO 
    266          END DO 
    267       END DO 
     218      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     219         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     220            !  production terms for nanophyto. 
     221            zprorcan(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * tr(ji,jj,jk,jpphy,Kbb) * rfact2 
     222            ! 
     223            zration = tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
     224            zratiop = tr(ji,jj,jk,jppph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
     225            zratiof = tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
     226            zprnutmax = zprnut(ji,jj,jk) * fvnuptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jpphy,Kbb) * rfact2 
     227            ! Uptake of nitrogen 
     228            zrat = MIN( 1., zration / (xqnnmax(ji,jj,jk) + rtrn) )  
     229            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
     230            zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpnmin(ji,jj,jk) )   & 
     231            &          / ( xqpnmax(ji,jj,jk) - xqpnmin(ji,jj,jk) + rtrn ), xlimnfe(ji,jj,jk) ) ) 
     232            zpronewn(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xnanono3(ji,jj,jk) 
     233            zproregn(ji,jj,jk) = zpronmax * xnanonh4(ji,jj,jk) 
     234            ! Uptake of phosphorus 
     235            zrat = MIN( 1., zratiop / (xqpnmax(ji,jj,jk) + rtrn) ) 
     236            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
     237            zpropmax = zprnutmax * zmax * xlimnfe(ji,jj,jk) 
     238            zpropo4n(ji,jj,jk) = zpropmax * xnanopo4(ji,jj,jk) 
     239            zprodopn(ji,jj,jk) = zpropmax * xnanodop(ji,jj,jk) 
     240            ! Uptake of iron 
     241            zrat = MIN( 1., zratiof / qfnmax ) 
     242            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
     243            zprofmax = zprnutmax * qfnmax * zmax 
     244            zprofen(ji,jj,jk) = zprofmax * xnanofer(ji,jj,jk) * ( 3. - 2.4 * xlimnfe(ji,jj,jk)    & 
     245            &          / ( xlimnfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xnanono3(ji,jj,jk) / ( rtrn  & 
     246            &          + xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) ) * (1. - xnanofer(ji,jj,jk) ) ) 
     247         ENDIF 
     248      END_3D 
    268249 
    269250      ! Computation of the various production terms of picophytoplankton  
    270       DO jk = 1, jpkm1 
    271          DO jj = 1, jpj 
    272             DO ji = 1, jpi 
    273                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    274                   !  production terms for picophyto. 
    275                   zprorcap(ji,jj,jk) = zprpic(ji,jj,jk)  * xlimpic(ji,jj,jk) * trb(ji,jj,jk,jppic) * rfact2 
    276                   ! 
    277                   zration = trb(ji,jj,jk,jpnpi) / ( trb(ji,jj,jk,jppic) + rtrn ) 
    278                   zratiop = trb(ji,jj,jk,jpppi) / ( trb(ji,jj,jk,jppic) + rtrn ) 
    279                   zratiof = trb(ji,jj,jk,jppfe) / ( trb(ji,jj,jk,jppic) + rtrn ) 
    280                   zprnutmax = zprnut(ji,jj,jk) * fvpuptk(ji,jj,jk) / rno3 * trb(ji,jj,jk,jppic) * rfact2 
    281                   ! Uptake of nitrogen 
    282                   zrat = MIN( 1., zration / (xqnpmax(ji,jj,jk) + rtrn) ) 
    283                   zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
    284                   zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqppmin(ji,jj,jk) )   & 
    285                   &          / ( xqppmax(ji,jj,jk) - xqppmin(ji,jj,jk) + rtrn ), xlimpfe(ji,jj,jk) ) ) 
    286                   zpronewp(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xpicono3(ji,jj,jk)  
    287                   zproregp(ji,jj,jk) = zpronmax * xpiconh4(ji,jj,jk) 
    288                   ! Uptake of phosphorus 
    289                   zrat = MIN( 1., zratiop / (xqppmax(ji,jj,jk) + rtrn) ) 
    290                   zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
    291                   zpropmax = zprnutmax * zmax * xlimpfe(ji,jj,jk) 
    292                   zpropo4p(ji,jj,jk) = zpropmax * xpicopo4(ji,jj,jk) 
    293                   zprodopp(ji,jj,jk) = zpropmax * xpicodop(ji,jj,jk) 
    294                   ! Uptake of iron 
    295                   zrat = MIN( 1., zratiof / qfpmax ) 
    296                   zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
    297                   zprofmax = zprnutmax * qfpmax * zmax 
    298                   zprofep(ji,jj,jk) = zprofmax * xpicofer(ji,jj,jk) * ( 3. - 2.4 * xlimpfe(ji,jj,jk)   & 
    299                   &          / ( xlimpfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xpicono3(ji,jj,jk) / ( rtrn   & 
    300                   &          + xpicono3(ji,jj,jk) + xpiconh4(ji,jj,jk) ) * (1. - xpicofer(ji,jj,jk) ) ) 
    301                ENDIF 
    302             END DO 
    303          END DO 
    304       END DO 
     251      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     252         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     253            !  production terms for picophyto. 
     254            zprorcap(ji,jj,jk) = zprpic(ji,jj,jk)  * xlimpic(ji,jj,jk) * tr(ji,jj,jk,jppic,Kbb) * rfact2 
     255            ! 
     256            zration = tr(ji,jj,jk,jpnpi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 
     257            zratiop = tr(ji,jj,jk,jpppi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 
     258            zratiof = tr(ji,jj,jk,jppfe,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 
     259            zprnutmax = zprnut(ji,jj,jk) * fvpuptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jppic,Kbb) * rfact2 
     260            ! Uptake of nitrogen 
     261            zrat = MIN( 1., zration / (xqnpmax(ji,jj,jk) + rtrn) ) 
     262            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
     263            zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqppmin(ji,jj,jk) )   & 
     264            &          / ( xqppmax(ji,jj,jk) - xqppmin(ji,jj,jk) + rtrn ), xlimpfe(ji,jj,jk) ) ) 
     265            zpronewp(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xpicono3(ji,jj,jk)  
     266            zproregp(ji,jj,jk) = zpronmax * xpiconh4(ji,jj,jk) 
     267            ! Uptake of phosphorus 
     268            zrat = MIN( 1., zratiop / (xqppmax(ji,jj,jk) + rtrn) ) 
     269            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
     270            zpropmax = zprnutmax * zmax * xlimpfe(ji,jj,jk) 
     271            zpropo4p(ji,jj,jk) = zpropmax * xpicopo4(ji,jj,jk) 
     272            zprodopp(ji,jj,jk) = zpropmax * xpicodop(ji,jj,jk) 
     273            ! Uptake of iron 
     274            zrat = MIN( 1., zratiof / qfpmax ) 
     275            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
     276            zprofmax = zprnutmax * qfpmax * zmax 
     277            zprofep(ji,jj,jk) = zprofmax * xpicofer(ji,jj,jk) * ( 3. - 2.4 * xlimpfe(ji,jj,jk)   & 
     278            &          / ( xlimpfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xpicono3(ji,jj,jk) / ( rtrn   & 
     279            &          + xpicono3(ji,jj,jk) + xpiconh4(ji,jj,jk) ) * (1. - xpicofer(ji,jj,jk) ) ) 
     280         ENDIF 
     281      END_3D 
    305282 
    306283      ! Computation of the various production terms of diatoms 
    307       DO jk = 1, jpkm1 
    308          DO jj = 1, jpj 
    309             DO ji = 1, jpi 
    310                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    311                   !  production terms for diatomees 
    312                   zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trb(ji,jj,jk,jpdia) * rfact2 
    313                   ! Computation of the respiration term according to pahlow  
    314                   ! & oschlies (2013) 
    315                   ! 
    316                   zration = trb(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    317                   zratiop = trb(ji,jj,jk,jppdi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    318                   zratiof = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    319                   zprnutmax = zprnut(ji,jj,jk) * fvduptk(ji,jj,jk) / rno3 * trb(ji,jj,jk,jpdia) * rfact2 
    320                   ! Uptake of nitrogen 
    321                   zrat = MIN( 1., zration / (xqndmax(ji,jj,jk) + rtrn) ) 
    322                   zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))  
    323                   zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpdmin(ji,jj,jk) )   & 
    324                   &          / ( xqpdmax(ji,jj,jk) - xqpdmin(ji,jj,jk) + rtrn ), xlimdfe(ji,jj,jk) ) ) 
    325                   zpronewd(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xdiatno3(ji,jj,jk) 
    326                   zproregd(ji,jj,jk) = zpronmax * xdiatnh4(ji,jj,jk) 
    327                   ! Uptake of phosphorus 
    328                   zrat = MIN( 1., zratiop / (xqpdmax(ji,jj,jk) + rtrn) ) 
    329                   zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))  
    330                   zpropmax = zprnutmax * zmax * xlimdfe(ji,jj,jk) 
    331                   zpropo4d(ji,jj,jk) = zpropmax * xdiatpo4(ji,jj,jk) 
    332                   zprodopd(ji,jj,jk) = zpropmax * xdiatdop(ji,jj,jk) 
    333                   ! Uptake of iron 
    334                   zrat = MIN( 1., zratiof / qfdmax ) 
    335                   zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
    336                   zprofmax = zprnutmax * qfdmax * zmax 
    337                   zprofed(ji,jj,jk) = zprofmax * xdiatfer(ji,jj,jk) * ( 3. - 2.4 * xlimdfe(ji,jj,jk)     & 
    338                   &          / ( xlimdfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xdiatno3(ji,jj,jk) / ( rtrn   & 
    339                   &          + xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) ) * (1. - xdiatfer(ji,jj,jk) ) ) 
    340                ENDIF 
    341             END DO 
    342          END DO 
    343       END DO 
    344  
    345       DO jk = 1, jpkm1 
    346          DO jj = 1, jpj 
    347             DO ji = 1, jpi 
    348                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    349                      !  production terms for nanophyto. ( chlorophyll ) 
    350                   znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
    351                   zprod = rday * (zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)) * zprchln(ji,jj,jk) * xlimphy(ji,jj,jk) 
    352                   thetannm_n   = MIN ( thetannm, ( thetannm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem)))   & 
    353                   &               * (1. - 1.14 / 43.4 * 20.)) 
    354                   zprochln = thetannm_n * zprod / ( zpislopeadn(ji,jj,jk) * znanotot + rtrn ) 
    355                   zprochln = MAX(zprochln, chlcmin * 12. * zprorcan (ji,jj,jk) ) 
    356                      !  production terms for picophyto. ( chlorophyll ) 
    357                   zpicotot = epicom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
    358                   zprod = rday * (zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)) * zprchlp(ji,jj,jk) * xlimpic(ji,jj,jk) 
    359                   thetanpm_n   = MIN ( thetanpm, ( thetanpm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem)))   & 
    360                   &               * (1. - 1.14 / 43.4 * 20.)) 
    361                   zprochlp = thetanpm_n * zprod / ( zpislopeadp(ji,jj,jk) * zpicotot + rtrn ) 
    362                   zprochlp = MAX(zprochlp, chlcmin * 12. * zprorcap(ji,jj,jk) ) 
    363                   !  production terms for diatomees ( chlorophyll ) 
    364                   zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
    365                   zprod = rday * (zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)) * zprchld(ji,jj,jk) * xlimdia(ji,jj,jk) 
    366                   thetandm_n   = MIN ( thetandm, ( thetandm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem)))   & 
    367                   &               * (1. - 1.14 / 43.4 * 20.)) 
    368                   zprochld = thetandm_n * zprod / ( zpislopeadd(ji,jj,jk) * zdiattot + rtrn ) 
    369                   zprochld = MAX(zprochld, chlcmin * 12. * zprorcad(ji,jj,jk) ) 
    370                   !   Update the arrays TRA which contain the Chla sources and sinks 
    371                   tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln * texcretn 
    372                   tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld * texcretd 
    373                   tra(ji,jj,jk,jppch) = tra(ji,jj,jk,jppch) + zprochlp * texcretp 
    374                ENDIF 
    375             END DO 
    376          END DO 
    377       END DO 
     284      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     285         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     286            !  production terms for diatomees 
     287            zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr(ji,jj,jk,jpdia,Kbb) * rfact2 
     288            ! Computation of the respiration term according to pahlow  
     289            ! & oschlies (2013) 
     290            ! 
     291            zration = tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     292            zratiop = tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     293            zratiof = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     294            zprnutmax = zprnut(ji,jj,jk) * fvduptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jpdia,Kbb) * rfact2 
     295            ! Uptake of nitrogen 
     296            zrat = MIN( 1., zration / (xqndmax(ji,jj,jk) + rtrn) ) 
     297            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))  
     298            zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpdmin(ji,jj,jk) )   & 
     299            &          / ( xqpdmax(ji,jj,jk) - xqpdmin(ji,jj,jk) + rtrn ), xlimdfe(ji,jj,jk) ) ) 
     300            zpronewd(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xdiatno3(ji,jj,jk) 
     301            zproregd(ji,jj,jk) = zpronmax * xdiatnh4(ji,jj,jk) 
     302            ! Uptake of phosphorus 
     303            zrat = MIN( 1., zratiop / (xqpdmax(ji,jj,jk) + rtrn) ) 
     304            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))  
     305            zpropmax = zprnutmax * zmax * xlimdfe(ji,jj,jk) 
     306            zpropo4d(ji,jj,jk) = zpropmax * xdiatpo4(ji,jj,jk) 
     307            zprodopd(ji,jj,jk) = zpropmax * xdiatdop(ji,jj,jk) 
     308            ! Uptake of iron 
     309            zrat = MIN( 1., zratiof / qfdmax ) 
     310            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
     311            zprofmax = zprnutmax * qfdmax * zmax 
     312            zprofed(ji,jj,jk) = zprofmax * xdiatfer(ji,jj,jk) * ( 3. - 2.4 * xlimdfe(ji,jj,jk)     & 
     313            &          / ( xlimdfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xdiatno3(ji,jj,jk) / ( rtrn   & 
     314            &          + xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) ) * (1. - xdiatfer(ji,jj,jk) ) ) 
     315         ENDIF 
     316      END_3D 
     317 
     318      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     319         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     320               !  production terms for nanophyto. ( chlorophyll ) 
     321            znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     322            zprod = rday * (zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)) * zprchln(ji,jj,jk) * xlimphy(ji,jj,jk) 
     323            thetannm_n   = MIN ( thetannm, ( thetannm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm)))   & 
     324            &               * (1. - 1.14 / 43.4 * 20.)) 
     325            zprochln = thetannm_n * zprod / ( zpislopeadn(ji,jj,jk) * znanotot + rtrn ) 
     326            zprochln = MAX(zprochln, chlcmin * 12. * zprorcan (ji,jj,jk) ) 
     327               !  production terms for picophyto. ( chlorophyll ) 
     328            zpicotot = epicom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     329            zprod = rday * (zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)) * zprchlp(ji,jj,jk) * xlimpic(ji,jj,jk) 
     330            thetanpm_n   = MIN ( thetanpm, ( thetanpm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm)))   & 
     331            &               * (1. - 1.14 / 43.4 * 20.)) 
     332            zprochlp = thetanpm_n * zprod / ( zpislopeadp(ji,jj,jk) * zpicotot + rtrn ) 
     333            zprochlp = MAX(zprochlp, chlcmin * 12. * zprorcap(ji,jj,jk) ) 
     334            !  production terms for diatomees ( chlorophyll ) 
     335            zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     336            zprod = rday * (zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)) * zprchld(ji,jj,jk) * xlimdia(ji,jj,jk) 
     337            thetandm_n   = MIN ( thetandm, ( thetandm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm)))   & 
     338            &               * (1. - 1.14 / 43.4 * 20.)) 
     339            zprochld = thetandm_n * zprod / ( zpislopeadd(ji,jj,jk) * zdiattot + rtrn ) 
     340            zprochld = MAX(zprochld, chlcmin * 12. * zprorcad(ji,jj,jk) ) 
     341            !   Update the arrays TRA which contain the Chla sources and sinks 
     342            tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) + zprochln * texcretn 
     343            tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) + zprochld * texcretd 
     344            tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) + zprochlp * texcretp 
     345         ENDIF 
     346      END_3D 
    378347 
    379348      !   Update the arrays TRA which contain the biological sources and sinks 
    380       DO jk = 1, jpkm1 
    381          DO jj = 1, jpj 
    382            DO ji =1 ,jpi 
    383               zprontot = zpronewn(ji,jj,jk) + zproregn(ji,jj,jk) 
    384               zproptot = zpronewp(ji,jj,jk) + zproregp(ji,jj,jk) 
    385               zprodtot = zpronewd(ji,jj,jk) + zproregd(ji,jj,jk) 
    386               zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)  & 
    387               &          + excretp * zprorcap(ji,jj,jk) 
    388               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zpropo4n(ji,jj,jk) - zpropo4d(ji,jj,jk)  & 
    389               &                     - zpropo4p(ji,jj,jk) 
    390               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk)  & 
    391               &                     - zpronewp(ji,jj,jk) 
    392               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproregn(ji,jj,jk) - zproregd(ji,jj,jk)  & 
    393               &                     - zproregp(ji,jj,jk) 
    394               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorcan(ji,jj,jk) * texcretn    & 
    395                  &                  - zpsino3 * zpronewn(ji,jj,jk) - zpsinh4 * zproregn(ji,jj,jk)   & 
    396                  &                  - zrespn(ji,jj,jk)  
    397               zcroissn(ji,jj,jk) = tra(ji,jj,jk,jpphy) / rfact2/ (trb(ji,jj,jk,jpphy) + rtrn) 
    398               tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) + zprontot * texcretn 
    399               tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) + zpropo4n(ji,jj,jk) * texcretn   & 
    400               &                     + zprodopn(ji,jj,jk) * texcretn 
    401               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcretn 
    402               tra(ji,jj,jk,jppic) = tra(ji,jj,jk,jppic) + zprorcap(ji,jj,jk) * texcretp     & 
    403                  &                  - zpsino3 * zpronewp(ji,jj,jk) - zpsinh4 * zproregp(ji,jj,jk)   & 
    404                  &                  - zrespp(ji,jj,jk)  
    405               zcroissp(ji,jj,jk) = tra(ji,jj,jk,jppic) / rfact2/ (trb(ji,jj,jk,jppic) + rtrn) 
    406               tra(ji,jj,jk,jpnpi) = tra(ji,jj,jk,jpnpi) + zproptot * texcretp 
    407               tra(ji,jj,jk,jpppi) = tra(ji,jj,jk,jpppi) + zpropo4p(ji,jj,jk) * texcretp   & 
    408               &                     + zprodopp(ji,jj,jk) * texcretp 
    409               tra(ji,jj,jk,jppfe) = tra(ji,jj,jk,jppfe) + zprofep(ji,jj,jk) * texcretp 
    410               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcretd   & 
    411                  &                  - zpsino3 * zpronewd(ji,jj,jk) - zpsinh4 * zproregd(ji,jj,jk)   & 
    412                  &                  - zrespd(ji,jj,jk)  
    413               zcroissd(ji,jj,jk) = tra(ji,jj,jk,jpdia) / rfact2 / (trb(ji,jj,jk,jpdia) + rtrn) 
    414               tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) + zprodtot * texcretd 
    415               tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) + zpropo4d(ji,jj,jk) * texcretd   & 
    416               &                     + zprodopd(ji,jj,jk) * texcretd 
    417               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcretd 
    418               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 
    419               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)  & 
    420               &                     + excretp * zprorcap(ji,jj,jk) 
    421               tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + excretd * zprodtot + excretn * zprontot   & 
    422               &                     + excretp * zproptot 
    423               tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + excretd * zpropo4d(ji,jj,jk) + excretn * zpropo4n(ji,jj,jk)   & 
    424               &    - texcretn * zprodopn(ji,jj,jk) - texcretd * zprodopd(ji,jj,jk) + excretp * zpropo4p(ji,jj,jk)     & 
    425               &    - texcretp * zprodopp(ji,jj,jk) 
    426               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk)   & 
    427                  &                + zproregp(ji,jj,jk) ) + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk)           & 
    428                  &                + zpronewd(ji,jj,jk) + zpronewp(ji,jj,jk) )   & 
    429                  &                - o2ut * ( zrespn(ji,jj,jk) + zrespp(ji,jj,jk) + zrespd(ji,jj,jk) ) 
    430               zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) 
    431               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zfeup 
    432               tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 
    433               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) - zprorcap(ji,jj,jk)  & 
    434               &                     + zpsino3 * zpronewn(ji,jj,jk) + zpsinh4 * zproregn(ji,jj,jk)   & 
    435               &                     + zpsino3 * zpronewp(ji,jj,jk) + zpsinh4 * zproregp(ji,jj,jk)   & 
    436               &                     + zpsino3 * zpronewd(ji,jj,jk) + zpsinh4 * zproregd(ji,jj,jk)  & 
    437               &                     + zrespn(ji,jj,jk) + zrespd(ji,jj,jk) + zrespp(ji,jj,jk)  
    438               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk)  & 
    439               &                     + zpronewp(ji,jj,jk) ) - rno3 * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk)     & 
    440               &                     + zproregp(ji,jj,jk) )  
    441           END DO 
    442         END DO 
    443      END DO 
     349      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     350        zprontot = zpronewn(ji,jj,jk) + zproregn(ji,jj,jk) 
     351        zproptot = zpronewp(ji,jj,jk) + zproregp(ji,jj,jk) 
     352        zprodtot = zpronewd(ji,jj,jk) + zproregd(ji,jj,jk) 
     353        zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)  & 
     354        &          + excretp * zprorcap(ji,jj,jk) 
     355        tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zpropo4n(ji,jj,jk) - zpropo4d(ji,jj,jk)  & 
     356        &                     - zpropo4p(ji,jj,jk) 
     357        tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk)  & 
     358        &                     - zpronewp(ji,jj,jk) 
     359        tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zproregn(ji,jj,jk) - zproregd(ji,jj,jk)  & 
     360        &                     - zproregp(ji,jj,jk) 
     361        tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zprorcan(ji,jj,jk) * texcretn    & 
     362           &                  - zpsino3 * zpronewn(ji,jj,jk) - zpsinh4 * zproregn(ji,jj,jk)   & 
     363           &                  - zrespn(ji,jj,jk)  
     364        zcroissn(ji,jj,jk) = tr(ji,jj,jk,jpphy,Krhs) / rfact2/ (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
     365        tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) + zprontot * texcretn 
     366        tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) + zpropo4n(ji,jj,jk) * texcretn   & 
     367        &                     + zprodopn(ji,jj,jk) * texcretn 
     368        tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) + zprofen(ji,jj,jk) * texcretn 
     369        tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) + zprorcap(ji,jj,jk) * texcretp     & 
     370           &                  - zpsino3 * zpronewp(ji,jj,jk) - zpsinh4 * zproregp(ji,jj,jk)   & 
     371           &                  - zrespp(ji,jj,jk)  
     372        zcroissp(ji,jj,jk) = tr(ji,jj,jk,jppic,Krhs) / rfact2/ (tr(ji,jj,jk,jppic,Kbb) + rtrn) 
     373        tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) + zproptot * texcretp 
     374        tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) + zpropo4p(ji,jj,jk) * texcretp   & 
     375        &                     + zprodopp(ji,jj,jk) * texcretp 
     376        tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) + zprofep(ji,jj,jk) * texcretp 
     377        tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) + zprorcad(ji,jj,jk) * texcretd   & 
     378           &                  - zpsino3 * zpronewd(ji,jj,jk) - zpsinh4 * zproregd(ji,jj,jk)   & 
     379           &                  - zrespd(ji,jj,jk)  
     380        zcroissd(ji,jj,jk) = tr(ji,jj,jk,jpdia,Krhs) / rfact2 / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
     381        tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) + zprodtot * texcretd 
     382        tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) + zpropo4d(ji,jj,jk) * texcretd   & 
     383        &                     + zprodopd(ji,jj,jk) * texcretd 
     384        tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) + zprofed(ji,jj,jk) * texcretd 
     385        tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 
     386        tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)  & 
     387        &                     + excretp * zprorcap(ji,jj,jk) 
     388        tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + excretd * zprodtot + excretn * zprontot   & 
     389        &                     + excretp * zproptot 
     390        tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + excretd * zpropo4d(ji,jj,jk) + excretn * zpropo4n(ji,jj,jk)   & 
     391        &    - texcretn * zprodopn(ji,jj,jk) - texcretd * zprodopd(ji,jj,jk) + excretp * zpropo4p(ji,jj,jk)     & 
     392        &    - texcretp * zprodopp(ji,jj,jk) 
     393        tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + o2ut * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk)   & 
     394           &                + zproregp(ji,jj,jk) ) + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk)           & 
     395           &                + zpronewd(ji,jj,jk) + zpronewp(ji,jj,jk) )   & 
     396           &                - o2ut * ( zrespn(ji,jj,jk) + zrespp(ji,jj,jk) + zrespd(ji,jj,jk) ) 
     397        zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) 
     398        tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zfeup 
     399        tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 
     400        tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) - zprorcap(ji,jj,jk)  & 
     401        &                     + zpsino3 * zpronewn(ji,jj,jk) + zpsinh4 * zproregn(ji,jj,jk)   & 
     402        &                     + zpsino3 * zpronewp(ji,jj,jk) + zpsinh4 * zproregp(ji,jj,jk)   & 
     403        &                     + zpsino3 * zpronewd(ji,jj,jk) + zpsinh4 * zproregd(ji,jj,jk)  & 
     404        &                     + zrespn(ji,jj,jk) + zrespd(ji,jj,jk) + zrespp(ji,jj,jk)  
     405        tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk)  & 
     406        &                     + zpronewp(ji,jj,jk) ) - rno3 * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk)     & 
     407        &                     + zproregp(ji,jj,jk) )  
     408      END_3D 
    444409     ! 
    445410     IF( ln_ligand ) THEN 
    446          zpligprod1(:,:,:) = 0._wp    ;    zpligprod2(:,:,:) = 0._wp 
    447          DO jk = 1, jpkm1 
    448             DO jj = 1, jpj 
    449               DO ji =1 ,jpi 
    450                  zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) + excretp * zprorcap(ji,jj,jk) 
    451                  zfeup    = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) 
    452                  tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 
    453                  zpligprod1(ji,jj,jk) = zdocprod * ldocp 
    454                  zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet 
    455               END DO 
    456            END DO 
    457         END DO 
     411         zpligprod1(:,:,:) = 0._wp    ;    zpligprod2(:,:,:) = 0._wp              
     412         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     413           zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) + excretp * zprorcap(ji,jj,jk) 
     414           zfeup    = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) 
     415           tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 
     416           zpligprod1(ji,jj,jk) = zdocprod * ldocp 
     417           zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet 
     418         END_3D 
    458419     ENDIF 
    459420 
    … …  
    465426      & tpp = glob_sum( 'p5zprod', ( zprorcan(:,:,:) + zprorcad(:,:,:) + zprorcap(:,:,:) ) * cvol(:,:,:) ) 
    466427 
    467     IF( lk_iomput ) THEN 
    468        IF( knt == nrdttrc ) THEN 
    469           ALLOCATE( zw2d(jpi,jpj), zw3d(jpi,jpj,jpk) ) 
    470           zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s 
    471           ! 
    472           IF( iom_use( "PPPHYN" ) .OR. iom_use( "PPPHYD" ) .OR. iom_use( "PPPHYP" ) )  THEN 
    473               zw3d(:,:,:) = zprorcan(:,:,:) * zfact * tmask(:,:,:)  ! primary production by nanophyto 
    474               CALL iom_put( "PPPHYN"  , zw3d ) 
    475               ! 
    476               zw3d(:,:,:) = zprorcap(:,:,:) * zfact * tmask(:,:,:)  ! primary production by picophyto 
    477               CALL iom_put( "PPPHYP"  , zw3d ) 
    478               ! 
    479               zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:)  ! primary production by diatomes 
    480               CALL iom_put( "PPPHYD"  , zw3d ) 
    481           ENDIF 
    482           IF( iom_use( "PPNEWN" ) .OR. iom_use( "PPNEWD" ) .OR. iom_use( "PPNEWP" ) )  THEN 
    483               zw3d(:,:,:) = zpronewn(:,:,:) * zfact * tmask(:,:,:)  ! new primary production by nanophyto 
    484               CALL iom_put( "PPNEWN"  , zw3d ) 
    485               ! 
    486               zw3d(:,:,:) = zpronewp(:,:,:) * zfact * tmask(:,:,:)  ! new primary production by picophyto 
    487               CALL iom_put( "PPNEWP"  , zw3d ) 
    488               ! 
    489               zw3d(:,:,:) = zpronewd(:,:,:) * zfact * tmask(:,:,:)  ! new primary production by diatomes 
    490               CALL iom_put( "PPNEWD"  , zw3d ) 
    491           ENDIF 
    492           IF( iom_use( "PBSi" ) )  THEN 
    493               zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:) ! biogenic silica production 
    494               CALL iom_put( "PBSi"  , zw3d ) 
    495           ENDIF 
    496           IF( iom_use( "PFeN" ) .OR. iom_use( "PFeD" ) .OR. iom_use( "PFeP" ) )  THEN 
    497               zw3d(:,:,:) = zprofen(:,:,:) * zfact * tmask(:,:,:)  ! biogenic iron production by nanophyto 
    498               CALL iom_put( "PFeN"  , zw3d ) 
    499               ! 
    500               zw3d(:,:,:) = zprofep(:,:,:) * zfact * tmask(:,:,:)  ! biogenic iron production by picophyto 
    501               CALL iom_put( "PFeP"  , zw3d ) 
    502               ! 
    503               zw3d(:,:,:) = zprofed(:,:,:) * zfact * tmask(:,:,:)  ! biogenic iron production by  diatomes 
    504               CALL iom_put( "PFeD"  , zw3d ) 
    505           ENDIF 
    506           IF( iom_use( "LPRODP" ) )  THEN 
    507               zw3d(:,:,:) = zpligprod1(:,:,:) * 1e9 * zfact * tmask(:,:,:) 
    508               CALL iom_put( "LPRODP"  , zw3d ) 
    509           ENDIF 
    510           IF( iom_use( "LDETP" ) )  THEN 
    511               zw3d(:,:,:) = zpligprod2(:,:,:) * 1e9 * zfact * tmask(:,:,:) 
    512               CALL iom_put( "LDETP"  , zw3d ) 
    513           ENDIF 
    514           IF( iom_use( "Mumax" ) )  THEN 
    515               zw3d(:,:,:) = zprmaxn(:,:,:) * tmask(:,:,:)   ! Maximum growth rate 
    516               CALL iom_put( "Mumax"  , zw3d ) 
    517           ENDIF 
    518           IF( iom_use( "MuN" ) .OR. iom_use( "MuD" ) .OR. iom_use( "MuP" ) )  THEN 
    519               zw3d(:,:,:) = zprbio(:,:,:) * xlimphy(:,:,:) * tmask(:,:,:)  ! Realized growth rate for nanophyto 
    520               CALL iom_put( "MuN"  , zw3d ) 
    521               ! 
    522               zw3d(:,:,:) = zprpic(:,:,:) * xlimpic(:,:,:) * tmask(:,:,:)  ! Realized growth rate for picophyto 
    523               CALL iom_put( "MuP"  , zw3d ) 
    524               ! 
    525               zw3d(:,:,:) =  zprdia(:,:,:) * xlimdia(:,:,:) * tmask(:,:,:)  ! Realized growth rate for diatoms 
    526               CALL iom_put( "MuD"  , zw3d ) 
    527           ENDIF 
    528           IF( iom_use( "LNlight" ) .OR. iom_use( "LDlight" ) .OR. iom_use( "LPlight" ) )  THEN 
    529               zw3d(:,:,:) = zprbio (:,:,:) / (zprmaxn(:,:,:) + rtrn) * tmask(:,:,:) ! light limitation term 
    530               CALL iom_put( "LNlight"  , zw3d ) 
    531               ! 
    532               zw3d(:,:,:) = zprpic (:,:,:) / (zprmaxp(:,:,:) + rtrn) * tmask(:,:,:) ! light limitation term 
    533               CALL iom_put( "LPlight"  , zw3d ) 
    534               ! 
    535               zw3d(:,:,:) =  zprdia (:,:,:) / (zprmaxd(:,:,:) + rtrn) * tmask(:,:,:)  ! light limitation term 
    536               CALL iom_put( "LDlight"  , zw3d ) 
    537           ENDIF 
    538           IF( iom_use( "MunetN" ) .OR. iom_use( "MunetD" ) .OR. iom_use( "MunetP" ) )  THEN 
    539               zw3d(:,:,:) = zcroissn(:,:,:) * tmask(:,:,:) ! ! Realized growth rate for nanophyto 
    540               CALL iom_put( "MunetN"  , zw3d ) 
    541               ! 
    542               zw3d(:,:,:) = zcroissp(:,:,:) * tmask(:,:,:) ! ! Realized growth rate for picophyto 
    543               CALL iom_put( "MunetP"  , zw3d ) 
    544               ! 
    545               zw3d(:,:,:) = zcroissd(:,:,:) * tmask(:,:,:) ! ! Realized growth rate for diatomes 
    546               CALL iom_put( "MunetD"  , zw3d ) 
    547               ! 
    548           ENDIF 
    549  
    550           IF( iom_use( "tintpp" ) )  CALL iom_put( "tintpp" , tpp * zfact )  !  global total integrated primary production molC/s 
    551           ! 
    552           DEALLOCATE( zw2d, zw3d ) 
     428    IF( lk_iomput .AND.  knt == nrdttrc ) THEN 
     429       zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s 
     430       ! 
     431       CALL iom_put( "PPPHYP"  , zprorcap(:,:,:) * zfact * tmask(:,:,:)   ) ! primary production by picophyto 
     432       CALL iom_put( "PPPHYN"  , zprorcan(:,:,:) * zfact * tmask(:,:,:) )  ! primary production by nanophyto 
     433       CALL iom_put( "PPPHYD"  , zprorcad(:,:,:) * zfact * tmask(:,:,:)   ) ! primary production by diatomes 
     434       CALL iom_put( "PPNEWN"  , zpronewp(:,:,:) * zfact * tmask(:,:,:)    ) ! new primary production by picophyto 
     435       CALL iom_put( "PPNEWN"  , zpronewn(:,:,:) * zfact * tmask(:,:,:)    ) ! new primary production by nanophyto 
     436       CALL iom_put( "PPNEWD"  , zpronewd(:,:,:) * zfact * tmask(:,:,:)   ) ! new primary production by diatomes 
     437       CALL iom_put( "PBSi"    , zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:)  ) ! biogenic silica production 
     438       CALL iom_put( "PFeP"    , zprofep(:,:,:) * zfact * tmask(:,:,:)  ) ! biogenic iron production by picophyto 
     439       CALL iom_put( "PFeN"    , zprofen(:,:,:) * zfact * tmask(:,:,:)  ) ! biogenic iron production by nanophyto 
     440       CALL iom_put( "PFeD"    , zprofed(:,:,:) * zfact * tmask(:,:,:)  ) ! biogenic iron production by  diatomes 
     441       IF( ln_ligand ) THEN 
     442         CALL iom_put( "LPRODP"  , zpligprod1(:,:,:) * 1e9 * zfact * tmask(:,:,:) ) 
     443         CALL iom_put( "LDETP"   , zpligprod2(:,:,:) * 1e9 * zfact * tmask(:,:,:) ) 
    553444       ENDIF 
     445       CALL iom_put( "Mumax"   , zprmaxn(:,:,:) * tmask(:,:,:)  ) ! Maximum growth rate 
     446       CALL iom_put( "MuP"     , zprpic(:,:,:) * xlimpic(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for picophyto 
     447       CALL iom_put( "MuN"     , zprbio(:,:,:) * xlimphy(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for nanophyto 
     448       CALL iom_put( "MuD"     , zprdia(:,:,:) * xlimdia(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for diatoms 
     449       CALL iom_put( "LPlight" , zprpic(:,:,:) / (zprmaxp(:,:,:) + rtrn) * tmask(:,:,:)  )  ! light limitation term 
     450       CALL iom_put( "LNlight" , zprbio(:,:,:) / (zprmaxn(:,:,:) + rtrn) * tmask(:,:,:)  )  ! light limitation term 
     451       CALL iom_put( "LDlight" , zprdia(:,:,:) / (zprmaxd(:,:,:) + rtrn) * tmask(:,:,:)   ) 
     452       CALL iom_put( "MunetP"  , zcroissp(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for picophyto 
     453       CALL iom_put( "MunetN"  , zcroissn(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for nanophyto 
     454       CALL iom_put( "MunetD"  , zcroissd(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for diatoms 
     455       CALL iom_put( "TPP"     , ( zprorcap(:,:,:) + zprorcan(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:)  )  ! total primary production 
     456       CALL iom_put( "TPNEW"   , ( zpronewp(:,:,:) + zpronewn(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:)  ) ! total new production 
     457       CALL iom_put( "TPBFE"   , ( zprofep (:,:,:) + zprofen (:,:,:) + zprofed (:,:,:) ) * zfact * tmask(:,:,:)  )  ! total biogenic iron production 
     458       CALL iom_put( "tintpp"  , tpp * zfact )  !  global total integrated primary production molC/s 
    554459     ENDIF 
    555460 
    556       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     461      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    557462         WRITE(charout, FMT="('prod')") 
    558          CALL prt_ctl_trc_info(charout) 
    559          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     463         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     464         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    560465      ENDIF 
    561466      ! 
    … …  
    582487      !!---------------------------------------------------------------------- 
    583488 
    584       REWIND( numnatp_ref )              ! Namelist nampisprod in reference namelist : Pisces phytoplankton production 
    585489      READ  ( numnatp_ref, namp5zprod, IOSTAT = ios, ERR = 901) 
    586 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp5zprod in reference namelist', lwp ) 
    587  
    588       REWIND( numnatp_cfg )              ! Namelist nampisprod in configuration namelist : Pisces phytoplankton production 
     490901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp5zprod in reference namelist' ) 
     491 
    589492      READ  ( numnatp_cfg, namp5zprod, IOSTAT = ios, ERR = 902 ) 
    590 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namp5zprod in configuration namelist', lwp ) 
     493902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namp5zprod in configuration namelist' ) 
    591494      IF(lwm) WRITE ( numonp, namp5zprod ) 
    592495 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/SED/oce_sed.F90

    r10362 r13463  
    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!!st  
     16#if ! defined key_qco 
     17   USE dom_oce , ONLY :   e3t       =>   e3t            !: latitude  of t-point (degre) 
     18#endif 
    1619   USE dom_oce , ONLY :   e3t_1d    =>   e3t_1d         !: reference depth of t-points (m) 
    1720   USE dom_oce , ONLY :   gdepw_0   =>   gdepw_0        !: reference depth of t-points (m) 
    1821   USE dom_oce , ONLY :   mbkt      =>   mbkt           !: vertical index of the bottom last T- ocean level 
    1922   USE dom_oce , ONLY :   tmask     =>   tmask          !: land/ocean mask at t-points 
    20    USE dom_oce , ONLY :   rdt       =>   rdt            !: time step for the dynamics 
     23   USE dom_oce , ONLY :   rn_Dt     =>   rn_Dt          !: time step for the dynamics 
    2124   USE dom_oce , ONLY :   nyear     =>   nyear          !: Current year 
    2225   USE dom_oce , ONLY :   ndastp    =>   ndastp         !: time step date in year/month/day aammjj 
    … …  
    2629   !                                !: that may have been run with different time steps. 
    2730 
    28    USE oce     , ONLY :  tsn        =>   tsn             !: pot. temperature (celsius) and salinity (psu) 
    29    USE trc     , ONLY :  trb        =>   trb             !: pot. temperature (celsius) and salinity (psu) 
     31   USE oce     , ONLY :   ts        =>   ts              !: pot. temperature (celsius) and salinity (psu) 
     32   USE trc     , ONLY :   tr        =>   tr              !: pot. temperature (celsius) and salinity (psu) 
    3033 
    3134   USE sms_pisces, ONLY : wsbio4    =>   wsbio4          !: sinking flux for POC 
    3235   USE sms_pisces, ONLY : wsbio3    =>   wsbio3          !: sinking flux for GOC 
    33    USE sms_pisces, ONLY : wsbio2    =>   wsbio2           !: sinking flux for calcite 
     36   USE sms_pisces, ONLY : wsbio2    =>   wsbio2          !: sinking flux for calcite 
    3437   USE sms_pisces, ONLY : wsbio     =>   wsbio           !: sinking flux for calcite 
    3538   USE sms_pisces, ONLY : ln_p5z    =>   ln_p5z          !: PISCES-QUOTA flag 
    … …  
    4952   USE p4zche, ONLY     : sulfat    =>   sulfat          !: Chemical constants   
    5053   USE p4zche, ONLY     : sio3eq    =>   sio3eq          !: Chemical constants   
    51    USE p4zsbc, ONLY     : dust      =>   dust 
    52    USE trc       , ONLY : r2dttrc   =>   r2dttrc 
     54   USE p4zbc, ONLY     : dust      =>   dust 
     55   USE trc  , ONLY : rDt_trc   =>   rDt_trc 
    5356 
    5457END MODULE oce_sed 
    55  
    56  

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/SED/sedchem.F90

    r10356 r13463  
    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( 1, 1, 1, 1 ) 
     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) ) 
    … …  
    577577         saltprac(:) = salt(:) * 35.0 / 35.16504 
    578578      ELSE 
    579          saltprac(:) = temp(:) 
     579         saltprac(:) = salt(:) 
    580580      ENDIF 
    581581 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/SED/seddta.F90

    r10362 r13463  
    2222   REAL(wp) ::  conv2    ! [kg/m2/month]-->[g/cm2/s] ( 1 month has 30 days ) 
    2323 
     24   !! * Substitutions 
     25#  include "do_loop_substitute.h90" 
     26#  include "domzgr_substitute.h90" 
    2427   !! $Id$ 
    2528CONTAINS 
    … …  
    2932   !!--------------------------------------------------------------------------- 
    3033 
    31    SUBROUTINE sed_dta( kt ) 
     34   SUBROUTINE sed_dta( kt, Kbb, Kmm ) 
    3235      !!---------------------------------------------------------------------- 
    3336      !!                   ***  ROUTINE sed_dta  *** 
    … …  
    4346 
    4447      !! Arguments 
    45       INTEGER, INTENT(in) ::  kt    ! time-step 
     48      INTEGER, INTENT(in) ::  kt         ! time-step 
     49      INTEGER, INTENT(in) ::  Kbb, Kmm   ! time level indices 
    4650 
    4751      !! * Local declarations 
    … …  
    7276      IF( kt == nitsed000 ) THEN 
    7377         IF (lwp) WRITE(numsed,*) ' sed_dta : Sediment fields' 
    74          dtsed = r2dttrc 
     78         dtsed = rDt_trc 
    7579         rsecday = 60.* 60. * 24. 
    7680!         conv2   = 1.0e+3 / ( 1.0e+4 * rsecday * 30. ) 
    … …  
    9296      !    ----------------------------------------------------------- 
    9397      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 
     98         DO_2D( 1, 1, 1, 1 ) 
     99            ikt = mbkt(ji,jj) 
     100            zwsbio4(ji,jj) = wsbio2 / rday 
     101            zwsbio3(ji,jj) = wsbio  / rday 
     102         END_2D 
    101103      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 
     104         DO_2D( 1, 1, 1, 1 ) 
     105            ikt = mbkt(ji,jj) 
     106            zdep = e3t(ji,jj,ikt,Kmm) / rDt_trc 
     107            zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) / rday ) 
     108            zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) / rday ) 
     109         END_2D 
    110110      ENDIF 
    111111 
    112112      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 
     113      DO_2D( 1, 1, 1, 1 ) 
     114         ikt = mbkt(ji,jj) 
     115         IF ( tmask(ji,jj,ikt) == 1 ) THEN 
     116            trc_data(ji,jj,1)   = tr(ji,jj,ikt,jpsil,Kbb) 
     117            trc_data(ji,jj,2)   = tr(ji,jj,ikt,jpoxy,Kbb) 
     118            trc_data(ji,jj,3)   = tr(ji,jj,ikt,jpdic,Kbb) 
     119            trc_data(ji,jj,4)   = tr(ji,jj,ikt,jpno3,Kbb) / 7.625 
     120            trc_data(ji,jj,5)   = tr(ji,jj,ikt,jppo4,Kbb) / 122. 
     121            trc_data(ji,jj,6)   = tr(ji,jj,ikt,jptal,Kbb) 
     122            trc_data(ji,jj,7)   = tr(ji,jj,ikt,jpnh4,Kbb) / 7.625 
     123            trc_data(ji,jj,8)   = 0.0 
     124            trc_data(ji,jj,9)   = 28.0E-3 
     125            trc_data(ji,jj,10)  = tr(ji,jj,ikt,jpfer,Kbb) 
     126            trc_data(ji,jj,11 ) = MIN(tr(ji,jj,ikt,jpgsi,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 
     127            trc_data(ji,jj,12 ) = MIN(tr(ji,jj,ikt,jppoc,Kbb), 1E-4) * zwsbio3(ji,jj) * 1E3 
     128            trc_data(ji,jj,13 ) = MIN(tr(ji,jj,ikt,jpgoc,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 
     129            trc_data(ji,jj,14)  = MIN(tr(ji,jj,ikt,jpcal,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 
     130            trc_data(ji,jj,15)  = ts(ji,jj,ikt,jp_tem,Kmm) 
     131            trc_data(ji,jj,16)  = ts(ji,jj,ikt,jp_sal,Kmm) 
     132            trc_data(ji,jj,17 ) = ( tr(ji,jj,ikt,jpsfe,Kbb) * zwsbio3(ji,jj) + tr(ji,jj,ikt,jpbfe,Kbb)  & 
     133            &                     * zwsbio4(ji,jj)  ) * 1E3 / ( trc_data(ji,jj,12 ) + trc_data(ji,jj,13 ) + rtrn ) 
     134            trc_data(ji,jj,17 ) = MIN(1E-3, trc_data(ji,jj,17 ) ) 
     135         ENDIF 
     136      END_2D 
    139137 
    140138      ! Pore water initial concentration [mol/l] in  k=1 
    … …  
    167165      CALL pack_arr ( jpoce,  rainrm_dta(1:jpoce,jscal), trc_data(1:jpi,1:jpj,14), iarroce(1:jpoce) ) 
    168166      rainrm_dta(1:jpoce,jscal) = rainrm_dta(1:jpoce,jscal) * 1e-4 
    169       ! vector temperature [°C] and salinity  
     167      ! vector temperature [�C] and salinity  
    170168      CALL pack_arr ( jpoce,  temp(1:jpoce), trc_data(1:jpi,1:jpj,15), iarroce(1:jpoce) ) 
    171169      CALL pack_arr ( jpoce,  salt(1:jpoce), trc_data(1:jpi,1:jpj,16), iarroce(1:jpoce) ) 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/SED/sedini.F90

    r10362 r13463  
    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( 1, 1, 1, 1 ) 
     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( 1, 1, 1, 1 ) 
     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) 
    462 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_run in reference namelist', lwp ) 
    463  
    464       REWIND( numnamsed_cfg )              ! Namelist nam_run in reference namelist : Pisces variables 
     458901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_run in reference namelist' ) 
     459 
    465460      READ  ( numnamsed_cfg, nam_run, IOSTAT = ios, ERR = 902) 
    466 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_run in configuration namelist', lwp ) 
     461902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_run in configuration namelist' ) 
    467462 
    468463      IF (lwp) THEN 
    … …  
    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) 
    478 903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_geom in reference namelist', lwp ) 
    479  
    480       REWIND( numnamsed_cfg )              ! Namelist nam_geom in reference namelist : Pisces variables 
     472903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_geom in reference namelist' ) 
     473 
    481474      READ  ( numnamsed_cfg, nam_geom, IOSTAT = ios, ERR = 904) 
    482 904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_geom in configuration namelist', lwp ) 
     475904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_geom in configuration namelist' ) 
    483476 
    484477      IF (lwp) THEN  
    … …  
    495488 
    496489      jpksedm1  = jpksed - 1 
    497       dtsed = r2dttrc 
    498  
    499       REWIND( numnamsed_ref )              ! Namelist nam_trased in reference namelist : Pisces variables 
     490      dtsed = rDt_trc 
     491 
    500492      READ  ( numnamsed_ref, nam_trased, IOSTAT = ios, ERR = 905) 
    501 905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_trased in reference namelist', lwp ) 
    502  
    503       REWIND( numnamsed_cfg )              ! Namelist nam_trased in reference namelist : Pisces variables 
     493905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_trased in reference namelist' ) 
     494 
    504495      READ  ( numnamsed_cfg, nam_trased, IOSTAT = ios, ERR = 906) 
    505 906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_trased in configuration namelist', lwp ) 
     496906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_trased in configuration namelist' ) 
    506497 
    507498      DO jn = 1, jpsol 
    … …  
    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) 
    534 907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diased in reference namelist', lwp ) 
    535  
    536       REWIND( numnamsed_cfg )              ! Namelist nam_diased in reference namelist : Pisces variables 
     524907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diased in reference namelist' ) 
     525 
    537526      READ  ( numnamsed_cfg, nam_diased, IOSTAT = ios, ERR = 908) 
    538 908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diased in configuration namelist', lwp ) 
     527908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diased in configuration namelist' ) 
    539528       
    540529      DO jn = 1, jpdia3dsed 
    … …  
    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) 
    576 909   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_inorg in reference namelist', lwp ) 
    577  
    578       REWIND( numnamsed_cfg )              ! Namelist nam_inorg in reference namelist : Pisces variables 
     564909   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_inorg in reference namelist' ) 
     565 
    579566      READ  ( numnamsed_cfg, nam_inorg, IOSTAT = ios, ERR = 910) 
    580 910   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_inorg in configuration namelist', lwp ) 
     567910   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_inorg in configuration namelist' ) 
    581568 
    582569      IF (lwp) THEN 
    … …  
    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) 
    602 911   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_poc in reference namelist', lwp ) 
    603  
    604       REWIND( numnamsed_cfg )              ! Namelist nam_poc in reference namelist : Pisces variables 
     588911   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_poc in reference namelist' ) 
     589 
    605590      READ  ( numnamsed_cfg, nam_poc, IOSTAT = ios, ERR = 912) 
    606 912   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_poc in configuration namelist', lwp ) 
     591912   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_poc in configuration namelist' ) 
    607592 
    608593      IF (lwp) THEN 
    … …  
    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) 
    654 913   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_btb in reference namelist', lwp ) 
    655  
    656       REWIND( numnamsed_cfg )              ! Namelist nam_btb in reference namelist : Pisces variables 
     638913   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_btb in reference namelist' ) 
     639 
    657640      READ  ( numnamsed_cfg, nam_btb, IOSTAT = ios, ERR = 914) 
    658 914   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_btb in configuration namelist', lwp ) 
     641914   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_btb in configuration namelist' ) 
    659642 
    660643      IF (lwp) THEN 
    … …  
    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) 
    675 915   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_rst in reference namelist', lwp ) 
    676  
    677       REWIND( numnamsed_cfg )              ! Namelist nam_rst in reference namelist : Pisces variables 
     657915   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_rst in reference namelist' ) 
     658 
    678659      READ  ( numnamsed_cfg, nam_rst, IOSTAT = ios, ERR = 916) 
    679 916   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_rst in configuration namelist', lwp ) 
     660916   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_rst in configuration namelist' ) 
    680661 
    681662      IF (lwp) THEN 
    … …  
    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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/SED/sedinitrc.F90

    r10225 r13463  
    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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/SED/sedinorg.F90

    r10225 r13463  
    8989            zsolcpcl = zsolcpcl + solcp(ji,jk,jsclay) * dz(jk) 
    9090         END DO 
     91         zsolcpsi = MAX( zsolcpsi, rtrn ) 
    9192         zsieq(ji) = sieqs(ji) * MAX(0.25, 1.0 - (0.045 * zsolcpcl / zsolcpsi )**0.58 ) 
    9293         zsieq(ji) = MAX( rtrn, sieqs(ji) ) 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/SED/sedmodel.F90

    r10222 r13463  
    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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/SED/sedrst.F90

    r10425 r13463  
    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 
    … …  
    4949            IF( ln_rst_list ) THEN 
    5050               nrst_lst = 1 
    51                nitrst = nstocklist( nrst_lst ) 
     51               nitrst = nn_stocklist( nrst_lst ) 
    5252            ELSE 
    5353               nitrst = nitend 
    5454            ENDIF 
    5555         ENDIF 
    56          IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN 
     56         IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nn_stock ) == 0 ) THEN 
    5757            ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment 
    58             nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing 
     58            nitrst = kt + nn_stock - 1                  ! define the next value of nitrst for restart writing 
    5959            IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run 
    6060         ENDIF 
    … …  
    6363      ENDIF 
    6464 
     65      IF( .NOT. ln_rst_list .AND. nn_stock == -1 )   RETURN   ! we will never do any restart 
     66 
    6567      ! to get better performances with NetCDF format: 
    66       ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1) 
    67       ! 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       IF( kt == nitrst - 2*nn_dtsed .OR. nstock == nn_dtsed .OR. ( kt == nitend - nn_dtsed .AND. .NOT. lrst_sed ) ) THEN 
     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 
     70      IF( kt == nitrst - 2*nn_dtsed .OR. nn_stock == nn_dtsed .OR. ( kt == nitend - nn_dtsed .AND. .NOT. lrst_sed ) ) THEN 
    6971         ! beware of the format used to write kt (default is i8.8, that should be large enough) 
    7072         IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst 
    … …  
    7880         IF(lwp) WRITE(numsed,*) & 
    7981             '             open sed restart.output NetCDF file: ',TRIM(clpath)//clname 
    80          CALL iom_open( TRIM(clpath)//TRIM(clname), numrsw, ldwrt = .TRUE., kdlev = jpksed ) 
     82         CALL iom_open( TRIM(clpath)//TRIM(clname), numrsw, ldwrt = .TRUE., kdlev = jpksed, cdcomp = 'SED' ) 
    8183         lrst_sed = .TRUE. 
    8284      ENDIF 
    … …  
    121123         cltra = TRIM(sedtrcd(jn)) 
    122124         IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 
    123             CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta(:,:,:,jn) ) 
     125            CALL iom_get( numrsr, jpdom_auto, TRIM(cltra), zdta(:,:,:,jn) ) 
    124126         ELSE 
    125127            zdta(:,:,:,jn) = 0.0 
    … …  
    140142         cltra = TRIM(seddia3d(jn)) 
    141143         IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 
    142             CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta1(:,:,:,jn) ) 
     144            CALL iom_get( numrsr, jpdom_auto, TRIM(cltra), zdta1(:,:,:,jn) ) 
    143145         ELSE 
    144146            zdta1(:,:,:,jn) = 0.0 
    … …  
    167169      cltra = "dbioturb" 
    168170      IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 
    169          CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta2(:,:,:) ) 
     171         CALL iom_get( numrsr, jpdom_auto, TRIM(cltra), zdta2(:,:,:) ) 
    170172      ELSE 
    171173         zdta2(:,:,:) = 0.0 
    … …  
    177179      cltra = "irrig" 
    178180      IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 
    179          CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta2(:,:,:) ) 
     181         CALL iom_get( numrsr, jpdom_auto, TRIM(cltra), zdta2(:,:,:) ) 
    180182      ELSE 
    181183         zdta2(:,:,:) = 0.0 
    … …  
    187189      cltra = "sedligand" 
    188190      IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 
    189          CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta2(:,:,:) ) 
     191         CALL iom_get( numrsr, jpdom_auto, TRIM(cltra), zdta2(:,:,:) ) 
    190192      ELSE 
    191193         zdta2(:,:,:) = 0.0 
    … …  
    300302          IF( l_offline .AND. ln_rst_list ) THEN 
    301303             nrst_lst = nrst_lst + 1 
    302              nitrst = nstocklist( nrst_lst ) 
     304             nitrst = nn_stocklist( nrst_lst ) 
    303305          ENDIF 
    304306      ENDIF 
    … …  
    328330      !!       In both those options, the  exact duration of the experiment 
    329331      !!       since the beginning (cumulated duration of all previous restart runs) 
    330       !!       is not stored in the restart and is assumed to be (nittrc000-1)*rdt. 
     332      !!       is not stored in the restart and is assumed to be (nittrc000-1)*rn_Dt. 
    331333      !!       This is valid is the time step has remained constant. 
    332334      !! 
    … …  
    379381             ELSE 
    380382               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam 
    381                adatrj = ( REAL( nittrc000-1, wp ) * rdt ) / rday 
     383               adatrj = ( REAL( nittrc000-1, wp ) * rn_Dt ) / rday 
    382384               ! note this is wrong if time step has changed during run 
    383385            ENDIF 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/SED/sedsfc.F90

    r10222 r13463  
    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( 1, 1, 1, 1 ) 
     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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/SED/sedstp.F90

    r10222 r13463  
    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 
    56       dtsed  = r2dttrc 
     57      dtsed  = rDt_trc 
    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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/SED/sedwri.F90

    r10222 r13463  
    9494         DO ji = 1, jpoce 
    9595            zflx(ji,jw) = ( pwcp(ji,1,jw) - pwcp_dta(ji,jw) ) & 
    96                &         * 1.e3 / 1.e2 * dzkbot(ji) / r2dttrc 
     96               &         * 1.e3 / 1.e2 * dzkbot(ji) / rDt_trc 
    9797         ENDDO 
    9898      ENDDO 
    … …  
    100100      ! Calculation of accumulation rate per dt 
    101101      DO js = 1, jpsol 
    102          zrate =  1.0 / ( denssol * por1(jpksed) ) / r2dttrc 
     102         zrate =  1.0 / ( denssol * por1(jpksed) ) / rDt_trc 
    103103         DO ji = 1, jpoce 
    104104            zflx(ji,jpwatp1) = zflx(ji,jpwatp1) + ( tosed(ji,js) - fromsed(ji,js) ) * zrate 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/SED/trcdmp_sed.F90

    r10225 r13463  
    2121   USE trc             ! ocean passive tracers variables 
    2222   USE trcdta 
    23    USE prtctl_trc      ! Print control for debbuging 
     23   USE prtctl          ! Print control for debbuging 
    2424   USE iom 
    2525 
    … …  
    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( 1, 1, 1, 1 ) 
     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 ')") 
    110          CALL prt_ctl_trc_info(charout) 
    111          CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     109         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     110         CALL prt_ctl( tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/par_pisces.F90

    r10416 r13463  
    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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/sms_pisces.F90

    r10788 r13463  
    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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/trcini_pisces.F90

    r10817 r13463  
    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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/trcnam_pisces.F90

    r10222 r13463  
    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) 
    59 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampismod in reference namelist', lwp ) 
    60       REWIND( numnatp_cfg )              ! Namelist nampisbio in configuration namelist : Pisces variables 
     58901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampismod in reference namelist' ) 
    6159      READ  ( numnatp_cfg, nampismod, IOSTAT = ios, ERR = 902 ) 
    62 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampismod in configuration namelist', lwp ) 
     60902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampismod in configuration namelist' ) 
    6361      IF(lwm) WRITE( numonp, nampismod ) 
    6462      ! 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/trcsms_pisces.F90

    r10068 r13463  
    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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/trcwri_pisces.F90

    r10069 r13463  
    1919   PUBLIC trc_wri_pisces  
    2020 
     21   !! * Substitutions 
     22#  include "do_loop_substitute.h90" 
     23#  include "domzgr_substitute.h90" 
    2124   !!---------------------------------------------------------------------- 
    2225   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    2629CONTAINS 
    2730 
    28    SUBROUTINE trc_wri_pisces 
     31   SUBROUTINE trc_wri_pisces( Kmm ) 
    2932      !!--------------------------------------------------------------------- 
    3033      !!                     ***  ROUTINE trc_wri_trc  *** 
    … …  
    3235      !! ** Purpose :   output passive tracers fields  
    3336      !!--------------------------------------------------------------------- 
     37      INTEGER, INTENT(in)          :: Kmm      ! time level indices 
    3438      CHARACTER (len=20)           :: cltra 
    3539      REAL(wp)                     :: zfact 
    … …  
    4347         DO jn = jp_pcs0, jp_pcs1 
    4448            cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
    45             CALL iom_put( cltra, trn(:,:,:,jn) ) 
     49            CALL iom_put( cltra, tr(:,:,:,jn,Kmm) ) 
    4650         END DO 
    4751      ELSE 
    … …  
    5155            IF( jn == jppo4  )                 zfact = po4r * 1.0e+6 
    5256            cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
    53             IF( iom_use( cltra ) )  CALL iom_put( cltra, trn(:,:,:,jn) * zfact ) 
     57            IF( iom_use( cltra ) )  CALL iom_put( cltra, tr(:,:,:,jn,Kmm) * zfact ) 
    5458         END DO 
    5559 
    … …  
    5761            zdic(:,:) = 0. 
    5862            DO jk = 1, jpkm1 
    59                zdic(:,:) = zdic(:,:) + trn(:,:,jk,jpdic) * e3t_n(:,:,jk) * tmask(:,:,jk) * 12. 
     63               zdic(:,:) = zdic(:,:) + tr(:,:,jk,jpdic,Kmm) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) * 12. 
    6064            ENDDO 
    6165            CALL iom_put( 'INTDIC', zdic )      
    … …  
    6367         ! 
    6468         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 
     69            zo2min   (:,:) = tr(:,:,1,jpoxy,Kmm) * tmask(:,:,1) 
     70            zdepo2min(:,:) = gdepw(:,:,1,Kmm)   * tmask(:,:,1) 
     71            DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 
     72               IF( tmask(ji,jj,jk) == 1 ) then 
     73                  IF( tr(ji,jj,jk,jpoxy,Kmm) < zo2min(ji,jj) ) then 
     74                     zo2min   (ji,jj) = tr(ji,jj,jk,jpoxy,Kmm) 
     75                     zdepo2min(ji,jj) = gdepw(ji,jj,jk,Kmm) 
     76                  ENDIF 
     77               ENDIF 
     78            END_3D 
    7979            ! 
    8080            CALL iom_put('O2MIN' , zo2min     )                              ! oxygen minimum concentration 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/README.rst

    r10549 r13463  
    33*************** 
    44 
     5.. todo:: 
     6 
     7 
     8 
    59.. contents:: 
    6    :local: 
    7  
    8 TOP (Tracers in the Ocean Paradigm) is the NEMO hardwired interface toward biogeochemical models and 
    9 provide the physical constraints/boundaries for oceanic tracers. 
    10 It consists of a modular framework to handle multiple ocean tracers, including also a variety of built-in modules. 
     10   :local: 
     11 
     12TOP (Tracers in the Ocean Paradigm) is the NEMO hardwired interface toward 
     13biogeochemical models and provide the physical constraints/boundaries for oceanic tracers. 
     14It consists of a modular framework to handle multiple ocean tracers, 
     15including also a variety of built-in modules. 
    1116 
    1217This component of the NEMO framework allows one to exploit available modules (see below) and 
    1318further develop a range of applications, spanning from the implementation of a dye passive tracer to 
    1419evaluate dispersion processes (by means of MY_TRC), track water masses age (AGE module), 
    15 assess the ocean interior penetration of persistent chemical compounds (e.g., gases like CFC or even PCBs), 
    16 up to the full set of equations involving marine biogeochemical cycles. 
     20assess the ocean interior penetration of persistent chemical compounds 
     21(e.g., gases like CFC or even PCBs), up to the full set of equations involving 
     22marine biogeochemical cycles. 
    1723 
    1824Structure 
    1925========= 
    2026 
    21 TOP interface has the following location in the source code ``./src/MBG/`` and 
     27TOP interface has the following location in the source code :file:`./src/TOP` and 
    2228the following modules are available: 
    2329 
    24 ``TRP`` 
    25    Interface to NEMO physical core for computing tracers transport 
    26  
    27 ``CFC`` 
    28    Inert carbon tracers (CFC11,CFC12,SF6) 
    29  
    30 ``C14`` 
    31    Radiocarbon passive tracer 
    32  
    33 ``AGE`` 
    34    Water age tracking 
    35  
    36 ``MY_TRC`` 
    37    Template for creation of new modules and external BGC models coupling 
    38  
    39 ``PISCES`` 
    40    Built in BGC model. 
    41    See [https://www.geosci-model-dev.net/8/2465/2015/gmd-8-2465-2015-discussion.html Aumont et al. (2015)] for 
    42    a throughout description. | 
    43  
    44 The usage of TOP is activated i) by including in the configuration definition  the component ``MBG`` and 
    45 ii) by adding the macro ``key_top`` in the configuration CPP file 
    46 (see for more details [http://forge.ipsl.jussieu.fr/nemo/wiki/Users "Learn more about the model"]). 
     30:file:`TRP` 
     31   Interface to NEMO physical core for computing tracers transport 
     32 
     33:file:`CFC` 
     34   Inert carbon tracers (CFC11,CFC12,SF6) 
     35 
     36:file:`C14` 
     37   Radiocarbon passive tracer 
     38 
     39:file:`AGE` 
     40   Water age tracking 
     41 
     42:file:`MY_TRC` 
     43   Template for creation of new modules and external BGC models coupling 
     44 
     45:file:`PISCES` 
     46   Built in BGC model. See :cite:`gmd-8-2465-2015` for a throughout description. 
     47 
     48The usage of TOP is activated 
     49*i)* by including in the configuration definition the component ``TOP`` and 
     50*ii)* by adding the macro ``key_top`` in the configuration CPP file 
     51(see for more details :forge:`"Learn more about the model" <wiki/Users>`). 
    4752 
    4853As an example, the user can refer to already available configurations in the code, 
    … …  
    5156(see also Section 4) . 
    5257 
    53 Note that, since version 4.0, TOP interface core functionalities are activated by means of logical keys and 
     58Note that, since version 4.0, 
     59TOP interface core functionalities are activated by means of logical keys and 
    5460all submodules preprocessing macros from previous versions were removed. 
    5561 
    … …  
    5763 
    5864``key_iomput`` 
    59    use XIOS I/O 
     65   use XIOS I/O 
    6066 
    6167``key_agrif`` 
    62    enable AGRIF coupling 
     68   enable AGRIF coupling 
    6369 
    6470``key_trdtrc`` & ``key_trdmxl_trc`` 
    65    trend computation for tracers 
     71   trend computation for tracers 
    6672 
    6773Synthetic Workflow 
    6874================== 
    6975 
    70 A synthetic description of the TOP interface workflow is given below to summarize the steps involved in 
    71 the computation of biogeochemical and physical trends and their time integration and outputs, 
     76A synthetic description of the TOP interface workflow is given below to 
     77summarize the steps involved in the computation of biogeochemical and physical trends and 
     78their time integration and outputs, 
    7279by reporting also the principal Fortran subroutine herein involved. 
    7380 
    74 **Model initialization (OPA_SRC/nemogcm.F90)** 
    75  
    76 call to trc_init (trcini.F90) 
    77  
    78   ↳ call trc_nam (trcnam.F90) to initialize TOP tracers and run setting 
    79  
    80   ↳ call trc_ini_sms, to initialize each submodule 
    81  
    82   ↳ call trc_ini_trp, to initialize transport for tracers 
    83  
    84   ↳ call trc_ice_ini, to initialize tracers in seaice 
    85  
    86   ↳ call trc_ini_state, read passive tracers from a restart or input data 
    87  
    88   ↳ call trc_sub_ini, setup substepping if {{{nn_dttrc /= 1}}} 
    89  
    90 **Time marching procedure (OPA_SRC/stp.F90)** 
    91  
    92 call to trc_stp.F90 (trcstp.F90) 
    93  
    94   ↳ call trc_sub_stp, averaging physical variables for sub-stepping 
    95  
    96   ↳ call trc_wri, call XIOS for output of data 
    97  
    98   ↳ call trc_sms, compute BGC trends for each submodule 
    99  
    100     ↳ call trc_sms_my_trc, includes also surface and coastal BCs trends 
    101  
    102   ↳ call trc_trp (TRP/trctrp.F90), compute physical trends 
    103  
    104     ↳ call trc_sbc, get trend due to surface concentration/dilution 
    105  
    106     ↳ call trc_adv, compute tracers advection 
    107  
    108     ↳ call to trc_ldf, compute tracers lateral diffusion 
    109  
    110     ↳ call to trc_zdf, vertical mixing and after tracer fields 
    111  
    112     ↳ call to trc_nxt, tracer fields at next time step. Lateral Boundary Conditions are solved in here. 
    113  
    114     ↳ call to trc_rad, Correct artificial negative concentrations 
    115  
    116   ↳ call trc_rst_wri, output tracers restart files 
     81Model initialization (:file:`./src/OCE/nemogcm.F90`) 
     82---------------------------------------------------- 
     83 
     84Call to ``trc_init`` subroutine (:file:`./src/TOP/trcini.F90`) to initialize TOP. 
     85 
     86.. literalinclude:: ../../../src/TOP/trcini.F90 
     87   :language:        fortran 
     88   :lines:           41-86 
     89   :emphasize-lines: 21,30-32,38-40 
     90   :caption:         ``trc_init`` subroutine 
     91 
     92Time marching procedure (:file:`./src/OCE/step.F90`) 
     93---------------------------------------------------- 
     94 
     95Call to ``trc_stp`` subroutine (:file:`./src/TOP/trcstp.F90`) to compute/update passive tracers. 
     96 
     97.. literalinclude:: ../../../src/TOP/trcstp.F90 
     98   :language:        fortran 
     99   :lines:           46-125 
     100   :emphasize-lines: 42,55-57 
     101   :caption:         ``trc_stp`` subroutine 
     102 
     103BGC trends computation for each submodule (:file:`./src/TOP/trcsms.F90`) 
     104------------------------------------------------------------------------ 
     105 
     106.. literalinclude:: ../../../src/TOP/trcsms.F90 
     107   :language:        fortran 
     108   :lines:           21 
     109   :caption:         :file:`trcsms` snippet 
     110 
     111Physical trends computation (:file:`./src/TOP/TRP/trctrp.F90`) 
     112-------------------------------------------------------------- 
     113 
     114.. literalinclude:: ../../../src/TOP/TRP/trctrp.F90 
     115   :language:        fortran 
     116   :lines:           46-95 
     117   :emphasize-lines: 17,21,29,33-35 
     118   :caption:         ``trc_trp`` subroutine 
    117119 
    118120Namelists walkthrough 
    119121===================== 
    120122 
    121 namelist_top 
    122 ------------ 
    123  
    124 Here below are listed the features/options of the TOP interface accessible through the namelist_top_ref and 
    125 modifiable by means of namelist_top_cfg (as for NEMO physical ones). 
    126  
    127 Note that ## is used to refer to a number in an array field. 
     123:file:`namelist_top` 
     124-------------------- 
     125 
     126Here below are listed the features/options of the TOP interface accessible through 
     127the :file:`namelist_top_ref` and modifiable by means of :file:`namelist_top_cfg` 
     128(as for NEMO physical ones). 
     129 
     130Note that ``##`` is used to refer to a number in an array field. 
    128131 
    129132.. literalinclude:: ../../namelists/namtrc_run 
     133   :language: fortran 
    130134 
    131135.. literalinclude:: ../../namelists/namtrc 
     136   :language: fortran 
    132137 
    133138.. literalinclude:: ../../namelists/namtrc_dta 
     139   :language: fortran 
    134140 
    135141.. literalinclude:: ../../namelists/namtrc_adv 
     142   :language: fortran 
    136143 
    137144.. literalinclude:: ../../namelists/namtrc_ldf 
     145   :language: fortran 
    138146 
    139147.. literalinclude:: ../../namelists/namtrc_rad 
     148   :language: fortran 
    140149 
    141150.. literalinclude:: ../../namelists/namtrc_snk 
     151   :language: fortran 
    142152 
    143153.. literalinclude:: ../../namelists/namtrc_dmp 
     154   :language: fortran 
    144155 
    145156.. literalinclude:: ../../namelists/namtrc_ice 
     157   :language: fortran 
    146158 
    147159.. literalinclude:: ../../namelists/namtrc_trd 
     160   :language: fortran 
    148161 
    149162.. literalinclude:: ../../namelists/namtrc_bc 
     163   :language: fortran 
    150164 
    151165.. literalinclude:: ../../namelists/namtrc_bdy 
     166   :language: fortran 
    152167 
    153168.. literalinclude:: ../../namelists/namage 
    154  
    155 Two main types of data structure are used within TOP interface to initialize tracer properties (1) and 
     169   :language: fortran 
     170 
     171Two main types of data structure are used within TOP interface 
     172to initialize tracer properties (1) and 
    156173to provide related initial and boundary conditions (2). 
    157174 
    158 **1. TOP tracers initialization**: sn_tracer (namtrc) 
     1751. TOP tracers initialization: ``sn_tracer`` (``&namtrc``) 
     176^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 
    159177 
    160178Beside providing name and metadata for tracers, 
    161 here are also defined the use of initial ({{{sn_tracer%llinit}}}) and 
    162 boundary ({{{sn_tracer%llsbc, sn_tracer%llcbc, sn_tracer%llobc}}}) conditions. 
    163  
    164 In the following, an example of the full structure definition is given for two idealized tracers both with 
    165 initial conditions given, while the first has only surface boundary forcing and 
     179here are also defined the use of initial (``sn_tracer%llinit``) and 
     180boundary (``sn_tracer%llsbc, sn_tracer%llcbc, sn_tracer%llobc``) conditions. 
     181 
     182In the following, an example of the full structure definition is given for 
     183two idealized tracers both with initial conditions given, 
     184while the first has only surface boundary forcing and 
    166185the second both surface and coastal forcings: 
    167186 
    168187.. code-block:: fortran 
    169188 
    170    !             !    name   !           title of the field            !   units    ! initial data ! sbc   !   cbc  !   obc  ! 
    171    sn_tracer(1)  = 'TRC1'    , 'Tracer 1 Concentration                ',   ' - '    ,  .true.      , .true., .false., .true. 
    172    sn_tracer(2)  = 'TRC2 '   , 'Tracer 2 Concentration                ',   ' - '    ,  .true.      , .true., .true. , .false. 
     189   !             !    name   !           title of the field            !   units    ! initial data ! sbc   !   cbc  !   obc  ! 
     190   sn_tracer(1)  = 'TRC1'    , 'Tracer 1 Concentration                ',   ' - '    ,  .true.      , .true., .false., .true. 
     191   sn_tracer(2)  = 'TRC2 '   , 'Tracer 2 Concentration                ',   ' - '    ,  .true.      , .true., .true. , .false. 
    173192 
    174193As tracers in BGC models are increasingly growing, 
    … …  
    177196.. code-block:: fortran 
    178197 
    179    !             !    name   !           title of the field            !   units    ! initial data ! 
    180    sn_tracer(1)  = 'TRC1'    , 'Tracer 1 Concentration                ',   ' - '    ,   .true. 
    181    sn_tracer(2)  = 'TRC2 '   , 'Tracer 2 Concentration                ',   ' - '    ,   .true. 
    182    ! sbc 
    183    sn_tracer(1)%llsbc = .true. 
    184    sn_tracer(2)%llsbc = .true. 
    185    ! cbc 
    186    sn_tracer(2)%llcbc = .true. 
     198   !             !    name   !           title of the field            !   units    ! initial data ! 
     199   sn_tracer(1)  = 'TRC1'    , 'Tracer 1 Concentration                ',   ' - '    ,   .true. 
     200   sn_tracer(2)  = 'TRC2 '   , 'Tracer 2 Concentration                ',   ' - '    ,   .true. 
     201   ! sbc 
     202   sn_tracer(1)%llsbc = .true. 
     203   sn_tracer(2)%llsbc = .true. 
     204   ! cbc 
     205   sn_tracer(2)%llcbc = .true. 
    187206 
    188207The data structure is internally initialized by code with dummy names and 
    189 all initialization/forcing logical fields set to .false. . 
    190  
    191 **2. Structures to read input initial and boundary conditions**: namtrc_dta (sn_trcdta), namtrc_bc (sn_trcsbc/sn_trccbc/sn_trcobc) 
     208all initialization/forcing logical fields set to ``.false.`` . 
     209 
     2102. Structures to read input initial and boundary conditions: ``&namtrc_dta`` (``sn_trcdta``), ``&namtrc_bc`` (``sn_trcsbc`` / ``sn_trccbc`` / ``sn_trcobc``) 
     211^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 
    192212 
    193213The overall data structure (Fortran type) is based on the general one defined for NEMO core in the SBC component 
    194 (see details in User Manual SBC Chapter on Input Data specification). 
    195  
    196 Input fields are prescribed within namtrc_dta (with sn_trcdta structure), 
    197 while Boundary Conditions are applied to the model by means of namtrc_bc, 
    198 with dedicated structure fields for surface (sn_trcsbc), riverine (sn_trccbc), and 
    199 lateral open (sn_trcobc) boundaries. 
     214(see details in ``SBC`` Chapter of :doc:`Reference Manual <cite>` on Input Data specification). 
     215 
     216Input fields are prescribed within ``&namtrc_dta`` (with ``sn_trcdta`` structure), 
     217while Boundary Conditions are applied to the model by means of ``&namtrc_bc``, 
     218with dedicated structure fields for surface (``sn_trcsbc``), riverine (``sn_trccbc``), and 
     219lateral open (``sn_trcobc``) boundaries. 
    200220 
    201221The following example illustrates the data structure in the case of initial condition for 
    202 a single tracer contained in the file named tracer_1_data.nc (.nc is implicitly assumed in namelist filename), 
    203 with a doubled initial value, and located in the usr/work/model/inputdata/ folder: 
     222a single tracer contained in the file named :file:`tracer_1_data.nc` 
     223(``.nc`` is implicitly assumed in namelist filename), 
     224with a doubled initial value, and located in the :file:`usr/work/model/inputdata` folder: 
    204225 
    205226.. code-block:: fortran 
    206227 
    207    !               !  file name             ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    208    !               !                        !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      ! 
    209      sn_trcdta(1)  = 'tracer_1_data'        ,        -12        ,  'TRC1'   ,    .false.   , .true. , 'yearly'  , ''       , ''       , '' 
    210      rf_trfac(1) = 2.0 
    211      cn_dir = “usr/work/model/inputdata/” 
    212  
    213 Note that, the Lateral Open Boundaries conditions are applied on the segments defined for the physical core of NEMO 
    214 (see BDY description in the User Manual). 
    215  
    216 namelist_trc 
    217 ------------ 
    218  
    219 Here below the description of namelist_trc_ref used to handle Carbon tracers modules, namely CFC and C14. 
    220  
    221 |||| &'''namcfc'''     !   CFC || 
    222  
    223 |||| &'''namc14_typ'''     !  C14 - type of C14 tracer, default values of C14/C and pco2 || 
    224  
    225 |||| &'''namc14_sbc'''     !  C14 - surface BC || 
    226  
    227 |||| &'''namc14_fcg'''     !  files & dates || 
     228   !               !  file name             ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
     229   !               !                        !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      ! 
     230     sn_trcdta(1)  = 'tracer_1_data'        ,        -12        ,  'TRC1'   ,    .false.   , .true. , 'yearly'  , ''       , ''       , '' 
     231     rf_trfac(1) = 2.0 
     232     cn_dir = 'usr/work/model/inputdata/' 
     233 
     234Note that, the Lateral Open Boundaries conditions are applied on 
     235the segments defined for the physical core of NEMO 
     236(see ``BDY`` description in the :doc:`Reference Manual <cite>`). 
     237 
     238:file:`namelist_trc` 
     239-------------------- 
     240 
     241Here below the description of :file:`namelist_trc_ref` used to handle Carbon tracers modules, 
     242namely CFC and C14. 
     243 
     244.. literalinclude:: ../../../cfgs/SHARED/namelist_trc_ref 
     245   :language: fortran 
     246   :lines: 7,17,26,34 
     247   :caption: :file:`namelist_trc_ref` snippet 
    228248 
    229249``MY_TRC`` interface for coupling external BGC models 
    230250===================================================== 
    231251 
    232 The generalized interface is pivoted on MY_TRC module that contains template files to build the coupling between 
     252The generalized interface is pivoted on MY_TRC module that contains template files to 
     253build the coupling between 
    233254NEMO and any external BGC model. 
    234255 
    235 The call to MY_TRC is activated by setting ``ln_my_trc = .true.`` (in namtrc) 
     256The call to MY_TRC is activated by setting ``ln_my_trc = .true.`` (in ``&namtrc``) 
    236257 
    237258The following 6 fortran files are available in MY_TRC with the specific purposes here described. 
    238259 
    239 ``par_my_trc.F90`` 
    240    This module allows to define additional arrays and public variables to be used within the MY_TRC interface 
    241  
    242 ``trcini_my_trc.F90`` 
    243    Here are initialized user defined namelists and the call to the external BGC model initialization procedures to 
    244    populate general tracer array (trn and trb). Here are also likely to be defined suport arrays related to 
    245    system metrics that could be needed by the BGC model. 
    246  
    247 ``trcnam_my_trc.F90`` 
    248    This routine is called at the beginning of trcini_my_trc and should contain the initialization of 
    249    additional namelists for the BGC model or user-defined code. 
    250  
    251 ``trcsms_my_trc.F90`` 
    252    The routine performs the call to Boundary Conditions and its main purpose is to 
    253    contain the Source-Minus-Sinks terms due to the biogeochemical processes of the external model. 
    254    Be aware that lateral boundary conditions are applied in trcnxt routine. 
    255    IMPORTANT: the routines to compute the light penetration along the water column and 
    256    the tracer vertical sinking should be defined/called in here, as generalized modules are still missing in 
    257    the code. 
    258  
    259 ``trcice_my_trc.F90`` 
    260    Here it is possible to prescribe the tracers concentrations in the seaice that will be used as 
    261    boundary conditions when ice melting occurs (nn_ice_tr =1 in namtrc_ice). 
    262    See e.g. the correspondent PISCES subroutine. 
    263  
    264 ``trcwri_my_trc.F90`` 
    265    This routine performs the output of the model tracers (only those defined in namtrc) using IOM module 
    266    (see Manual Chapter “Output and Diagnostics”). 
    267    It is possible to place here the output of additional variables produced by the model, 
    268    if not done elsewhere in the code, using the call to iom_put. 
     260:file:`par_my_trc.F90` 
     261   This module allows to define additional arrays and public variables to 
     262   be used within the MY_TRC interface 
     263 
     264:file:`trcini_my_trc.F90` 
     265   Here are initialized user defined namelists and 
     266   the call to the external BGC model initialization procedures to populate general tracer array 
     267   (``trn`` and ``trb``). 
     268   Here are also likely to be defined support arrays related to system metrics that 
     269   could be needed by the BGC model. 
     270 
     271:file:`trcnam_my_trc.F90` 
     272   This routine is called at the beginning of ``trcini_my_trc`` and 
     273   should contain the initialization of additional namelists for the BGC model or user-defined code. 
     274 
     275:file:`trcsms_my_trc.F90` 
     276   The routine performs the call to Boundary Conditions and its main purpose is to 
     277   contain the Source-Minus-Sinks terms due to the biogeochemical processes of the external model. 
     278   Be aware that lateral boundary conditions are applied in trcnxt routine. 
     279 
     280   .. warning:: 
     281      The routines to compute the light penetration along the water column and 
     282      the tracer vertical sinking should be defined/called in here, 
     283      as generalized modules are still missing in the code. 
     284 
     285:file:`trcice_my_trc.F90` 
     286   Here it is possible to prescribe the tracers concentrations in the sea-ice that 
     287   will be used as boundary conditions when ice melting occurs (``nn_ice_tr = 1`` in ``&namtrc_ice``). 
     288   See e.g. the correspondent PISCES subroutine. 
     289 
     290:file:`trcwri_my_trc.F90` 
     291   This routine performs the output of the model tracers (only those defined in ``&namtrc``) using 
     292   IOM module (see chapter “Output and Diagnostics” in the :doc:`Reference Manual <cite>`). 
     293   It is possible to place here the output of additional variables produced by the model, 
     294   if not done elsewhere in the code, using the call to ``iom_put``. 
    269295 
    270296Coupling an external BGC model using NEMO framework 
    … …  
    273299The coupling with an external BGC model through the NEMO compilation framework can be achieved in 
    274300different ways according to the degree of coding complexity of the Biogeochemical model, like e.g., 
    275 the whole code is made only by one file or it has multiple modules and interfaces spread across several subfolders. 
    276  
    277 Beside the 6 core files of MY_TRC module, let’s assume an external BGC model named *MYBGC* and constituted by 
    278 a rather essential coding structure, likely few Fortran files. 
     301the whole code is made only by one file or 
     302it has multiple modules and interfaces spread across several subfolders. 
     303 
     304Beside the 6 core files of MY_TRC module, let’s assume an external BGC model named *MYBGC* and 
     305constituted by a rather essential coding structure, likely few Fortran files. 
    279306The new coupled configuration name is *NEMO_MYBGC*. 
    280307 
    281 The best solution is to have all files (the modified ``MY_TRC`` routines and the BGC model ones) placed in 
    282 a unique folder with root ``MYBGCPATH`` and to use the makenemo external readdressing of ``MY_SRC`` folder. 
    283  
    284 The coupled configuration listed in ``work_cfgs.txt`` will look like 
     308The best solution is to have all files (the modified ``MY_TRC`` routines and the BGC model ones) 
     309placed in a unique folder with root ``MYBGCPATH`` and 
     310to use the makenemo external readdressing of ``MY_SRC`` folder. 
     311 
     312The coupled configuration listed in :file:`work_cfgs.txt` will look like 
    285313 
    286314:: 
    287315 
    288    NEMO_MYBGC OPA_SRC TOP_SRC 
     316   NEMO_MYBGC OCE TOP 
    289317 
    290318and the related ``cpp_MYBGC.fcm`` content will be 
    … …  
    292320.. code-block:: perl 
    293321 
    294    bld::tool::fppkeys key_iomput key_mpp_mpi key_top 
    295  
    296 the compilation with ``makenemo`` will be executed through the following syntax 
     322   bld::tool::fppkeys key_iomput key_mpp_mpi key_top 
     323 
     324the compilation with :file:`makenemo` will be executed through the following syntax 
    297325 
    298326.. code-block:: console 
    299327 
    300    $ makenemo -n 'NEMO_MYBGC' -m '<arch_my_machine>' -j 8 -e '<MYBGCPATH>' 
    301  
    302 The makenemo feature “-e” was introduced to readdress at compilation time the standard MY_SRC folder 
    303 (usually found in NEMO configurations) with a user defined external one. 
    304  
    305 The compilation of more articulated BGC model code & infrastructure, like in the case of BFM 
    306 ([http://www.bfm-community.eu/publications/bfmnemomanual_r1.0_201508.pdf BFM-NEMO coupling manual]), 
    307 requires some additional features. 
     328   $ makenemo -n 'NEMO_MYBGC' -m '<arch_my_machine>' -j 8 -e '<MYBGCPATH>' 
     329 
     330The makenemo feature ``-e`` was introduced to 
     331readdress at compilation time the standard MY_SRC folder (usually found in NEMO configurations) with 
     332a user defined external one. 
     333 
     334The compilation of more articulated BGC model code & infrastructure, 
     335like in the case of BFM (|BFM man|_), requires some additional features. 
    308336 
    309337As before, let’s assume a coupled configuration name *NEMO_MYBGC*, 
    310 but in this case MYBGC model root becomes ``<MYBGCPATH>`` that contains 4 different subfolders for 
    311 biogeochemistry, named ``initialization``, ``pelagic``, and ``benthic``, and 
    312 a separate one named ``nemo_coupling`` including the modified ``MY_SRC`` routines. 
     338but in this case MYBGC model root becomes :file:`MYBGC` path that 
     339contains 4 different subfolders for biogeochemistry, 
     340named :file:`initialization`, :file:`pelagic`, and :file:`benthic`, 
     341and a separate one named :file:`nemo_coupling` including the modified `MY_SRC` routines. 
    313342The latter folder containing the modified NEMO coupling interface will be still linked using 
    314 the makenemo “-e” option. 
     343the makenemo ``-e`` option. 
    315344 
    316345In order to include the BGC model subfolders in the compilation of NEMO code, 
    317 it will be necessary to extend the configuration ``cpp_NEMO_MYBGC.fcm`` file to include the specific paths of 
    318 ``MYBGC`` folders, as in the following example 
     346it will be necessary to extend the configuration :file:`cpp_NEMO_MYBGC.fcm` file to include the specific paths of :file:`MYBGC` folders, as in the following example 
    319347 
    320348.. code-block:: perl 
    321349 
    322    bld::tool::fppkeys  key_iomput key_mpp_mpi key_top 
    323     
    324    src::MYBGC::initialization         <MYBGCPATH>/initialization 
    325    src::MYBGC::pelagic                <MYBGCPATH>/pelagic 
    326    src::MYBGC::benthic                <MYBGCPATH>/benthic 
    327     
    328    bld::pp::MYBGC      1 
    329    bld::tool::fppflags::MYBGC   %FPPFLAGS 
    330    bld::tool::fppkeys           %bld::tool::fppkeys MYBGC_MACROS 
     350   bld::tool::fppkeys  key_iomput key_mpp_mpi key_top 
     351 
     352   src::MYBGC::initialization         <MYBGCPATH>/initialization 
     353   src::MYBGC::pelagic                <MYBGCPATH>/pelagic 
     354   src::MYBGC::benthic                <MYBGCPATH>/benthic 
     355 
     356   bld::pp::MYBGC      1 
     357   bld::tool::fppflags::MYBGC   %FPPFLAGS 
     358   bld::tool::fppkeys           %bld::tool::fppkeys MYBGC_MACROS 
    331359 
    332360where *MYBGC_MACROS* is the space delimited list of macros used in *MYBGC* model for 
    333361selecting/excluding specific parts of the code. 
    334 The BGC model code will be preprocessed in the configuration ``BLD`` folder as for NEMO, 
    335 but with an independent path, like ``NEMO_MYBGC/BLD/MYBGC/<subforlders>``. 
     362The BGC model code will be preprocessed in the configuration :file:`BLD` folder as for NEMO, 
     363but with an independent path, like :file:`NEMO_MYBGC/BLD/MYBGC/<subforlders>`. 
    336364 
    337365The compilation will be performed similarly to in the previous case with the following 
    … …  
    339367.. code-block:: console 
    340368 
    341    $ makenemo -n 'NEMO_MYBGC' -m '<arch_my_machine>' -j 8 -e '<MYBGCPATH>/nemo_coupling' 
    342  
    343 Note that, the additional lines specific for the BGC model source and build paths can be written into 
    344 a separate file, e.g. named ``MYBGC.fcm``, and then simply included in the ``cpp_NEMO_MYBGC.fcm`` as follow 
    345  
    346 .. code-block:: perl 
    347  
    348    bld::tool::fppkeys  key_zdftke key_dynspg_ts key_iomput key_mpp_mpi key_top 
    349    inc <MYBGCPATH>/MYBGC.fcm 
    350  
    351 This will enable a more portable compilation structure for all MYBGC related configurations. 
    352  
    353 **Important**: the coupling interface contained in nemo_coupling cannot be added using the FCM syntax, 
    354 as the same files already exists in NEMO and they are overridden only with the readdressing of MY_SRC contents to 
    355 avoid compilation conflicts due to duplicate routines. 
    356  
    357 All modifications illustrated above, can be easily implemented using shell or python scripting to 
    358 edit the NEMO configuration CPP.fcm file and to create the BGC model specific FCM compilation file with code paths. 
     369   $ makenemo -n 'NEMO_MYBGC' -m '<arch_my_machine>' -j 8 -e '<MYBGCPATH>/nemo_coupling' 
     370 
     371.. note:: 
     372   The additional lines specific for the BGC model source and build paths can be written into 
     373   a separate file, e.g. named :file:`MYBGC.fcm`, 
     374   and then simply included in the :file:`cpp_NEMO_MYBGC.fcm` as follow 
     375 
     376   .. code-block:: perl 
     377 
     378      bld::tool::fppkeys  key_zdftke key_dynspg_ts key_iomput key_mpp_mpi key_top 
     379      inc <MYBGCPATH>/MYBGC.fcm 
     380 
     381   This will enable a more portable compilation structure for all MYBGC related configurations. 
     382 
     383.. warning:: 
     384   The coupling interface contained in :file:`nemo_coupling` cannot be added using the FCM syntax, 
     385   as the same files already exists in NEMO and they are overridden only with 
     386   the readdressing of MY_SRC contents to avoid compilation conflicts due to duplicate routines. 
     387 
     388All modifications illustrated above, can be easily implemented using shell or python scripting 
     389to edit the NEMO configuration :file:`CPP.fcm` file and 
     390to create the BGC model specific FCM compilation file with code paths. 
     391 
     392.. |BFM man| replace:: BFM-NEMO coupling manual 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trcadv.F90

    r10068 r13463  
    2929   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces 
    3030   ! 
    31    USE prtctl_trc     ! control print 
     31   USE prtctl         ! control print 
    3232   USE timing         ! Timing 
    3333 
    … …  
    5959   INTEGER, PARAMETER ::   np_QCK     = 5   ! QUICK scheme 
    6060    
    61    !! * Substitutions 
    62 #  include "vectopt_loop_substitute.h90" 
     61#  include "domzgr_substitute.h90" 
    6362   !!---------------------------------------------------------------------- 
    6463   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    6867CONTAINS 
    6968 
    70    SUBROUTINE trc_adv( kt ) 
     69   SUBROUTINE trc_adv( kt, Kbb, Kmm, ptr, Krhs ) 
    7170      !!---------------------------------------------------------------------- 
    7271      !!                  ***  ROUTINE trc_adv  *** 
    … …  
    7473      !! ** Purpose :   compute the ocean tracer advection trend. 
    7574      !! 
    76       !! ** Method  : - Update after tracers (tra) with the advection term following nadv 
    77       !!---------------------------------------------------------------------- 
    78       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     75      !! ** Method  : - Update after tracers (tr(Krhs)) with the advection term following nadv 
     76      !!---------------------------------------------------------------------- 
     77      INTEGER                                   , INTENT(in)    :: kt   ! ocean time-step index 
     78      INTEGER                                   , INTENT(in)    :: Kbb, Kmm, Krhs ! time level indices 
     79      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr            ! passive tracers and RHS of tracer equation 
    7980      ! 
    8081      INTEGER ::   jk   ! dummy loop index 
    8182      CHARACTER (len=22) ::   charout 
    82       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zun, zvn, zwn  ! effective velocity 
     83      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zuu, zvv, zww  ! effective velocity 
    8384      !!---------------------------------------------------------------------- 
    8485      ! 
    … …  
    8788      !                                         !==  effective transport  ==! 
    8889      IF( l_offline ) THEN 
    89          zun(:,:,:) = un(:,:,:)                    ! already in (un,vn,wn) 
    90          zvn(:,:,:) = vn(:,:,:) 
    91          zwn(:,:,:) = wn(:,:,:) 
     90         zuu(:,:,:) = uu(:,:,:,Kmm)                ! already in (uu(Kmm),vv(Kmm),ww) 
     91         zvv(:,:,:) = vv(:,:,:,Kmm) 
     92         zww(:,:,:) = ww(:,:,:) 
    9293      ELSE                                         ! build the effective transport 
    93          zun(:,:,jpk) = 0._wp 
    94          zvn(:,:,jpk) = 0._wp 
    95          zwn(:,:,jpk) = 0._wp 
     94         zuu(:,:,jpk) = 0._wp 
     95         zvv(:,:,jpk) = 0._wp 
     96         zww(:,:,jpk) = 0._wp 
    9697         IF( ln_wave .AND. ln_sdw )  THEN 
    9798            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) ) 
     99               zuu(:,:,jk) = e2u  (:,:) * e3u(:,:,jk,Kmm) * ( uu(:,:,jk,Kmm) + usd(:,:,jk) ) 
     100               zvv(:,:,jk) = e1v  (:,:) * e3v(:,:,jk,Kmm) * ( vv(:,:,jk,Kmm) + vsd(:,:,jk) ) 
     101               zww(:,:,jk) = e1e2t(:,:)                   * ( ww(:,:,jk) + wsd(:,:,jk) ) 
    101102            END DO 
    102103         ELSE 
    103104            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) 
     105               zuu(:,:,jk) = e2u  (:,:) * e3u(:,:,jk,Kmm) * uu(:,:,jk,Kmm)                   ! eulerian transport 
     106               zvv(:,:,jk) = e1v  (:,:) * e3v(:,:,jk,Kmm) * vv(:,:,jk,Kmm) 
     107               zww(:,:,jk) = e1e2t(:,:)                   * ww(:,:,jk) 
    107108            END DO 
    108109         ENDIF 
    109110         ! 
    110111         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(:,:,:) 
     112            zuu(:,:,:) = zuu(:,:,:) + un_td(:,:,:) 
     113            zvv(:,:,:) = zvv(:,:,:) + vn_td(:,:,:) 
    113114         ENDIF 
    114115         ! 
    115116         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 
     117            &              CALL ldf_eiv_trp( kt, nittrc000, zuu, zvv, zww, 'TRC', Kmm, Krhs )  ! add the eiv transport 
     118         ! 
     119         IF( ln_mle    )   CALL tra_mle_trp( kt, nittrc000, zuu, zvv, zww, 'TRC', Kmm      )  ! add the mle transport 
    119120         ! 
    120121      ENDIF 
    … …  
    123124      ! 
    124125      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 ) 
     126         CALL tra_adv_cen( kt, nittrc000,'TRC',          zuu, zvv, zww,      Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v ) 
    126127      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 ) 
     128         CALL tra_adv_fct( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 
    128129      CASE ( np_MUS )                                 ! MUSCL 
    129          CALL tra_adv_mus( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb,      tra, jptra        , ln_mus_ups )  
     130         CALL tra_adv_mus( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups        )  
    130131      CASE ( np_UBS )                                 ! UBS 
    131          CALL tra_adv_ubs( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra          , nn_ubs_v ) 
     132         CALL tra_adv_ubs( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_ubs_v          ) 
    132133      CASE ( np_QCK )                                 ! QUICKEST 
    133          CALL tra_adv_qck( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra                     ) 
     134         CALL tra_adv_qck( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs                     ) 
    134135      ! 
    135136      END SELECT 
    136137      !                   
    137       IF( ln_ctl ) THEN                         !== print mean trends (used for debugging) 
     138      IF( sn_cfctl%l_prttrc ) THEN        !== print mean trends (used for debugging) 
    138139         WRITE(charout, FMT="('adv ')") 
    139          CALL prt_ctl_trc_info(charout) 
    140          CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     140         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     141         CALL prt_ctl( tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    141142      END IF 
    142143      ! 
    … …  
    164165      ! 
    165166      !                                !==  Namelist  ==! 
    166       REWIND( numnat_ref )                   !  namtrc_adv in reference namelist  
    167167      READ  ( numnat_ref, namtrc_adv, IOSTAT = ios, ERR = 901) 
    168 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_adv in reference namelist', lwp ) 
    169       REWIND( numnat_cfg )                   ! namtrc_adv in configuration namelist 
     168901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_adv in reference namelist' ) 
    170169      READ  ( numnat_cfg, namtrc_adv, IOSTAT = ios, ERR = 902 ) 
    171 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist', lwp ) 
     170902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist' ) 
    172171      IF(lwm) WRITE ( numont, namtrc_adv ) 
    173172      ! 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trcbbl.F90

    r10068 r13463  
    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 
    2525   USE trdtra         ! tracer trends 
    2626   USE trabbl         ! bottom boundary layer  
    27    USE prtctl_trc     ! Print control for debbuging 
     27   USE prtctl         ! Print control for debbuging 
    2828 
    2929   PUBLIC   trc_bbl   !  routine called by trctrp.F90 
    … …  
    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             WRITE(charout, FMT="(' bbl_dif')")  ;  CALL prt_ctl_trc_info(charout) 
    71             CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     70         CALL tra_bbl_dif( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm )   
     71         IF( sn_cfctl%l_prttrc )   THEN 
     72            WRITE(charout, FMT="(' bbl_dif')")  ;  CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     73            CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='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             WRITE(charout, FMT="(' bbl_adv')")  ;  CALL prt_ctl_trc_info(charout) 
    82             CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     81         CALL tra_bbl_adv( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm )   
     82         IF( sn_cfctl%l_prttrc )   THEN 
     83            WRITE(charout, FMT="(' bbl_adv')")  ;  CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     84            CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trcdmp.F90

    r10351 r13463  
    2424   ! 
    2525   USE iom 
    26    USE prtctl_trc      ! Print control for debbuging 
     26   USE prtctl          ! Print control for debbuging 
    2727 
    2828   IMPLICIT NONE 
    … …  
    4444 
    4545   !! * Substitutions 
    46 #  include "vectopt_loop_substitute.h90" 
     46#  include "do_loop_substitute.h90" 
     47#  include "domzgr_substitute.h90" 
    4748   !!---------------------------------------------------------------------- 
    4849   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    6364 
    6465 
    65    SUBROUTINE trc_dmp( kt ) 
     66   SUBROUTINE trc_dmp( kt, Kbb, Kmm, ptr, Krhs ) 
    6667      !!---------------------------------------------------------------------- 
    6768      !!                   ***  ROUTINE trc_dmp  *** 
    … …  
    7374      !! ** Method  :   Newtonian damping towards trdta computed  
    7475      !!      and add to the general tracer trends: 
    75       !!                     trn = tra + restotr * (trdta - trb) 
     76      !!                     tr(Kmm) = tr(Krhs) + restotr * (trdta - tr(Kbb)) 
    7677      !!         The trend is computed either throughout the water column 
    7778      !!      (nlmdmptr=0) or in area of weak vertical mixing (nlmdmptr=1) or 
    7879      !!      below the well mixed layer (nlmdmptr=2) 
    7980      !! 
    80       !! ** Action  : - update the tracer trends tra with the newtonian  
     81      !! ** Action  : - update the tracer trends tr(:,:,:,:,Krhs) with the newtonian  
    8182      !!                damping trends. 
    8283      !!              - save the trends ('key_trdmxl_trc') 
    8384      !!---------------------------------------------------------------------- 
    84       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     85      INTEGER,                                    INTENT(in   ) :: kt              ! ocean time-step index 
     86      INTEGER,                                    INTENT(in   ) :: Kbb, Kmm, Krhs  ! time level indices 
     87      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr             ! passive tracers and RHS of tracer equation 
    8588      ! 
    8689      INTEGER ::   ji, jj, jk, jn, jl   ! dummy loop indices 
    … …  
    100103         DO jn = 1, jptra                                           ! tracer loop 
    101104            !                                                       ! =========== 
    102             IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)    ! save trends  
     105            IF( l_trdtrc ) ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs)    ! save trends  
    103106            ! 
    104107            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
    105108               ! 
    106109               jl = n_trc_index(jn)  
    107                CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000 
     110               CALL trc_dta( kt, Kmm, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000 
    108111               ! 
    109112               SELECT CASE ( nn_zdmp_tr ) 
    110113               ! 
    111114               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 
     115                  DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     116                     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) ) 
     117                  END_3D 
    119118                  ! 
    120119               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 
     120                  DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     121                     IF( avt(ji,jj,jk) <= avt_c )  THEN  
     122                        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) ) 
     123                     ENDIF 
     124                  END_3D 
    130125                  ! 
    131126               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 
     127                  DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     128                     IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 
     129                        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) ) 
     130                     END IF 
     131                  END_3D 
    141132                  !   
    142133               END SELECT 
    … …  
    145136            ! 
    146137            IF( l_trdtrc ) THEN 
    147                ztrtrd(:,:,:) = tra(:,:,:,jn) -  ztrtrd(:,:,:) 
    148                CALL trd_tra( kt, 'TRC', jn, jptra_dmp, ztrtrd ) 
     138               ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) -  ztrtrd(:,:,:) 
     139               CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_dmp, ztrtrd ) 
    149140            END IF 
    150141            !                                                       ! =========== 
    … …  
    156147      IF( l_trdtrc )  DEALLOCATE( ztrtrd ) 
    157148      !                                          ! print mean trends (used for debugging) 
    158       IF( ln_ctl ) THEN 
     149      IF( sn_cfctl%l_prttrc ) THEN 
    159150         WRITE(charout, FMT="('dmp ')") 
    160          CALL prt_ctl_trc_info(charout) 
    161          CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     151         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     152         CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    162153      ENDIF 
    163154      ! 
    … …  
    181172      !!---------------------------------------------------------------------- 
    182173      ! 
    183       REWIND( numnat_ref )              ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping 
    184174      READ  ( numnat_ref, namtrc_dmp, IOSTAT = ios, ERR = 909) 
    185 909   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_dmp in reference namelist', lwp ) 
    186       REWIND( numnat_cfg )              ! Namelist namtrc_dmp in configuration namelist : Passive tracers newtonian damping 
     175909   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_dmp in reference namelist' ) 
    187176      READ  ( numnat_cfg, namtrc_dmp, IOSTAT = ios, ERR = 910) 
    188 910   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_dmp in configuration namelist', lwp ) 
     177910   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_dmp in configuration namelist' ) 
    189178      IF(lwm) WRITE ( numont, namtrc_dmp ) 
    190179 
    … …  
    216205         !Read in mask from file 
    217206         CALL iom_open ( cn_resto_tr, imask) 
    218          CALL iom_get  ( imask, jpdom_autoglo, 'resto', restotr) 
     207         CALL iom_get  ( imask, jpdom_auto, 'resto', restotr) 
    219208         CALL iom_close( imask ) 
    220209         ! 
    … …  
    224213 
    225214 
    226    SUBROUTINE trc_dmp_clo( kt ) 
     215   SUBROUTINE trc_dmp_clo( kt, Kbb, Kmm ) 
    227216      !!--------------------------------------------------------------------- 
    228217      !!                  ***  ROUTINE trc_dmp_clo  *** 
    … …  
    236225      !!                nctsi2(), nctsj2() : north-east Closed sea limits (i,j) 
    237226      !!---------------------------------------------------------------------- 
    238       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     227      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index 
     228      INTEGER, INTENT( in ) ::   Kbb, Kmm     ! time level indices 
    239229      ! 
    240230      INTEGER :: ji , jj, jk, jn, jl, jc                    ! dummy loop indicesa 
    … …  
    256246            !                                           ! ======================= 
    257247            CASE ( 1 )                                  ! eORCA_R1 configuration 
    258             !                                           ! ======================= 
    259             isrow = 332 - jpjglo 
    260             ! 
    261             nctsi1(1)   = 333  ; nctsj1(1)   = 243 - isrow   ! Caspian Sea 
    262             nctsi2(1)   = 342  ; nctsj2(1)   = 274 - isrow 
    263             !                                         
    264             nctsi1(2)   = 198  ; nctsj1(2)   = 258 - isrow   ! Lake Superior 
    265             nctsi2(2)   = 204  ; nctsj2(2)   = 262 - isrow 
    266             !                                          
    267             nctsi1(3)   = 201  ; nctsj1(3)   = 250 - isrow   ! Lake Michigan 
    268             nctsi2(3)   = 203  ; nctsj2(3)   = 256 - isrow 
    269             !                                         
    270             nctsi1(4)   = 204  ; nctsj1(4)   = 252 - isrow   ! Lake Huron 
    271             nctsi2(4)   = 209  ; nctsj2(4)   = 256 - isrow 
    272             !                                         
    273             nctsi1(5)   = 206  ; nctsj1(5)   = 249 - isrow   ! Lake Erie 
    274             nctsi2(5)   = 209  ; nctsj2(5)   = 251 - isrow 
    275             !                                         
    276             nctsi1(6)   = 210  ; nctsj1(6)   = 252 - isrow   ! Lake Ontario 
    277             nctsi2(6)   = 212  ; nctsj2(6)   = 252 - isrow 
    278             !                                         
    279             nctsi1(7)   = 321  ; nctsj1(7)   = 180 - isrow   ! Victoria Lake 
    280             nctsi2(7)   = 322  ; nctsj2(7)   = 189 - isrow 
    281             !                                         
    282             nctsi1(8)   = 297  ; nctsj1(8)   = 270 - isrow   ! Baltic Sea 
    283             nctsi2(8)   = 308  ; nctsj2(8)   = 293 - isrow 
    284             !                                         
    285             !                                           ! ======================= 
     248               !                                        ! ======================= 
     249               ! 
     250               isrow = 332 - (Nj0glo + 1)   ! was 332 - jpjglo -> jpjglo_old_version = Nj0glo + 1 
     251               ! 
     252               nctsi1(1)   = 333  ; nctsj1(1)   = 243 - isrow   ! Caspian Sea 
     253               nctsi2(1)   = 342  ; nctsj2(1)   = 274 - isrow 
     254               !                                         
     255               nctsi1(2)   = 198  ; nctsj1(2)   = 258 - isrow   ! Lake Superior 
     256               nctsi2(2)   = 204  ; nctsj2(2)   = 262 - isrow 
     257               !                                          
     258               nctsi1(3)   = 201  ; nctsj1(3)   = 250 - isrow   ! Lake Michigan 
     259               nctsi2(3)   = 203  ; nctsj2(3)   = 256 - isrow 
     260               !                                         
     261               nctsi1(4)   = 204  ; nctsj1(4)   = 252 - isrow   ! Lake Huron 
     262               nctsi2(4)   = 209  ; nctsj2(4)   = 256 - isrow 
     263               !                                         
     264               nctsi1(5)   = 206  ; nctsj1(5)   = 249 - isrow   ! Lake Erie 
     265               nctsi2(5)   = 209  ; nctsj2(5)   = 251 - isrow 
     266               !                                         
     267               nctsi1(6)   = 210  ; nctsj1(6)   = 252 - isrow   ! Lake Ontario 
     268               nctsi2(6)   = 212  ; nctsj2(6)   = 252 - isrow 
     269               !                                         
     270               nctsi1(7)   = 321  ; nctsj1(7)   = 180 - isrow   ! Victoria Lake 
     271               nctsi2(7)   = 322  ; nctsj2(7)   = 189 - isrow 
     272               !                                         
     273               nctsi1(8)   = 297  ; nctsj1(8)   = 270 - isrow   ! Baltic Sea 
     274               nctsi2(8)   = 308  ; nctsj2(8)   = 293 - isrow 
     275               ! 
     276               !                                        ! ======================= 
    286277            CASE ( 2 )                                  !  ORCA_R2 configuration 
    287278               !                                        ! ======================= 
    … …  
    296287               nctsi2(3)   = 181  ;  nctsj2(3)   = 112 
    297288              !                                       
    298                nctsi1(4)   =   2  ;  nctsj1(4)   = 107      ! Black Sea 2 : est part of the Black Sea 
     289               nctsi1(4)   =   2  ;  nctsj1(4)   = 107       ! Black Sea 2 : est part of the Black Sea 
    299290               nctsi2(4)   =   6  ;  nctsj2(4)   = 112 
    300291               !                                      
    301292               nctsi1(5)   =  145 ;  nctsj1(5)   = 116       ! Baltic Sea 
    302293               nctsi2(5)   =  150 ;  nctsj2(5)   = 126 
     294               ! 
    303295               !                                        ! ======================= 
    304296            CASE ( 4 )                                  !  ORCA_R4 configuration 
    … …  
    316308               nctsi1(4)   = 75  ;  nctsj1(4)   = 59         ! Baltic Sea 
    317309               nctsi2(4)   = 76  ;  nctsj2(4)   = 61 
     310               ! 
    318311               !                                        ! ======================= 
    319312            CASE ( 025 )                                ! ORCA_R025 configuration 
    … …  
    330323         ENDIF 
    331324         ! 
     325         nctsi1(:) = nctsi1(:) + nn_hls - 1   ;   nctsi2(:) = nctsi2(:) + nn_hls - 1   ! -1 as x-perio included in old input files 
     326         nctsj1(:) = nctsj1(:) + nn_hls       ;   nctsj2(:) = nctsj2(:) + nn_hls 
     327         ! 
    332328         ! convert the position in local domain indices 
    333329         ! -------------------------------------------- 
    … …  
    354350            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
    355351                jl = n_trc_index(jn) 
    356                 CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000 
     352                CALL trc_dta( kt, Kmm, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000 
    357353                DO jc = 1, npncts 
    358354                   DO jk = 1, jpkm1 
    359355                      DO jj = nctsj1(jc), nctsj2(jc) 
    360356                         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) 
     357                            tr(ji,jj,jk,jn,Kmm) = ztrcdta(ji,jj,jk) 
     358                            tr(ji,jj,jk,jn,Kbb) = tr(ji,jj,jk,jn,Kmm) 
    363359                         END DO 
    364360                      END DO 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trcldf.F90

    r10068 r13463  
    2525   USE trdtra         ! trends manager: tracers 
    2626   ! 
    27    USE prtctl_trc     ! Print control 
     27   USE prtctl         ! Print control 
    2828 
    2929   IMPLICIT NONE 
    … …  
    4343    
    4444   !! * Substitutions 
    45 #  include "vectopt_loop_substitute.h90" 
     45#  include "do_loop_substitute.h90" 
     46#  include "domzgr_substitute.h90" 
    4647   !!---------------------------------------------------------------------- 
    4748   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    5152CONTAINS 
    5253 
    53    SUBROUTINE trc_ldf( kt ) 
     54   SUBROUTINE trc_ldf( kt, Kbb, Kmm, ptr, Krhs ) 
    5455      !!---------------------------------------------------------------------- 
    5556      !!                  ***  ROUTINE tra_ldf  *** 
    … …  
    5859      !! 
    5960      !!---------------------------------------------------------------------- 
    60       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     61      INTEGER,                                    INTENT(in   ) :: kt              ! ocean time-step index 
     62      INTEGER,                                    INTENT(in   ) :: Kbb, Kmm, Krhs  ! ocean time-level index 
     63      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr             ! passive tracers and RHS of tracer equation 
    6164      ! 
    6265      INTEGER            :: ji, jj, jk, jn 
    6366      REAL(wp)           :: zdep 
    6467      CHARACTER (len=22) :: charout 
    65       REAL(wp), DIMENSION(jpi,jpj,jpk)  ::   zahu, zahv 
    66       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd 
     68      REAL(wp),          DIMENSION(jpi,jpj,jpk) ::   zahu, zahv 
     69      REAL(wp), POINTER, DIMENSION(:,:,:,:)     ::   ztrtrd 
    6770      !!---------------------------------------------------------------------- 
    6871      ! 
    … …  
    7376      IF( l_trdtrc )  THEN 
    7477         ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) ) 
    75          ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
     78         ztrtrd(:,:,:,:)  = ptr(:,:,:,:,Krhs) 
    7679      ENDIF 
    7780      !                                  !* set the lateral diffusivity coef. for passive tracer       
    … …  
    7982      zahv(:,:,:) = rldf * ahtv(:,:,:) 
    8083      !                                  !* 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 
     84      DO_3D( 1, 1, 1, 1, 1, jpk ) 
     85         IF( gdept(ji,jj,jk,Kmm) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN 
     86            zdep = MAX( gdept(ji,jj,jk,Kmm) - 1000., 0. ) / 1000. 
     87            zahu(ji,jj,jk) = zahu(ji,jj,jk) * MAX( 1., rn_fact_lap * EXP( -zdep ) ) 
     88         ENDIF 
     89      END_3D 
    9190      ! 
    9291      SELECT CASE ( nldf_trc )                 !* compute lateral mixing trend and add it to the general trend 
    9392      ! 
    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 ) 
     93      CASE ( np_lap   )                                                                                    ! iso-level laplacian 
     94         CALL tra_ldf_lap  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            & 
     95           &                     ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs),                   jptra, 1 ) 
     96      CASE ( np_lap_i )                                                                                    ! laplacian : standard iso-neutral operator (Madec) 
     97         CALL tra_ldf_iso  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            & 
     98           &                     ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 ) 
     99      CASE ( np_lap_it )                                                                                   ! laplacian : triad iso-neutral operator (griffies) 
     100         CALL tra_ldf_triad( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            & 
     101           &                     ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 ) 
     102      CASE ( np_blp , np_blp_i , np_blp_it )                                                               ! bilaplacian: all operator (iso-level, -neutral) 
     103         CALL tra_ldf_blp  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            & 
     104           &                     ptr(:,:,:,:,Kbb) , ptr(:,:,:,:,Krhs),                 jptra, nldf_trc ) 
    102105      END SELECT 
    103106      ! 
    104107      IF( l_trdtrc )   THEN                    ! send the trends for further diagnostics 
    105108        DO jn = 1, jptra 
    106            ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 
    107            CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) ) 
     109           ztrtrd(:,:,:,jn) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:,jn) 
     110           CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) ) 
    108111        END DO 
    109112        DEALLOCATE( ztrtrd ) 
    110113      ENDIF 
    111114      !                 
    112       IF( ln_ctl ) THEN                        ! print mean trends (used for debugging) 
     115      IF( sn_cfctl%l_prttrc ) THEN ! print mean trends (used for debugging) 
    113116         WRITE(charout, FMT="('ldf ')") 
    114          CALL prt_ctl_trc_info(charout) 
    115          CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     117         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     118         CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    116119      ENDIF 
    117120      ! 
    … …  
    143146      ENDIF 
    144147      ! 
    145       REWIND( numnat_ref )             !  namtrc_ldf in reference namelist  
    146148      READ  ( numnat_ref, namtrc_ldf, IOSTAT = ios, ERR = 903) 
    147 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_ldf in reference namelist', lwp ) 
     149903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_ldf in reference namelist' ) 
    148150      ! 
    149       REWIND( numnat_cfg )             !  namtrc_ldf in configuration namelist  
    150151      READ  ( numnat_cfg, namtrc_ldf, IOSTAT = ios, ERR = 904 ) 
    151 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist', lwp ) 
     152904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist' ) 
    152153      IF(lwm) WRITE ( numont, namtrc_ldf ) 
    153154      ! 
    … …  
    167168      IF( ln_trcldf_OFF  ) THEN   ;   nldf_trc = np_no_ldf   ;   ioptio = ioptio + 1   ;   ENDIF 
    168169      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)' ) 
     170      IF( ioptio /=  1   )   CALL ctl_stop( 'trc_ldf_ini: use ONE of the 2 operator options (OFF/tra)' ) 
    170171       
    171172      !                                ! multiplier : passive/active tracers ration 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trcrad.F90

    r10425 r13463  
    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 
    … …  
    1819   USE trd_oce 
    1920   USE trdtra 
    20    USE prtctl_trc          ! Print control for debbuging 
     21   USE prtctl              ! Print control for debbuging 
    2122   USE lib_fortran 
    2223 
    … …  
    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')") 
    69          CALL prt_ctl_trc_info( charout ) 
    70          CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
     74         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     75         CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Kbb), mask1=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) 
    91 907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_rad in reference namelist', lwp ) 
    92       REWIND( numnat_cfg )              ! namtrc_rad in configuration namelist  
     95907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_rad in reference namelist' ) 
    9396      READ  ( numnat_cfg, namtrc_rad, IOSTAT = ios, ERR = 908 ) 
    94 908   IF( ios > 0 )   CALL ctl_nam ( ios , 'namtrc_rad in configuration namelist', lwp ) 
     97908   IF( ios > 0 )   CALL ctl_nam ( ios , 'namtrc_rad in configuration namelist' ) 
    9598      IF(lwm) WRITE( numont, namtrc_rad ) 
    9699 
    … …  
    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. * rn_Dt ) 
     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( nn_hls, nn_hls, nn_hls, nn_hls, 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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trcsbc.F90

    r10788 r13463  
    1818   USE oce_trc         ! ocean dynamics and active tracers variables 
    1919   USE trc             ! ocean  passive tracers variables 
    20    USE prtctl_trc      ! Print control for debbuging 
     20   USE prtctl          ! Print control for debbuging 
    2121   USE iom 
    2222   USE trd_oce 
    … …  
    2929 
    3030   !! * Substitutions 
    31 #  include "vectopt_loop_substitute.h90" 
     31#  include "do_loop_substitute.h90" 
     32#  include "domzgr_substitute.h90" 
    3233   !!---------------------------------------------------------------------- 
    3334   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    3738CONTAINS 
    3839 
    39    SUBROUTINE trc_sbc ( kt ) 
     40   SUBROUTINE trc_sbc ( kt, Kmm, ptr, Krhs ) 
    4041      !!---------------------------------------------------------------------- 
    4142      !!                  ***  ROUTINE trc_sbc  *** 
    … …  
    4950      !!            The surface freshwater flux modify the ocean volume 
    5051      !!         and thus the concentration of a tracer as : 
    51       !!            tra = tra + emp * trn / e3t   for k=1 
     52      !!            tr(Krhs) = tr(Krhs) + emp * tr(Kmm) / e3t_   for k=1 
    5253      !!         where emp, the surface freshwater budget (evaporation minus 
    5354      !!         precipitation ) given in kg/m2/s is divided 
    5455      !!         by 1035 kg/m3 (density of ocean water) to obtain m/s. 
    5556      !! 
    56       !! ** Action  : - Update the 1st level of tra with the trend associated 
     57      !! ** Action  : - Update the 1st level of tr(:,:,:,:,Krhs) with the trend associated 
    5758      !!                with the tracer surface boundary condition  
    5859      !! 
    5960      !!---------------------------------------------------------------------- 
    60       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     61      INTEGER,                                    INTENT(in   ) :: kt        ! ocean time-step index 
     62      INTEGER,                                    INTENT(in   ) :: Kmm, Krhs ! time level indices 
     63      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr       ! passive tracers and RHS of tracer equation 
    6164      ! 
    6265      INTEGER  ::   ji, jj, jn                      ! dummy loop indices 
    … …  
    8285         IF( ln_rsttr .AND. .NOT.ln_top_euler .AND.   &                     ! Restart: read in restart  file 
    8386            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' 
     87            IF(lwp) WRITE(numout,*) '          nittrc000-1 surface tracer content forcing fields read in the restart file' 
    8588            zfact = 0.5_wp 
    8689            DO jn = 1, jptra 
    87                CALL iom_get( numrtr, jpdom_autoglo, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) )   ! before tracer content sbc 
     90               CALL iom_get( numrtr, jpdom_auto, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) )   ! before tracer content sbc 
    8891            END DO 
    8992         ELSE                                         ! No restart or restart not found: Euler forward time stepping 
    … …  
    102105      ENDIF 
    103106 
    104       ! Coupling online : river runoff is added to the horizontal divergence (hdivn) in the subroutine sbc_rnf_div  
     107      ! Coupling online : river runoff is added to the horizontal divergence (hdiv) in the subroutine sbc_rnf_div  
    105108      ! one only consider the concentration/dilution effect due to evaporation minus precipitation + freezing/melting of sea-ice 
    106109      ! Coupling offline : runoff are in emp which contains E-P-R 
    … …  
    118121         ! 
    119122         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 
     123            DO_2D( 0, 1, 0, 0 ) 
     124               sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rho0 * ptr(ji,jj,1,jn,Kmm) 
     125            END_2D 
    125126         END DO 
    126127         ! 
    … …  
    128129         ! 
    129130         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 
     131            DO_2D( 0, 1, 0, 0 ) 
     132               sbc_trc(ji,jj,jn) = ( zsfx(ji,jj) + fmmflx(ji,jj) ) * r1_rho0 * ptr(ji,jj,1,jn,Kmm) 
     133            END_2D 
    135134         END DO 
    136135         ! 
    … …  
    138137         ! 
    139138         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 
     139            DO_2D( 0, 1, 0, 0 ) 
     140               zse3t = 1. / e3t(ji,jj,1,Kmm) 
     141               ! tracer flux at the ice/ocean interface (tracer/m2/s) 
     142               zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice 
     143               !                                         ! only used in the levitating sea ice case 
     144               ! tracer flux only       : add concentration dilution term in net tracer flux, no F-M in volume flux 
     145               ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux 
     146               ztfx  = zftra                        ! net tracer flux 
     147               ! 
     148               zdtra = r1_rho0 * ( ztfx + ( zsfx(ji,jj) + fmmflx(ji,jj) ) * ptr(ji,jj,1,jn,Kmm) )  
     149               IF ( zdtra < 0. ) THEN 
     150                  zdtra  = MAX(zdtra, -ptr(ji,jj,1,jn,Kmm) * e3t(ji,jj,1,Kmm) / rDt_trc )   ! avoid negative concentrations to arise 
     151               ENDIF 
     152               sbc_trc(ji,jj,jn) =  zdtra  
     153            END_2D 
    157154         END DO 
    158155      END SELECT 
    159156      ! 
    160       CALL lbc_lnk( 'trcsbc', sbc_trc(:,:,:), 'T', 1. ) 
     157      CALL lbc_lnk( 'trcsbc', sbc_trc(:,:,:), 'T', 1.0_wp ) 
    161158      !                                       Concentration dilution effect on tracers due to evaporation & precipitation  
    162159      DO jn = 1, jptra 
    163160         ! 
    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 
     161         IF( l_trdtrc )   ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs)  ! save trends 
     162         ! 
     163         DO_2D( 0, 1, 0, 0 ) 
     164            zse3t = zfact / e3t(ji,jj,1,Kmm) 
     165            ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t 
     166         END_2D 
    172167         ! 
    173168         IF( l_trdtrc ) THEN 
    174             ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 
    175             CALL trd_tra( kt, 'TRC', jn, jptra_nsr, ztrtrd ) 
     169            ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:) 
     170            CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_nsr, ztrtrd ) 
    176171         END IF 
    177172         !                                                       ! =========== 
    … …  
    191186      ENDIF 
    192187      ! 
    193       IF( ln_ctl )   THEN 
    194          WRITE(charout, FMT="('sbc ')") ;  CALL prt_ctl_trc_info(charout) 
    195                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     188      IF( sn_cfctl%l_prttrc )   THEN 
     189         WRITE(charout, FMT="('sbc ')") ;  CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     190                                           CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    196191      ENDIF 
    197192      IF( l_trdtrc )  DEALLOCATE( ztrtrd ) 
    … …  
    205200   !!   Dummy module :                      NO passive tracer 
    206201   !!---------------------------------------------------------------------- 
     202   USE par_oce 
     203   USE par_trc 
    207204CONTAINS 
    208    SUBROUTINE trc_sbc (kt)              ! Empty routine 
    209       INTEGER, INTENT(in) :: kt 
     205   SUBROUTINE trc_sbc ( kt, Kmm, ptr, Krhs )      ! Empty routine 
     206      INTEGER,                                    INTENT(in   ) :: kt        ! ocean time-step index 
     207      INTEGER,                                    INTENT(in   ) :: Kmm, Krhs ! time level indices 
     208      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr       ! passive tracers and RHS of tracer equation 
    210209      WRITE(*,*) 'trc_sbc: You should not have seen this print! error?', kt 
    211210   END SUBROUTINE trc_sbc 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trcsink.F90

    r10788 r13463  
    2424   INTEGER, PUBLIC :: nitermax      !: Maximum number of iterations for sinking 
    2525 
     26   !! * Substitutions 
     27#  include "do_loop_substitute.h90" 
     28#  include "domzgr_substitute.h90" 
    2629   !!---------------------------------------------------------------------- 
    2730   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    3538   !!---------------------------------------------------------------------- 
    3639 
    37    SUBROUTINE trc_sink ( kt, pwsink, psinkflx, jp_tra, rsfact ) 
     40   SUBROUTINE trc_sink ( kt, Kbb, Kmm, pwsink, psinkflx, jp_tra, rsfact ) 
    3841      !!--------------------------------------------------------------------- 
    3942      !!                     ***  ROUTINE trc_sink  *** 
    … …  
    4548      !!--------------------------------------------------------------------- 
    4649      INTEGER , INTENT(in)  :: kt 
     50      INTEGER , INTENT(in)  :: Kbb, Kmm 
    4751      INTEGER , INTENT(in)  :: jp_tra    ! tracer index index       
    4852      REAL(wp), INTENT(in)  :: rsfact    ! time step duration 
    … …  
    7074         iiter(:,:) = 1 
    7175      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 
     76         DO_2D( 1, 1, 1, 1 ) 
     77            iiter(ji,jj) = 1 
     78            DO jk = 1, jpkm1 
     79               IF( tmask(ji,jj,jk) == 1.0 ) THEN 
     80                   zwsmax =  0.5 * e3t(ji,jj,jk,Kmm) * rday / rsfact 
     81                   iiter(ji,jj) =  MAX( iiter(ji,jj), INT( pwsink(ji,jj,jk) / zwsmax ) ) 
     82               ENDIF 
     83            END DO 
     84         END_2D 
    8385         iiter(:,:) = MIN( iiter(:,:), nitermax ) 
    8486      ENDIF 
    8587 
    86       DO jk = 1,jpkm1 
    87          DO jj = 1, jpj 
    88             DO ji = 1, jpi 
    89                IF( tmask(ji,jj,jk) == 1 ) 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                ENDIF 
    93             END DO 
    94          END DO 
    95       END DO 
     88      DO_3D( 1, 1, 1, 1, 1,jpkm1 ) 
     89         IF( tmask(ji,jj,jk) == 1.0 ) THEN 
     90           zwsmax = 0.5 * e3t(ji,jj,jk,Kmm) * 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_3D 
    9697 
    9798      !  Initializa to zero all the sinking arrays  
    … …  
    101102      !   Compute the sedimentation term using trc_sink2 for the considered sinking particle 
    102103      !   ----------------------------------------------------- 
    103       CALL trc_sink2( zwsink, psinkflx, jp_tra, iiter, rsfact ) 
     104      CALL trc_sink2( Kbb, Kmm, zwsink, psinkflx, jp_tra, iiter, rsfact ) 
    104105      ! 
    105106      IF( ln_timing )   CALL timing_stop('trc_sink') 
    … …  
    107108   END SUBROUTINE trc_sink 
    108109 
    109    SUBROUTINE trc_sink2( pwsink, psinkflx, jp_tra, kiter, rsfact ) 
     110   SUBROUTINE trc_sink2( Kbb, Kmm, pwsink, psinkflx, jp_tra, kiter, rsfact ) 
    110111      !!--------------------------------------------------------------------- 
    111112      !!                     ***  ROUTINE trc_sink2  *** 
    … …  
    118119      !!      transport term, i.e.  div(u*tra). 
    119120      !!--------------------------------------------------------------------- 
     121      INTEGER,  INTENT(in   )                         ::   Kbb, Kmm  ! time level indices 
    120122      INTEGER,  INTENT(in   )                         ::   jp_tra    ! tracer index index       
    121123      REAL(wp), INTENT(in   )                         ::   rsfact    ! duration of time step 
    … …  
    133135      ztraz(:,:,:) = 0.e0 
    134136      zakz (:,:,:) = 0.e0 
    135       ztrb (:,:,:) = trb(:,:,:,jp_tra) 
     137      ztrb (:,:,:) = tr(:,:,:,jp_tra,Kbb) 
    136138 
    137139      DO jk = 1, jpkm1 
    … …  
    144146      DO jn = 1, 2 
    145147         !  first guess of the slopes interior values 
    146          DO jj = 1, jpj 
    147             DO ji = 1, jpi 
    148                ! 
    149                zstep = rsfact / REAL( kiter(ji,jj), wp ) / 2. 
    150                !               
    151                DO jk = 2, jpkm1 
    152                   ztraz(ji,jj,jk) = ( trb(ji,jj,jk-1,jp_tra) - trb(ji,jj,jk,jp_tra) ) * 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_n(ji,jj,jk+1) 
    172                   zew   = zwsink2(ji,jj,jk+1) 
    173                   psinkflx(ji,jj,jk+1) = -zew * ( trb(ji,jj,jk,jp_tra) - 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_n(ji,jj,jk) 
    182                   trb(ji,jj,jk,jp_tra) = trb(ji,jj,jk,jp_tra) + zflx 
    183                END DO 
    184             END DO 
    185          END DO 
     148         DO_2D( 1, 1, 1, 1 ) 
     149            ! 
     150            zstep = rsfact / REAL( kiter(ji,jj), wp ) / 2. 
     151            !               
     152            DO jk = 2, jpkm1 
     153               ztraz(ji,jj,jk) = ( tr(ji,jj,jk-1,jp_tra,Kbb) - tr(ji,jj,jk,jp_tra,Kbb) ) * tmask(ji,jj,jk) 
     154            END DO 
     155            ztraz(ji,jj,1  ) = 0.0 
     156            ztraz(ji,jj,jpk) = 0.0 
     157 
     158            ! slopes 
     159            DO jk = 2, jpkm1 
     160               zign = 0.25 + SIGN( 0.25_wp, ztraz(ji,jj,jk) * ztraz(ji,jj,jk+1) ) 
     161               zakz(ji,jj,jk) = ( ztraz(ji,jj,jk) + ztraz(ji,jj,jk+1) ) * zign 
     162            END DO 
     163       
     164            ! Slopes limitation 
     165            DO jk = 2, jpkm1 
     166               zakz(ji,jj,jk) = SIGN( 1.0_wp, zakz(ji,jj,jk) ) *        & 
     167                  &             MIN( ABS( zakz(ji,jj,jk) ), 2. * ABS(ztraz(ji,jj,jk+1)), 2. * ABS(ztraz(ji,jj,jk) ) ) 
     168            END DO 
     169       
     170            ! vertical advective flux 
     171            DO jk = 1, jpkm1 
     172               zigma = zwsink2(ji,jj,jk+1) * zstep / e3w(ji,jj,jk+1,Kmm) 
     173               zew   = zwsink2(ji,jj,jk+1) 
     174               psinkflx(ji,jj,jk+1) = -zew * ( tr(ji,jj,jk,jp_tra,Kbb) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep 
     175            END DO 
     176            ! 
     177            ! Boundary conditions 
     178            psinkflx(ji,jj,1  ) = 0.e0 
     179            psinkflx(ji,jj,jpk) = 0.e0 
     180       
     181            DO jk=1,jpkm1 
     182               zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 
     183               tr(ji,jj,jk,jp_tra,Kbb) = tr(ji,jj,jk,jp_tra,Kbb) + zflx 
     184            END DO 
     185         END_2D 
    186186      END DO 
    187187 
    188       DO jk = 1,jpkm1 
    189          DO jj = 1,jpj 
    190             DO ji = 1, jpi 
    191                zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t_n(ji,jj,jk) 
    192                ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx 
    193             END DO 
    194          END DO 
    195       END DO 
    196  
    197       trb(:,:,:,jp_tra) = ztrb(:,:,:) 
     188      DO_3D( 1, 1, 1, 1, 1,jpkm1 ) 
     189         zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 
     190         ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx 
     191      END_3D 
     192 
     193      tr(:,:,:,jp_tra,Kbb) = ztrb(:,:,:) 
    198194      psinkflx(:,:,:)   = 2. * psinkflx(:,:,:) 
    199195      ! 
    … …  
    213209      !!---------------------------------------------------------------------- 
    214210      ! 
    215       REWIND( numnat_ref )              ! namtrc_rad in reference namelist  
    216211      READ  ( numnat_ref, namtrc_snk, IOSTAT = ios, ERR = 907) 
    217 907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_snk in reference namelist', lwp ) 
    218       REWIND( numnat_cfg )              ! namtrc_rad in configuration namelist  
     212907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_snk in reference namelist' ) 
    219213      READ  ( numnat_cfg, namtrc_snk, IOSTAT = ios, ERR = 908 ) 
    220 908   IF( ios > 0 )   CALL ctl_nam ( ios , 'namtrc_snk in configuration namelist', lwp ) 
     214908   IF( ios > 0 )   CALL ctl_nam ( ios , 'namtrc_snk in configuration namelist' ) 
    221215      IF(lwm) WRITE( numont, namtrc_snk ) 
    222216 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trctrp.F90

    r10068 r13463  
    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/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trczdf.F90

    r10068 r13463  
    2222!!gm 
    2323   USE trdtra        ! trends manager: tracers  
    24    USE prtctl_trc    ! Print control 
     24   USE prtctl        ! Print control 
    2525 
    2626   IMPLICIT NONE 
    … …  
    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', rDt_trc, 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) ) / rDt_trc ) - 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 ')") 
    69          CALL prt_ctl_trc_info(charout) 
    70          CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     71         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     72         CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kaa), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    7173      END IF 
    7274      ! 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trdmxl_trc.F90

    r10425 r13463  
    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" 
     53#  include "domzgr_substitute.h90" 
    5254   !!---------------------------------------------------------------------- 
    5355   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    7072 
    7173 
    72    SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn ) 
     74   SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn, Kmm ) 
    7375      !!---------------------------------------------------------------------- 
    7476      !!                  ***  ROUTINE trd_mxl_trc_zint  *** 
    … …  
    9294      !! 
    9395      INTEGER, INTENT( in ) ::   ktrd, kjn                        ! ocean trend index and passive tracer rank 
     96      INTEGER, INTENT( in ) ::   Kmm                              ! time level index 
    9497      CHARACTER(len=2), INTENT( in ) ::  ctype                    ! surface/bottom (2D) or interior (3D) physics 
    9598      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::  ptrc_trdmxl ! passive tracer trend 
    … …  
    108111         ! ... Set nmld(ji,jj) = index of first T point below control surf. or outside mixed-layer 
    109112         SELECT CASE ( nn_ctls_trc )                                ! choice of the control surface 
    110             CASE ( -2  )   ;   STOP 'trdmxl_trc : not ready '     !     -> isopycnal surface (see ???) 
     113            CASE ( -2  )   ;   CALL ctl_stop( 'STOP', 'trdmxl_trc : not ready ' )     !     -> isopycnal surface (see ???) 
    111114            CASE ( -1  )   ;   nmld_trc(:,:) = neln(:,:)          !     -> euphotic layer with light criterion 
    112115            CASE (  0  )   ;   nmld_trc(:,:) = nmln(:,:)          !     -> ML with density criterion (see zdfmxl) 
    … …  
    122125 
    123126            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 
     127               DO_2D( 1, 1, 1, 1 ) 
     128                  IF( nmld_trc(ji,jj) <= jpktrd_trc ) THEN 
     129                     zvlmsk(ji,jj) = tmask(ji,jj,1) 
     130                  ELSE 
     131                     isum = isum + 1 
     132                     zvlmsk(ji,jj) = 0.e0 
     133                  ENDIF 
     134               END_2D 
    134135            ENDIF 
    135136 
    … …  
    147148         ! ... Weights for vertical averaging 
    148149         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 
     150         DO_3D( 1, 1, 1, 1, 1, jpktrd_trc ) 
     151            IF( jk - nmld_trc(ji,jj) < 0 )   wkx_trc(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 
     152         END_3D 
    156153          
    157154         rmld_trc(:,:) = 0.e0 
    … …  
    183180 
    184181 
    185    SUBROUTINE trd_mxl_trc( kt ) 
     182   SUBROUTINE trd_mxl_trc( kt, Kmm ) 
    186183      !!---------------------------------------------------------------------- 
    187184      !!                  ***  ROUTINE trd_mxl_trc  *** 
    … …  
    232229      ! 
    233230      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     231      INTEGER, INTENT(in) ::   Kmm                              ! time level index 
    234232      ! 
    235233      INTEGER ::   ji, jj, jk, jl, ik, it, itmod, jn 
    … …  
    251249 
    252250 
    253       IF( nn_dttrc  /= 1  )   CALL ctl_stop( " Be careful, trends diags never validated " ) 
    254  
    255251      ! ====================================================================== 
    256252      ! I. Diagnose the purely vertical (K_z) diffusion trend 
    … …  
    263259         ! 
    264260         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 
     261            DO_2D( 1, 1, 1, 1 ) 
     262               ik = nmld_trc(ji,jj) 
     263               IF( ln_trdtrc(jn) )    & 
     264               tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - avs(ji,jj,ik) / e3w(ji,jj,ik,Kmm) * tmask(ji,jj,ik)  & 
     265                    &                    * ( tr(ji,jj,ik-1,jn,Kmm) - tr(ji,jj,ik,jn,Kmm) )            & 
     266                    &                    / MAX( 1., rmld_trc(ji,jj) ) * tmask(ji,jj,1) 
     267            END_2D 
    274268         END DO 
    275269 
    … …  
    322316         DO jn = 1, jptra 
    323317            IF( ln_trdtrc(jn) ) & 
    324                tml_trc(:,:,jn) = tml_trc(:,:,jn) + wkx_trc(:,:,jk) * trn(:,:,jk,jn) 
     318               tml_trc(:,:,jn) = tml_trc(:,:,jn) + wkx_trc(:,:,jk) * tr(:,:,jk,jn,Kmm) 
    325319         END DO 
    326320      END DO 
    … …  
    328322      ! II.3 Initialize mixed-layer "before" arrays for the 1rst analysis window     
    329323      ! ------------------------------------------------------------------------ 
    330       IF( kt == nittrc000 + nn_dttrc ) THEN  !  i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1)    ??? 
     324      IF( kt == nittrc000 + 1 ) THEN  !  i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1)    ??? 
    331325         ! 
    332326         DO jn = 1, jptra 
    … …  
    408402         DO jn = 1, jptra 
    409403            IF( ln_trdtrc(jn) ) THEN 
    410                !-- Compute total trends    (use rdttrc instead of rdt ???) 
     404               !-- Compute total trends  
    411405               IF ( ln_trcadv_muscl .OR. ln_trcadv_muscl2 ) THEN  ! EULER-FORWARD schemes 
    412                   ztmltot(:,:,jn) =  ( tml_trc(:,:,jn) - tmlbn_trc(:,:,jn) )/rdt 
     406                  ztmltot(:,:,jn) =  ( tml_trc(:,:,jn) - tmlbn_trc(:,:,jn) )/rn_Dt 
    413407               ELSE                                                                     ! LEAP-FROG schemes 
    414                   ztmltot(:,:,jn) =  ( tml_trc(:,:,jn) - tmlbn_trc(:,:,jn) + tmlb_trc(:,:,jn) - tmlbb_trc(:,:,jn))/(2.*rdt) 
     408                  ztmltot(:,:,jn) =  ( tml_trc(:,:,jn) - tmlbn_trc(:,:,jn) + tmlb_trc(:,:,jn) - tmlbb_trc(:,:,jn))/(2.*rn_Dt) 
    415409               ENDIF 
    416410                
    … …  
    431425 
    432426#if defined key_diainstant 
    433                STOP 'tmltrd_trc : key_diainstant was never checked within trdmxl. Comment this to proceed.' 
     427               CALL ctl_stop( 'STOP', 'tmltrd_trc : key_diainstant was never checked within trdmxl. Comment this to proceed.' ) 
    434428#endif 
    435429            ENDIF 
    … …  
    446440            IF( ln_trdtrc(jn) ) THEN 
    447441               tml_sum_trc(:,:,jn) = tmlbn_trc(:,:,jn) + 2 * ( tml_sum_trc(:,:,jn) - tml_trc(:,:,jn) ) + tml_trc(:,:,jn) 
    448                ztmltot2   (:,:,jn) = ( tml_sum_trc(:,:,jn) - tml_sumb_trc(:,:,jn) ) /  ( 2.*rdt )    ! now tracer unit is /sec 
     442               ztmltot2   (:,:,jn) = ( tml_sum_trc(:,:,jn) - tml_sumb_trc(:,:,jn) ) /  ( 2.*rn_Dt )    ! now tracer unit is /sec 
    449443            ENDIF 
    450444         END DO 
    … …  
    857851#  if defined key_diainstant 
    858852      IF( .NOT. ln_trdmxl_trc_instant ) THEN 
    859          STOP 'trd_mxl_trc : this was never checked. Comment this line to proceed...' 
    860       ENDIF 
    861       zsto = nn_trd_trc * rdt 
     853         CALL ctl_stop( 'STOP', 'trd_mxl_trc : this was never checked. Comment this line to proceed...' ) 
     854      ENDIF 
     855      zsto = nn_trd_trc * rn_Dt 
    862856      clop = "inst("//TRIM(clop)//")" 
    863857#  else 
    864858      IF( ln_trdmxl_trc_instant ) THEN 
    865          zsto = rdt                                               ! inst. diags : we use IOIPSL time averaging 
     859         zsto = rn_Dt                                               ! inst. diags : we use IOIPSL time averaging 
    866860      ELSE 
    867          zsto = nn_trd_trc * rdt                                    ! mean  diags : we DO NOT use any IOIPSL time averaging 
     861         zsto = nn_trd_trc * rn_Dt                                    ! mean  diags : we DO NOT use any IOIPSL time averaging 
    868862      ENDIF 
    869863      clop = "ave("//TRIM(clop)//")" 
    870864#  endif 
    871       zout = nn_trd_trc * rdt 
    872       iiter = ( nittrc000 - 1 ) / nn_dttrc 
     865      zout = nn_trd_trc * rn_Dt 
     866      iiter = nittrc000 - 1 
    873867 
    874868      IF(lwp) WRITE (numout,*) '                netCDF initialization' 
    … …  
    876870      ! II.2 Compute julian date from starting date of the run 
    877871      ! ------------------------------------------------------ 
    878       CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) 
     872      CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian ) 
    879873      zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    880874      IF(lwp) WRITE(numout,*)' '   
    … …  
    908902            CALL dia_nam( clhstnam, nn_trd_trc, csuff ) 
    909903            CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,                                            & 
    910                &        1, jpi, 1, jpj, iiter, zjulian, rdt, nh_t(jn), nidtrd(jn), domain_id=nidom, snc4chunks=snc4set ) 
     904               &        1, jpi, 1, jpj, iiter, zjulian, rn_Dt, nh_t(jn), nidtrd(jn), domain_id=nidom, snc4chunks=snc4set ) 
    911905       
    912906            !-- Define the ML depth variable 
    … …  
    928922      !-- Define miscellaneous passive tracer mixed-layer variables  
    929923      IF( jpltrd_trc /= jpmxl_trc_atf .OR.  jpltrd_trc - 1 /= jpmxl_trc_radb ) THEN 
    930          STOP 'Error : jpltrd_trc /= jpmxl_trc_atf .OR.  jpltrd_trc - 1 /= jpmxl_trc_radb' ! see below 
     924         CALL ctl_stop( 'STOP', 'Error : jpltrd_trc /= jpmxl_trc_atf .OR.  jpltrd_trc - 1 /= jpmxl_trc_radb' ) ! see below 
    931925      ENDIF 
    932926 
    … …  
    945939               CALL histdef(nidtrd(jn), trim(clvar)//trim(ctrd_trc(jl,2)), clmxl//" "//clvar//ctrd_trc(jl,1),                      &  
    946940                 &    cltrcu, jpi, jpj, nh_t(jn), 1  , 1, 1  , -99 , 32, clop, zsto, zout ) ! IOIPSL: time mean 
    947             END DO                                                                         ! if zsto=rdt above 
     941            END DO                                                                         ! if zsto=rn_Dt above 
    948942          
    949943            CALL histdef(nidtrd(jn), trim(clvar)//trim(ctrd_trc(jpmxl_trc_radb,2)), clmxl//" "//clvar//ctrd_trc(jpmxl_trc_radb,1), &  
    … …  
    970964   !!---------------------------------------------------------------------- 
    971965CONTAINS 
    972    SUBROUTINE trd_mxl_trc( kt )                                   ! Empty routine 
     966   SUBROUTINE trd_mxl_trc( kt, Kmm )                                   ! Empty routine 
    973967      INTEGER, INTENT( in) ::   kt 
     968      INTEGER, INTENT( in) ::   Kmm            ! time level index 
    974969      WRITE(*,*) 'trd_mxl_trc: You should not have seen this print! error?', kt 
    975970   END SUBROUTINE trd_mxl_trc 
    976    SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn ) 
     971   SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn, Kmm ) 
    977972      INTEGER               , INTENT( in ) ::  ktrd, kjn              ! ocean trend index and passive tracer rank 
     973      INTEGER               , INTENT( in ) ::  Kmm                    ! time level index 
    978974      CHARACTER(len=2)      , INTENT( in ) ::  ctype                  ! surface/bottom (2D) or interior (3D) physics 
    979975      REAL, DIMENSION(:,:,:), INTENT( in ) ::  ptrc_trdmxl            ! passive trc trend 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trdmxl_trc_rst.F90

    r10425 r13463  
    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 
    … …  
    144144          
    145145         DO jn = 1, jptra 
    146             CALL iom_get( inum, jpdom_autoglo, 'tmlbb_trc_'  //ctrcnm(jn), tmlbb_trc  (:,:,jn) ) 
    147             CALL iom_get( inum, jpdom_autoglo, 'tmlbn_trc_'  //ctrcnm(jn), tmlbn_trc  (:,:,jn) ) 
    148             CALL iom_get( inum, jpdom_autoglo, 'tmlatfb_trc_'//ctrcnm(jn), tmlatfb_trc(:,:,jn) ) 
    149             CALL iom_get( inum, jpdom_autoglo, 'tmlradb_trc_'//ctrcnm(jn), tmlradb_trc(:,:,jn) ) 
     146            CALL iom_get( inum, jpdom_auto, 'tmlbb_trc_'  //ctrcnm(jn), tmlbb_trc  (:,:,jn) ) 
     147            CALL iom_get( inum, jpdom_auto, 'tmlbn_trc_'  //ctrcnm(jn), tmlbn_trc  (:,:,jn) ) 
     148            CALL iom_get( inum, jpdom_auto, 'tmlatfb_trc_'//ctrcnm(jn), tmlatfb_trc(:,:,jn) ) 
     149            CALL iom_get( inum, jpdom_auto, 'tmlradb_trc_'//ctrcnm(jn), tmlradb_trc(:,:,jn) ) 
    150150         END DO 
    151151          
    152152      ELSE 
    153          CALL iom_get( inum, jpdom_autoglo, 'rmldbn_trc', rmldbn_trc ) ! needed for rmld_sum 
     153         CALL iom_get( inum, jpdom_auto, 'rmldbn_trc', rmldbn_trc ) ! needed for rmld_sum 
    154154          
    155155         !                                                          ! =========== 
    156156         DO jn = 1, jptra                                           ! tracer loop 
    157157            !                                                       ! =========== 
    158             CALL iom_get( inum, jpdom_autoglo, 'tmlatfb_trc_' //ctrcnm(jn), tmlatfb_trc(:,:,jn) ) 
    159             CALL iom_get( inum, jpdom_autoglo, 'tmlbb_trc_'   //ctrcnm(jn), tmlbb_trc  (:,:,jn) ) 
    160             CALL iom_get( inum, jpdom_autoglo, 'tmlradb_trc_' //ctrcnm(jn), tmlradb_trc(:,:,jn) ) 
    161  
    162             CALL iom_get( inum, jpdom_autoglo, 'tmlbn_trc_'   //ctrcnm(jn), tmlbn_trc   (:,:,jn) ) ! needed for tml_sum 
    163             CALL iom_get( inum, jpdom_autoglo, 'tml_sumb_trc_'//ctrcnm(jn), tml_sumb_trc(:,:,jn) ) 
     158            CALL iom_get( inum, jpdom_auto, 'tmlatfb_trc_' //ctrcnm(jn), tmlatfb_trc(:,:,jn) ) 
     159            CALL iom_get( inum, jpdom_auto, 'tmlbb_trc_'   //ctrcnm(jn), tmlbb_trc  (:,:,jn) ) 
     160            CALL iom_get( inum, jpdom_auto, 'tmlradb_trc_' //ctrcnm(jn), tmlradb_trc(:,:,jn) ) 
     161 
     162            CALL iom_get( inum, jpdom_auto, 'tmlbn_trc_'   //ctrcnm(jn), tmlbn_trc   (:,:,jn) ) ! needed for tml_sum 
     163            CALL iom_get( inum, jpdom_auto, 'tml_sumb_trc_'//ctrcnm(jn), tml_sumb_trc(:,:,jn) ) 
    164164             
    165165            DO jk = 1, jpltrd_trc 
    … …  
    169169                  WRITE(charout,FMT="('tmltrd_csum_ub_trc_', A3, '_', I2)") ctrcnm(jn), jk 
    170170               ENDIF 
    171                CALL iom_get( inum, jpdom_autoglo, charout, tmltrd_csum_ub_trc(:,:,jk,jn) ) 
     171               CALL iom_get( inum, jpdom_auto, charout, tmltrd_csum_ub_trc(:,:,jk,jn) ) 
    172172            END DO 
    173173             
    174             CALL iom_get( inum, jpdom_autoglo, 'tmltrd_atf_sumb_trc_'//ctrcnm(jn) , & 
     174            CALL iom_get( inum, jpdom_auto, 'tmltrd_atf_sumb_trc_'//ctrcnm(jn) , & 
    175175                 &        tmltrd_atf_sumb_trc(:,:,jn) ) 
    176176 
    177             CALL iom_get( inum, jpdom_autoglo, 'tmltrd_rad_sumb_trc_'//ctrcnm(jn) , & 
     177            CALL iom_get( inum, jpdom_auto, 'tmltrd_rad_sumb_trc_'//ctrcnm(jn) , & 
    178178                 &        tmltrd_rad_sumb_trc(:,:,jn) ) 
    179179            !                                                       ! =========== 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trdtrc.F90

    r10096 r13463  
    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 
    1818   USE trdmxl_trc        ! Mixed layer trends diag. 
    1919   USE iom               ! I/O library 
     20   USE par_kind 
    2021 
    2122   IMPLICIT NONE 
    … …  
    3233CONTAINS 
    3334 
    34    SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt ) 
     35   SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt, Kmm ) 
    3536      !!---------------------------------------------------------------------- 
    3637      !!                  ***  ROUTINE trd_trc  *** 
    3738      !!---------------------------------------------------------------------- 
    3839      INTEGER, INTENT( in )  ::   kt                                  ! time step 
     40      INTEGER, INTENT( in )  ::   Kmm                                 ! time level index 
    3941      INTEGER, INTENT( in )  ::   kjn                                 ! tracer index 
    4042      INTEGER, INTENT( in )  ::   ktrd                                ! tracer trend index 
    … …  
    5658         ! 
    5759         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 ) 
     60         CASE ( jptra_xad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_xad, '3D', kjn, Kmm ) 
     61         CASE ( jptra_yad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_yad, '3D', kjn, Kmm ) 
     62         CASE ( jptra_zad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zad, '3D', kjn, Kmm ) 
     63         CASE ( jptra_ldf     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn, Kmm ) 
     64         CASE ( jptra_bbl     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_bbl, '3D', kjn, Kmm ) 
    6365         CASE ( jptra_zdf     ) 
    6466            IF( ln_trcldf_iso ) THEN 
    65                CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn ) 
     67               CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn, Kmm ) 
    6668            ELSE 
    67                CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zdf, '3D', kjn ) 
     69               CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zdf, '3D', kjn, Kmm ) 
    6870            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 ) 
     71         CASE ( jptra_dmp     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_dmp , '3D', kjn, Kmm ) 
     72         CASE ( jptra_nsr     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_sbc , '2D', kjn, Kmm ) 
     73         CASE ( jptra_sms     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_sms , '3D', kjn, Kmm ) 
     74         CASE ( jptra_radb    )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_radb, '3D', kjn, Kmm ) 
     75         CASE ( jptra_radn    )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_radn, '3D', kjn, Kmm ) 
     76         CASE ( jptra_atf     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_atf , '3D', kjn, Kmm ) 
    7577         END SELECT 
    7678         ! 
    … …  
    106108   !!---------------------------------------------------------------------- 
    107109 
     110   USE par_kind 
     111 
    108112   PUBLIC trd_trc 
    109113 
    110114CONTAINS 
    111115 
    112    SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt ) 
     116   SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt, Kmm ) 
    113117      INTEGER               , INTENT( in )     ::   kt      ! time step 
     118      INTEGER               , INTENT( in )     ::   Kmm     ! time level index 
    114119      INTEGER               , INTENT( in )     ::   kjn     ! tracer index 
    115120      INTEGER               , INTENT( in )     ::   ktrd    ! tracer trend index 
    116       REAL, DIMENSION(:,:,:), INTENT( inout )  ::   ptrtrd  ! Temperature or U trend 
     121      REAL(wp), DIMENSION(:,:,:), INTENT( inout )  ::   ptrtrd  ! Temperature or U trend 
    117122      WRITE(*,*) 'trd_trc : You should not have seen this print! error?', ptrtrd(1,1,1) 
    118123      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kjn 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/oce_trc.F90

    r10351 r13463  
    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   
    … …  
    1718   USE par_oce , ONLY :   jp_tem   =>   jp_tem     !: indice for temperature 
    1819   USE par_oce , ONLY :   jp_sal   =>   jp_sal     !: indice for salinity 
     20   USE par_oce , ONLY :   nn_hls   =>   nn_hls     !:  
     21   USE par_oce , ONLY :   Nis0    =>   Nis0      !:  
     22   USE par_oce , ONLY :   Njs0    =>   Njs0      !:  
     23   USE par_oce , ONLY :   Nie0    =>   Nie0      !:  
     24   USE par_oce , ONLY :   Nje0    =>   Nje0      !:  
     25   USE par_oce , ONLY :   Nis1    =>   Nis1      !:  
     26   USE par_oce , ONLY :   Njs1    =>   Njs1      !:  
     27   USE par_oce , ONLY :   Nie1    =>   Nie1      !:  
     28   USE par_oce , ONLY :   Nje1    =>   Nje1      !:  
     29   USE par_oce , ONLY :   Nis1nxt2    =>   Nis1nxt2      !:  
     30   USE par_oce , ONLY :   Njs1nxt2    =>   Njs1nxt2      !:  
     31   USE par_oce , ONLY :   Nie1nxt2    =>   Nie1nxt2      !:  
     32   USE par_oce , ONLY :   Nje1nxt2    =>   Nje1nxt2      !:  
     33   USE par_oce , ONLY :   Nis2    =>   Nis2      !:  
     34   USE par_oce , ONLY :   Njs2    =>   Njs2      !:  
     35   USE par_oce , ONLY :   Nie2    =>   Nie2      !:  
     36   USE par_oce , ONLY :   Nje2    =>   Nje2      !:  
     37   USE par_oce , ONLY :   Ni_0    =>   Ni_0      !:  
     38   USE par_oce , ONLY :   Nj_0    =>   Nj_0      !:  
     39   USE par_oce , ONLY :   Ni_1    =>   Ni_1      !:  
     40   USE par_oce , ONLY :   Nj_1    =>   Nj_1      !:  
     41   USE par_oce , ONLY :   Ni_2    =>   Ni_2      !:  
     42   USE par_oce , ONLY :   Nj_2    =>   Nj_2      !:  
    1943 
    2044   USE in_out_manager                           !* IO manager * 
    … …  
    3357 
    3458   !* 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 
     59   USE oce , ONLY :   uu     =>    uu     !: i-horizontal velocity (m s-1)  
     60   USE oce , ONLY :   vv     =>    vv     !: j-horizontal velocity (m s-1) 
     61   USE oce , ONLY :   ww     =>    ww     !: vertical velocity (m s-1)   
     62   USE oce , ONLY :   ts     =>    ts     !: 4D array contaning ( tn, sn ) 
     63   USE oce , ONLY :   rhop   =>    rhop   !: potential volumic mass (kg m-3)  
     64   USE oce , ONLY :   rhd    =>    rhd    !: in situ density anomalie rhd=(rho-rho0)/rho0 (no units) 
     65   USE oce , ONLY :   hdiv   =>    hdiv   !: horizontal divergence (1/s) 
     66   USE oce , ONLY :   ssh    =>    ssh    !: sea surface height at t-point [m]    
     67   USE oce , ONLY :   rab_n  =>    rab_n  !: local thermal/haline expension ratio at T-points 
    4868 
    4969   !* surface fluxes * 
    … …  
    6585   USE traqsr  , ONLY :   rn_abs     =>    rn_abs     !: fraction absorbed in the very near surface 
    6686   USE traqsr  , ONLY :   rn_si0     =>    rn_si0     !: very near surface depth of extinction 
     87   USE traqsr  , ONLY :   nksr       =>    nksr       !: levels below which the light cannot penetrate (depth larger than 391 m) 
     88   USE traqsr  , ONLY :   rkrgb      =>    rkrgb      !: tabulated attenuation coefficients for RGB absorption 
    6789   USE traqsr  , ONLY :   ln_qsr_bio =>    ln_qsr_bio !: flag to use or not the biological fluxes for light 
    6890   USE sbcrnf  , ONLY :   rnfmsk     =>    rnfmsk     !: mixed adv scheme in runoffs vicinity (hori.)  

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/trc.F90

    r10425 r13463  
    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 
    … …  
    6361   CHARACTER(len = 80) , PUBLIC ::   cn_trcrst_out      !: suffix of pass. tracer restart name (output) 
    6462   CHARACTER(len = 256), PUBLIC ::   cn_trcrst_outdir   !: restart output directory 
    65    REAL(wp)            , PUBLIC ::   rdttrc             !: passive tracer time step 
    66    REAL(wp)            , PUBLIC ::   r2dttrc            !: = 2*rdttrc except at nit000 (=rdttrc) if neuler=0 
     63   REAL(wp)            , PUBLIC ::   rDt_trc            !: = 2*rn_Dt except at nit000 (=rn_Dt) if l_1st_euler=.true. 
    6764   LOGICAL             , PUBLIC ::   ln_top_euler       !: boolean term for euler integration  
    6865   LOGICAL             , PUBLIC ::   ln_trcdta          !: Read inputs data from files 
     66   LOGICAL             , PUBLIC ::   ln_trcbc           !: Enable surface, lateral or open boundaries conditions 
    6967   LOGICAL             , PUBLIC ::   ln_trcdmp          !: internal damping flag 
    7068   LOGICAL             , PUBLIC ::   ln_trcdmp_clo      !: internal damping flag on closed seas 
    … …  
    117115   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ln_trc_cbc    !: Use coastal boundary condition data 
    118116   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) 
     117   REAL(wp), PUBLIC                                  ::   rn_sbc_time   !: Time scaling factor for SBC data (seconds in a day) 
     118   REAL(wp), PUBLIC                                  ::   rn_cbc_time   !: Time scaling factor for CBC data (seconds in a day) 
     119   LOGICAL , PUBLIC                                  ::   lltrcbc       !: Applying one of the boundary conditions  
    120120   ! 
    121121   CHARACTER(len=20), PUBLIC, DIMENSION(jp_bdy) :: cn_trc_dflt   ! Default OBC condition for all tracers 
    … …  
    130130!$AGRIF_END_DO_NOT_TREAT 
    131131   ! 
     132   !! Substitutions 
     133#include "do_loop_substitute.h90" 
    132134   !!---------------------------------------------------------------------- 
    133135   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    147149      ierr(:) = 0 
    148150      ! 
    149       ALLOCATE( trn(jpi,jpj,jpk,jptra), trb(jpi,jpj,jpk,jptra), tra(jpi,jpj,jpk,jptra),       &   
     151      ALLOCATE( tr(jpi,jpj,jpk,jptra,jpt)                                             ,       &   
    150152         &      trc_i(jpi,jpj,jptra)  , trc_o(jpi,jpj,jptra)                          ,       & 
    151153         &      gtru (jpi,jpj,jptra)  , gtrv (jpi,jpj,jptra)                          ,       & 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/trcbc.F90

    r10068 r13463  
    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 
    … …  
    4440   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:), TARGET  :: sf_trcobc 
    4541#endif 
    46    TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr   ! array of pointers to nbmap 
     42 
     43#if defined key_top 
     44   !!---------------------------------------------------------------------- 
     45   !!   'key_top'                                                TOP model  
     46   !!---------------------------------------------------------------------- 
    4747 
    4848   !! * Substitutions 
    49 #  include "vectopt_loop_substitute.h90" 
     49#  include "do_loop_substitute.h90" 
     50#  include "domzgr_substitute.h90" 
    5051   !!---------------------------------------------------------------------- 
    5152   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    5556CONTAINS 
    5657 
    57    SUBROUTINE trc_bc_ini( ntrc ) 
     58   SUBROUTINE trc_bc_ini( ntrc, Kmm ) 
    5859      !!---------------------------------------------------------------------- 
    5960      !!                   ***  ROUTINE trc_bc_ini  *** 
    … …  
    6465      !!              - allocates passive tracer BC data structure  
    6566      !!---------------------------------------------------------------------- 
    66       INTEGER,INTENT(in) :: ntrc                           ! number of tracers 
     67      INTEGER, INTENT(in) :: ntrc                          ! number of tracers 
     68      INTEGER, INTENT(in) ::   Kmm                         ! time level index 
    6769      ! 
    6870      INTEGER            :: jl, jn , ib, ibd, ii, ij, ik   ! dummy loop indices 
    … …  
    8284      !! 
    8385      NAMELIST/namtrc_bc/ cn_dir_obc, sn_trcobc, rn_trofac, cn_dir_sbc, sn_trcsbc, rn_trsfac, &  
    84                         & cn_dir_cbc, sn_trccbc, rn_trcfac, ln_rnf_ctl, rn_bc_time 
     86                        & cn_dir_cbc, sn_trccbc, rn_trcfac, ln_rnf_ctl, rn_sbc_time, rn_cbc_time 
    8587      NAMELIST/namtrc_bdy/ cn_trc_dflt, cn_trc, nn_trcdmp_bdy 
    8688      !!---------------------------------------------------------------------- 
    … …  
    121123      ! 
    122124      ! Read Boundary Conditions Namelists 
    123       REWIND( numnat_ref )              ! Namelist namtrc_bc in reference namelist : Passive tracer data structure 
    124125      READ  ( numnat_ref, namtrc_bc, IOSTAT = ios, ERR = 901) 
    125 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_bc in reference namelist', lwp ) 
    126       REWIND( numnat_cfg )              ! Namelist namtrc_bc in configuration namelist : Passive tracer data structure 
     126901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_bc in reference namelist' ) 
    127127      READ  ( numnat_cfg, namtrc_bc, IOSTAT = ios, ERR = 902 ) 
    128 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist', lwp ) 
     128902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist' ) 
    129129      IF(lwm) WRITE ( numont, namtrc_bc ) 
    130130 
    131131      IF ( ln_bdy ) THEN 
    132          REWIND( numnat_ref )              ! Namelist namtrc_bdy in reference namelist : Passive tracer data structure 
    133132         READ  ( numnat_ref, namtrc_bdy, IOSTAT = ios, ERR = 903) 
    134 903      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_bdy in reference namelist', lwp ) 
    135  
    136          REWIND( numnat_cfg )              ! Namelist namtrc_bdy in configuration namelist : Passive tracer data structure 
     133903      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_bdy in reference namelist' ) 
     134         ! make sur that all elements of the namelist variables have a default definition from namelist_ref 
     135         cn_trc     (2:jp_bdy) = cn_trc     (1) 
     136         cn_trc_dflt(2:jp_bdy) = cn_trc_dflt(1) 
    137137         READ  ( numnat_cfg, namtrc_bdy, IOSTAT = ios, ERR = 904 ) 
    138 904      IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_bdy in configuration namelist', lwp ) 
     138904      IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_bdy in configuration namelist' ) 
    139139         IF(lwm) WRITE ( numont, namtrc_bdy ) 
    140140       
    … …  
    152152               IF(trcdta_bdy(jn,ib)%cn_obc == 'frs' .AND. nn_trcdmp_bdy(ib) /= 0 )  & 
    153153                   & CALL ctl_stop( 'trc_bc_ini: Use FRS OR relaxation' ) 
    154                IF(  .NOT.( 0 < nn_trcdmp_bdy(ib)  .AND.  nn_trcdmp_bdy(ib) <= 2 )  )   & 
     154               IF(  .NOT.( 0 <= nn_trcdmp_bdy(ib)  .AND.  nn_trcdmp_bdy(ib) <= 2 )  )   & 
    155155                   & CALL ctl_stop( 'trc_bc_ini: Not a valid option for nn_trcdmp_bdy. Allowed: 0,1,2.' ) 
    156156            END DO 
    … …  
    234234      ! OPEN Lateral boundary conditions 
    235235      IF( ln_bdy .AND. nb_trcobc > 0 ) THEN  
    236          ALLOCATE ( sf_trcobc(nb_trcobc), rf_trofac(nb_trcobc), nbmap_ptr(nb_trcobc), STAT=ierr1 ) 
     236         ALLOCATE ( sf_trcobc(nb_trcobc), rf_trofac(nb_trcobc), STAT=ierr1 ) 
    237237         IF( ierr1 > 0 ) THEN 
    238238            CALL ctl_stop( 'trc_bc_ini: unable to allocate sf_trcobc structure' )   ;   RETURN 
    … …  
    257257                  trcdta_bdy(jn,ib)%trc => sf_trcobc(jl)%fnow(:,1,:) 
    258258                  trcdta_bdy(jn,ib)%rn_fac = rf_trofac(jl) 
    259                   ! create OBC mapping array 
    260                   nbmap_ptr(jl)%ptr => idx_bdy(ib)%nbmap(:,igrd) 
    261                   nbmap_ptr(jl)%ll_unstruc = ln_coords_file(igrd) 
    262                   ! 
    263259               ELSE                          !* Initialise obc arrays from initial conditions *! 
    264260                  ALLOCATE ( trcdta_bdy(jn,ib)%trc(nblen,jpk) ) 
    … …  
    267263                        ii = idx_bdy(ib)%nbi(ibd,igrd) 
    268264                        ij = idx_bdy(ib)%nbj(ibd,igrd) 
    269                         trcdta_bdy(jn,ib)%trc(ibd,ik) = trn(ii,ij,ik,jn) * tmask(ii,ij,ik) 
     265                        trcdta_bdy(jn,ib)%trc(ibd,ik) = tr(ii,ij,ik,jn,Kmm) * tmask(ii,ij,ik) 
    270266                     END DO 
    271267                  END DO 
    … …  
    276272         ! 
    277273         CALL fld_fill( sf_trcobc, slf_i, cn_dir_obc, 'trc_bc_ini', 'Passive tracer OBC data', 'namtrc_bc' ) 
     274         DO jn = 1, ntrc   ! define imap pointer, must be done after the call to fld_fill 
     275            DO ib = 1, nb_bdy 
     276               IF( ln_trc_obc(jn) ) THEN     !* Initialise from external data *! 
     277                  jl = n_trc_indobc(jn) 
     278                  sf_trcobc(jl)%imap => idx_bdy(ib)%nbmap(1:idx_bdy(ib)%nblen(igrd),igrd) 
     279               ENDIF 
     280            END DO 
     281         END DO 
     282         ! 
    278283      ENDIF 
    279284 
    … …  
    333338 
    334339 
    335    SUBROUTINE trc_bc(kt, jit) 
     340   SUBROUTINE trc_bc(kt, Kmm, ptr, Krhs, jit) 
    336341      !!---------------------------------------------------------------------- 
    337342      !!                   ***  ROUTINE trc_bc  *** 
    … …  
    344349      USE fldread 
    345350      !!       
    346       INTEGER, INTENT(in)           ::   kt    ! ocean time-step index 
    347       INTEGER, INTENT(in), OPTIONAL ::   jit   ! subcycle time-step index (for timesplitting option) 
     351      INTEGER                                   , INTENT(in)           ::   kt        ! ocean time-step index 
     352      INTEGER                                   , INTENT(in)           ::   Kmm, Krhs ! time level indices 
     353      INTEGER                                   , INTENT(in), OPTIONAL ::   jit       ! subcycle time-step index (for timesplitting option) 
     354      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr            ! passive tracers and RHS of tracer equation 
    348355      !! 
    349356      INTEGER  :: ji, jj, jk, jn, jl             ! Loop index 
    … …  
    362369      IF( PRESENT(jit) ) THEN  
    363370         ! 
    364          ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 
     371         ! BDY: use pt_offset=0.5 as applied at the end of the step and fldread is referenced at the middle of the step 
    365372         IF( nb_trcobc > 0 ) THEN 
    366373           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 
    367            CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, map=nbmap_ptr, kit=jit, kt_offset=+1) 
     374           CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, kit=jit, pt_offset = 0.5_wp ) 
    368375         ENDIF 
    369376         ! 
    … …  
    382389      ELSE 
    383390         ! 
    384          ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 
     391         ! BDY: use pt_offset=0.5 as applied at the end of the step and fldread is referenced at the middle of the step 
    385392         IF( nb_trcobc > 0 ) THEN 
    386393           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 
    387            CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, map=nbmap_ptr, kt_offset=+1) 
     394           CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, pt_offset = 0.5_wp ) 
    388395         ENDIF 
    389396         ! 
    … …  
    408415         ! Remove river dilution for tracers with absent river load 
    409416         IF( ln_rnf_ctl .AND. .NOT.ln_trc_cbc(jn) ) THEN 
    410             DO jj = 2, jpj 
    411                DO ji = fs_2, fs_jpim1 
    412                   DO jk = 1, nk_rnf(ji,jj) 
    413                      zrnf = (rnf(ji,jj) + rnf_b(ji,jj)) * 0.5_wp * r1_rau0 / h_rnf(ji,jj) 
    414                      tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn)  + (trn(ji,jj,jk,jn) * zrnf) 
    415                   END DO 
     417            DO_2D( 0, 1, 0, 0 ) 
     418               DO jk = 1, nk_rnf(ji,jj) 
     419                  zrnf = (rnf(ji,jj) + rnf_b(ji,jj)) * 0.5_wp * r1_rho0 / h_rnf(ji,jj) 
     420                  ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs)  + (ptr(ji,jj,jk,jn,Kmm) * zrnf) 
    416421               END DO 
    417             END DO 
     422            END_2D 
    418423         ENDIF 
    419424         ! 
    … …  
    423428         IF( ln_trc_sbc(jn) ) THEN 
    424429            jl = n_trc_indsbc(jn) 
    425             DO jj = 2, jpj 
    426                DO ji = fs_2, fs_jpim1   ! vector opt. 
    427                   zfact = 1. / ( e3t_n(ji,jj,1) * rn_bc_time ) 
    428                   tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) * zfact 
     430            sf_trcsbc(jl)%fnow(:,:,1) = MAX( rtrn, sf_trcsbc(jl)%fnow(:,:,1) ) ! avoid nedgative value due to interpolation 
     431            DO_2D( 0, 1, 0, 0 ) 
     432               zfact = 1. / ( e3t(ji,jj,1,Kmm) * rn_sbc_time ) 
     433               ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) * zfact 
     434            END_2D 
     435         ENDIF 
     436         ! 
     437         ! COASTAL boundary conditions 
     438         IF( ( ln_rnf .OR. l_offline ) .AND. ln_trc_cbc(jn) ) THEN 
     439            IF( l_offline )   rn_rfact = 1._wp 
     440            jl = n_trc_indcbc(jn) 
     441            DO_2D( 0, 1, 0, 0 ) 
     442               DO jk = 1, nk_rnf(ji,jj) 
     443                  zfact = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_cbc_time ) * tmask(ji,jj,1) 
     444                  ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zfact 
    429445               END DO 
    430             END DO 
    431          ENDIF 
    432          ! 
    433          ! COASTAL boundary conditions 
    434          IF( ln_rnf .AND. ln_trc_cbc(jn) ) THEN 
    435             jl = n_trc_indcbc(jn) 
    436             DO jj = 2, jpj 
    437                DO ji = fs_2, fs_jpim1   ! vector opt. 
    438                   DO jk = 1, nk_rnf(ji,jj) 
    439                      zfact = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_bc_time )  
    440                      tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zfact 
    441                   END DO 
    442                END DO 
    443             END DO 
     446            END_2D 
    444447         ENDIF 
    445448         !                                                       ! =========== 
    … …  
    455458   !!---------------------------------------------------------------------- 
    456459CONTAINS 
    457    SUBROUTINE trc_bc_ini( ntrc )        ! Empty routine 
    458       INTEGER,INTENT(IN) :: ntrc                           ! number of tracers 
    459       WRITE(*,*) 'trc_bc_ini: You should not have seen this print! error?', kt 
     460   SUBROUTINE trc_bc_ini( ntrc, Kmm )        ! Empty routine 
     461      INTEGER, INTENT(IN) :: ntrc                           ! number of tracers 
     462      INTEGER, INTENT(in) :: Kmm                            ! time level index 
     463      WRITE(*,*) 'trc_bc_ini: You should not have seen this print! error?', ntrc, Kmm 
    460464   END SUBROUTINE trc_bc_ini 
    461    SUBROUTINE trc_bc( kt )        ! Empty routine 
    462       WRITE(*,*) 'trc_bc: You should not have seen this print! error?', kt 
     465   SUBROUTINE trc_bc( kt, Kmm, Krhs )        ! Empty routine 
     466      INTEGER, INTENT(in) :: kt, Kmm, Krhs ! time level indices 
     467      WRITE(*,*) 'trc_bc: You should not have seen this print! error?', kt, Kmm, Krhs  
    463468   END SUBROUTINE trc_bc 
    464469#endif 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/trcbdy.F90

    r10425 r13463  
    2222   USE lbclnk                       ! ocean lateral boundary conditions (or mpp link) 
    2323   USE in_out_manager               ! I/O manager 
    24    USE bdy_oce, only: idx_bdy       ! ocean open boundary conditions 
     24   USE bdy_oce                      ! ocean open boundary conditions 
    2525 
    2626   IMPLICIT NONE 
    … …  
    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      !! 
    48       INTEGER                           :: ib_bdy ,jn ,igrd ! Loop indeces 
     49      INTEGER                           :: ib_bdy ,ir, jn ,igrd ! Loop indices 
    4950      REAL(wp), POINTER, DIMENSION(:,:) ::  ztrc 
    5051      REAL(wp), POINTER                 ::  zfac 
     52      LOGICAL                           :: llrim0               ! indicate if rim 0 is treated 
     53      LOGICAL, DIMENSION(4)             :: llsend1, llrecv1     ! indicate how communications are to be carried out 
    5154      !!---------------------------------------------------------------------- 
    5255      ! 
    … …  
    5457      ! 
    5558      igrd = 1  
    56       ! 
    57       DO ib_bdy=1, nb_bdy 
    58          DO jn = 1, jptra 
    59             ! 
    60             ztrc => trcdta_bdy(jn,ib_bdy)%trc  
    61             zfac => trcdta_bdy(jn,ib_bdy)%rn_fac 
    62             ! 
    63             SELECT CASE( TRIM(trcdta_bdy(jn,ib_bdy)%cn_obc) ) 
    64             CASE('none'        )   ;   CYCLE 
    65             CASE('frs'         )   ;   CALL bdy_frs( idx_bdy(ib_bdy),                tra(:,:,:,jn), ztrc*zfac ) 
    66             CASE('specified'   )   ;   CALL bdy_spe( idx_bdy(ib_bdy),                tra(:,:,:,jn), ztrc*zfac ) 
    67             CASE('neumann'     )   ;   CALL bdy_nmn( idx_bdy(ib_bdy), igrd         , tra(:,:,:,jn) ) 
    68             CASE('orlanski'    )   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), ztrc*zfac, ll_npo=.false. ) 
    69             CASE('orlanski_npo')   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), ztrc*zfac, ll_npo=.true. ) 
    70             CASE DEFAULT           ;   CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' ) 
     59      llsend1(:) = .false.  ;   llrecv1(:) = .false. 
     60      DO ir = 1, 0, -1   ! treat rim 1 before rim 0 
     61         IF( ir == 0 ) THEN   ;   llrim0 = .TRUE. 
     62         ELSE                 ;   llrim0 = .FALSE. 
     63         END IF 
     64         DO ib_bdy=1, nb_bdy 
     65            DO jn = 1, jptra 
     66               ! 
     67               ztrc => trcdta_bdy(jn,ib_bdy)%trc  
     68               zfac => trcdta_bdy(jn,ib_bdy)%rn_fac 
     69               ! 
     70               SELECT CASE( TRIM(trcdta_bdy(jn,ib_bdy)%cn_obc) ) 
     71               CASE('none'        )   ;   CYCLE 
     72               CASE('frs'         )   ! treat the whole boundary at once 
     73                  IF( ir == 0 ) CALL bdy_frs( idx_bdy(ib_bdy),                tr(:,:,:,jn,Krhs), ztrc*zfac ) 
     74               CASE('specified'   )   ! treat the whole rim      at once 
     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. ) 
     79               CASE DEFAULT           ;   CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' ) 
     80               END SELECT 
     81               ! 
     82            END DO 
     83         END DO 
     84         ! 
     85         IF( nn_hls > 1 .AND. ir == 1 ) CYCLE   ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0 
     86         IF( nn_hls == 1 ) THEN   ;   llsend1(:) = .false.   ;   llrecv1(:) = .false.   ;   END IF 
     87         DO ib_bdy=1, nb_bdy 
     88            SELECT CASE( TRIM(cn_tra(ib_bdy)) ) 
     89            CASE('neumann') 
     90               llsend1(:) = llsend1(:) .OR. lsend_bdyint(ib_bdy,1,:,ir)   ! possibly every direction, T points 
     91               llrecv1(:) = llrecv1(:) .OR. lrecv_bdyint(ib_bdy,1,:,ir)   ! possibly every direction, T points 
     92            CASE('orlanski','orlanski_npo') 
     93               llsend1(:) = llsend1(:) .OR. lsend_bdy(ib_bdy,1,:,ir)   ! possibly every direction, T points 
     94               llrecv1(:) = llrecv1(:) .OR. lrecv_bdy(ib_bdy,1,:,ir)   ! possibly every direction, T points 
    7195            END SELECT 
    72             ! Boundary points should be updated 
    73             CALL lbc_bdy_lnk( 'trcbdy', tra(:,:,:,jn), 'T', 1., ib_bdy ) 
    74             ! 
    7596         END DO 
    76       END DO 
     97         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
     98            CALL lbc_lnk( 'trcbdy', tr(:,:,:,:,Krhs), 'T',  1.0_wp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
     99         END IF 
     100         ! 
     101      END DO   ! ir 
    77102      ! 
    78103      IF( ln_timing )   CALL timing_stop('trc_bdy') 
    79  
     104      ! 
    80105   END SUBROUTINE trc_bdy 
    81106 
    82107 
    83    SUBROUTINE trc_bdy_dmp( kt ) 
     108   SUBROUTINE trc_bdy_dmp( kt, Kbb, Krhs ) 
    84109      !!---------------------------------------------------------------------- 
    85110      !!                 ***  SUBROUTINE trc_bdy_dmp  *** 
    … …  
    90115      !!---------------------------------------------------------------------- 
    91116      INTEGER,         INTENT(in) ::   kt 
     117      INTEGER,         INTENT(in) ::   Kbb, Krhs  ! time level indices 
    92118      !!  
    93119      INTEGER  ::   jn             ! Tracer index 
    … …  
    110136                  zwgt = idx_bdy(ib_bdy)%nbd(ib,igrd) 
    111137                  DO ik = 1, jpkm1 
    112                      zta = zwgt * ( trcdta_bdy(jn, ib_bdy)%trc(ib,ik) - trb(ii,ij,ik,jn) ) * tmask(ii,ij,ik) 
    113                      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 
    114140                  END DO 
    115141               END DO 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/trcdta.F90

    r10222 r13463  
    3939!$AGRIF_END_DO_NOT_TREAT 
    4040 
     41   !! Substitutions 
     42#include "do_loop_substitute.h90" 
     43#include "domzgr_substitute.h90" 
    4144   !!---------------------------------------------------------------------- 
    4245   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    98101      ENDIF 
    99102      ! 
    100       REWIND( numnat_ref )              ! Namelist namtrc_dta in reference namelist : Passive tracer input data 
    101103      READ  ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901) 
    102 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_dta_ini in reference namelist', lwp ) 
    103       REWIND( numnat_cfg )              ! Namelist namtrc_dta in configuration namelist : Passive tracer input data 
     104901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_dta_ini in reference namelist' ) 
    104105      READ  ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 ) 
    105 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_dta_ini in configuration namelist', lwp ) 
     106902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_dta_ini in configuration namelist' ) 
    106107      IF(lwm) WRITE ( numont, namtrc_dta ) 
    107108 
    … …  
    154155 
    155156 
    156    SUBROUTINE trc_dta( kt, sf_trcdta, ptrcfac, ptrcdta) 
     157   SUBROUTINE trc_dta( kt, Kmm, sf_trcdta, ptrcfac, ptrcdta) 
    157158      !!---------------------------------------------------------------------- 
    158159      !!                   ***  ROUTINE trc_dta  *** 
    … …  
    167168      !!---------------------------------------------------------------------- 
    168169      INTEGER                          , INTENT(in   )   ::   kt         ! ocean time-step 
     170      INTEGER                          , INTENT(in   )   ::   Kmm        ! time level index 
    169171      TYPE(FLD), DIMENSION(1)          , INTENT(inout)   ::   sf_trcdta  ! array of information on the field to read 
    170172      REAL(wp)                         , INTENT(in   )   ::   ptrcfac    ! multiplication factor 
    … …  
    178180      ! 
    179181      IF( ln_timing )   CALL timing_start('trc_dta') 
     182      ! 
     183      IF( kt == nit000 .AND. lwp) THEN 
     184         WRITE(numout,*) 
     185         WRITE(numout,*) 'trc_dta : passive tracers data for IC' 
     186         WRITE(numout,*) '~~~~~~~ ' 
     187      ENDIF 
    180188      ! 
    181189      IF( nb_trcdta > 0 ) THEN 
    … …  
    191199               WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh' 
    192200            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 
     201            DO_2D( 1, 1, 1, 1 ) 
     202               DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
     203                  zl = gdept(ji,jj,jk,Kmm) 
     204                  IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data 
     205                     ztp(jk) = ptrcdta(ji,jj,1) 
     206                  ELSEIF( zl > gdept_1d(jpk) ) THEN         ! below the last level of data 
     207                     ztp(jk) = ptrcdta(ji,jj,jpkm1) 
     208                  ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1 
     209                     DO jkk = 1, jpkm1                                  ! when  gdept_1d(jkk) < zl < gdept_1d(jkk+1) 
     210                        IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 
     211                           zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 
     212                           ztp(jk) = ptrcdta(ji,jj,jkk) + ( ptrcdta(ji,jj,jkk+1) - ptrcdta(ji,jj,jkk) ) * zi 
     213                        ENDIF 
     214                     END DO 
     215                  ENDIF 
     216               END DO 
     217               DO jk = 1, jpkm1 
     218                  ptrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord 
     219               END DO 
     220               ptrcdta(ji,jj,jpk) = 0._wp 
     221            END_2D 
    216222            !  
    217223         ELSE                                !==   z- or zps- coordinate   ==! 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/trcice.F90

    r10069 r13463  
    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) 
    89  901  IF( ios /= 0 )   CALL ctl_nam ( ios , ' namtrc_ice in reference namelist ', lwp ) 
    90       REWIND( numnat_cfg )              ! Namelist namtrc_ice in configuration namelist : Pisces external sources of nutrients 
     88 901  IF( ios /= 0 )   CALL ctl_nam ( ios , ' namtrc_ice in reference namelist ' ) 
    9189      READ  ( numnat_cfg, namtrc_ice, IOSTAT = ios, ERR = 902 ) 
    92  902  IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_ice in configuration namelist', lwp ) 
     90 902  IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_ice in configuration namelist' ) 
    9391 
    9492      IF( lwp ) THEN 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/trcini.F90

    r10817 r13463  
    2020   USE trcnam          ! Namelist read 
    2121   USE daymod          ! calendar manager 
    22    USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine) 
    23    USE trcsub          ! variables to substep passive tracers 
     22   USE prtctl          ! Print control passive tracers (prt_ctl_init routine) 
    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 
    … …  
    3231   PUBLIC   trc_init   ! called by opa 
    3332 
     33#  include "domzgr_substitute.h90" 
    3434   !!---------------------------------------------------------------------- 
    3535   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    3939CONTAINS 
    4040    
    41    SUBROUTINE trc_init 
     41   SUBROUTINE trc_init( Kbb, Kmm, Kaa ) 
    4242      !!--------------------------------------------------------------------- 
    4343      !!                     ***  ROUTINE trc_init  *** 
    … …  
    5151      !!                or read data or analytical formulation 
    5252      !!--------------------------------------------------------------------- 
     53      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa   ! time level indices 
    5354      ! 
    5455      IF( ln_timing )   CALL timing_start('trc_init') 
    … …  
    5859      IF(lwp) WRITE(numout,*) '~~~~~~~~' 
    5960      ! 
    60       CALL trc_ini_ctl   ! control  
    6161      CALL trc_nam       ! read passive tracers namelists 
    6262      CALL top_alloc()   ! allocate TOP arrays 
     63 
    6364      ! 
    6465      IF(.NOT.ln_trcdta )   ln_trc_ini(:) = .FALSE. 
    … …  
    6869      IF(lwp) WRITE(numout,*) 
    6970      ! 
    70       CALL trc_ini_sms   ! SMS 
    71       CALL trc_ini_trp   ! passive tracers transport 
    72       CALL trc_ice_ini   ! Tracers in sea ice 
     71      CALL trc_ini_sms( Kmm )   ! SMS 
     72      CALL trc_ini_trp          ! passive tracers transport 
     73      CALL trc_ice_ini          ! Tracers in sea ice 
    7374      ! 
    7475      IF( lwm .AND. sn_cfctl%l_trcstat ) THEN 
    … …  
    7677      ENDIF 
    7778      ! 
    78       CALL trc_ini_state  !  passive tracers initialisation : from a restart or from clim 
    79       IF( nn_dttrc /= 1 ) & 
    80       CALL trc_sub_ini    ! Initialize variables for substepping passive tracers 
    81       ! 
    82       CALL trc_ini_inv   ! Inventories 
     79      CALL trc_ini_state( Kbb, Kmm, Kaa )  !  passive tracers initialisation : from a restart or from clim 
     80      ! 
     81      CALL trc_ini_inv( Kmm )              ! Inventories 
    8382      ! 
    8483      IF( ln_timing )   CALL timing_stop('trc_init') 
    … …  
    8786 
    8887 
    89    SUBROUTINE trc_ini_ctl 
    90       !!---------------------------------------------------------------------- 
    91       !!                     ***  ROUTINE trc_ini_ctl  *** 
    92       !! ** Purpose :        Control  + ocean volume 
    93       !!---------------------------------------------------------------------- 
    94       INTEGER ::   jk    ! dummy loop indices 
    95       ! 
    96       ! Define logical parameter ton control dirunal cycle in TOP 
    97       l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 ) 
    98       l_trcdm2dc = l_trcdm2dc  .AND. .NOT. l_offline 
    99       IF( l_trcdm2dc .AND. lwp )   CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.',   & 
    100          &                           'Computation of a daily mean shortwave for some biogeochemical models ' ) 
    101       ! 
    102    END SUBROUTINE trc_ini_ctl 
    103  
    104  
    105    SUBROUTINE trc_ini_inv 
     88   SUBROUTINE trc_ini_inv( Kmm ) 
    10689      !!---------------------------------------------------------------------- 
    10790      !!                     ***  ROUTINE trc_ini_stat  *** 
    10891      !! ** Purpose :      passive tracers inventories at initialsation phase 
    10992      !!---------------------------------------------------------------------- 
    110       INTEGER ::  jk, jn    ! dummy loop indices 
     93      INTEGER, INTENT(in) ::   Kmm    ! time level index 
     94      INTEGER             ::  jk, jn  ! dummy loop indices 
    11195      CHARACTER (len=25) :: charout 
     96      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) :: zzmsk 
     97      CHARACTER (len=25), DIMENSION(jptra) :: clseb   
    11298      !!---------------------------------------------------------------------- 
    11399      ! 
    … …  
    118104      !                          ! masked grid volume 
    119105      DO jk = 1, jpk 
    120          cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 
     106         cvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
    121107      END DO 
    122108      !                          ! total volume of the ocean  
    … …  
    125111      trai(:) = 0._wp            ! initial content of all tracers 
    126112      DO jn = 1, jptra 
    127          trai(jn) = trai(jn) + glob_sum( 'trcini', trn(:,:,:,jn) * cvol(:,:,:)   ) 
     113         trai(jn) = trai(jn) + glob_sum( 'trcini', tr(:,:,:,jn,Kmm) * cvol(:,:,:)   ) 
    128114      END DO 
    129115 
    … …  
    140126      ENDIF 
    141127      IF(lwp) WRITE(numout,*) 
    142       IF(ln_ctl) THEN            ! print mean trends (used for debugging) 
    143          CALL prt_ctl_trc_init 
     128      IF(sn_cfctl%l_prttrc) THEN            ! print mean trends (used for debugging) 
     129         CALL prt_ctl_init( 'top', jptra ) 
    144130         WRITE(charout, FMT="('ini ')") 
    145          CALL prt_ctl_trc_info( charout ) 
    146          CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
     131         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     132         CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kmm), mask1=tmask, clinfo=ctrcnm ) 
     133         DO jn = 1, jptra 
     134            zzmsk(:,:,:,jn) = tmask(:,:,:) 
     135            WRITE(clseb(jn),'(a,i2.2)') 'seb ', jn 
     136         END DO 
     137         CALL prt_ctl( tab4d_1=zzmsk, mask1=tmask, clinfo=clseb ) 
    147138      ENDIF 
    1481399000  FORMAT('      tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10) 
    … …  
    151142 
    152143 
    153    SUBROUTINE trc_ini_sms 
     144   SUBROUTINE trc_ini_sms( Kmm ) 
    154145      !!---------------------------------------------------------------------- 
    155146      !!                     ***  ROUTINE trc_ini_sms  *** 
    … …  
    162153      USE trcini_my_trc  ! MY_TRC   initialisation 
    163154      ! 
     155      INTEGER, INTENT(in) ::   Kmm ! time level indices 
    164156      INTEGER :: jn 
    165157      !!---------------------------------------------------------------------- 
    … …  
    175167         ln_trc_obc(jn) =       sn_tracer(jn)%llobc 
    176168      END DO 
     169      ! 
     170      IF( .NOT.ln_trcbc ) THEN 
     171         DO jn = 1, jp_bgc 
     172            ln_trc_sbc(jn) = .FALSE. 
     173            ln_trc_cbc(jn) = .FALSE. 
     174            ln_trc_obc(jn) = .FALSE. 
     175         END DO 
     176      ENDIF 
     177      
     178      lltrcbc = ( COUNT(ln_trc_sbc) + COUNT(ln_trc_obc) + COUNT(ln_trc_cbc) ) > 0  
    177179      !     
    178       IF( ln_pisces      )   CALL trc_ini_pisces     !  PISCES model 
    179       IF( ln_my_trc      )   CALL trc_ini_my_trc     !  MY_TRC model 
    180       IF( ll_cfc         )   CALL trc_ini_cfc        !  CFC's 
    181       IF( ln_c14         )   CALL trc_ini_c14        !  C14 model 
    182       IF( ln_age         )   CALL trc_ini_age        !  AGE 
     180      IF( ln_pisces      )   CALL trc_ini_pisces( Kmm )     !  PISCES model 
     181      IF( ln_my_trc      )   CALL trc_ini_my_trc( Kmm )     !  MY_TRC model 
     182      IF( ll_cfc         )   CALL trc_ini_cfc   ( Kmm )     !  CFC's 
     183      IF( ln_c14         )   CALL trc_ini_c14   ( Kmm )     !  C14 model 
     184      IF( ln_age         )   CALL trc_ini_age   ( Kmm )     !  AGE 
    183185      ! 
    184186      IF(lwp) THEN                   ! control print 
    … …  
    191193         END DO 
    192194      ENDIF 
     195      IF( lwp .AND. ln_trcbc .AND. lltrcbc ) THEN 
     196         WRITE(numout,*) 
     197         WRITE(numout,*) ' Applying tracer boundary conditions ' 
     198      ENDIF 
     199      
    1932009001  FORMAT(3x,i3,1x,a10,3x,l2,3x,l2,3x,l2,3x,l2) 
    194201      ! 
    … …  
    221228 
    222229 
    223    SUBROUTINE trc_ini_state 
     230   SUBROUTINE trc_ini_state( Kbb, Kmm, Kaa ) 
    224231      !!---------------------------------------------------------------------- 
    225232      !!                     ***  ROUTINE trc_ini_state *** 
    … …  
    230237      USE trcdta          ! initialisation from files 
    231238      ! 
    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_my_trc )   CALL trc_bc_ini ( jptra )      ! set tracers Boundary Conditions 
     239      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa   ! time level index 
     240      INTEGER             :: jn, jl          ! dummy loop indices 
     241      !!---------------------------------------------------------------------- 
     242      ! 
     243      IF( ln_trcdta )   CALL trc_dta_ini( jptra )           ! set initial tracers values 
     244      ! 
     245      IF( ln_trcbc .AND. lltrcbc )  THEN  
     246        CALL trc_bc_ini ( jptra, Kmm  )            ! set tracers Boundary Conditions 
     247        CALL trc_bc     ( nit000, Kmm, tr, Kaa )   ! tracers: surface and lateral Boundary Conditions 
     248      ENDIF 
    238249      ! 
    239250      ! 
    240251      IF( ln_rsttr ) THEN              ! restart from a file 
    241252        ! 
    242         CALL trc_rst_read 
     253        CALL trc_rst_read( Kbb, Kmm ) 
    243254        ! 
    244255      ELSE                             ! Initialisation of tracer from a file that may also be used for damping 
    … …  
    249260               IF( ln_trc_ini(jn) ) THEN 
    250261                  jl = n_trc_index(jn)  
    251                   CALL trc_dta( nit000, sf_trcdta(jl), rf_trfac(jl), trn(:,:,:,jn) ) 
     262                  CALL trc_dta( nit000, Kmm, sf_trcdta(jl), rf_trfac(jl), tr(:,:,:,jn,Kmm) ) 
    252263                  ! 
    253264                  ! deallocate data structure if data are not used for damping 
    … …  
    263274        ENDIF 
    264275        ! 
    265         trb(:,:,:,:) = trn(:,:,:,:) 
     276        tr(:,:,:,:,Kbb) = tr(:,:,:,:,Kmm) 
    266277        !  
    267278      ENDIF 
    268279      ! 
    269       tra(:,:,:,:) = 0._wp 
    270       !                                                         ! Partial top/bottom cell: GRADh(trn) 
     280      tr(:,:,:,:,Kaa) = 0._wp 
     281      !                                                         ! Partial top/bottom cell: GRADh(tr(Kmm)) 
    271282   END SUBROUTINE trc_ini_state 
    272283 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/trcnam.F90

    r10425 r13463  
    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       
    82       !  
    8378      IF(lwp) THEN                              ! control print 
    8479        WRITE(numout,*)  
    85         WRITE(numout,*) '   ==>>>   Passive Tracer  time step    rdttrc = nn_dttrc*rdt = ', rdttrc 
     80        WRITE(numout,*) '   ==>>>   Passive Tracer time step = rn_Dt = ', rn_Dt 
    8681      ENDIF 
    8782      ! 
    … …  
    10095      INTEGER  ::   ios   ! Local integer 
    10196      !! 
    102       NAMELIST/namtrc_run/ nn_dttrc, ln_rsttr, nn_rsttr, ln_top_euler, & 
     97      NAMELIST/namtrc_run/ ln_rsttr, nn_rsttr, ln_top_euler, & 
    10398        &                  cn_trcrst_indir, cn_trcrst_outdir, cn_trcrst_in, cn_trcrst_out 
    10499      !!--------------------------------------------------------------------- 
    … …  
    108103      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    109104      ! 
    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. ) 
     105      CALL load_nml( numnat_ref, 'namelist_top_ref' , numout, lwm ) 
     106      CALL load_nml( numnat_cfg, 'namelist_top_cfg' , numout, lwm ) 
    112107      IF(lwm) CALL ctl_opn( numont, 'output.namelist.top', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., 1 ) 
    113108      ! 
    114       REWIND( numnat_ref )              ! Namelist namtrc in reference namelist : Passive tracer variables 
    115109      READ  ( numnat_ref, namtrc_run, IOSTAT = ios, ERR = 901) 
    116 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc in reference namelist', lwp ) 
    117       REWIND( numnat_cfg )              ! Namelist namtrc in configuration namelist : Passive tracer variables 
     110901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc in reference namelist' ) 
    118111      READ  ( numnat_cfg, namtrc_run, IOSTAT = ios, ERR = 902 ) 
    119 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc in configuration namelist', lwp ) 
     112902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc in configuration namelist' ) 
    120113      IF(lwm) WRITE( numont, namtrc_run ) 
    121114 
    122       nittrc000 = nit000 + nn_dttrc - 1      ! first time step of tracer model 
     115      nittrc000 = nit000             ! first time step of tracer model 
    123116 
    124117      IF(lwp) THEN                   ! control print 
    125118         WRITE(numout,*) '   Namelist : namtrc_run' 
    126          WRITE(numout,*) '      time step freq. for passive tracer           nn_dttrc      = ', nn_dttrc 
    127119         WRITE(numout,*) '      restart  for passive tracer                  ln_rsttr      = ', ln_rsttr 
    128120         WRITE(numout,*) '      control of time step for passive tracer      nn_rsttr      = ', nn_rsttr 
    … …  
    131123      ENDIF 
    132124      ! 
    133 #if defined key_mpp_mpi 
    134       ncom_dttrc = nn_dttrc    ! make nn_fsbc available for lib_mpp 
    135 #endif 
    136       ! 
    137125   END SUBROUTINE trc_nam_run 
    138126 
    … …  
    148136      !! 
    149137      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 
     138         &            sn_tracer, ln_trcdta, ln_trcbc, ln_trcdmp, ln_trcdmp_clo, jp_dia3d, jp_dia2d 
    151139      !!--------------------------------------------------------------------- 
    152140      ! Dummy settings to fill tracers data structure 
    … …  
    158146      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    159147 
    160       REWIND( numnat_ref )              ! Namelist namtrc in reference namelist : Passive tracer variables 
    161148      READ  ( numnat_ref, namtrc, IOSTAT = ios, ERR = 901) 
    162 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc in reference namelist', lwp ) 
    163       REWIND( numnat_cfg )              ! Namelist namtrc in configuration namelist : Passive tracer variables 
     149901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc in reference namelist' ) 
    164150      READ  ( numnat_cfg, namtrc, IOSTAT = ios, ERR = 902 ) 
    165 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc in configuration namelist', lwp ) 
     151902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc in configuration namelist' ) 
    166152      IF(lwm) WRITE( numont, namtrc ) 
    167153 
    … …  
    222208         WRITE(numout,*) '      Simulating C14   passive tracer              ln_c14        = ', ln_c14 
    223209         WRITE(numout,*) '      Read inputs data from file (y/n)             ln_trcdta     = ', ln_trcdta 
     210         WRITE(numout,*) '      Enable surface, lateral or open boundaries conditions (y/n)  ln_trcbc  = ', ln_trcbc 
    224211         WRITE(numout,*) '      Damping of passive tracer (y/n)              ln_trcdmp     = ', ln_trcdmp 
    225212         WRITE(numout,*) '      Restoring of tracer on closed seas           ln_trcdmp_clo = ', ln_trcdmp_clo 
    … …  
    228215      IF( ll_cfc .OR. ln_c14 ) THEN 
    229216        !                             ! 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. ) 
     217        CALL load_nml( numtrc_ref, 'namelist_trc_ref' , numout, lwm ) 
     218        CALL load_nml( numtrc_cfg, 'namelist_trc_cfg' , numout, lwm ) 
    232219        IF(lwm) CALL ctl_opn( numonr, 'output.namelist.trc', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    233220        ! 
    … …  
    261248      ALLOCATE( ln_trdtrc(jptra) )  
    262249      ! 
    263       REWIND( numnat_ref )              ! Namelist namtrc_trd in reference namelist : Passive tracer trends 
    264250      READ  ( numnat_ref, namtrc_trd, IOSTAT = ios, ERR = 905) 
    265 905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_trd in reference namelist', lwp ) 
    266       REWIND( numnat_cfg )              ! Namelist namtrc_trd in configuration namelist : Passive tracer trends 
     251905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_trd in reference namelist' ) 
    267252      READ  ( numnat_cfg, namtrc_trd, IOSTAT = ios, ERR = 906 ) 
    268 906   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_trd in configuration namelist', lwp ) 
     253906   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_trd in configuration namelist' ) 
    269254      IF(lwm) WRITE( numont, namtrc_trd ) 
    270255 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/trcrst.F90

    r10425 r13463  
    3333   PUBLIC   trc_rst_cal 
    3434 
     35#  include "domzgr_substitute.h90" 
    3536   !!---------------------------------------------------------------------- 
    3637   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    5859            IF( ln_rst_list ) THEN 
    5960               nrst_lst = 1 
    60                nitrst = nstocklist( nrst_lst ) 
     61               nitrst = nn_stocklist( nrst_lst ) 
    6162            ELSE 
    6263               nitrst = nitend 
    … …  
    6465         ENDIF 
    6566 
    66          IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN 
     67         IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nn_stock ) == 0 ) THEN 
    6768            ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment 
    68             nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing 
     69            nitrst = kt + nn_stock - 1                  ! define the next value of nitrst for restart writing 
    6970            IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run 
    7071         ENDIF 
    … …  
    7374      ENDIF 
    7475 
     76      IF( .NOT. ln_rst_list .AND. nn_stock == -1 )   RETURN   ! we will never do any restart 
     77 
    7578      ! to get better performances with NetCDF format: 
    76       ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1) 
    77       ! 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 
    78       IF( kt == nitrst - 2*nn_dttrc .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .AND. .NOT. lrst_trc ) ) THEN 
     79      ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 1) 
     80      ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 1 
     81      IF( kt == nitrst - 1 .OR. nn_stock == 1 .OR. ( kt == nitend - 1 .AND. .NOT. lrst_trc ) ) THEN 
    7982         ! beware of the format used to write kt (default is i8.8, that should be large enough) 
    8083         IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst 
    … …  
    9497   END SUBROUTINE trc_rst_opn 
    9598 
    96    SUBROUTINE trc_rst_read 
     99   SUBROUTINE trc_rst_read( Kbb, Kmm ) 
    97100      !!---------------------------------------------------------------------- 
    98101      !!                    ***  trc_rst_opn  *** 
    … …  
    100103      !! ** purpose  :   read passive tracer fields in restart files 
    101104      !!---------------------------------------------------------------------- 
     105      INTEGER, INTENT( in ) ::   Kbb, Kmm  ! time level indices 
    102106      INTEGER  ::  jn      
    103107 
    … …  
    110114      ! READ prognostic variables and computes diagnostic variable 
    111115      DO jn = 1, jptra 
    112          CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 
    113       END DO 
    114  
    115       DO jn = 1, jptra 
    116          CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 
     116         CALL iom_get( numrtr, jpdom_auto, 'TRN'//ctrcnm(jn), tr(:,:,:,jn,Kmm) ) 
     117      END DO 
     118 
     119      DO jn = 1, jptra 
     120         CALL iom_get( numrtr, jpdom_auto, 'TRB'//ctrcnm(jn), tr(:,:,:,jn,Kbb) ) 
    117121      END DO 
    118122      ! 
    … …  
    121125   END SUBROUTINE trc_rst_read 
    122126 
    123    SUBROUTINE trc_rst_wri( kt ) 
     127   SUBROUTINE trc_rst_wri( kt, Kbb, Kmm, Krhs ) 
    124128      !!---------------------------------------------------------------------- 
    125129      !!                    ***  trc_rst_wri  *** 
    … …  
    127131      !! ** purpose  :   write passive tracer fields in restart files 
    128132      !!---------------------------------------------------------------------- 
    129       INTEGER, INTENT( in ) ::   kt    ! ocean time-step index 
     133      INTEGER, INTENT( in ) ::   kt              ! ocean time-step index 
     134      INTEGER, INTENT( in ) ::   Kbb, Kmm, Krhs  ! time level indices 
    130135      !! 
    131136      INTEGER  :: jn 
    132137      !!---------------------------------------------------------------------- 
    133138      ! 
    134       CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc )   ! passive tracer time step 
     139      CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rn_Dt )   ! passive tracer time step (= ocean time step) 
    135140      ! prognostic variables  
    136141      ! --------------------  
    137142      DO jn = 1, jptra 
    138          CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 
    139       END DO 
    140  
    141       DO jn = 1, jptra 
    142          CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 
     143         CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), tr(:,:,:,jn,Kmm) ) 
     144      END DO 
     145 
     146      DO jn = 1, jptra 
     147         CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), tr(:,:,:,jn,Kbb) ) 
    143148      END DO 
    144149      ! 
    … …  
    146151     
    147152      IF( kt == nitrst ) THEN 
    148           CALL trc_rst_stat            ! statistics 
     153          CALL trc_rst_stat( Kmm, Krhs )             ! statistics 
    149154          CALL iom_close( numrtw )     ! close the restart file (only at last time step) 
    150155#if ! defined key_trdmxl_trc 
    … …  
    153158          IF( l_offline .AND. ln_rst_list ) THEN 
    154159             nrst_lst = nrst_lst + 1 
    155              nitrst = nstocklist( nrst_lst ) 
     160             nitrst = nn_stocklist( nrst_lst ) 
    156161          ENDIF 
    157162      ENDIF 
    … …  
    179184      !!       In both those options, the  exact duration of the experiment 
    180185      !!       since the beginning (cumulated duration of all previous restart runs) 
    181       !!       is not stored in the restart and is assumed to be (nittrc000-1)*rdt. 
     186      !!       is not stored in the restart and is assumed to be (nittrc000-1)*rn_Dt. 
    182187      !!       This is valid is the time step has remained constant. 
    183188      !! 
    … …  
    217222            ENDIF 
    218223            ! Control of date  
    219             IF( nittrc000  - NINT( zkt ) /= nn_dttrc .AND.  nn_rsttr /= 0 )                                  & 
     224            IF( nittrc000  - NINT( zkt ) /= 1 .AND.  nn_rsttr /= 0 )                                  & 
    220225               &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 & 
    221226               &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' ) 
    … …  
    259264               nminute = ( nn_time0 - nhour * 100 ) 
    260265               IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0) 
    261                adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday 
     266               adatrj = ( REAL( nit000-1, wp ) * rn_Dt ) / rday 
    262267               ! note this is wrong if time step has changed during run 
    263268            ENDIF 
    … …  
    272277            ENDIF 
    273278            ! 
    274             IF( ln_rsttr )  THEN   ;    neuler = 1 
    275             ELSE                   ;    neuler = 0 
     279            IF( ln_rsttr )  THEN   ;    l_1st_euler = .false. 
     280            ELSE                   ;    l_1st_euler = .true. 
    276281            ENDIF 
    277282            ! 
    … …  
    297302 
    298303 
    299    SUBROUTINE trc_rst_stat 
     304   SUBROUTINE trc_rst_stat( Kmm, Krhs ) 
    300305      !!---------------------------------------------------------------------- 
    301306      !!                    ***  trc_rst_stat  *** 
    … …  
    303308      !! ** purpose  :   Compute tracers statistics 
    304309      !!---------------------------------------------------------------------- 
     310      INTEGER, INTENT( in ) ::   Kmm, Krhs  ! time level indices 
    305311      INTEGER  :: jk, jn 
    306312      REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift 
    … …  
    315321      ! 
    316322      DO jk = 1, jpk 
    317          zvol(:,:,jk) = e1e2t(:,:) * e3t_a(:,:,jk) * tmask(:,:,jk) 
    318       END DO 
    319       ! 
    320       DO jn = 1, jptra 
    321          ztraf = glob_sum( 'trcrst', trn(:,:,:,jn) * zvol(:,:,:) ) 
    322          zmin  = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
    323          zmax  = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
     323         zvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Krhs) * tmask(:,:,jk) 
     324      END DO 
     325      ! 
     326      DO jn = 1, jptra 
     327         ztraf = glob_sum( 'trcrst', tr(:,:,:,jn,Kmm) * zvol(:,:,:) ) 
     328         zmin  = MINVAL( tr(:,:,:,jn,Kmm), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
     329         zmax  = MAXVAL( tr(:,:,:,jn,Kmm), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
    324330         IF( lk_mpp ) THEN 
    325331            CALL mpp_min( 'trcrst', zmin )      ! min over the global domain 
    … …  
    341347   !!---------------------------------------------------------------------- 
    342348CONTAINS 
    343    SUBROUTINE trc_rst_read                      ! Empty routines 
     349   SUBROUTINE trc_rst_read( Kbb, Kmm)                      ! Empty routines 
     350      INTEGER, INTENT( in ) :: Kbb, Kmm  ! time level indices 
    344351   END SUBROUTINE trc_rst_read 
    345    SUBROUTINE trc_rst_wri( kt ) 
    346       INTEGER, INTENT ( in ) :: kt 
     352   SUBROUTINE trc_rst_wri( kt, Kbb, Kmm, Krhs ) 
     353      INTEGER, INTENT( in ) :: kt 
     354      INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs  ! time level indices 
    347355      WRITE(*,*) 'trc_rst_wri: You should not have seen this print! error?', kt 
    348356   END SUBROUTINE trc_rst_wri    

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/trcsms.F90

    r10068 r13463  
    2020   USE trcsms_age         ! AGE 
    2121   USE trcsms_my_trc      ! MY_TRC  tracers 
    22    USE prtctl_trc         ! Print control for debbuging 
     22   USE prtctl             ! Print control for debbuging 
    2323 
    2424   IMPLICIT NONE 
    … …  
    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 ')") 
    59          CALL prt_ctl_trc_info( charout ) 
    60          CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
     60         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     61         CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kmm), mask1=tmask, clinfo=ctrcnm ) 
    6162      ENDIF 
    6263      ! 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/trcstp.F90

    r10570 r13463  
    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 
    2222   USE sms_pisces,  ONLY : ln_check_mass 
    2323   ! 
    24    USE prtctl_trc     ! Print control for debbuging 
     24   USE prtctl         ! Print control for debbuging 
    2525   USE iom            ! 
    2626   USE in_out_manager ! 
    … …  
    3737   REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE ::   qsr_arr   ! save qsr during TOP time-step 
    3838 
     39#  include "domzgr_substitute.h90" 
    3940   !!---------------------------------------------------------------------- 
    4041   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4445CONTAINS 
    4546 
    46    SUBROUTINE trc_stp( kt ) 
     47   SUBROUTINE trc_stp( kt, Kbb, Kmm, Krhs, Kaa ) 
    4748      !!------------------------------------------------------------------- 
    4849      !!                     ***  ROUTINE trc_stp  *** 
    … …  
    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 
    5658      ! 
    5759      INTEGER ::   jk, jn   ! dummy loop indices 
    … …  
    6365      IF( ln_timing )   CALL timing_start('trc_stp') 
    6466      ! 
    65       IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000 
    66          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. & 
     67      IF( l_1st_euler .OR. ln_top_euler ) THEN     ! at nittrc000 
     68         rDt_trc =  rn_Dt           ! = rn_Dt (use or restarting with Euler time stepping) 
     69      ELSEIF( kt <= nittrc000 + 1 ) THEN                                     ! at nittrc000 or nittrc000+1  
     70         rDt_trc = 2. * rn_Dt       ! = 2 rn_Dt (leapfrog)  
     71      ENDIF 
     72      ! 
     73      ll_trcstat  = ( sn_cfctl%l_trcstat ) .AND. & 
    7274     &              ( ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) ) 
     75 
     76      IF( kt == nittrc000 )                      CALL trc_stp_ctl   ! control  
    7377      IF( kt == nittrc000 .AND. lk_trdmxl_trc )  CALL trd_mxl_trc_init    ! trends: Mixed-layer 
    7478      ! 
    7579      IF( .NOT.ln_linssh ) THEN                                           ! update ocean volume due to ssh temporal evolution 
    7680         DO jk = 1, jpk 
    77             cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 
     81            cvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
    7882         END DO 
    79          IF ( ln_ctl .OR. kt == nitrst .OR. ( ln_check_mass .AND. kt == nitend )              & 
     83         IF ( ll_trcstat .OR. kt == nitrst .OR. ( ln_check_mass .AND. kt == nitend )   & 
    8084            & .OR. iom_use( "pno3tot" ) .OR. iom_use( "ppo4tot" ) .OR. iom_use( "psiltot" )   & 
    8185            & .OR. iom_use( "palktot" ) .OR. iom_use( "pfertot" ) )                           & 
    … …  
    8589      IF( l_trcdm2dc )   CALL trc_mean_qsr( kt ) 
    8690      !     
    87       IF( nn_dttrc /= 1 )   CALL trc_sub_stp( kt )  ! averaging physical variables for sub-stepping 
    88       !     
    89       IF( MOD( kt , nn_dttrc ) == 0 ) THEN      ! only every nn_dttrc time step 
    90          ! 
    91          IF(ln_ctl) 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          tra(:,:,:,:) = 0.e0 
    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 )       ! output of passive tracers with iom I/O manager 
    101                                    CALL trc_sms      ( kt )       ! tracers: sinks and sources 
    102                                    CALL trc_trp      ( kt )       ! transport of passive tracers 
    103          IF( kt == nittrc000 ) THEN 
    104             CALL iom_close( numrtr )       ! close input tracer restart file 
    105             IF(lwm) CALL FLUSH( numont )   ! flush namelist output 
    106          ENDIF 
    107          IF( lrst_trc )            CALL trc_rst_wri  ( kt )       ! write tracer restart file 
    108          IF( lk_trdmxl_trc  )      CALL trd_mxl_trc  ( kt )       ! trends: Mixed-layer 
    109          ! 
    110          IF( nn_dttrc /= 1   )     CALL trc_sub_reset( kt )       ! resetting physical variables when sub-stepping 
    111          ! 
     91      ! 
     92      IF(sn_cfctl%l_prttrc) THEN 
     93         WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear 
     94         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     95      ENDIF 
     96      ! 
     97      tr(:,:,:,:,Krhs) = 0._wp 
     98      ! 
     99      CALL trc_rst_opn  ( kt )                            ! Open tracer restart file  
     100      IF( lrst_trc )  CALL trc_rst_cal  ( kt, 'WRITE' )   ! calendar 
     101      CALL trc_wri      ( kt,      Kmm            )       ! output of passive tracers with iom I/O manager 
     102      CALL trc_sms      ( kt, Kbb, Kmm, Krhs      )       ! tracers: sinks and sources 
     103      CALL trc_trp      ( kt, Kbb, Kmm, Krhs, Kaa )       ! transport of passive tracers 
     104           ! 
     105           ! Note passive tracers have been time-filtered in trc_trp but the time level 
     106           ! indices will not be swapped until after tra_atf/dyn_atf/ssh_atf in stp. Subsequent calls here 
     107           ! anticipate this update which will be: Nrhs= Nbb ; Nbb = Nnn ; Nnn = Naa ; Naa = Nrhs 
     108           ! and use the filtered levels explicitly. 
     109           ! 
     110      IF( kt == nittrc000 ) THEN 
     111         CALL iom_close( numrtr )                         ! close input tracer restart file 
     112         IF(lwm) CALL FLUSH( numont )                     ! flush namelist output 
     113      ENDIF 
     114      IF( lrst_trc )            CALL trc_rst_wri  ( kt, Kmm, Kaa, Kbb  )       ! write tracer restart file 
     115      IF( lk_trdmxl_trc  )      CALL trd_mxl_trc  ( kt,      Kaa       )       ! trends: Mixed-layer 
     116      ! 
     117      IF( ln_top_euler ) THEN  
     118         ! For Euler timestepping for TOP we need to copy the "after" to the "now" fields  
     119         ! here then after the (leapfrog) swapping of the time-level indices in OCE/step.F90 we have  
     120         ! "before" fields = "now" fields. 
     121         tr(:,:,:,:,Kmm) = tr(:,:,:,:,Kaa) 
    112122      ENDIF 
    113123      ! 
    … …  
    115125         ztrai = 0._wp                                                   !  content of all tracers 
    116126         DO jn = 1, jptra 
    117             ztrai = ztrai + glob_sum( 'trcstp', trn(:,:,:,jn) * cvol(:,:,:)   ) 
     127            ztrai = ztrai + glob_sum( 'trcstp', tr(:,:,:,jn,Kaa) * cvol(:,:,:)   ) 
    118128         END DO 
    119129         IF( lwm ) WRITE(numstr,9300) kt,  ztrai / areatot 
    … …  
    124134      ! 
    125135   END SUBROUTINE trc_stp 
     136 
     137 
     138   SUBROUTINE trc_stp_ctl 
     139      !!---------------------------------------------------------------------- 
     140      !!                     ***  ROUTINE trc_stp_ctl  *** 
     141      !! ** Purpose :        Control  + ocean volume 
     142      !!---------------------------------------------------------------------- 
     143      ! 
     144      ! Define logical parameter ton control dirunal cycle in TOP 
     145      l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 .AND. ncpl_qsr_freq /= 0 ) 
     146      l_trcdm2dc = l_trcdm2dc .AND. .NOT. l_offline 
     147      ! 
     148      IF( l_trcdm2dc .AND. lwp )   CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.',   & 
     149         &                           'Computation of a daily mean shortwave for some biogeochemical models ' ) 
     150      ! 
     151   END SUBROUTINE trc_stp_ctl 
    126152 
    127153 
    … …  
    153179            nb_rec_per_day = ncpl_qsr_freq 
    154180         ELSE   
    155             rdt_sampl = MAX( 3600., rdttrc ) 
     181            rdt_sampl = MAX( 3600., rn_Dt ) 
    156182            nb_rec_per_day = INT( rday / rdt_sampl ) 
    157183         ENDIF 
    … …  
    172198 
    173199            CALL iom_get( numrtr, 'ktdcy', zkt )   
    174             rsecfst = INT( zkt ) * rdttrc 
     200            rsecfst = INT( zkt ) * rn_Dt 
    175201            IF(lwp) WRITE(numout,*) 'trc_qsr_mean:   qsr_mean read in the restart file at time-step rsecfst =', rsecfst, ' s ' 
    176             CALL iom_get( numrtr, jpdom_autoglo, 'qsr_mean', qsr_mean )   !  A mean of qsr 
     202            CALL iom_get( numrtr, jpdom_auto, 'qsr_mean', qsr_mean )   !  A mean of qsr 
    177203            CALL iom_get( numrtr, 'nrdcy', zrec )   !  Number of record per days 
    178204            IF( INT( zrec ) == nb_rec_per_day ) THEN 
    … …  
    180206                  IF( jn <= 9 )  THEN 
    181207                    WRITE(cl1,'(i1)') jn 
    182                     CALL iom_get( numrtr, jpdom_autoglo, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) )   !  A mean of qsr 
     208                    CALL iom_get( numrtr, jpdom_auto, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) )   !  A mean of qsr 
    183209                  ELSE 
    184210                    WRITE(cl2,'(i2.2)') jn 
    185                     CALL iom_get( numrtr, jpdom_autoglo, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) )   !  A mean of qsr 
     211                    CALL iom_get( numrtr, jpdom_auto, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) )   !  A mean of qsr 
    186212                  ENDIF 
    187213              END DO 
    … …  
    193219         ELSE                                         !* no restart: set from nit000 values 
    194220            IF(lwp) WRITE(numout,*) 'trc_qsr_mean:   qsr_mean set to nit000 values' 
    195             rsecfst  = kt * rdttrc 
     221            rsecfst  = kt * rn_Dt 
    196222            ! 
    197223            qsr_mean(:,:) = qsr(:,:) 
    … …  
    203229      ENDIF 
    204230      ! 
    205       rseclast = kt * rdttrc 
     231      rseclast = kt * rn_Dt 
    206232      ! 
    207233      llnew   = ( rseclast - rsecfst ) .ge.  rdt_sampl    !   new shortwave to store 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/trcwri.F90

    r10068 r13463  
    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 
    … …  
    4647      IF( ln_timing )   CALL timing_start('trc_wri') 
    4748      ! 
    48       IF( l_offline .AND. kt == nittrc000 .AND. lwp ) THEN    ! WRITE root name in date.file for use by postpro 
    49          CALL dia_nam( clhstnam, nn_writetrc,' ' ) 
    50          CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    51          WRITE(inum,*) clhstnam 
    52          CLOSE(inum) 
     49      IF( l_offline ) THEN    ! WRITE root name in date.file for use by postpro 
     50         IF(  kt == nittrc000 .AND. lwp ) THEN    ! WRITE root name in date.file for use by postpro 
     51           CALL dia_nam( clhstnam, nn_writetrc,' ' ) 
     52           CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     53           WRITE(inum,*) clhstnam 
     54           CLOSE(inum) 
     55        ENDIF 
     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#if ! defined key_qco 
     63       CALL iom_put( "e3t" , e3t(:,:,:,Kmm) ) 
     64       CALL iom_put( "e3u" , e3u(:,:,:,Kmm) ) 
     65       CALL iom_put( "e3v" , e3v(:,:,:,Kmm) ) 
     66#endif  
     67       ! 
    5368      ENDIF 
    5469      ! write the tracer concentrations in the file 
    5570      ! --------------------------------------- 
    56       IF( ln_pisces  )   CALL trc_wri_pisces     ! PISCES  
    57       IF( ll_cfc     )   CALL trc_wri_cfc        ! surface fluxes of CFC 
    58       IF( ln_c14     )   CALL trc_wri_c14        ! surface fluxes of C14 
    59       IF( ln_age     )   CALL trc_wri_age        ! AGE tracer 
    60       IF( ln_my_trc  )   CALL trc_wri_my_trc     ! MY_TRC  tracers 
     71      IF( ln_pisces  )   CALL trc_wri_pisces( Kmm )     ! PISCES  
     72      IF( ll_cfc     )   CALL trc_wri_cfc   ( Kmm )     ! surface fluxes of CFC 
     73      IF( ln_c14     )   CALL trc_wri_c14   ( Kmm )     ! surface fluxes of C14 
     74      IF( ln_age     )   CALL trc_wri_age   ( Kmm )     ! AGE tracer 
     75      IF( ln_my_trc  )   CALL trc_wri_my_trc( Kmm )     ! MY_TRC  tracers 
    6176      ! 
    6277      IF( ln_timing )   CALL timing_stop('trc_wri') 
    … …  
    7085   PUBLIC trc_wri 
    7186CONTAINS 
    72    SUBROUTINE trc_wri( kt )                     ! Empty routine    
     87   SUBROUTINE trc_wri( kt, Kmm )                     ! Empty routine    
    7388   INTEGER, INTENT(in) :: kt 
     89   INTEGER, INTENT(in) :: Kmm  ! time level indices 
    7490   END SUBROUTINE trc_wri 
    7591#endif 
Note: See TracChangeset for help on using the changeset viewer.