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

Ignore:
Timestamp:
2020-01-27T15:31:53+01:00 (5 years ago)
Author:
acc
Message:

Branch 2019/dev_r11943_MERGE_2019. This commit introduces basic do loop macro
substitution to the 2019 option 1, merge branch. These changes have been SETTE
tested. The only addition is the do_loop_substitute.h90 file in the OCE directory but
the macros defined therein are used throughout the code to replace identifiable, 2D-
and 3D- nested loop opening and closing statements with single-line alternatives. Code
indents are also adjusted accordingly.

The following explanation is taken from comments in the new header file:

This header file contains preprocessor definitions and macros used in the do-loop
substitutions introduced between version 4.0 and 4.2. The primary aim of these macros
is to assist in future applications of tiling to improve performance. This is expected
to be achieved by alternative versions of these macros in selected locations. The
initial introduction of these macros simply replaces all identifiable nested 2D- and
3D-loops with single line statements (and adjusts indenting accordingly). Do loops
are identifiable if they comform to either:

DO jk = ....

DO jj = .... DO jj = ...

DO ji = .... DO ji = ...
. OR .
. .

END DO END DO

END DO END DO

END DO

and white-space variants thereof.

Additionally, only loops with recognised jj and ji loops limits are treated; these are:
Lower limits of 1, 2 or fs_2
Upper limits of jpi, jpim1 or fs_jpim1 (for ji) or jpj, jpjm1 or fs_jpjm1 (for jj)

The macro naming convention takes the form: DO_2D_BT_LR where:

B is the Bottom offset from the PE's inner domain;
T is the Top offset from the PE's inner domain;
L is the Left offset from the PE's inner domain;
R is the Right offset from the PE's inner domain

So, given an inner domain of 2,jpim1 and 2,jpjm1, a typical example would replace:

DO jj = 2, jpj

DO ji = 1, jpim1
.
.

END DO

END DO

with:

DO_2D_01_10
.
.
END_2D

similar conventions apply to the 3D loops macros. jk loop limits are retained
through macro arguments and are not restricted. This includes the possibility of
strides for which an extra set of DO_3DS macros are defined.

In the example definition below the inner PE domain is defined by start indices of
(kIs, kJs) and end indices of (kIe, KJe)

#define DO_2D_00_00 DO jj = kJs, kJe ; DO ji = kIs, kIe
#define END_2D END DO ; END DO

TO DO:

Only conventional nested loops have been identified and replaced by this step. There are constructs such as:

DO jk = 2, jpkm1

z2d(:,:) = z2d(:,:) + e3w(:,:,jk,Kmm) * z3d(:,:,jk) * wmask(:,:,jk)

END DO

which may need to be considered.

Location:
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP
Files:
49 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/C14/trcatm_c14.F90

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

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

    r11949 r12340  
    2626   PUBLIC   trc_sms_c14       ! called in trcsms.F90 
    2727 
     28   !! * Substitutions 
     29#  include "do_loop_substitute.h90" 
    2830   !!---------------------------------------------------------------------- 
    2931   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    7880      ! ------------------------------------------------------------------- 
    7981 
    80       DO jj = 1, jpj 
    81          DO ji = 1, jpi   
    82             IF( tmask(ji,jj,1) >  0. ) THEN 
    83                ! 
    84                zt   = MIN( 40. , ts(ji,jj,1,jp_tem,Kmm) ) 
    85                ! 
    86                !  Computation of solubility zsol in [mol/(L * atm)] 
    87                !   after Wanninkhof (2014) referencing Weiss (1974) 
    88                ztp  = ( zt + 273.16 ) * 0.01 
    89                zsk  = 0.027766 + ztp * ( -0.025888 + 0.0050578 * ztp )   ! [mol/(L * atm)] 
    90                zsol = EXP( -58.0931 + 90.5069 / ztp  + 22.2940 * LOG( ztp ) + zsk * ts(ji,jj,1,jp_sal,Kmm) ) 
    91                ! convert solubilities [mol/(L * atm)] -> [mol/(m^3 * ppm)] 
    92                zsol = zsol * 1.e-03 
     82      DO_2D_11_11 
     83         IF( tmask(ji,jj,1) >  0. ) THEN 
     84            ! 
     85            zt   = MIN( 40. , ts(ji,jj,1,jp_tem,Kmm) ) 
     86            ! 
     87            !  Computation of solubility zsol in [mol/(L * atm)] 
     88            !   after Wanninkhof (2014) referencing Weiss (1974) 
     89            ztp  = ( zt + 273.16 ) * 0.01 
     90            zsk  = 0.027766 + ztp * ( -0.025888 + 0.0050578 * ztp )   ! [mol/(L * atm)] 
     91            zsol = EXP( -58.0931 + 90.5069 / ztp  + 22.2940 * LOG( ztp ) + zsk * ts(ji,jj,1,jp_sal,Kmm) ) 
     92            ! convert solubilities [mol/(L * atm)] -> [mol/(m^3 * ppm)] 
     93            zsol = zsol * 1.e-03 
    9394 
    94                ! Computes the Schmidt number of CO2 in seawater 
    95                !               Wanninkhof-2014 
    96                zsch = 2116.8 + zt * ( -136.25 + zt * (4.7353 + zt * (-0.092307 + 0.0007555 * zt ) ) ) 
     95            ! Computes the Schmidt number of CO2 in seawater 
     96            !               Wanninkhof-2014 
     97            zsch = 2116.8 + zt * ( -136.25 + zt * (4.7353 + zt * (-0.092307 + 0.0007555 * zt ) ) ) 
    9798 
    98                ! Wanninkhof Piston velocity: zpv in units [m/s] 
    99                zv2 = xkwind * (wndm(ji,jj) * wndm(ji,jj))              ! wind speed module at T points 
    100                ! chemical enhancement (Wanninkhof & Knox, 1996) 
    101                IF( ln_chemh ) zv2 = zv2 + 2.5 * ( 0.5246 + zt * (0.016256 + 0.00049946  * zt ) ) 
    102                zv2 = zv2/360000._wp                                    ! conversion cm/h -> m/s 
    103                ! 
    104                zpv  = ( zv2 * SQRT( 660./ zsch ) ) * ( 1. - fr_i(ji,jj) ) * tmask(ji,jj,1) 
     99            ! Wanninkhof Piston velocity: zpv in units [m/s] 
     100            zv2 = xkwind * (wndm(ji,jj) * wndm(ji,jj))              ! wind speed module at T points 
     101            ! chemical enhancement (Wanninkhof & Knox, 1996) 
     102            IF( ln_chemh ) zv2 = zv2 + 2.5 * ( 0.5246 + zt * (0.016256 + 0.00049946  * zt ) ) 
     103            zv2 = zv2/360000._wp                                    ! conversion cm/h -> m/s 
     104            ! 
     105            zpv  = ( zv2 * SQRT( 660./ zsch ) ) * ( 1. - fr_i(ji,jj) ) * tmask(ji,jj,1) 
    105106 
    106                ! CO2 piston velocity (m/s) 
    107                exch_co2(ji,jj)= zpv 
    108                ! CO2 invasion rate (mol/ppm/m2/s) = 1st part of 14C/C exchange velocity 
    109                exch_c14(ji,jj)= zpv * zsol 
    110             ELSE 
    111                exch_co2(ji,jj) = 0._wp 
    112                exch_c14(ji,jj) = 0._wp 
    113             ENDIF 
    114          END DO 
    115       END DO 
     107            ! CO2 piston velocity (m/s) 
     108            exch_co2(ji,jj)= zpv 
     109            ! CO2 invasion rate (mol/ppm/m2/s) = 1st part of 14C/C exchange velocity 
     110            exch_c14(ji,jj)= zpv * zsol 
     111         ELSE 
     112            exch_co2(ji,jj) = 0._wp 
     113            exch_c14(ji,jj) = 0._wp 
     114         ENDIF 
     115      END_2D 
    116116 
    117117      ! Exchange velocity for 14C/C ratio (m/s) 
    … …  
    127127      ! 
    128128      ! Add the surface flux to the trend of jp_c14 
    129       DO jj = 1, jpj 
    130          DO ji = 1, jpi 
    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 DO 
    133       END DO 
     129      DO_2D_11_11 
     130         tr(ji,jj,1,jp_c14,Krhs) = tr(ji,jj,1,jp_c14,Krhs) + qtr_c14(ji,jj) / e3t(ji,jj,1,Kmm)  
     131      END_2D 
    134132      ! 
    135133      ! Computation of decay effects on jp_c14 
    136       DO jk = 1, jpk 
    137          DO jj = 1, jpj 
    138             DO ji = 1, jpi 
    139                ! 
    140                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)  
    141                ! 
    142             END DO 
    143          END DO 
    144       END DO 
     134      DO_3D_11_11( 1, jpk ) 
     135         ! 
     136         tr(ji,jj,jk,jp_c14,Krhs) = tr(ji,jj,jk,jp_c14,Krhs) - rlam14 * tr(ji,jj,jk,jp_c14,Kbb) * tmask(ji,jj,jk)  
     137         ! 
     138      END_3D 
    145139      ! 
    146140      IF( lrst_trc ) THEN 

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

    r11949 r12340  
    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 
    … …  
    5860         zz3d(:,:,:) = 0._wp 
    5961         ! 
    60          DO jk = 1, jpkm1 
    61             DO jj = 1, jpj 
    62                DO ji = 1, jpi 
    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                ENDDO 
    68             ENDDO 
    69          ENDDO 
     62         DO_3D_11_11( 1, jpkm1 ) 
     63            IF( tmask(ji,jj,jk) > 0._wp) THEN 
     64               z3d (ji,jj,jk) = tr(ji,jj,jk,jp_c14,Kmm) 
     65               zz3d(ji,jj,jk) = LOG( z3d(ji,jj,jk) ) 
     66            ENDIF 
     67         END_3D 
    7068         zres(:,:) = z3d(:,:,1) 
    7169 
    … …  
    7371         z2d(:,:) =0._wp 
    7472         jk = 1 
    75          DO jj = 1, jpj 
    76             DO ji = 1, jpi 
    77                ztemp = zres(ji,jj) / c14sbc(ji,jj) 
    78                IF( ztemp > 0._wp .AND. tmask(ji,jj,jk) > 0._wp ) z2d(ji,jj) = LOG( ztemp ) 
    79             ENDDO 
    80          ENDDO 
     73         DO_2D_11_11 
     74            ztemp = zres(ji,jj) / c14sbc(ji,jj) 
     75            IF( ztemp > 0._wp .AND. tmask(ji,jj,jk) > 0._wp ) z2d(ji,jj) = LOG( ztemp ) 
     76         END_2D 
    8177         ! 
    8278         z3d(:,:,:) = 1.d03 * ( z3d(:,:,:) - 1._wp ) 
    … …  
    131127#endif 
    132128 
     129   !! * Substitutions 
     130#  include "do_loop_substitute.h90" 
    133131   !!---------------------------------------------------------------------- 
    134132   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/CFC/trcini_cfc.F90

    r11949 r12340  
    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) 
    … …  
    130132      !--------------------------------------------------------------------------------------- 
    131133      zyd = ylatn - ylats       
    132       DO jj = 1 , jpj 
    133          DO ji = 1 , jpi 
    134             IF(     gphit(ji,jj) >= ylatn ) THEN   ;   xphem(ji,jj) = 1.e0 
    135             ELSEIF( gphit(ji,jj) <= ylats ) THEN   ;   xphem(ji,jj) = 0.e0 
    136             ELSE                                   ;   xphem(ji,jj) = ( gphit(ji,jj) - ylats) / zyd 
    137             ENDIF 
    138          END DO 
    139       END DO 
     134      DO_2D_11_11 
     135         IF(     gphit(ji,jj) >= ylatn ) THEN   ;   xphem(ji,jj) = 1.e0 
     136         ELSEIF( gphit(ji,jj) <= ylats ) THEN   ;   xphem(ji,jj) = 0.e0 
     137         ELSE                                   ;   xphem(ji,jj) = ( gphit(ji,jj) - ylats) / zyd 
     138         ENDIF 
     139      END_2D 
    140140      ! 
    141141      IF(lwp) WRITE(numout,*) 'Initialization of CFC tracers done' 

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

    r12301 r12340  
    4747   REAL(wp) ::   xconv4 = 1.0e-12      ! conversion from mol/m3/atm to mol/m3/pptv  
    4848 
     49   !! * Substitutions 
     50#  include "do_loop_substitute.h90" 
    4951   !!---------------------------------------------------------------------- 
    5052   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    123125          
    124126         !                                                         !------------! 
    125          DO jj = 1, jpj                                            !  i-j loop  ! 
    126             DO ji = 1, jpi                                         !------------! 
     127         DO_2D_11_11 
    127128  
    128                ! space interpolation 
    129                zpp_cfc  =       xphem(ji,jj)   * zpatm(1,jl)   & 
    130                   &     + ( 1.- xphem(ji,jj) ) * zpatm(2,jl) 
    131  
    132                ! Computation of concentration at equilibrium : in picomol/l 
    133                ! coefficient for solubility for CFC-11/12 in  mol/l/atm 
    134                IF( tmask(ji,jj,1) .GE. 0.5 ) THEN 
    135                   ztap  = ( ts(ji,jj,1,jp_tem,Kmm) + 273.16 ) * 0.01 
    136                   zdtap = sob(1,jl) + ztap * ( sob(2,jl) + ztap * sob(3,jl) )  
    137                   zsol  =  EXP( soa(1,jl) + soa(2,jl) / ztap + soa(3,jl) * LOG( ztap )   & 
    138                      &                    + soa(4,jl) * ztap * ztap + ts(ji,jj,1,jp_sal,Kmm) * zdtap )  
    139                ELSE 
    140                   zsol  = 0.e0 
    141                ENDIF 
    142                ! conversion from mol/l/atm to mol/m3/atm and from mol/m3/atm to mol/m3/pptv     
    143                zsol = xconv4 * xconv3 * zsol * tmask(ji,jj,1)   
    144                ! concentration at equilibrium 
    145                zca_cfc = xconv1 * zpp_cfc * zsol * tmask(ji,jj,1)              
    146    
    147                ! Computation of speed transfert 
    148                !    Schmidt number revised in Wanninkhof (2014) 
    149                zt1  = ts(ji,jj,1,jp_tem,Kmm) 
    150                zt2  = zt1 * zt1  
    151                zt3  = zt1 * zt2 
    152                zt4  = zt2 * zt2 
    153                zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 + sca(5,jl) * zt4 
    154  
    155                !    speed transfert : formulae revised in Wanninkhof (2014) 
    156                zv2     = wndm(ji,jj) * wndm(ji,jj) 
    157                zsch    = zsch / 660. 
    158                zak_cfc = ( 0.251 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 
    159  
    160                ! Input function  : speed *( conc. at equil - concen at surface ) 
    161                ! tr(:,:,:,:,Kmm) in pico-mol/l idem qtr; ak in en m/a 
    162                qtr_cfc(ji,jj,jl) = -zak_cfc * ( tr(ji,jj,1,jn,Kbb) - zca_cfc )   & 
    163                   &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) 
    164                ! Add the surface flux to the trend 
    165                tr(ji,jj,1,jn,Krhs) = tr(ji,jj,1,jn,Krhs) + qtr_cfc(ji,jj,jl) / e3t(ji,jj,1,Kmm)  
    166  
    167                ! cumulation of surface flux at each time step 
    168                qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * rdt 
    169                !                                               !----------------! 
    170             END DO                                             !  end i-j loop  ! 
    171          END DO                                                !----------------! 
     129            ! space interpolation 
     130            zpp_cfc  =       xphem(ji,jj)   * zpatm(1,jl)   & 
     131               &     + ( 1.- xphem(ji,jj) ) * zpatm(2,jl) 
     132 
     133            ! Computation of concentration at equilibrium : in picomol/l 
     134            ! coefficient for solubility for CFC-11/12 in  mol/l/atm 
     135            IF( tmask(ji,jj,1) .GE. 0.5 ) THEN 
     136               ztap  = ( ts(ji,jj,1,jp_tem,Kmm) + 273.16 ) * 0.01 
     137               zdtap = sob(1,jl) + ztap * ( sob(2,jl) + ztap * sob(3,jl) )  
     138               zsol  =  EXP( soa(1,jl) + soa(2,jl) / ztap + soa(3,jl) * LOG( ztap )   & 
     139                  &                    + soa(4,jl) * ztap * ztap + ts(ji,jj,1,jp_sal,Kmm) * zdtap )  
     140            ELSE 
     141               zsol  = 0.e0 
     142            ENDIF 
     143            ! conversion from mol/l/atm to mol/m3/atm and from mol/m3/atm to mol/m3/pptv     
     144            zsol = xconv4 * xconv3 * zsol * tmask(ji,jj,1)   
     145            ! concentration at equilibrium 
     146            zca_cfc = xconv1 * zpp_cfc * zsol * tmask(ji,jj,1)              
     147            ! Computation of speed transfert 
     148            !    Schmidt number revised in Wanninkhof (2014) 
     149            zt1  = ts(ji,jj,1,jp_tem,Kmm) 
     150            zt2  = zt1 * zt1  
     151            zt3  = zt1 * zt2 
     152            zt4  = zt2 * zt2 
     153            zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 + sca(5,jl) * zt4 
     154 
     155            !    speed transfert : formulae revised in Wanninkhof (2014) 
     156            zv2     = wndm(ji,jj) * wndm(ji,jj) 
     157            zsch    = zsch / 660. 
     158            zak_cfc = ( 0.251 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 
     159 
     160            ! Input function  : speed *( conc. at equil - concen at surface ) 
     161            ! tr(:,:,:,:,Kmm) in pico-mol/l idem qtr; ak in en m/a 
     162            qtr_cfc(ji,jj,jl) = -zak_cfc * ( tr(ji,jj,1,jn,Kbb) - zca_cfc )   & 
     163               &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) 
     164            ! Add the surface flux to the trend 
     165            tr(ji,jj,1,jn,Krhs) = tr(ji,jj,1,jn,Krhs) + qtr_cfc(ji,jj,jl) / e3t(ji,jj,1,Kmm)  
     166 
     167            ! cumulation of surface flux at each time step 
     168            qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * rdt 
     169            !                                               !----------------! 
     170         END_2D 
    172171         !                                                  !----------------! 
    173172      END DO                                                !  end CFC loop  ! 

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P2Z/p2zbio.F90

    r12236 r12340  
    5858   !! * Substitutions 
    5959#  include "vectopt_loop_substitute.h90" 
     60#  include "do_loop_substitute.h90" 
    6061   !!---------------------------------------------------------------------- 
    6162   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    121122      DO jk = 1, jpkbm1                      !  Upper ocean (bio-layers)  ! 
    122123         !                                   ! -------------------------- ! 
    123          DO jj = 2, jpjm1 
    124             DO ji = fs_2, fs_jpim1  
    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 DO 
    239          END DO 
     124         DO_2D_00_00 
     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 
    240239      END DO 
    241240 
    … …  
    243242      DO jk = jpkb, jpkm1                    !  Upper ocean (bio-layers)  ! 
    244243         !                                   ! -------------------------- ! 
    245          DO jj = 2, jpjm1 
    246             DO ji = fs_2, fs_jpim1  
    247                ! remineralisation of all quantities towards nitrate  
    248  
    249                !    trophic variables( det, zoo, phy, no3, nh4, dom) 
    250                !       negative trophic variables DO not contribute to the fluxes 
    251                zdet = MAX( 0.e0, tr(ji,jj,jk,jpdet,Kmm) ) 
    252                zzoo = MAX( 0.e0, tr(ji,jj,jk,jpzoo,Kmm) ) 
    253                zphy = MAX( 0.e0, tr(ji,jj,jk,jpphy,Kmm) ) 
    254                zno3 = MAX( 0.e0, tr(ji,jj,jk,jpno3,Kmm) ) 
    255                znh4 = MAX( 0.e0, tr(ji,jj,jk,jpnh4,Kmm) ) 
    256                zdom = MAX( 0.e0, tr(ji,jj,jk,jpdom,Kmm) ) 
    257  
    258                !    Limitations 
    259                zlt   = 0.e0 
    260                zle   = 0.e0 
    261                zlno3 = 0.e0 
    262                zlnh4 = 0.e0 
    263  
    264                !    sinks and sources 
    265                !       phytoplankton production and exsudation 
    266                zno3phy = 0.e0 
    267                znh4phy = 0.e0 
    268                zphydom = 0.e0 
    269                zphynh4 = 0.e0 
    270  
    271                !    zooplankton production 
    272                zphyzoo = 0.e0      ! grazing 
    273                zdetzoo = 0.e0 
    274  
    275                zzoodet = 0.e0      ! fecal pellets production 
    276  
    277                zzoonh4 = tauzn * fzoolab * zzoo         ! zooplankton liquide excretion 
    278                zzoodom = tauzn * (1 - fzoolab) * zzoo 
    279  
    280                !    mortality 
    281                zphydet = tmminp * zphy      ! phytoplankton mortality 
    282  
    283                zzoobod = 0.e0               ! zooplankton mortality 
    284                zboddet = 0.e0               ! closure : flux fbod is redistributed below level jpkbio 
    285  
    286                !    detritus and dom breakdown 
    287                zdetnh4 = taudn * fdetlab * zdet 
    288                zdetdom = taudn * (1 - fdetlab) * zdet 
    289  
    290                zdomnh4 = taudomn * zdom 
    291                zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 
    292  
    293                !    Nitrification 
    294                znh4no3 = taunn * znh4 
    295  
    296  
    297                ! determination of trends 
    298                !     total trend for each biological tracer 
    299                zphya =   zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet 
    300                zzooa =   zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod 
    301                zno3a = - zno3phy + znh4no3  
    302                znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju 
    303                zdeta = zphydet + zzoodet  - zdetzoo - zdetnh4 - zdetdom + zboddet 
    304                zdoma = zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju 
    305  
    306                ! tracer flux at totox-point added to the general trend 
    307                tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + zdeta 
    308                tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) + zzooa 
    309                tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zphya 
    310                tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + zno3a 
    311                tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + znh4a 
    312                tr(ji,jj,jk,jpdom,Krhs) = tr(ji,jj,jk,jpdom,Krhs) + zdoma 
     244         DO_2D_00_00 
     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 
    313335               ! 
    314                 IF( lk_iomput ) THEN                  ! convert fluxes in per day 
    315                   ze3t = e3t(ji,jj,jk,Kmm) * 86400._wp 
    316                   zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t 
    317                   zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t 
    318                   zw2d(ji,jj,3)  = zw2d(ji,jj,3)  + zphydom * ze3t 
    319                   zw2d(ji,jj,4)  = zw2d(ji,jj,4)  + zphynh4 * ze3t 
    320                   zw2d(ji,jj,5)  = zw2d(ji,jj,5)  + zphyzoo * ze3t 
    321                   zw2d(ji,jj,6)  = zw2d(ji,jj,6)  + zphydet * ze3t 
    322                   zw2d(ji,jj,7)  = zw2d(ji,jj,7)  + zdetzoo * ze3t 
    323                   zw2d(ji,jj,8)  = zw2d(ji,jj,8)  + zzoodet * ze3t 
    324                   zw2d(ji,jj,9)  = zw2d(ji,jj,9)  + zzoobod * ze3t 
    325                   zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t 
    326                   zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t 
    327                   zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t 
    328                   zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t 
    329                   zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t 
    330                   zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t 
    331                   zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t 
    332                   zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 
    333                   !    
    334                   zw3d(ji,jj,jk,1) = zno3phy * 86400._wp 
    335                   zw3d(ji,jj,jk,2) = znh4phy * 86400._wp 
    336                   zw3d(ji,jj,jk,3) = znh4no3 * 86400._wp 
    337                   ! 
    338                ENDIF 
    339             END DO 
    340          END DO 
     336            ENDIF 
     337         END_2D 
    341338      END DO 
    342339      ! 

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

    r12236 r12340  
    3939   !! * Substitutions 
    4040#  include "vectopt_loop_substitute.h90" 
     41#  include "do_loop_substitute.h90" 
    4142   !!---------------------------------------------------------------------- 
    4243   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    8182      ! LAYERS IS DETERMINED BY DMIN3 DEFINED IN sms_p2z.F90 
    8283      ! ---------------------------------------------------------------------- 
    83       DO jk = 1, jpkm1 
    84          DO jj = 2, jpjm1 
    85             DO ji = fs_2, fs_jpim1 
    86                ze3t = 1. / e3t(ji,jj,jk,Kmm) 
    87                tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj) 
    88             END DO 
    89          END DO 
    90       END DO 
     84      DO_3D_00_00( 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 
    9188 
    9289      ! Find the last level of the water column 
    … …  
    9693      zgeolpoc = 0.e0         !     Initialization 
    9794      ! Release of nutrients from the "simple" sediment 
    98       DO jj = 2, jpjm1 
    99          DO ji = fs_2, fs_jpim1 
    100             ikt = mbkt(ji,jj)  
    101             tr(ji,jj,ikt,jpno3,Krhs) = tr(ji,jj,ikt,jpno3,Krhs) + sedlam * sedpocn(ji,jj) / e3t(ji,jj,ikt,Kmm)  
    102             ! Deposition of organic matter in the sediment 
    103             zwork = vsed * tr(ji,jj,ikt,jpdet,Kmm) 
    104             zsedpoca(ji,jj) = ( zwork + dminl(ji,jj) * xksi(ji,jj)   & 
    105                &           - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rdt 
    106             zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1e2t(ji,jj) 
    107          END DO 
    108       END DO 
    109  
    110       DO jj = 2, jpjm1 
    111          DO ji = fs_2, fs_jpim1 
    112             tr(ji,jj,1,jpno3,Krhs) = tr(ji,jj,1,jpno3,Krhs) + zgeolpoc * cmask(ji,jj) / areacot / e3t(ji,jj,1,Kmm) 
    113          END DO 
    114       END DO 
     95      DO_2D_00_00 
     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) ) * rdt 
     102         zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1e2t(ji,jj) 
     103      END_2D 
     104 
     105      DO_2D_00_00 
     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 
    115108 
    116109      CALL lbc_lnk( 'p2zexp', sedpocn, 'T', 1. ) 
    … …  
    128121      ELSE 
    129122        ! 
    130         DO jj = 1, jpj 
    131            DO ji = 1, jpi 
    132               zsedpocd = zsedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj)      ! time laplacian on tracers 
    133               sedpocb(ji,jj) = sedpocn(ji,jj) + atfp * zsedpocd                     ! sedpocb <-- filtered sedpocn 
    134               sedpocn(ji,jj) = zsedpoca(ji,jj)                                       ! sedpocn <-- sedpoca 
    135            END DO 
    136         END DO 
     123        DO_2D_11_11 
     124           zsedpocd = zsedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj)      ! time laplacian on tracers 
     125           sedpocb(ji,jj) = sedpocn(ji,jj) + atfp * zsedpocd                     ! sedpocb <-- filtered sedpocn 
     126           sedpocn(ji,jj) = zsedpoca(ji,jj)                                       ! sedpocn <-- sedpoca 
     127        END_2D 
    137128        !  
    138129      ENDIF 
    … …  
    183174      zdm0 = 0._wp 
    184175      zrro = 1._wp 
    185       DO jk = jpkb, jpkm1 
    186          DO jj = 1, jpj 
    187             DO ji = 1, jpi 
    188                zfluo = ( gdepw(ji,jj,jk  ,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr 
    189                zfluu = ( gdepw(ji,jj,jk+1,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr 
    190                IF( zfluo.GT.1. )   zfluo = 1._wp 
    191                zdm0(ji,jj,jk) = zfluo - zfluu 
    192                IF( jk <= jpkb-1 )   zdm0(ji,jj,jk) = 0._wp 
    193                zrro(ji,jj) = zrro(ji,jj) - zdm0(ji,jj,jk) 
    194             END DO 
    195          END DO 
    196       END DO 
     176      DO_3D_11_11( 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 
    197184      ! 
    198185      zdm0(:,:,jpk) = zrro(:,:) 
    … …  
    204191      dminl(:,:)   = 0._wp 
    205192      dmin3(:,:,:) = zdm0 
    206       DO jk = 1, jpk 
    207          DO jj = 1, jpj 
    208             DO ji = 1, jpi 
    209                IF( tmask(ji,jj,jk) == 0._wp ) THEN 
    210                   dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk) 
    211                   dmin3(ji,jj,jk) = 0._wp 
    212                ENDIF 
    213             END DO 
    214          END DO 
    215       END DO 
    216  
    217       DO jj = 1, jpj 
    218          DO ji = 1, jpi 
    219             IF( tmask(ji,jj,1) == 0 )   dmin3(ji,jj,1) = 0._wp 
    220          END DO 
    221       END DO 
     193      DO_3D_11_11( 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_11_11 
     201         IF( tmask(ji,jj,1) == 0 )   dmin3(ji,jj,1) = 0._wp 
     202      END_2D 
    222203 
    223204      ! Coastal mask  
    224205      cmask(:,:) = 0._wp 
    225       DO jj = 2, jpjm1 
    226          DO ji = fs_2, fs_jpim1 
    227             IF( tmask(ji,jj,1) /= 0. ) THEN 
    228                zmaskt = tmask(ji+1,jj,1) * tmask(ji-1,jj,1) * tmask(ji,jj+1,1) * tmask(ji,jj-1,1)  
    229                IF( zmaskt == 0. )   cmask(ji,jj) = 1._wp 
    230             END IF 
    231          END DO 
    232       END DO 
     206      DO_2D_00_00 
     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 
    233212      CALL lbc_lnk( 'p2zexp', cmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged) 
    234213      areacot = glob_sum( 'p2zexp', e1e2t(:,:) * cmask(:,:) ) 

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

    r12236 r12340  
    3838   REAL(wp), PUBLIC ::  reddom    ! redfield ratio (C:N) for DOM 
    3939 
     40   !! * Substitutions 
     41#  include "do_loop_substitute.h90" 
    4042   !!---------------------------------------------------------------------- 
    4143   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    9294      !                                          ! Photosynthetically Available Radiation (PAR) 
    9395      zcoef = 12 * redf / rcchl / rpig           ! -------------------------------------- 
    94       DO jk = 2, jpk                                  ! local par at w-levels 
    95          DO jj = 1, jpj 
    96             DO ji = 1, jpi 
    97                zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk-1,jpphy,Kmm) ) * zcoef  ) 
    98                zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
    99                zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
    100                zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * e3t(ji,jj,jk-1,Kmm) ) 
    101                zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t(ji,jj,jk-1,Kmm) ) 
    102             END DO 
    103         END DO 
    104       END DO 
    105       DO jk = 1, jpkm1                                ! mean par at t-levels 
    106          DO jj = 1, jpj 
    107             DO ji = 1, jpi 
    108                zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk,jpphy,Kmm) ) * zcoef  ) 
    109                zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
    110                zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
    111                zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * e3t(ji,jj,jk,Kmm) ) * ( 1 - EXP( -zkr * e3t(ji,jj,jk,Kmm) ) ) 
    112                zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * e3t(ji,jj,jk,Kmm) ) * ( 1 - EXP( -zkg * e3t(ji,jj,jk,Kmm) ) ) 
    113                etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 ) 
    114             END DO 
    115          END DO 
    116       END DO 
     96      DO_3D_11_11( 2, jpk ) 
     97         zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk-1,jpphy,Kmm) ) * zcoef  ) 
     98         zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
     99         zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
     100         zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * e3t(ji,jj,jk-1,Kmm) ) 
     101         zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t(ji,jj,jk-1,Kmm) ) 
     102      END_3D 
     103      DO_3D_11_11( 1, jpkm1 ) 
     104         zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk,jpphy,Kmm) ) * zcoef  ) 
     105         zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
     106         zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
     107         zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * e3t(ji,jj,jk,Kmm) ) * ( 1 - EXP( -zkr * e3t(ji,jj,jk,Kmm) ) ) 
     108         zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * e3t(ji,jj,jk,Kmm) ) * ( 1 - EXP( -zkg * e3t(ji,jj,jk,Kmm) ) ) 
     109         etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 ) 
     110      END_3D 
    117111 
    118112      !                                          ! Euphotic layer 
    119113      !                                          ! -------------- 
    120114      neln(:,:) = 1                                   ! euphotic layer level 
    121       DO jk = 1, jpkm1                                ! (i.e. 1rst T-level strictly below EL bottom) 
    122          DO jj = 1, jpj 
    123            DO ji = 1, jpi 
    124               IF( etot(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk + 1  
    125            END DO 
    126          END DO 
    127       END DO 
     115      DO_3D_11_11( 1, jpkm1 ) 
     116        IF( etot(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk + 1  
     117      END_3D 
    128118      !                                               ! Euphotic layer depth 
    129       DO jj = 1, jpj 
    130          DO ji = 1, jpi 
    131             heup(ji,jj) = gdepw(ji,jj,neln(ji,jj),Kmm) 
    132          END DO 
    133       END DO  
     119      DO_2D_11_11 
     120         heup(ji,jj) = gdepw(ji,jj,neln(ji,jj),Kmm) 
     121      END_2D 
    134122 
    135123 

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

    r12236 r12340  
    3131   REAL(wp), PUBLIC ::   xhr         !: coeff for martin''s remineralisation profile 
    3232 
     33   !! * Substitutions 
     34#  include "do_loop_substitute.h90" 
    3335   !!---------------------------------------------------------------------- 
    3436   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    8688 
    8789      ! tracer flux divergence at t-point added to the general trend 
    88       DO jk = 1, jpkm1 
    89          DO jj = 1, jpj 
    90             DO ji = 1, jpi 
    91                ztra(ji,jj,jk)  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 
    92                tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + ztra(ji,jj,jk)  
    93             END DO 
    94          END DO 
    95       END DO 
     90      DO_3D_11_11( 1, jpkm1 ) 
     91         ztra(ji,jj,jk)  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 
     92         tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + ztra(ji,jj,jk)  
     93      END_3D 
    9694 
    9795      IF( lk_iomput )  THEN 

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zagg.F90

    r12236 r12340  
    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) 
    … …  
    5860      IF( ln_p4z ) THEN 
    5961         ! 
    60          DO jk = 1, jpkm1 
    61             DO jj = 1, jpj 
    62                DO ji = 1, jpi 
    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) 
     62         DO_3D_11_11( 1, jpkm1 ) 
     63            ! 
     64            zfact = xstep * xdiss(ji,jj,jk) 
     65            !  Part I : Coagulation dependent on turbulence 
     66            zagg1 = 25.9  * zfact * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jppoc,Kbb) 
     67            zagg2 = 4452. * zfact * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpgoc,Kbb) 
    6868 
    69                   ! Part II : Differential settling 
     69            ! Part II : Differential settling 
    7070 
    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) 
     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) 
    7474 
    75                   zagg   = zagg1 + zagg2 + zagg3 + zagg4 
    76                   zaggfe = zagg * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 
     75            zagg   = zagg1 + zagg2 + zagg3 + zagg4 
     76            zaggfe = zagg * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 
    7777 
    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) 
     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) 
    9090 
    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 DO 
    102             END DO 
    103          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 
    104102      ELSE    ! ln_p5z 
    105103        ! 
    106          DO jk = 1, jpkm1 
    107             DO jj = 1, jpj 
    108                DO ji = 1, jpi 
    109                   ! 
    110                   zfact = xstep * xdiss(ji,jj,jk) 
    111                   !  Part I : Coagulation dependent on turbulence 
    112                   zaggtmp = 25.9  * zfact * tr(ji,jj,jk,jppoc,Kbb) 
    113                   zaggpoc1 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 
    114                   zaggtmp = 4452. * zfact * tr(ji,jj,jk,jpgoc,Kbb) 
    115                   zaggpoc2 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 
     104         DO_3D_11_11( 1, jpkm1 ) 
     105            ! 
     106            zfact = xstep * xdiss(ji,jj,jk) 
     107            !  Part I : Coagulation dependent on turbulence 
     108            zaggtmp = 25.9  * zfact * tr(ji,jj,jk,jppoc,Kbb) 
     109            zaggpoc1 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 
     110            zaggtmp = 4452. * zfact * tr(ji,jj,jk,jpgoc,Kbb) 
     111            zaggpoc2 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 
    116112 
    117                   ! Part II : Differential settling 
    118     
    119                   !  Aggregation of small into large particles 
    120                   zaggtmp =  47.1 * xstep * tr(ji,jj,jk,jpgoc,Kbb) 
    121                   zaggpoc3 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 
    122                   zaggtmp =  3.3  * xstep * tr(ji,jj,jk,jppoc,Kbb) 
    123                   zaggpoc4 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 
     113            ! Part II : Differential settling 
    124114 
    125                   zaggpoc   = zaggpoc1 + zaggpoc2 + zaggpoc3 + zaggpoc4 
    126                   zaggpon = zaggpoc * tr(ji,jj,jk,jppon,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
    127                   zaggpop = zaggpoc * tr(ji,jj,jk,jppop,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
    128                   zaggfe = zaggpoc * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb)  + 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) 
    129120 
    130                   ! Aggregation of DOC to POC :  
    131                   ! 1st term is shear aggregation of DOC-DOC 
    132                   ! 2nd term is shear aggregation of DOC-POC 
    133                   ! 3rd term is differential settling of DOC-POC 
    134                   zaggtmp = ( ( 0.369 * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4 * tr(ji,jj,jk,jppoc,Kbb) ) * zfact       & 
    135                   &            + 2.4 * xstep * tr(ji,jj,jk,jppoc,Kbb) ) 
    136                   zaggdoc  = zaggtmp * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 
    137                   zaggdon  = zaggtmp * 0.3 * tr(ji,jj,jk,jpdon,Kbb) 
    138                   zaggdop  = zaggtmp * 0.3 * tr(ji,jj,jk,jpdop,Kbb) 
     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 ) 
    139125 
    140                   ! transfer of DOC to GOC :  
    141                   ! 1st term is shear aggregation 
    142                   ! 2nd term is differential settling  
    143                   zaggtmp = ( 3.53E3 * zfact + 0.1 * xstep ) * tr(ji,jj,jk,jpgoc,Kbb) 
    144                   zaggdoc2 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 
    145                   zaggdon2 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdon,Kbb) 
    146                   zaggdop2 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdop,Kbb) 
     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) 
    147135 
    148                   ! tranfer of DOC to POC due to brownian motion 
    149                   zaggtmp = ( 114. * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) ) * xstep 
    150                   zaggdoc3 =  zaggtmp * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 
    151                   zaggdon3 =  zaggtmp * 0.3 * tr(ji,jj,jk,jpdon,Kbb) 
    152                   zaggdop3 =  zaggtmp * 0.3 * tr(ji,jj,jk,jpdop,Kbb) 
     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) 
    153143 
    154                   !  Update the trends 
    155                   tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zaggpoc + zaggdoc + zaggdoc3 
    156                   tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) - zaggpon + zaggdon + zaggdon3 
    157                   tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) - zaggpop + zaggdop + zaggdop3 
    158                   tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zaggpoc + zaggdoc2 
    159                   tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zaggpon + zaggdon2 
    160                   tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + zaggpop + zaggdop2 
    161                   tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zaggfe 
    162                   tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zaggfe 
    163                   tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zaggdoc - zaggdoc2 - zaggdoc3 
    164                   tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) - zaggdon - zaggdon2 - zaggdon3 
    165                   tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) - zaggdop - zaggdop2 - zaggdop3 
    166                   ! 
    167                   conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zaggpoc + zaggdoc + zaggdoc3 
    168                   prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zaggpoc + zaggdoc2 
    169                   ! 
    170                END DO 
    171             END DO 
    172          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 
    173167         ! 
    174168      ENDIF 

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zbc.F90

    r12258 r12340  
    4848   !! * Substitutions 
    4949#  include "vectopt_loop_substitute.h90" 
     50#  include "do_loop_substitute.h90" 
    5051   !!---------------------------------------------------------------------- 
    5152   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    111112      IF( ll_river ) THEN 
    112113          jl = n_trc_indcbc(jpno3) 
    113           DO jj = 1, jpj 
    114              DO ji = 1, jpi 
    115                 DO jk = 1, nk_rnf(ji,jj) 
    116                    zcoef = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_cbc_time ) * tmask(ji,jj,1) 
    117                    zrivdin = rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zcoef 
    118                    tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - rno3 * zrivdin * rfact 
    119                ENDDO 
    120              END DO 
    121           END DO 
     114          DO_2D_11_11 
     115             DO jk = 1, nk_rnf(ji,jj) 
     116                zcoef = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_cbc_time ) * tmask(ji,jj,1) 
     117                zrivdin = rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zcoef 
     118                tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - rno3 * zrivdin * rfact 
     119            ENDDO 
     120          END_2D 
    122121      ENDIF 
    123122       
    … …  
    146145         ALLOCATE( zironice(jpi,jpj) ) 
    147146         ! 
    148          DO jj = 1, jpj 
    149             DO ji = 1, jpi 
    150                zdep    = rfact / e3t(ji,jj,1,Kmm) 
    151                zwflux  = fmmflx(ji,jj) / 1000._wp 
    152                zironice(ji,jj) =  MAX( -0.99 * tr(ji,jj,1,jpfer,Kbb), -zwflux * icefeinput * zdep ) 
    153             END DO 
    154          END DO 
     147         DO_2D_11_11 
     148            zdep    = rfact / e3t(ji,jj,1,Kmm) 
     149            zwflux  = fmmflx(ji,jj) / 1000._wp 
     150            zironice(ji,jj) =  MAX( -0.99 * tr(ji,jj,1,jpfer,Kbb), -zwflux * icefeinput * zdep ) 
     151         END_2D 
    155152         ! 
    156153         tr(:,:,1,jpfer,Krhs) = tr(:,:,1,jpfer,Krhs) + zironice(:,:) 
    … …  
    300297         IF(lwp) WRITE(numout,*) 
    301298         IF(lwp) WRITE(numout,*) ' Level corresponding to 50m depth ',  ik50,' ', gdept_1d(ik50+1) 
    302          DO jk = 1, ik50 
    303             DO jj = 2, jpjm1 
    304                DO ji = fs_2, fs_jpim1 
    305                   ze3t   = e3t_0(ji,jj,jk) 
    306                   zsurfc =  e1u(ji,jj) * ( 1. - umask(ji  ,jj  ,jk) )   & 
    307                           + e1u(ji,jj) * ( 1. - umask(ji-1,jj  ,jk) )   & 
    308                           + e2v(ji,jj) * ( 1. - vmask(ji  ,jj  ,jk) )   & 
    309                           + e2v(ji,jj) * ( 1. - vmask(ji  ,jj-1,jk) ) 
    310                   zsurfp = zsurfc * ze3t / e1e2t(ji,jj) 
    311                   ! estimation of the coastal slope : 5 km off the coast 
    312                   ze3t2 = ze3t * ze3t 
    313                   zcslp = SQRT( ( distcoast*distcoast + ze3t2 ) / ze3t2 ) 
    314                   ! 
    315                   zcmask(ji,jj,jk) = zcmask(ji,jj,jk) + zcslp * zsurfp 
    316                END DO 
    317             END DO 
    318          END DO 
     299         DO_3D_00_00( 1, ik50 ) 
     300            ze3t   = e3t_0(ji,jj,jk) 
     301            zsurfc =  e1u(ji,jj) * ( 1. - umask(ji  ,jj  ,jk) )   & 
     302                    + e1u(ji,jj) * ( 1. - umask(ji-1,jj  ,jk) )   & 
     303                    + e2v(ji,jj) * ( 1. - vmask(ji  ,jj  ,jk) )   & 
     304                    + e2v(ji,jj) * ( 1. - vmask(ji  ,jj-1,jk) ) 
     305            zsurfp = zsurfc * ze3t / e1e2t(ji,jj) 
     306            ! estimation of the coastal slope : 5 km off the coast 
     307            ze3t2 = ze3t * ze3t 
     308            zcslp = SQRT( ( distcoast*distcoast + ze3t2 ) / ze3t2 ) 
     309            ! 
     310            zcmask(ji,jj,jk) = zcmask(ji,jj,jk) + zcslp * zsurfp 
     311         END_3D 
    319312         ! 
    320313         CALL lbc_lnk( 'p4zbc', zcmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged) 
    321314         ! 
    322          DO jk = 1, jpk 
    323             DO jj = 1, jpj 
    324                DO ji = 1, jpi 
    325                   zexpide   = MIN( 8.,( gdept(ji,jj,jk,Kmm) / 500. )**(-1.5) ) 
    326                   zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2 
    327                   zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 ) 
    328                END DO 
    329             END DO 
    330          END DO 
     315         DO_3D_11_11( 1, jpk ) 
     316            zexpide   = MIN( 8.,( gdept(ji,jj,jk,Kmm) / 500. )**(-1.5) ) 
     317            zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2 
     318            zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 ) 
     319         END_3D 
    331320         ! Coastal supply of iron 
    332321         ! ------------------------- 

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

    r12236 r12340  
    3838   PUBLIC  p4z_bio     
    3939 
     40   !! * Substitutions 
     41#  include "do_loop_substitute.h90" 
    4042   !!---------------------------------------------------------------------- 
    4143   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    6971      xdiss(:,:,:) = 1. 
    7072!!gm the use of nmld should be better here? 
    71       DO jk = 2, jpkm1 
    72          DO jj = 1, jpj 
    73             DO ji = 1, jpi 
     73      DO_3D_11_11( 2, jpkm1 ) 
    7474!!gm  :  use nmln  and test on jk ...  less memory acces 
    75                IF( gdepw(ji,jj,jk+1,Kmm) > hmld(ji,jj) )   xdiss(ji,jj,jk) = 0.01 
    76             END DO  
    77          END DO 
    78       END DO 
     75         IF( gdepw(ji,jj,jk+1,Kmm) > hmld(ji,jj) )   xdiss(ji,jj,jk) = 0.01 
     76      END_3D 
    7977 
    8078      CALL p4z_opt     ( kt, knt, Kbb, Kmm       )     ! Optic: PAR in the water column 

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

    r11949 r12340  
    130130   INTEGER :: niter_atgen    = jp_maxniter_atgen 
    131131 
     132   !! * Substitutions 
     133#  include "do_loop_substitute.h90" 
    132134   !!---------------------------------------------------------------------- 
    133135   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    176178      ! 0.04°C relative to an exact computation 
    177179      ! --------------------------------------------------------------------- 
    178       DO jk = 1, jpk 
    179          DO jj = 1, jpj 
    180             DO ji = 1, jpi 
    181                zpres = gdept(ji,jj,jk,Kmm) / 1000. 
    182                za1 = 0.04 * ( 1.0 + 0.185 * ts(ji,jj,jk,jp_tem,Kmm) + 0.035 * (salinprac(ji,jj,jk) - 35.0) ) 
    183                za2 = 0.0075 * ( 1.0 - ts(ji,jj,jk,jp_tem,Kmm) / 30.0 ) 
    184                tempis(ji,jj,jk) = ts(ji,jj,jk,jp_tem,Kmm) - za1 * zpres + za2 * zpres**2 
    185             END DO 
    186          END DO 
    187       END DO 
     180      DO_3D_11_11( 1, jpk ) 
     181         zpres = gdept(ji,jj,jk,Kmm) / 1000. 
     182         za1 = 0.04 * ( 1.0 + 0.185 * ts(ji,jj,jk,jp_tem,Kmm) + 0.035 * (salinprac(ji,jj,jk) - 35.0) ) 
     183         za2 = 0.0075 * ( 1.0 - ts(ji,jj,jk,jp_tem,Kmm) / 30.0 ) 
     184         tempis(ji,jj,jk) = ts(ji,jj,jk,jp_tem,Kmm) - za1 * zpres + za2 * zpres**2 
     185      END_3D 
    188186      ! 
    189187      ! CHEMICAL CONSTANTS - SURFACE LAYER 
    … …  
    473471      IF( ln_timing )  CALL timing_start('ahini_for_at') 
    474472      ! 
    475       DO jk = 1, jpk 
    476         DO jj = 1, jpj 
    477           DO ji = 1, jpi 
    478             p_alkcb  = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 
    479             p_dictot = tr(ji,jj,jk,jpdic,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 
    480             p_bortot = borat(ji,jj,jk) 
    481             IF (p_alkcb <= 0.) THEN 
    482                 p_hini(ji,jj,jk) = 1.e-3 
    483             ELSEIF (p_alkcb >= (2.*p_dictot + p_bortot)) THEN 
    484                 p_hini(ji,jj,jk) = 1.e-10_wp 
     473      DO_3D_11_11( 1, jpk ) 
     474      p_alkcb  = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 
     475      p_dictot = tr(ji,jj,jk,jpdic,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 
     476      p_bortot = borat(ji,jj,jk) 
     477      IF (p_alkcb <= 0.) THEN 
     478          p_hini(ji,jj,jk) = 1.e-3 
     479      ELSEIF (p_alkcb >= (2.*p_dictot + p_bortot)) THEN 
     480          p_hini(ji,jj,jk) = 1.e-10_wp 
     481      ELSE 
     482          zca1 = p_dictot/( p_alkcb + rtrn ) 
     483          zba1 = p_bortot/ (p_alkcb + rtrn ) 
     484     ! Coefficients of the cubic polynomial 
     485          za2 = aKb3(ji,jj,jk)*(1. - zba1) + ak13(ji,jj,jk)*(1.-zca1) 
     486          za1 = ak13(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - zca1)    & 
     487          &     + ak13(ji,jj,jk)*ak23(ji,jj,jk)*(1. - (zca1+zca1)) 
     488          za0 = ak13(ji,jj,jk)*ak23(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - (zca1+zca1)) 
     489                                  ! Taylor expansion around the minimum 
     490          zd = za2*za2 - 3.*za1   ! Discriminant of the quadratic equation 
     491                                  ! for the minimum close to the root 
     492 
     493          IF(zd > 0.) THEN        ! If the discriminant is positive 
     494            zsqrtd = SQRT(zd) 
     495            IF(za2 < 0) THEN 
     496              zhmin = (-za2 + zsqrtd)/3. 
    485497            ELSE 
    486                 zca1 = p_dictot/( p_alkcb + rtrn ) 
    487                 zba1 = p_bortot/ (p_alkcb + rtrn ) 
    488            ! Coefficients of the cubic polynomial 
    489                 za2 = aKb3(ji,jj,jk)*(1. - zba1) + ak13(ji,jj,jk)*(1.-zca1) 
    490                 za1 = ak13(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - zca1)    & 
    491                 &     + ak13(ji,jj,jk)*ak23(ji,jj,jk)*(1. - (zca1+zca1)) 
    492                 za0 = ak13(ji,jj,jk)*ak23(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - (zca1+zca1)) 
    493                                         ! Taylor expansion around the minimum 
    494                 zd = za2*za2 - 3.*za1   ! Discriminant of the quadratic equation 
    495                                         ! for the minimum close to the root 
    496  
    497                 IF(zd > 0.) THEN        ! If the discriminant is positive 
    498                   zsqrtd = SQRT(zd) 
    499                   IF(za2 < 0) THEN 
    500                     zhmin = (-za2 + zsqrtd)/3. 
    501                   ELSE 
    502                     zhmin = -za1/(za2 + zsqrtd) 
    503                   ENDIF 
    504                   p_hini(ji,jj,jk) = zhmin + SQRT(-(za0 + zhmin*(za1 + zhmin*(za2 + zhmin)))/zsqrtd) 
    505                 ELSE 
    506                   p_hini(ji,jj,jk) = 1.e-7 
    507                 ENDIF 
    508              ! 
    509              ENDIF 
    510           END DO 
    511         END DO 
    512       END DO 
     498              zhmin = -za1/(za2 + zsqrtd) 
     499            ENDIF 
     500            p_hini(ji,jj,jk) = zhmin + SQRT(-(za0 + zhmin*(za1 + zhmin*(za2 + zhmin)))/zsqrtd) 
     501          ELSE 
     502            p_hini(ji,jj,jk) = 1.e-7 
     503          ENDIF 
     504       ! 
     505       ENDIF 
     506      END_3D 
    513507      ! 
    514508      IF( ln_timing )  CALL timing_stop('ahini_for_at') 
    … …  
    575569 
    576570   ! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree 
    577    DO jk = 1, jpk 
    578       DO jj = 1, jpj 
    579          DO ji = 1, jpi 
    580             IF (rmask(ji,jj,jk) == 1.) THEN 
    581                p_alktot = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 
    582                aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 
    583                zh_ini = p_hini(ji,jj,jk) 
    584  
    585                zdelta = (p_alktot-zalknw_inf(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 
    586  
    587                IF(p_alktot >= zalknw_inf(ji,jj,jk)) THEN 
    588                  zh_min(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_inf(ji,jj,jk) + SQRT(zdelta) ) 
    589                ELSE 
    590                  zh_min(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_inf(ji,jj,jk)) + SQRT(zdelta) ) / 2. 
    591                ENDIF 
    592  
    593                zdelta = (p_alktot-zalknw_sup(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 
    594  
    595                IF(p_alktot <= zalknw_sup(ji,jj,jk)) THEN 
    596                  zh_max(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_sup(ji,jj,jk)) + SQRT(zdelta) ) / 2. 
    597                ELSE 
    598                  zh_max(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_sup(ji,jj,jk) + SQRT(zdelta) ) 
    599                ENDIF 
    600  
    601                zhi(ji,jj,jk) = MAX(MIN(zh_max(ji,jj,jk), zh_ini), zh_min(ji,jj,jk)) 
     571   DO_3D_11_11( 1, jpk ) 
     572      IF (rmask(ji,jj,jk) == 1.) THEN 
     573         p_alktot = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 
     574         aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 
     575         zh_ini = p_hini(ji,jj,jk) 
     576 
     577         zdelta = (p_alktot-zalknw_inf(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 
     578 
     579         IF(p_alktot >= zalknw_inf(ji,jj,jk)) THEN 
     580           zh_min(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_inf(ji,jj,jk) + SQRT(zdelta) ) 
     581         ELSE 
     582           zh_min(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_inf(ji,jj,jk)) + SQRT(zdelta) ) / 2. 
     583         ENDIF 
     584 
     585         zdelta = (p_alktot-zalknw_sup(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 
     586 
     587         IF(p_alktot <= zalknw_sup(ji,jj,jk)) THEN 
     588           zh_max(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_sup(ji,jj,jk)) + SQRT(zdelta) ) / 2. 
     589         ELSE 
     590           zh_max(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_sup(ji,jj,jk) + SQRT(zdelta) ) 
     591         ENDIF 
     592 
     593         zhi(ji,jj,jk) = MAX(MIN(zh_max(ji,jj,jk), zh_ini), zh_min(ji,jj,jk)) 
     594      ENDIF 
     595   END_3D 
     596 
     597   zeqn_absmin(:,:,:) = HUGE(1._wp) 
     598 
     599   DO jn = 1, jp_maxniter_atgen  
     600   DO_3D_11_11( 1, jpk ) 
     601      IF (rmask(ji,jj,jk) == 1.) THEN 
     602         zfact = rhop(ji,jj,jk) / 1000. + rtrn 
     603         p_alktot = tr(ji,jj,jk,jptal,Kbb) / zfact 
     604         zdic  = tr(ji,jj,jk,jpdic,Kbb) / zfact 
     605         zbot  = borat(ji,jj,jk) 
     606         zpt = tr(ji,jj,jk,jppo4,Kbb) / zfact * po4r 
     607         zsit = tr(ji,jj,jk,jpsil,Kbb) / zfact 
     608         zst = sulfat (ji,jj,jk) 
     609         zft = fluorid(ji,jj,jk) 
     610         aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 
     611         zh = zhi(ji,jj,jk) 
     612         zh_prev = zh 
     613 
     614         ! H2CO3 - HCO3 - CO3 : n=2, m=0 
     615         znumer_dic = 2.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk) 
     616         zdenom_dic = ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*(ak13(ji,jj,jk) + zh) 
     617         zalk_dic   = zdic * (znumer_dic/zdenom_dic) 
     618         zdnumer_dic = ak13(ji,jj,jk)*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh     & 
     619                       *(4.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk)) 
     620         zdalk_dic   = -zdic*(zdnumer_dic/zdenom_dic**2) 
     621 
     622 
     623         ! B(OH)3 - B(OH)4 : n=1, m=0 
     624         znumer_bor = akb3(ji,jj,jk) 
     625         zdenom_bor = akb3(ji,jj,jk) + zh 
     626         zalk_bor   = zbot * (znumer_bor/zdenom_bor) 
     627         zdnumer_bor = akb3(ji,jj,jk) 
     628         zdalk_bor   = -zbot*(zdnumer_bor/zdenom_bor**2) 
     629 
     630 
     631         ! H3PO4 - H2PO4 - HPO4 - PO4 : n=3, m=1 
     632         znumer_po4 = 3.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  & 
     633         &            + zh*(2.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh* ak1p3(ji,jj,jk)) 
     634         zdenom_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)     & 
     635         &            + zh*( ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh*(ak1p3(ji,jj,jk) + zh)) 
     636         zalk_po4   = zpt * (znumer_po4/zdenom_po4 - 1.) ! Zero level of H3PO4 = 1 
     637         zdnumer_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  & 
     638         &             + zh*(4.*ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)         & 
     639         &             + zh*(9.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)                         & 
     640         &             + ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)                                & 
     641         &             + zh*(4.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh * ak1p3(ji,jj,jk) ) ) ) 
     642         zdalk_po4   = -zpt * (zdnumer_po4/zdenom_po4**2) 
     643 
     644         ! H4SiO4 - H3SiO4 : n=1, m=0 
     645         znumer_sil = aksi3(ji,jj,jk) 
     646         zdenom_sil = aksi3(ji,jj,jk) + zh 
     647         zalk_sil   = zsit * (znumer_sil/zdenom_sil) 
     648         zdnumer_sil = aksi3(ji,jj,jk) 
     649         zdalk_sil   = -zsit * (zdnumer_sil/zdenom_sil**2) 
     650 
     651         ! HSO4 - SO4 : n=1, m=1 
     652         aphscale = 1.0 + zst/aks3(ji,jj,jk) 
     653         znumer_so4 = aks3(ji,jj,jk) * aphscale 
     654         zdenom_so4 = aks3(ji,jj,jk) * aphscale + zh 
     655         zalk_so4   = zst * (znumer_so4/zdenom_so4 - 1.) 
     656         zdnumer_so4 = aks3(ji,jj,jk) 
     657         zdalk_so4   = -zst * (zdnumer_so4/zdenom_so4**2) 
     658 
     659         ! HF - F : n=1, m=1 
     660         znumer_flu =  akf3(ji,jj,jk) 
     661         zdenom_flu =  akf3(ji,jj,jk) + zh 
     662         zalk_flu   =  zft * (znumer_flu/zdenom_flu - 1.) 
     663         zdnumer_flu = akf3(ji,jj,jk) 
     664         zdalk_flu   = -zft * (zdnumer_flu/zdenom_flu**2) 
     665 
     666         ! H2O - OH 
     667         aphscale = 1.0 + zst/aks3(ji,jj,jk) 
     668         zalk_wat   = akw3(ji,jj,jk)/zh - zh/aphscale 
     669         zdalk_wat  = -akw3(ji,jj,jk)/zh**2 - 1./aphscale 
     670 
     671         ! CALCULATE [ALK]([CO3--], [HCO3-]) 
     672         zeqn = zalk_dic + zalk_bor + zalk_po4 + zalk_sil   & 
     673         &      + zalk_so4 + zalk_flu                       & 
     674         &      + zalk_wat - p_alktot 
     675 
     676         zalka = p_alktot - (zalk_bor + zalk_po4 + zalk_sil   & 
     677         &       + zalk_so4 + zalk_flu + zalk_wat) 
     678 
     679         zdeqndh = zdalk_dic + zdalk_bor + zdalk_po4 + zdalk_sil & 
     680         &         + zdalk_so4 + zdalk_flu + zdalk_wat 
     681 
     682         ! Adapt bracketing interval 
     683         IF(zeqn > 0._wp) THEN 
     684           zh_min(ji,jj,jk) = zh_prev 
     685         ELSEIF(zeqn < 0._wp) THEN 
     686           zh_max(ji,jj,jk) = zh_prev 
     687         ENDIF 
     688 
     689         IF(ABS(zeqn) >= 0.5_wp*zeqn_absmin(ji,jj,jk)) THEN 
     690         ! if the function evaluation at the current point is 
     691         ! not decreasing faster than with a bisection step (at least linearly) 
     692         ! in absolute value take one bisection step on [ph_min, ph_max] 
     693         ! ph_new = (ph_min + ph_max)/2d0 
     694         ! 
     695         ! In terms of [H]_new: 
     696         ! [H]_new = 10**(-ph_new) 
     697         !         = 10**(-(ph_min + ph_max)/2d0) 
     698         !         = SQRT(10**(-(ph_min + phmax))) 
     699         !         = SQRT(zh_max * zh_min) 
     700            zh = SQRT(zh_max(ji,jj,jk) * zh_min(ji,jj,jk)) 
     701            zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 
     702         ELSE 
     703         ! dzeqn/dpH = dzeqn/d[H] * d[H]/dpH 
     704         !           = -zdeqndh * LOG(10) * [H] 
     705         ! \Delta pH = -zeqn/(zdeqndh*d[H]/dpH) = zeqn/(zdeqndh*[H]*LOG(10)) 
     706         ! 
     707         ! pH_new = pH_old + \deltapH 
     708         ! 
     709         ! [H]_new = 10**(-pH_new) 
     710         !         = 10**(-pH_old - \Delta pH) 
     711         !         = [H]_old * 10**(-zeqn/(zdeqndh*[H]_old*LOG(10))) 
     712         !         = [H]_old * EXP(-LOG(10)*zeqn/(zdeqndh*[H]_old*LOG(10))) 
     713         !         = [H]_old * EXP(-zeqn/(zdeqndh*[H]_old)) 
     714 
     715            zh_lnfactor = -zeqn/(zdeqndh*zh_prev) 
     716 
     717            IF(ABS(zh_lnfactor) > pz_exp_threshold) THEN 
     718               zh          = zh_prev*EXP(zh_lnfactor) 
     719            ELSE 
     720               zh_delta    = zh_lnfactor*zh_prev 
     721               zh          = zh_prev + zh_delta 
    602722            ENDIF 
    603          END DO 
    604       END DO 
    605    END DO 
    606  
    607    zeqn_absmin(:,:,:) = HUGE(1._wp) 
    608  
    609    DO jn = 1, jp_maxniter_atgen  
    610    DO jk = 1, jpk 
    611       DO jj = 1, jpj 
    612          DO ji = 1, jpi 
    613             IF (rmask(ji,jj,jk) == 1.) THEN 
    614                zfact = rhop(ji,jj,jk) / 1000. + rtrn 
    615                p_alktot = tr(ji,jj,jk,jptal,Kbb) / zfact 
    616                zdic  = tr(ji,jj,jk,jpdic,Kbb) / zfact 
    617                zbot  = borat(ji,jj,jk) 
    618                zpt = tr(ji,jj,jk,jppo4,Kbb) / zfact * po4r 
    619                zsit = tr(ji,jj,jk,jpsil,Kbb) / zfact 
    620                zst = sulfat (ji,jj,jk) 
    621                zft = fluorid(ji,jj,jk) 
    622                aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 
    623                zh = zhi(ji,jj,jk) 
    624                zh_prev = zh 
    625  
    626                ! H2CO3 - HCO3 - CO3 : n=2, m=0 
    627                znumer_dic = 2.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk) 
    628                zdenom_dic = ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*(ak13(ji,jj,jk) + zh) 
    629                zalk_dic   = zdic * (znumer_dic/zdenom_dic) 
    630                zdnumer_dic = ak13(ji,jj,jk)*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh     & 
    631                              *(4.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk)) 
    632                zdalk_dic   = -zdic*(zdnumer_dic/zdenom_dic**2) 
    633  
    634  
    635                ! B(OH)3 - B(OH)4 : n=1, m=0 
    636                znumer_bor = akb3(ji,jj,jk) 
    637                zdenom_bor = akb3(ji,jj,jk) + zh 
    638                zalk_bor   = zbot * (znumer_bor/zdenom_bor) 
    639                zdnumer_bor = akb3(ji,jj,jk) 
    640                zdalk_bor   = -zbot*(zdnumer_bor/zdenom_bor**2) 
    641  
    642  
    643                ! H3PO4 - H2PO4 - HPO4 - PO4 : n=3, m=1 
    644                znumer_po4 = 3.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  & 
    645                &            + zh*(2.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh* ak1p3(ji,jj,jk)) 
    646                zdenom_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)     & 
    647                &            + zh*( ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh*(ak1p3(ji,jj,jk) + zh)) 
    648                zalk_po4   = zpt * (znumer_po4/zdenom_po4 - 1.) ! Zero level of H3PO4 = 1 
    649                zdnumer_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  & 
    650                &             + zh*(4.*ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)         & 
    651                &             + zh*(9.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)                         & 
    652                &             + ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)                                & 
    653                &             + zh*(4.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh * ak1p3(ji,jj,jk) ) ) ) 
    654                zdalk_po4   = -zpt * (zdnumer_po4/zdenom_po4**2) 
    655  
    656                ! H4SiO4 - H3SiO4 : n=1, m=0 
    657                znumer_sil = aksi3(ji,jj,jk) 
    658                zdenom_sil = aksi3(ji,jj,jk) + zh 
    659                zalk_sil   = zsit * (znumer_sil/zdenom_sil) 
    660                zdnumer_sil = aksi3(ji,jj,jk) 
    661                zdalk_sil   = -zsit * (zdnumer_sil/zdenom_sil**2) 
    662  
    663                ! HSO4 - SO4 : n=1, m=1 
    664                aphscale = 1.0 + zst/aks3(ji,jj,jk) 
    665                znumer_so4 = aks3(ji,jj,jk) * aphscale 
    666                zdenom_so4 = aks3(ji,jj,jk) * aphscale + zh 
    667                zalk_so4   = zst * (znumer_so4/zdenom_so4 - 1.) 
    668                zdnumer_so4 = aks3(ji,jj,jk) 
    669                zdalk_so4   = -zst * (zdnumer_so4/zdenom_so4**2) 
    670  
    671                ! HF - F : n=1, m=1 
    672                znumer_flu =  akf3(ji,jj,jk) 
    673                zdenom_flu =  akf3(ji,jj,jk) + zh 
    674                zalk_flu   =  zft * (znumer_flu/zdenom_flu - 1.) 
    675                zdnumer_flu = akf3(ji,jj,jk) 
    676                zdalk_flu   = -zft * (zdnumer_flu/zdenom_flu**2) 
    677  
    678                ! H2O - OH 
    679                aphscale = 1.0 + zst/aks3(ji,jj,jk) 
    680                zalk_wat   = akw3(ji,jj,jk)/zh - zh/aphscale 
    681                zdalk_wat  = -akw3(ji,jj,jk)/zh**2 - 1./aphscale 
    682  
    683                ! CALCULATE [ALK]([CO3--], [HCO3-]) 
    684                zeqn = zalk_dic + zalk_bor + zalk_po4 + zalk_sil   & 
    685                &      + zalk_so4 + zalk_flu                       & 
    686                &      + zalk_wat - p_alktot 
    687  
    688                zalka = p_alktot - (zalk_bor + zalk_po4 + zalk_sil   & 
    689                &       + zalk_so4 + zalk_flu + zalk_wat) 
    690  
    691                zdeqndh = zdalk_dic + zdalk_bor + zdalk_po4 + zdalk_sil & 
    692                &         + zdalk_so4 + zdalk_flu + zdalk_wat 
    693  
    694                ! Adapt bracketing interval 
    695                IF(zeqn > 0._wp) THEN 
    696                  zh_min(ji,jj,jk) = zh_prev 
    697                ELSEIF(zeqn < 0._wp) THEN 
    698                  zh_max(ji,jj,jk) = zh_prev 
    699                ENDIF 
    700  
    701                IF(ABS(zeqn) >= 0.5_wp*zeqn_absmin(ji,jj,jk)) THEN 
    702                ! if the function evaluation at the current point is 
    703                ! not decreasing faster than with a bisection step (at least linearly) 
    704                ! in absolute value take one bisection step on [ph_min, ph_max] 
    705                ! ph_new = (ph_min + ph_max)/2d0 
    706                ! 
     723 
     724            IF( zh < zh_min(ji,jj,jk) ) THEN 
     725               ! if [H]_new < [H]_min 
     726               ! i.e., if ph_new > ph_max then 
     727               ! take one bisection step on [ph_prev, ph_max] 
     728               ! ph_new = (ph_prev + ph_max)/2d0 
    707729               ! In terms of [H]_new: 
    708730               ! [H]_new = 10**(-ph_new) 
    709                !         = 10**(-(ph_min + ph_max)/2d0) 
    710                !         = SQRT(10**(-(ph_min + phmax))) 
    711                !         = SQRT(zh_max * zh_min) 
    712                   zh = SQRT(zh_max(ji,jj,jk) * zh_min(ji,jj,jk)) 
    713                   zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 
    714                ELSE 
    715                ! dzeqn/dpH = dzeqn/d[H] * d[H]/dpH 
    716                !           = -zdeqndh * LOG(10) * [H] 
    717                ! \Delta pH = -zeqn/(zdeqndh*d[H]/dpH) = zeqn/(zdeqndh*[H]*LOG(10)) 
    718                ! 
    719                ! pH_new = pH_old + \deltapH 
    720                ! 
    721                ! [H]_new = 10**(-pH_new) 
    722                !         = 10**(-pH_old - \Delta pH) 
    723                !         = [H]_old * 10**(-zeqn/(zdeqndh*[H]_old*LOG(10))) 
    724                !         = [H]_old * EXP(-LOG(10)*zeqn/(zdeqndh*[H]_old*LOG(10))) 
    725                !         = [H]_old * EXP(-zeqn/(zdeqndh*[H]_old)) 
    726  
    727                   zh_lnfactor = -zeqn/(zdeqndh*zh_prev) 
    728  
    729                   IF(ABS(zh_lnfactor) > pz_exp_threshold) THEN 
    730                      zh          = zh_prev*EXP(zh_lnfactor) 
    731                   ELSE 
    732                      zh_delta    = zh_lnfactor*zh_prev 
    733                      zh          = zh_prev + zh_delta 
    734                   ENDIF 
    735  
    736                   IF( zh < zh_min(ji,jj,jk) ) THEN 
    737                      ! if [H]_new < [H]_min 
    738                      ! i.e., if ph_new > ph_max then 
    739                      ! take one bisection step on [ph_prev, ph_max] 
    740                      ! ph_new = (ph_prev + ph_max)/2d0 
    741                      ! In terms of [H]_new: 
    742                      ! [H]_new = 10**(-ph_new) 
    743                      !         = 10**(-(ph_prev + ph_max)/2d0) 
    744                      !         = SQRT(10**(-(ph_prev + phmax))) 
    745                      !         = SQRT([H]_old*10**(-ph_max)) 
    746                      !         = SQRT([H]_old * zh_min) 
    747                      zh                = SQRT(zh_prev * zh_min(ji,jj,jk)) 
    748                      zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below 
    749                   ENDIF 
    750  
    751                   IF( zh > zh_max(ji,jj,jk) ) THEN 
    752                      ! if [H]_new > [H]_max 
    753                      ! i.e., if ph_new < ph_min, then 
    754                      ! take one bisection step on [ph_min, ph_prev] 
    755                      ! ph_new = (ph_prev + ph_min)/2d0 
    756                      ! In terms of [H]_new: 
    757                      ! [H]_new = 10**(-ph_new) 
    758                      !         = 10**(-(ph_prev + ph_min)/2d0) 
    759                      !         = SQRT(10**(-(ph_prev + ph_min))) 
    760                      !         = SQRT([H]_old*10**(-ph_min)) 
    761                      !         = SQRT([H]_old * zhmax) 
    762                      zh                = SQRT(zh_prev * zh_max(ji,jj,jk)) 
    763                      zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below 
    764                   ENDIF 
    765                ENDIF 
    766  
    767                zeqn_absmin(ji,jj,jk) = MIN( ABS(zeqn), zeqn_absmin(ji,jj,jk)) 
    768  
    769                ! Stop iterations once |\delta{[H]}/[H]| < rdel 
    770                ! <=> |(zh - zh_prev)/zh_prev| = |EXP(-zeqn/(zdeqndh*zh_prev)) -1| < rdel 
    771                ! |EXP(-zeqn/(zdeqndh*zh_prev)) -1| ~ |zeqn/(zdeqndh*zh_prev)| 
    772  
    773                ! Alternatively: 
    774                ! |\Delta pH| = |zeqn/(zdeqndh*zh_prev*LOG(10))| 
    775                !             ~ 1/LOG(10) * |\Delta [H]|/[H] 
    776                !             < 1/LOG(10) * rdel 
    777  
    778                ! Hence |zeqn/(zdeqndh*zh)| < rdel 
    779  
    780                ! rdel <-- pp_rdel_ah_target 
    781                l_exitnow = (ABS(zh_lnfactor) < pp_rdel_ah_target) 
    782  
    783                IF(l_exitnow) THEN  
    784                   rmask(ji,jj,jk) = 0. 
    785                ENDIF 
    786  
    787                zhi(ji,jj,jk) =  zh 
    788  
    789                IF(jn >= jp_maxniter_atgen) THEN 
    790                   zhi(ji,jj,jk) = -1._wp 
    791                ENDIF 
    792  
     731               !         = 10**(-(ph_prev + ph_max)/2d0) 
     732               !         = SQRT(10**(-(ph_prev + phmax))) 
     733               !         = SQRT([H]_old*10**(-ph_max)) 
     734               !         = SQRT([H]_old * zh_min) 
     735               zh                = SQRT(zh_prev * zh_min(ji,jj,jk)) 
     736               zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below 
    793737            ENDIF 
    794          END DO 
    795       END DO 
    796    END DO 
     738 
     739            IF( zh > zh_max(ji,jj,jk) ) THEN 
     740               ! if [H]_new > [H]_max 
     741               ! i.e., if ph_new < ph_min, then 
     742               ! take one bisection step on [ph_min, ph_prev] 
     743               ! ph_new = (ph_prev + ph_min)/2d0 
     744               ! In terms of [H]_new: 
     745               ! [H]_new = 10**(-ph_new) 
     746               !         = 10**(-(ph_prev + ph_min)/2d0) 
     747               !         = SQRT(10**(-(ph_prev + ph_min))) 
     748               !         = SQRT([H]_old*10**(-ph_min)) 
     749               !         = SQRT([H]_old * zhmax) 
     750               zh                = SQRT(zh_prev * zh_max(ji,jj,jk)) 
     751               zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below 
     752            ENDIF 
     753         ENDIF 
     754 
     755         zeqn_absmin(ji,jj,jk) = MIN( ABS(zeqn), zeqn_absmin(ji,jj,jk)) 
     756 
     757         ! Stop iterations once |\delta{[H]}/[H]| < rdel 
     758         ! <=> |(zh - zh_prev)/zh_prev| = |EXP(-zeqn/(zdeqndh*zh_prev)) -1| < rdel 
     759         ! |EXP(-zeqn/(zdeqndh*zh_prev)) -1| ~ |zeqn/(zdeqndh*zh_prev)| 
     760 
     761         ! Alternatively: 
     762         ! |\Delta pH| = |zeqn/(zdeqndh*zh_prev*LOG(10))| 
     763         !             ~ 1/LOG(10) * |\Delta [H]|/[H] 
     764         !             < 1/LOG(10) * rdel 
     765 
     766         ! Hence |zeqn/(zdeqndh*zh)| < rdel 
     767 
     768         ! rdel <-- pp_rdel_ah_target 
     769         l_exitnow = (ABS(zh_lnfactor) < pp_rdel_ah_target) 
     770 
     771         IF(l_exitnow) THEN  
     772            rmask(ji,jj,jk) = 0. 
     773         ENDIF 
     774 
     775         zhi(ji,jj,jk) =  zh 
     776 
     777         IF(jn >= jp_maxniter_atgen) THEN 
     778            zhi(ji,jj,jk) = -1._wp 
     779         ENDIF 
     780 
     781      ENDIF 
     782   END_3D 
    797783   END DO 
    798784   ! 

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

    r12258 r12340  
    3131   REAL(wp), PUBLIC ::   kfep         !: rate constant for nanoparticle formation 
    3232 
     33   !! * Substitutions 
     34#  include "do_loop_substitute.h90" 
    3335   !!---------------------------------------------------------------------- 
    3436   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    8991      ! Chemistry is supposed to be fast enough to be at equilibrium 
    9092      ! ------------------------------------------------------------ 
    91       DO jk = 1, jpkm1 
    92          DO jj = 1, jpj 
    93             DO ji = 1, jpi 
    94                zTL1(ji,jj,jk)  = ztotlig(ji,jj,jk) 
    95                zkeq            = fekeq(ji,jj,jk) 
    96                zfesatur        = zTL1(ji,jj,jk) * 1E-9 
    97                ztfe            = tr(ji,jj,jk,jpfer,Kbb)  
    98                ! Fe' is the root of a 2nd order polynom 
    99                zFe3 (ji,jj,jk) = ( -( 1. + zfesatur * zkeq - zkeq * ztfe )               & 
    100                   &              + SQRT( ( 1. + zfesatur * zkeq - zkeq * ztfe )**2       & 
    101                   &              + 4. * ztfe * zkeq) ) / ( 2. * zkeq ) 
    102                zFe3 (ji,jj,jk) = zFe3(ji,jj,jk) * 1E9 
    103                zFeL1(ji,jj,jk) = MAX( 0., tr(ji,jj,jk,jpfer,Kbb) * 1E9 - zFe3(ji,jj,jk) ) 
    104            END DO 
    105          END DO 
    106       END DO 
     93      DO_3D_11_11( 1, jpkm1 ) 
     94         zTL1(ji,jj,jk)  = ztotlig(ji,jj,jk) 
     95         zkeq            = fekeq(ji,jj,jk) 
     96         zfesatur        = zTL1(ji,jj,jk) * 1E-9 
     97         ztfe            = tr(ji,jj,jk,jpfer,Kbb)  
     98         ! Fe' is the root of a 2nd order polynom 
     99         zFe3 (ji,jj,jk) = ( -( 1. + zfesatur * zkeq - zkeq * ztfe )               & 
     100            &              + SQRT( ( 1. + zfesatur * zkeq - zkeq * ztfe )**2       & 
     101            &              + 4. * ztfe * zkeq) ) / ( 2. * zkeq ) 
     102         zFe3 (ji,jj,jk) = zFe3(ji,jj,jk) * 1E9 
     103         zFeL1(ji,jj,jk) = MAX( 0., tr(ji,jj,jk,jpfer,Kbb) * 1E9 - zFe3(ji,jj,jk) ) 
     104      END_3D 
    107105         ! 
    108106 
    109107      zdust = 0.         ! if no dust available 
    110       DO jk = 1, jpkm1 
    111          DO jj = 1, jpj 
    112             DO ji = 1, jpi 
    113                ! Scavenging rate of iron. This scavenging rate depends on the load of particles of sea water.  
    114                ! This parameterization assumes a simple second order kinetics (k[Particles][Fe]). 
    115                ! Scavenging onto dust is also included as evidenced from the DUNE experiments. 
    116                ! -------------------------------------------------------------------------------------- 
    117                zhplus  = max( rtrn, hi(ji,jj,jk) ) 
    118                fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  & 
    119                &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     & 
    120                &         + fesol(ji,jj,jk,5) / zhplus ) 
    121                ! 
    122                zfeequi = zFe3(ji,jj,jk) * 1E-9 
    123                zhplus  = max( rtrn, hi(ji,jj,jk) ) 
    124                fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  & 
    125                   &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     & 
    126                   &         + fesol(ji,jj,jk,5) / zhplus ) 
    127                zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9 
    128                ! precipitation of Fe3+, creation of nanoparticles 
    129                precip(ji,jj,jk) = MAX( 0., ( zFe3(ji,jj,jk) * 1E-9 - fe3sol ) ) * kfep * xstep 
    130                ! 
    131                ztrc   = ( 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  
    132                IF( ll_dust )  zdust  = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) & 
    133                &  * EXP( -gdept(ji,jj,jk,Kmm) / 540. ) 
    134                IF (ln_ligand) THEN 
    135                   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 ) )) 
    136                ELSE 
    137                   zxlam  = xlam1 * 1.0 
    138                ENDIF 
    139                zlam1b = 3.e-5 + xlamdust * zdust + zxlam * ztrc 
    140                zscave = zfeequi * zlam1b * xstep 
    141  
    142                ! Compute the different ratios for scavenging of iron 
    143                ! to later allocate scavenged iron to the different organic pools 
    144                ! --------------------------------------------------------- 
    145                zdenom1 = zxlam * tr(ji,jj,jk,jppoc,Kbb) / zlam1b 
    146                zdenom2 = zxlam * tr(ji,jj,jk,jpgoc,Kbb) / zlam1b 
    147  
    148                !  Increased scavenging for very high iron concentrations found near the coasts  
    149                !  due to increased lithogenic particles and let say it is unknown processes (precipitation, ...) 
    150                !  ----------------------------------------------------------- 
    151                zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 
    152                zlamfac = MIN( 1.  , zlamfac ) 
    153                zdep    = MIN( 1., 1000. / gdept(ji,jj,jk,Kmm) ) 
    154                zcoag   = 1E-4 * ( 1. - zlamfac ) * zdep * xstep * tr(ji,jj,jk,jpfer,Kbb) 
    155  
    156                !  Compute the coagulation of colloidal iron. This parameterization  
    157                !  could be thought as an equivalent of colloidal pumping. 
    158                !  It requires certainly some more work as it is very poorly constrained. 
    159                !  ---------------------------------------------------------------- 
    160                zlam1a   = ( 0.369  * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4  * tr(ji,jj,jk,jppoc,Kbb) ) * xdiss(ji,jj,jk)    & 
    161                    &      + ( 114.   * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) ) 
    162                zaggdfea = zlam1a * xstep * zfecoll 
    163                ! 
    164                zlam1b   = 3.53E3 * tr(ji,jj,jk,jpgoc,Kbb) * xdiss(ji,jj,jk) 
    165                zaggdfeb = zlam1b * xstep * zfecoll 
    166                ! 
    167                tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zscave - zaggdfea - zaggdfeb & 
    168                &                     - zcoag - precip(ji,jj,jk) 
    169                tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zscave * zdenom1 + zaggdfea 
    170                tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zscave * zdenom2 + zaggdfeb 
    171                zscav3d(ji,jj,jk)   = zscave 
    172                zcoll3d(ji,jj,jk)   = zaggdfea + zaggdfeb 
    173                ! 
    174             END DO 
    175          END DO 
    176       END DO 
     108      DO_3D_11_11( 1, jpkm1 ) 
     109         ! Scavenging rate of iron. This scavenging rate depends on the load of particles of sea water.  
     110         ! This parameterization assumes a simple second order kinetics (k[Particles][Fe]). 
     111         ! Scavenging onto dust is also included as evidenced from the DUNE experiments. 
     112         ! -------------------------------------------------------------------------------------- 
     113         zhplus  = max( rtrn, hi(ji,jj,jk) ) 
     114         fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  & 
     115         &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     & 
     116         &         + fesol(ji,jj,jk,5) / zhplus ) 
     117         ! 
     118         zfeequi = zFe3(ji,jj,jk) * 1E-9 
     119         zhplus  = max( rtrn, hi(ji,jj,jk) ) 
     120         fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  & 
     121            &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     & 
     122            &         + fesol(ji,jj,jk,5) / zhplus ) 
     123         zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9 
     124         ! precipitation of Fe3+, creation of nanoparticles 
     125         precip(ji,jj,jk) = MAX( 0., ( zFe3(ji,jj,jk) * 1E-9 - fe3sol ) ) * kfep * xstep 
     126         ! 
     127         ztrc   = ( tr(ji,jj,jk,jppoc,Kbb) + tr(ji,jj,jk,jpgoc,Kbb) + tr(ji,jj,jk,jpcal,Kbb) + tr(ji,jj,jk,jpgsi,Kbb) ) * 1.e6  
     128         IF( ll_dust )  zdust  = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) & 
     129         &  * EXP( -gdept(ji,jj,jk,Kmm) / 540. ) 
     130         IF (ln_ligand) THEN 
     131            zxlam  = xlam1 * MAX( 1.E-3, EXP(-2 * etot(ji,jj,jk) / 10. ) * (1. - EXP(-2 * tr(ji,jj,jk,jpoxy,Kbb) / 100.E-6 ) )) 
     132         ELSE 
     133            zxlam  = xlam1 * 1.0 
     134         ENDIF 
     135         zlam1b = 3.e-5 + xlamdust * zdust + zxlam * ztrc 
     136         zscave = zfeequi * zlam1b * xstep 
     137 
     138         ! Compute the different ratios for scavenging of iron 
     139         ! to later allocate scavenged iron to the different organic pools 
     140         ! --------------------------------------------------------- 
     141         zdenom1 = zxlam * tr(ji,jj,jk,jppoc,Kbb) / zlam1b 
     142         zdenom2 = zxlam * tr(ji,jj,jk,jpgoc,Kbb) / zlam1b 
     143 
     144         !  Increased scavenging for very high iron concentrations found near the coasts  
     145         !  due to increased lithogenic particles and let say it is unknown processes (precipitation, ...) 
     146         !  ----------------------------------------------------------- 
     147         zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 
     148         zlamfac = MIN( 1.  , zlamfac ) 
     149         zdep    = MIN( 1., 1000. / gdept(ji,jj,jk,Kmm) ) 
     150         zcoag   = 1E-4 * ( 1. - zlamfac ) * zdep * xstep * tr(ji,jj,jk,jpfer,Kbb) 
     151 
     152         !  Compute the coagulation of colloidal iron. This parameterization  
     153         !  could be thought as an equivalent of colloidal pumping. 
     154         !  It requires certainly some more work as it is very poorly constrained. 
     155         !  ---------------------------------------------------------------- 
     156         zlam1a   = ( 0.369  * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4  * tr(ji,jj,jk,jppoc,Kbb) ) * xdiss(ji,jj,jk)    & 
     157             &      + ( 114.   * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) ) 
     158         zaggdfea = zlam1a * xstep * zfecoll 
     159         ! 
     160         zlam1b   = 3.53E3 * tr(ji,jj,jk,jpgoc,Kbb) * xdiss(ji,jj,jk) 
     161         zaggdfeb = zlam1b * xstep * zfecoll 
     162         ! 
     163         tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zscave - zaggdfea - zaggdfeb & 
     164         &                     - zcoag - precip(ji,jj,jk) 
     165         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zscave * zdenom1 + zaggdfea 
     166         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zscave * zdenom2 + zaggdfeb 
     167         zscav3d(ji,jj,jk)   = zscave 
     168         zcoll3d(ji,jj,jk)   = zaggdfea + zaggdfeb 
     169         ! 
     170      END_3D 
    177171      ! 
    178172      !  Define the bioavailable fraction of iron 
    … …  
    182176      IF( ln_ligand ) THEN 
    183177         ! 
    184          DO jk = 1, jpkm1 
    185             DO jj = 1, jpj 
    186                DO ji = 1, jpi 
    187                   zlam1a   = ( 0.369  * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4  * tr(ji,jj,jk,jppoc,Kbb) ) * xdiss(ji,jj,jk)    & 
    188                       &    + ( 114.   * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) ) 
    189                   ! 
    190                   zlam1b   = 3.53E3 *   tr(ji,jj,jk,jpgoc,Kbb) * xdiss(ji,jj,jk) 
    191                   zligco   = 0.5 * tr(ji,jj,jk,jplgw,Kmm) 
    192                   zaggliga = zlam1a * xstep * zligco 
    193                   zaggligb = zlam1b * xstep * zligco 
    194                   tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) - zaggliga - zaggligb 
    195                   zlcoll3d(ji,jj,jk)  = zaggliga + zaggligb 
    196                END DO 
    197             END DO 
    198          END DO 
     178         DO_3D_11_11( 1, jpkm1 ) 
     179            zlam1a   = ( 0.369  * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4  * tr(ji,jj,jk,jppoc,Kbb) ) * xdiss(ji,jj,jk)    & 
     180                &    + ( 114.   * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) ) 
     181            ! 
     182            zlam1b   = 3.53E3 *   tr(ji,jj,jk,jpgoc,Kbb) * xdiss(ji,jj,jk) 
     183            zligco   = 0.5 * tr(ji,jj,jk,jplgw,Kmm) 
     184            zaggliga = zlam1a * xstep * zligco 
     185            zaggligb = zlam1b * xstep * zligco 
     186            tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) - zaggliga - zaggligb 
     187            zlcoll3d(ji,jj,jk)  = zaggliga + zaggligb 
     188         END_3D 
    199189         ! 
    200190         plig(:,:,:) =  MAX( 0., ( ( zFeL1(:,:,:) * 1E-9 ) / ( tr(:,:,:,jpfer,Kbb) +rtrn ) ) ) 

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

    r12258 r12340  
    5252   REAL(wp) ::   xconv  = 0.01_wp / 3600._wp   !: coefficients for conversion  
    5353 
     54   !! * Substitutions 
     55#  include "do_loop_substitute.h90" 
    5456   !!---------------------------------------------------------------------- 
    5557   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    107109      IF( l_co2cpl )   satmco2(:,:) = atm_co2(:,:) 
    108110 
    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  = tr(ji,jj,1,jpdic,Kbb) 
    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 
     111      DO_2D_11_11 
     112         ! DUMMY VARIABLES FOR DIC, H+, AND BORATE 
     113         zfact = rhop(ji,jj,1) / 1000. + rtrn 
     114         zdic  = tr(ji,jj,1,jpdic,Kbb) 
     115         zph   = MAX( hi(ji,jj,1), 1.e-10 ) / zfact 
     116         ! CALCULATE [H2CO3] 
     117         zh2co3(ji,jj) = zdic/(1. + ak13(ji,jj,1)/zph + ak13(ji,jj,1)*ak23(ji,jj,1)/zph**2) 
     118      END_2D 
    119119 
    120120      ! -------------- 
    … …  
    125125      ! ------------------------------------------- 
    126126 
    127       DO jj = 1, jpj 
    128          DO ji = 1, jpi 
    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 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 ) * tmask(ji,jj,1)  
    163             ! compute the trend 
    164             tr(ji,jj,1,jpdic,Krhs) = tr(ji,jj,1,jpdic,Krhs) + oce_co2(ji,jj) * rfact2 / e3t(ji,jj,1,Kmm) 
    165  
    166             ! Compute O2 flux  
    167             zfld16 = patm(ji,jj) * chemo2(ji,jj,1) * zkgo2(ji,jj)          ! (mol/L) * (m/s) 
    168             zflu16 = tr(ji,jj,1,jpoxy,Kbb) * zkgo2(ji,jj) 
    169             zoflx(ji,jj) = ( zfld16 - zflu16 ) * tmask(ji,jj,1) 
    170             tr(ji,jj,1,jpoxy,Krhs) = tr(ji,jj,1,jpoxy,Krhs) + zoflx(ji,jj) * rfact2 / e3t(ji,jj,1,Kmm) 
    171          END DO 
    172       END DO 
     127      DO_2D_11_11 
     128         ztc  = MIN( 35., ts(ji,jj,1,jp_tem,Kmm) ) 
     129         ztc2 = ztc * ztc 
     130         ztc3 = ztc * ztc2  
     131         ztc4 = ztc2 * ztc2  
     132         ! Compute the schmidt Number both O2 and CO2 
     133         zsch_co2 = 2116.8 - 136.25 * ztc + 4.7353 * ztc2 - 0.092307 * ztc3 + 0.0007555 * ztc4 
     134         zsch_o2  = 1920.4 - 135.6  * ztc + 5.2122 * ztc2 - 0.109390 * ztc3 + 0.0009377 * ztc4 
     135         !  wind speed  
     136         zws  = wndm(ji,jj) * wndm(ji,jj) 
     137         ! Compute the piston velocity for O2 and CO2 
     138         zkgwan = 0.251 * zws 
     139         zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) 
     140         ! compute gas exchange for CO2 and O2 
     141         zkgco2(ji,jj) = zkgwan * SQRT( 660./ zsch_co2 ) 
     142         zkgo2 (ji,jj) = zkgwan * SQRT( 660./ zsch_o2 ) 
     143      END_2D 
     144 
     145 
     146      DO_2D_11_11 
     147         ztkel = tempis(ji,jj,1) + 273.15 
     148         zsal  = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35. 
     149         zvapsw    = EXP(24.4543 - 67.4509*(100.0/ztkel) - 4.8489*LOG(ztkel/100) - 0.000544*zsal) 
     150         zpco2atm(ji,jj) = satmco2(ji,jj) * ( patm(ji,jj) - zvapsw ) 
     151         zxc2      = ( 1.0 - zpco2atm(ji,jj) * 1E-6 )**2 
     152         zfugcoeff = EXP( patm(ji,jj) * (chemc(ji,jj,2) + 2.0 * zxc2 * chemc(ji,jj,3) )   & 
     153         &           / ( 82.05736 * ztkel )) 
     154         zfco2 = zpco2atm(ji,jj) * zfugcoeff 
     155 
     156         ! Compute CO2 flux for the sea and air 
     157         zfld = zfco2 * chemc(ji,jj,1) * zkgco2(ji,jj)  ! (mol/L) * (m/s) 
     158         zflu = zh2co3(ji,jj) * zkgco2(ji,jj)                                   ! (mol/L) (m/s) ? 
     159         oce_co2(ji,jj) = ( zfld - zflu ) * tmask(ji,jj,1)  
     160         ! compute the trend 
     161         tr(ji,jj,1,jpdic,Krhs) = tr(ji,jj,1,jpdic,Krhs) + oce_co2(ji,jj) * rfact2 / e3t(ji,jj,1,Kmm) 
     162 
     163         ! Compute O2 flux  
     164         zfld16 = patm(ji,jj) * chemo2(ji,jj,1) * zkgo2(ji,jj)          ! (mol/L) * (m/s) 
     165         zflu16 = tr(ji,jj,1,jpoxy,Kbb) * zkgo2(ji,jj) 
     166         zoflx(ji,jj) = ( zfld16 - zflu16 ) * tmask(ji,jj,1) 
     167         tr(ji,jj,1,jpoxy,Krhs) = tr(ji,jj,1,jpoxy,Krhs) + zoflx(ji,jj) * rfact2 / e3t(ji,jj,1,Kmm) 
     168      END_2D 
    173169 
    174170      IF( iom_use("tcflx") .OR. iom_use("tcflxcum") .OR. kt == nitrst   & 

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zligand.F90

    r12258 r12340  
    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) 
    … …  
    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 * (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 DO 
    74          END DO 
    75       END DO 
     54      DO_3D_11_11( 1, jpkm1 ) 
     55         ! 
     56         ! ------------------------------------------------------------------ 
     57         ! Remineralization of iron ligands 
     58         ! ------------------------------------------------------------------ 
     59         ! production from remineralisation of organic matter 
     60         zlgwp = orem(ji,jj,jk) * rlig 
     61         ! decay of weak ligand 
     62         ! This is based on the idea that as LGW is lower 
     63         ! there is a larger fraction of refractory OM 
     64         zlgwr = max( rlgs , rlgw * exp( -2 * (tr(ji,jj,jk,jplgw,Kbb)*1e9) ) ) ! years 
     65         zlgwr = 1. / zlgwr * tgfunc(ji,jj,jk) * ( xstep / nyear_len(1) ) * blim(ji,jj,jk) * tr(ji,jj,jk,jplgw,Kbb) 
     66         ! photochem loss of weak ligand 
     67         zlgwpr = prlgw * xstep * etot(ji,jj,jk) * tr(ji,jj,jk,jplgw,Kbb) * (1. - fr_i(ji,jj)) 
     68         tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zlgwp - zlgwr - zlgwpr 
     69         zligrem(ji,jj,jk)   = zlgwr 
     70         zligpr(ji,jj,jk)    = zlgwpr 
     71         zligprod(ji,jj,jk) = zlgwp 
     72         ! 
     73      END_3D 
    7674      ! 
    7775      !  Output of some diagnostics variables 

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

    r12258 r12340  
    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) 
    … …  
    9698      IF( ln_timing )   CALL timing_start('p4z_lim') 
    9799      ! 
    98       DO jk = 1, jpkm1 
    99          DO jj = 1, jpj 
    100             DO ji = 1, jpi 
    101                 
    102                ! Tuning of the iron concentration to a minimum level that is set to the detection limit 
    103                !------------------------------------- 
    104                zno3    = tr(ji,jj,jk,jpno3,Kbb) / 40.e-6 
    105                zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 ) 
    106                zferlim = MIN( zferlim, 7e-11 ) 
    107                tr(ji,jj,jk,jpfer,Kbb) = MAX( tr(ji,jj,jk,jpfer,Kbb), zferlim ) 
    108  
    109                ! Computation of a variable Ks for iron on diatoms taking into account 
    110                ! that increasing biomass is made of generally bigger cells 
    111                !------------------------------------------------ 
    112                zconcd   = MAX( 0.e0 , tr(ji,jj,jk,jpdia,Kbb) - xsizedia ) 
    113                zconcd2  = tr(ji,jj,jk,jpdia,Kbb) - zconcd 
    114                zconcn   = MAX( 0.e0 , tr(ji,jj,jk,jpphy,Kbb) - xsizephy ) 
    115                zconcn2  = tr(ji,jj,jk,jpphy,Kbb) - zconcn 
    116                z1_trbphy   = 1. / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
    117                z1_trbdia   = 1. / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
    118  
    119                concdfe(ji,jj,jk) = MAX( concdfer, ( zconcd2 * concdfer + concdfer * xsizerd * zconcd ) * z1_trbdia ) 
    120                zconc1d           = MAX( concdno3, ( zconcd2 * concdno3 + concdno3 * xsizerd * zconcd ) * z1_trbdia ) 
    121                zconc1dnh4        = MAX( concdnh4, ( zconcd2 * concdnh4 + concdnh4 * xsizerd * zconcd ) * z1_trbdia ) 
    122  
    123                concnfe(ji,jj,jk) = MAX( concnfer, ( zconcn2 * concnfer + concnfer * xsizern * zconcn ) * z1_trbphy ) 
    124                zconc0n           = MAX( concnno3, ( zconcn2 * concnno3 + concnno3 * xsizern * zconcn ) * z1_trbphy ) 
    125                zconc0nnh4        = MAX( concnnh4, ( zconcn2 * concnnh4 + concnnh4 * xsizern * zconcn ) * z1_trbphy ) 
    126  
    127                ! Michaelis-Menten Limitation term for nutrients Small bacteria 
    128                ! ------------------------------------------------------------- 
    129                zdenom = 1. /  ( concbno3 * concbnh4 + concbnh4 * tr(ji,jj,jk,jpno3,Kbb) + concbno3 * tr(ji,jj,jk,jpnh4,Kbb) ) 
    130                xnanono3(ji,jj,jk) = tr(ji,jj,jk,jpno3,Kbb) * concbnh4 * zdenom 
    131                xnanonh4(ji,jj,jk) = tr(ji,jj,jk,jpnh4,Kbb) * concbno3 * zdenom 
    132                ! 
    133                zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 
    134                zlim2    = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concbnh4 ) 
    135                zlim3    = tr(ji,jj,jk,jpfer,Kbb) / ( concbfe + tr(ji,jj,jk,jpfer,Kbb) ) 
    136                zlim4    = tr(ji,jj,jk,jpdoc,Kbb) / ( xkdoc   + tr(ji,jj,jk,jpdoc,Kbb) ) 
    137                xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 
    138                xlimbac (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4 
    139  
    140                ! Michaelis-Menten Limitation term for nutrients Small flagellates 
    141                ! ----------------------------------------------- 
    142                zdenom = 1. /  ( zconc0n * zconc0nnh4 + zconc0nnh4 * tr(ji,jj,jk,jpno3,Kbb) + zconc0n * tr(ji,jj,jk,jpnh4,Kbb) ) 
    143                xnanono3(ji,jj,jk) = tr(ji,jj,jk,jpno3,Kbb) * zconc0nnh4 * zdenom 
    144                xnanonh4(ji,jj,jk) = tr(ji,jj,jk,jpnh4,Kbb) * zconc0n    * zdenom 
    145                ! 
    146                zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 
    147                zlim2    = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zconc0nnh4 ) 
    148                zratio   = tr(ji,jj,jk,jpnfe,Kbb) * z1_trbphy  
    149                zironmin = xcoef1 * tr(ji,jj,jk,jpnch,Kbb) * z1_trbphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk) 
    150                zlim3    = MAX( 0.,( zratio - zironmin ) / qnfelim ) 
    151                xnanopo4(ji,jj,jk) = zlim2 
    152                xlimnfe (ji,jj,jk) = MIN( 1., zlim3 ) 
    153                xlimphy (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 
    154                ! 
    155                !   Michaelis-Menten Limitation term for nutrients Diatoms 
    156                !   ---------------------------------------------- 
    157                zdenom   = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * tr(ji,jj,jk,jpno3,Kbb) + zconc1d * tr(ji,jj,jk,jpnh4,Kbb) ) 
    158                xdiatno3(ji,jj,jk) = tr(ji,jj,jk,jpno3,Kbb) * zconc1dnh4 * zdenom 
    159                xdiatnh4(ji,jj,jk) = tr(ji,jj,jk,jpnh4,Kbb) * zconc1d    * zdenom 
    160                ! 
    161                zlim1    = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 
    162                zlim2    = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zconc1dnh4  ) 
    163                zlim3    = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi(ji,jj) ) 
    164                zratio   = tr(ji,jj,jk,jpdfe,Kbb) * z1_trbdia 
    165                zironmin = xcoef1 * tr(ji,jj,jk,jpdch,Kbb) * z1_trbdia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk) 
    166                zlim4    = MAX( 0., ( zratio - zironmin ) / qdfelim ) 
    167                xdiatpo4(ji,jj,jk) = zlim2 
    168                xlimdfe (ji,jj,jk) = MIN( 1., zlim4 ) 
    169                xlimdia (ji,jj,jk) = MIN( zlim1, zlim2, zlim3, zlim4 ) 
    170                xlimsi  (ji,jj,jk) = MIN( zlim1, zlim2, zlim4 ) 
    171            END DO 
    172          END DO 
    173       END DO 
     100      DO_3D_11_11( 1, jpkm1 ) 
     101          
     102         ! Tuning of the iron concentration to a minimum level that is set to the detection limit 
     103         !------------------------------------- 
     104         zno3    = tr(ji,jj,jk,jpno3,Kbb) / 40.e-6 
     105         zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 ) 
     106         zferlim = MIN( zferlim, 7e-11 ) 
     107         tr(ji,jj,jk,jpfer,Kbb) = MAX( tr(ji,jj,jk,jpfer,Kbb), zferlim ) 
     108 
     109         ! Computation of a variable Ks for iron on diatoms taking into account 
     110         ! that increasing biomass is made of generally bigger cells 
     111         !------------------------------------------------ 
     112         zconcd   = MAX( 0.e0 , tr(ji,jj,jk,jpdia,Kbb) - xsizedia ) 
     113         zconcd2  = tr(ji,jj,jk,jpdia,Kbb) - zconcd 
     114         zconcn   = MAX( 0.e0 , tr(ji,jj,jk,jpphy,Kbb) - xsizephy ) 
     115         zconcn2  = tr(ji,jj,jk,jpphy,Kbb) - zconcn 
     116         z1_trbphy   = 1. / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
     117         z1_trbdia   = 1. / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     118 
     119         concdfe(ji,jj,jk) = MAX( concdfer, ( zconcd2 * concdfer + concdfer * xsizerd * zconcd ) * z1_trbdia ) 
     120         zconc1d           = MAX( concdno3, ( zconcd2 * concdno3 + concdno3 * xsizerd * zconcd ) * z1_trbdia ) 
     121         zconc1dnh4        = MAX( concdnh4, ( zconcd2 * concdnh4 + concdnh4 * xsizerd * zconcd ) * z1_trbdia ) 
     122 
     123         concnfe(ji,jj,jk) = MAX( concnfer, ( zconcn2 * concnfer + concnfer * xsizern * zconcn ) * z1_trbphy ) 
     124         zconc0n           = MAX( concnno3, ( zconcn2 * concnno3 + concnno3 * xsizern * zconcn ) * z1_trbphy ) 
     125         zconc0nnh4        = MAX( concnnh4, ( zconcn2 * concnnh4 + concnnh4 * xsizern * zconcn ) * z1_trbphy ) 
     126 
     127         ! Michaelis-Menten Limitation term for nutrients Small bacteria 
     128         ! ------------------------------------------------------------- 
     129         zdenom = 1. /  ( concbno3 * concbnh4 + concbnh4 * tr(ji,jj,jk,jpno3,Kbb) + concbno3 * tr(ji,jj,jk,jpnh4,Kbb) ) 
     130         xnanono3(ji,jj,jk) = tr(ji,jj,jk,jpno3,Kbb) * concbnh4 * zdenom 
     131         xnanonh4(ji,jj,jk) = tr(ji,jj,jk,jpnh4,Kbb) * concbno3 * zdenom 
     132         ! 
     133         zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 
     134         zlim2    = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concbnh4 ) 
     135         zlim3    = tr(ji,jj,jk,jpfer,Kbb) / ( concbfe + tr(ji,jj,jk,jpfer,Kbb) ) 
     136         zlim4    = tr(ji,jj,jk,jpdoc,Kbb) / ( xkdoc   + tr(ji,jj,jk,jpdoc,Kbb) ) 
     137         xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 
     138         xlimbac (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4 
     139 
     140         ! Michaelis-Menten Limitation term for nutrients Small flagellates 
     141         ! ----------------------------------------------- 
     142         zdenom = 1. /  ( zconc0n * zconc0nnh4 + zconc0nnh4 * tr(ji,jj,jk,jpno3,Kbb) + zconc0n * tr(ji,jj,jk,jpnh4,Kbb) ) 
     143         xnanono3(ji,jj,jk) = tr(ji,jj,jk,jpno3,Kbb) * zconc0nnh4 * zdenom 
     144         xnanonh4(ji,jj,jk) = tr(ji,jj,jk,jpnh4,Kbb) * zconc0n    * zdenom 
     145         ! 
     146         zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 
     147         zlim2    = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zconc0nnh4 ) 
     148         zratio   = tr(ji,jj,jk,jpnfe,Kbb) * z1_trbphy  
     149         zironmin = xcoef1 * tr(ji,jj,jk,jpnch,Kbb) * z1_trbphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk) 
     150         zlim3    = MAX( 0.,( zratio - zironmin ) / qnfelim ) 
     151         xnanopo4(ji,jj,jk) = zlim2 
     152         xlimnfe (ji,jj,jk) = MIN( 1., zlim3 ) 
     153         xlimphy (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 
     154         ! 
     155         !   Michaelis-Menten Limitation term for nutrients Diatoms 
     156         !   ---------------------------------------------- 
     157         zdenom   = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * tr(ji,jj,jk,jpno3,Kbb) + zconc1d * tr(ji,jj,jk,jpnh4,Kbb) ) 
     158         xdiatno3(ji,jj,jk) = tr(ji,jj,jk,jpno3,Kbb) * zconc1dnh4 * zdenom 
     159         xdiatnh4(ji,jj,jk) = tr(ji,jj,jk,jpnh4,Kbb) * zconc1d    * zdenom 
     160         ! 
     161         zlim1    = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 
     162         zlim2    = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zconc1dnh4  ) 
     163         zlim3    = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi(ji,jj) ) 
     164         zratio   = tr(ji,jj,jk,jpdfe,Kbb) * z1_trbdia 
     165         zironmin = xcoef1 * tr(ji,jj,jk,jpdch,Kbb) * z1_trbdia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk) 
     166         zlim4    = MAX( 0., ( zratio - zironmin ) / qdfelim ) 
     167         xdiatpo4(ji,jj,jk) = zlim2 
     168         xlimdfe (ji,jj,jk) = MIN( 1., zlim4 ) 
     169         xlimdia (ji,jj,jk) = MIN( zlim1, zlim2, zlim3, zlim4 ) 
     170         xlimsi  (ji,jj,jk) = MIN( zlim1, zlim2, zlim4 ) 
     171      END_3D 
    174172 
    175173      ! Compute the fraction of nanophytoplankton that is made of calcifiers 
    176174      ! -------------------------------------------------------------------- 
    177       DO jk = 1, jpkm1 
    178          DO jj = 1, jpj 
    179             DO ji = 1, jpi 
    180                zlim1 =  ( tr(ji,jj,jk,jpno3,Kbb) * concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) * concnno3 )    & 
    181                   &   / ( concnno3 * concnnh4 + concnnh4 * tr(ji,jj,jk,jpno3,Kbb) + concnno3 * tr(ji,jj,jk,jpnh4,Kbb) )  
    182                zlim2  = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concnnh4 ) 
    183                zlim3  = tr(ji,jj,jk,jpfer,Kbb) / ( tr(ji,jj,jk,jpfer,Kbb) +  5.E-11   ) 
    184                ztem1  = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) ) 
    185                ztem2  = ts(ji,jj,jk,jp_tem,Kmm) - 10. 
    186                zetot1 = MAX( 0., etot_ndcy(ji,jj,jk) - 1.) / ( 4. + etot_ndcy(ji,jj,jk) )  
    187                zetot2 = 30. / ( 30. + etot_ndcy(ji,jj,jk) )  
    188  
    189                xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 )                  & 
    190                   &                       * ztem1 / ( 0.1 + ztem1 )                     & 
    191                   &                       * MAX( 1., tr(ji,jj,jk,jpphy,Kbb) * 1.e6 / 2. )  & 
    192                   &                       * zetot1 * zetot2               & 
    193                   &                       * ( 1. + EXP(-ztem2 * ztem2 / 25. ) )         & 
    194                   &                       * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) ) 
    195                xfracal(ji,jj,jk) = MIN( 0.8 , xfracal(ji,jj,jk) ) 
    196                xfracal(ji,jj,jk) = MAX( 0.02, xfracal(ji,jj,jk) ) 
    197             END DO 
    198          END DO 
    199       END DO 
    200       ! 
    201       DO jk = 1, jpkm1 
    202          DO jj = 1, jpj 
    203             DO ji = 1, jpi 
    204                ! denitrification factor computed from O2 levels 
    205                nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - tr(ji,jj,jk,jpoxy,Kbb) )    & 
    206                   &                                / ( oxymin + tr(ji,jj,jk,jpoxy,Kbb) )  ) 
    207                nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 
    208                ! 
    209                ! denitrification factor computed from NO3 levels 
    210                nitrfac2(ji,jj,jk) = MAX( 0.e0,       ( 1.E-6 - tr(ji,jj,jk,jpno3,Kbb) )  & 
    211                   &                                / ( 1.E-6 + tr(ji,jj,jk,jpno3,Kbb) ) ) 
    212                nitrfac2(ji,jj,jk) = MIN( 1., nitrfac2(ji,jj,jk) ) 
    213             END DO 
    214          END DO 
    215       END DO 
     175      DO_3D_11_11( 1, jpkm1 ) 
     176         zlim1 =  ( tr(ji,jj,jk,jpno3,Kbb) * concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) * concnno3 )    & 
     177            &   / ( concnno3 * concnnh4 + concnnh4 * tr(ji,jj,jk,jpno3,Kbb) + concnno3 * tr(ji,jj,jk,jpnh4,Kbb) )  
     178         zlim2  = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concnnh4 ) 
     179         zlim3  = tr(ji,jj,jk,jpfer,Kbb) / ( tr(ji,jj,jk,jpfer,Kbb) +  5.E-11   ) 
     180         ztem1  = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) ) 
     181         ztem2  = ts(ji,jj,jk,jp_tem,Kmm) - 10. 
     182         zetot1 = MAX( 0., etot_ndcy(ji,jj,jk) - 1.) / ( 4. + etot_ndcy(ji,jj,jk) )  
     183         zetot2 = 30. / ( 30. + etot_ndcy(ji,jj,jk) )  
     184 
     185         xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 )                  & 
     186            &                       * ztem1 / ( 0.1 + ztem1 )                     & 
     187            &                       * MAX( 1., tr(ji,jj,jk,jpphy,Kbb) * 1.e6 / 2. )  & 
     188            &                       * zetot1 * zetot2               & 
     189            &                       * ( 1. + EXP(-ztem2 * ztem2 / 25. ) )         & 
     190            &                       * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) ) 
     191         xfracal(ji,jj,jk) = MIN( 0.8 , xfracal(ji,jj,jk) ) 
     192         xfracal(ji,jj,jk) = MAX( 0.02, xfracal(ji,jj,jk) ) 
     193      END_3D 
     194      ! 
     195      DO_3D_11_11( 1, jpkm1 ) 
     196         ! denitrification factor computed from O2 levels 
     197         nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - tr(ji,jj,jk,jpoxy,Kbb) )    & 
     198            &                                / ( oxymin + tr(ji,jj,jk,jpoxy,Kbb) )  ) 
     199         nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 
     200         ! 
     201         ! denitrification factor computed from NO3 levels 
     202         nitrfac2(ji,jj,jk) = MAX( 0.e0,       ( 1.E-6 - tr(ji,jj,jk,jpno3,Kbb) )  & 
     203            &                                / ( 1.E-6 + tr(ji,jj,jk,jpno3,Kbb) ) ) 
     204         nitrfac2(ji,jj,jk) = MIN( 1., nitrfac2(ji,jj,jk) ) 
     205      END_3D 
    216206      ! 
    217207      IF( lk_iomput .AND. knt == nrdttrc ) THEN        ! save output diagnostics 

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

    r12258 r12340  
    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) 
    … …  
    7375      CALL solve_at_general( zhinit, zhi, Kbb ) 
    7476 
    75       DO jk = 1, jpkm1 
    76          DO jj = 1, jpj 
    77             DO ji = 1, jpi 
    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 DO 
    82          END DO 
    83       END DO 
     77      DO_3D_11_11( 1, jpkm1 ) 
     78         zco3(ji,jj,jk) = tr(ji,jj,jk,jpdic,Kbb) * ak13(ji,jj,jk) * ak23(ji,jj,jk) / (zhi(ji,jj,jk)**2   & 
     79            &             + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn ) 
     80         hi  (ji,jj,jk) = zhi(ji,jj,jk) * rhop(ji,jj,jk) / 1000. 
     81      END_3D 
    8482 
    8583      !     --------------------------------------------------------- 
    … …  
    8987      !     --------------------------------------------------------- 
    9088 
    91       DO jk = 1, jpkm1 
    92          DO jj = 1, jpj 
    93             DO ji = 1, jpi 
     89      DO_3D_11_11( 1, jpkm1 ) 
    9490 
    95                ! DEVIATION OF [CO3--] FROM SATURATION VALUE 
    96                ! Salinity dependance in zomegaca and divide by rhop/1000 to have good units 
    97                zcalcon  = calcon * ( salinprac(ji,jj,jk) / 35._wp ) 
    98                zfact    = rhop(ji,jj,jk) / 1000._wp 
    99                zomegaca = ( zcalcon * zco3(ji,jj,jk) ) / ( aksp(ji,jj,jk) * zfact + rtrn ) 
    100                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 ) 
    10197 
    102                ! SET DEGREE OF UNDER-/SUPERSATURATION 
    103                excess(ji,jj,jk) = 1._wp - zomegaca 
    104                zexcess0 = MAX( 0., excess(ji,jj,jk) ) 
    105                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 
    106102 
    107                ! AMOUNT CACO3 (12C) THAT RE-ENTERS SOLUTION 
    108                !       (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE 
    109                !       CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION) 
    110                zdispot = kdca * zexcess * tr(ji,jj,jk,jpcal,Kbb) 
    111               !  CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3], 
    112               !       AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION 
    113               zcaldiss(ji,jj,jk)  = zdispot * rfact2 / rmtss ! calcite dissolution 
    114               ! 
    115               tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + 2. * zcaldiss(ji,jj,jk) 
    116               tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) -      zcaldiss(ji,jj,jk) 
    117               tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) +      zcaldiss(ji,jj,jk) 
    118             END DO 
    119          END DO 
    120       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 
    121115      ! 
    122116 

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

    r12258 r12340  
    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) 
    … …  
    7880      IF( ln_timing )   CALL timing_start('p4z_meso') 
    7981      ! 
    80       DO jk = 1, jpkm1 
    81          DO jj = 1, jpj 
    82             DO ji = 1, jpi 
    83                zcompam   = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - 1.e-9 ), 0.e0 ) 
    84                zfact     = xstep * tgfunc2(ji,jj,jk) * zcompam 
    85  
    86                !  Respiration rates of both zooplankton 
    87                !  ------------------------------------- 
    88                zrespz    = resrat2 * zfact * ( tr(ji,jj,jk,jpmes,Kbb) / ( xkmort + tr(ji,jj,jk,jpmes,Kbb) )  & 
    89                &           + 3. * nitrfac(ji,jj,jk) ) 
    90  
    91                !  Zooplankton mortality. A square function has been selected with 
    92                !  no real reason except that it seems to be more stable and may mimic predation 
    93                !  --------------------------------------------------------------- 
    94                ztortz    = mzrat2 * 1.e6 * zfact * tr(ji,jj,jk,jpmes,Kbb)  * (1. - nitrfac(ji,jj,jk) ) 
    95                ! 
    96                zcompadi  = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthresh2dia ), 0.e0 ) 
    97                zcompaz   = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - xthresh2zoo ), 0.e0 ) 
    98                zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthresh2poc ), 0.e0 ) 
    99                ! Size effect of nanophytoplankton on grazing : the smaller it is, the less prone 
    100                ! it is to predation by mesozooplankton 
    101                ! ------------------------------------------------------------------------------- 
    102                zcompaph  = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthresh2phy ), 0.e0 ) & 
    103                   &      * MIN(1., MAX( 0., ( quotan(ji,jj,jk) - 0.2) / 0.3 ) ) 
    104  
    105                !   Mesozooplankton grazing 
    106                !   ------------------------ 
    107                zfood     = xpref2d * zcompadi + xpref2z * zcompaz + xpref2n * zcompaph + xpref2c * zcompapoc  
    108                zfoodlim  = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) ) 
    109                zdenom    = zfoodlim / ( xkgraz2 + zfoodlim ) 
    110                zdenom2   = zdenom / ( zfood + rtrn ) 
    111                zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpmes,Kbb) * (1. - nitrfac(ji,jj,jk))  
    112  
    113                zgrazd    = zgraze2  * xpref2d  * zcompadi  * zdenom2  
    114                zgrazz    = zgraze2  * xpref2z  * zcompaz   * zdenom2  
    115                zgrazn    = zgraze2  * xpref2n  * zcompaph  * zdenom2  
    116                zgrazpoc  = zgraze2  * xpref2c  * zcompapoc * zdenom2  
    117  
    118                zgraznf   = zgrazn   * tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
    119                zgrazf    = zgrazd   * tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
    120                zgrazpof  = zgrazpoc * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
    121  
    122                !  Mesozooplankton flux feeding on GOC 
    123                !  ---------------------------------- 
    124                zgrazffeg = grazflux  * xstep * wsbio4(ji,jj,jk)      & 
    125                &           * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 
    126                &           * (1. - nitrfac(ji,jj,jk)) 
    127                zgrazfffg = zgrazffeg * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 
    128                zgrazffep = grazflux  * xstep *  wsbio3(ji,jj,jk)     & 
    129                &           * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 
    130                &           * (1. - nitrfac(ji,jj,jk)) 
    131                zgrazfffp = zgrazffep * tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
    132                ! 
    133                zgraztotc = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg 
    134                ! Compute the proportion of filter feeders 
    135                zproport  = (zgrazffep + zgrazffeg)/(rtrn + zgraztotc) 
    136                ! Compute fractionation of aggregates. It is assumed that  
    137                ! diatoms based aggregates are more prone to fractionation 
    138                ! since they are more porous (marine snow instead of fecal pellets) 
    139                zratio    = tr(ji,jj,jk,jpgsi,Kbb) / ( tr(ji,jj,jk,jpgoc,Kbb) + rtrn ) 
    140                zratio2   = zratio * zratio 
    141                zfrac     = zproport * grazflux  * xstep * wsbio4(ji,jj,jk)      & 
    142                &          * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb)          & 
    143                &          * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) ) 
    144                zfracfe   = zfrac * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 
    145  
    146                zgrazffep = zproport * zgrazffep 
    147                zgrazffeg = zproport * zgrazffeg 
    148                zgrazfffp = zproport * zgrazfffp 
    149                zgrazfffg = zproport * zgrazfffg 
    150                zgraztotc = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg 
    151                zgraztotn = zgrazd * quotad(ji,jj,jk) + zgrazz + zgrazn * quotan(ji,jj,jk)   & 
    152                &   + zgrazpoc + zgrazffep + zgrazffeg 
    153                zgraztotf = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfffp + zgrazfffg 
    154  
    155                ! Total grazing ( grazing by microzoo is already computed in p4zmicro ) 
    156                zgrazing2(ji,jj,jk) = zgraztotc 
    157  
    158                !    Mesozooplankton efficiency 
    159                !    -------------------------- 
    160                zgrasrat  =  ( zgraztotf + rtrn )/ ( zgraztotc + rtrn ) 
    161                zgrasratn =  ( zgraztotn + rtrn )/ ( zgraztotc + rtrn ) 
    162                zepshert  = MIN( 1., zgrasratn, zgrasrat / ferat3) 
    163                zbeta     = MAX(0., (epsher2 - epsher2min) ) 
    164                zepsherf  = epsher2min + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta )  
    165                zepsherv  = zepsherf * zepshert  
    166  
    167                zgrarem2  = zgraztotc * ( 1. - zepsherv - unass2 ) & 
    168                &         + ( 1. - epsher2 - unass2 ) / ( 1. - epsher2 ) * ztortz 
    169                zgrafer2  = zgraztotc * MAX( 0. , ( 1. - unass2 ) * zgrasrat - ferat3 * zepsherv )    & 
    170                &         + ferat3 * ( ( 1. - epsher2 - unass2 ) /( 1. - epsher2 ) * ztortz ) 
    171                zgrapoc2  = zgraztotc * unass2 
    172  
    173                !   Update the arrays TRA which contain the biological sources and sinks 
    174                zgrarsig  = zgrarem2 * sigma2 
    175                tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarsig 
    176                tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgrarsig 
    177                tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgrarem2 - zgrarsig 
    178                ! 
    179                IF( ln_ligand ) THEN  
    180                   tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + (zgrarem2 - zgrarsig) * ldocz 
    181                   zz2ligprod(ji,jj,jk) = (zgrarem2 - zgrarsig) * ldocz 
    182                ENDIF 
    183                ! 
    184                tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarsig 
    185                tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgrafer2 
    186                zfezoo2(ji,jj,jk)   = zgrafer2 
    187                tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarsig 
    188                tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zgrarsig               
    189  
    190                zmortz = ztortz + zrespz 
    191                zmortzgoc = unass2 / ( 1. - epsher2 ) * ztortz + zrespz 
    192                tr(ji,jj,jk,jpmes,Krhs) = tr(ji,jj,jk,jpmes,Krhs) - zmortz + zepsherv * zgraztotc  
    193                tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazd 
    194                tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) - zgrazz 
    195                tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgrazn 
    196                tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgrazn * tr(ji,jj,jk,jpnch,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
    197                tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazd * tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
    198                tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazd * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
    199                tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazd * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
    200                tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgraznf 
    201                tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazf 
    202  
    203                tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zgrazpoc - zgrazffep + zfrac 
    204                prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfrac 
    205                conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep 
    206                tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zmortzgoc - zgrazffeg + zgrapoc2 - zfrac 
    207                prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zmortzgoc + zgrapoc2 
    208                consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfrac 
    209                tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zgrazpof - zgrazfffp + zfracfe 
    210                tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + ferat3 * zmortzgoc - zgrazfffg     & 
    211                  &                + zgraztotf * unass2 - zfracfe 
    212                zfracal = tr(ji,jj,jk,jpcal,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + tr(ji,jj,jk,jpgoc,Kbb) + rtrn ) 
    213                zgrazcal = (zgrazffeg + zgrazpoc) * (1. - part2) * zfracal 
    214                ! calcite production 
    215                zprcaca = xfracal(ji,jj,jk) * zgrazn 
    216                prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    217                ! 
    218                zprcaca = part2 * zprcaca 
    219                tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrazcal - zprcaca 
    220                tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * ( zgrazcal + zprcaca ) 
    221                tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) - zgrazcal + zprcaca 
    222             END DO 
    223          END DO 
    224       END DO 
     82      DO_3D_11_11( 1, jpkm1 ) 
     83         zcompam   = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - 1.e-9 ), 0.e0 ) 
     84         zfact     = xstep * tgfunc2(ji,jj,jk) * zcompam 
     85 
     86         !  Respiration rates of both zooplankton 
     87         !  ------------------------------------- 
     88         zrespz    = resrat2 * zfact * ( tr(ji,jj,jk,jpmes,Kbb) / ( xkmort + tr(ji,jj,jk,jpmes,Kbb) )  & 
     89         &           + 3. * nitrfac(ji,jj,jk) ) 
     90 
     91         !  Zooplankton mortality. A square function has been selected with 
     92         !  no real reason except that it seems to be more stable and may mimic predation 
     93         !  --------------------------------------------------------------- 
     94         ztortz    = mzrat2 * 1.e6 * zfact * tr(ji,jj,jk,jpmes,Kbb)  * (1. - nitrfac(ji,jj,jk) ) 
     95         ! 
     96         zcompadi  = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthresh2dia ), 0.e0 ) 
     97         zcompaz   = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - xthresh2zoo ), 0.e0 ) 
     98         zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthresh2poc ), 0.e0 ) 
     99         ! Size effect of nanophytoplankton on grazing : the smaller it is, the less prone 
     100         ! it is to predation by mesozooplankton 
     101         ! ------------------------------------------------------------------------------- 
     102         zcompaph  = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthresh2phy ), 0.e0 ) & 
     103            &      * MIN(1., MAX( 0., ( quotan(ji,jj,jk) - 0.2) / 0.3 ) ) 
     104 
     105         !   Mesozooplankton grazing 
     106         !   ------------------------ 
     107         zfood     = xpref2d * zcompadi + xpref2z * zcompaz + xpref2n * zcompaph + xpref2c * zcompapoc  
     108         zfoodlim  = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) ) 
     109         zdenom    = zfoodlim / ( xkgraz2 + zfoodlim ) 
     110         zdenom2   = zdenom / ( zfood + rtrn ) 
     111         zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpmes,Kbb) * (1. - nitrfac(ji,jj,jk))  
     112 
     113         zgrazd    = zgraze2  * xpref2d  * zcompadi  * zdenom2  
     114         zgrazz    = zgraze2  * xpref2z  * zcompaz   * zdenom2  
     115         zgrazn    = zgraze2  * xpref2n  * zcompaph  * zdenom2  
     116         zgrazpoc  = zgraze2  * xpref2c  * zcompapoc * zdenom2  
     117 
     118         zgraznf   = zgrazn   * tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
     119         zgrazf    = zgrazd   * tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
     120         zgrazpof  = zgrazpoc * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
     121 
     122         !  Mesozooplankton flux feeding on GOC 
     123         !  ---------------------------------- 
     124         zgrazffeg = grazflux  * xstep * wsbio4(ji,jj,jk)      & 
     125         &           * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 
     126         &           * (1. - nitrfac(ji,jj,jk)) 
     127         zgrazfffg = zgrazffeg * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 
     128         zgrazffep = grazflux  * xstep *  wsbio3(ji,jj,jk)     & 
     129         &           * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 
     130         &           * (1. - nitrfac(ji,jj,jk)) 
     131         zgrazfffp = zgrazffep * tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
     132         ! 
     133         zgraztotc = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg 
     134         ! Compute the proportion of filter feeders 
     135         zproport  = (zgrazffep + zgrazffeg)/(rtrn + zgraztotc) 
     136         ! Compute fractionation of aggregates. It is assumed that  
     137         ! diatoms based aggregates are more prone to fractionation 
     138         ! since they are more porous (marine snow instead of fecal pellets) 
     139         zratio    = tr(ji,jj,jk,jpgsi,Kbb) / ( tr(ji,jj,jk,jpgoc,Kbb) + rtrn ) 
     140         zratio2   = zratio * zratio 
     141         zfrac     = zproport * grazflux  * xstep * wsbio4(ji,jj,jk)      & 
     142         &          * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb)          & 
     143         &          * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) ) 
     144         zfracfe   = zfrac * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 
     145 
     146         zgrazffep = zproport * zgrazffep 
     147         zgrazffeg = zproport * zgrazffeg 
     148         zgrazfffp = zproport * zgrazfffp 
     149         zgrazfffg = zproport * zgrazfffg 
     150         zgraztotc = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg 
     151         zgraztotn = zgrazd * quotad(ji,jj,jk) + zgrazz + zgrazn * quotan(ji,jj,jk)   & 
     152         &   + zgrazpoc + zgrazffep + zgrazffeg 
     153         zgraztotf = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfffp + zgrazfffg 
     154 
     155         ! Total grazing ( grazing by microzoo is already computed in p4zmicro ) 
     156         zgrazing2(ji,jj,jk) = zgraztotc 
     157 
     158         !    Mesozooplankton efficiency 
     159         !    -------------------------- 
     160         zgrasrat  =  ( zgraztotf + rtrn )/ ( zgraztotc + rtrn ) 
     161         zgrasratn =  ( zgraztotn + rtrn )/ ( zgraztotc + rtrn ) 
     162         zepshert  = MIN( 1., zgrasratn, zgrasrat / ferat3) 
     163         zbeta     = MAX(0., (epsher2 - epsher2min) ) 
     164         zepsherf  = epsher2min + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta )  
     165         zepsherv  = zepsherf * zepshert  
     166 
     167         zgrarem2  = zgraztotc * ( 1. - zepsherv - unass2 ) & 
     168         &         + ( 1. - epsher2 - unass2 ) / ( 1. - epsher2 ) * ztortz 
     169         zgrafer2  = zgraztotc * MAX( 0. , ( 1. - unass2 ) * zgrasrat - ferat3 * zepsherv )    & 
     170         &         + ferat3 * ( ( 1. - epsher2 - unass2 ) /( 1. - epsher2 ) * ztortz ) 
     171         zgrapoc2  = zgraztotc * unass2 
     172 
     173         !   Update the arrays TRA which contain the biological sources and sinks 
     174         zgrarsig  = zgrarem2 * sigma2 
     175         tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarsig 
     176         tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgrarsig 
     177         tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgrarem2 - zgrarsig 
     178         ! 
     179         IF( ln_ligand ) THEN  
     180            tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + (zgrarem2 - zgrarsig) * ldocz 
     181            zz2ligprod(ji,jj,jk) = (zgrarem2 - zgrarsig) * ldocz 
     182         ENDIF 
     183         ! 
     184         tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarsig 
     185         tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgrafer2 
     186         zfezoo2(ji,jj,jk)   = zgrafer2 
     187         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarsig 
     188         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zgrarsig               
     189 
     190         zmortz = ztortz + zrespz 
     191         zmortzgoc = unass2 / ( 1. - epsher2 ) * ztortz + zrespz 
     192         tr(ji,jj,jk,jpmes,Krhs) = tr(ji,jj,jk,jpmes,Krhs) - zmortz + zepsherv * zgraztotc  
     193         tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazd 
     194         tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) - zgrazz 
     195         tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgrazn 
     196         tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgrazn * tr(ji,jj,jk,jpnch,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
     197         tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazd * tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     198         tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazd * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     199         tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazd * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     200         tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgraznf 
     201         tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazf 
     202 
     203         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zgrazpoc - zgrazffep + zfrac 
     204         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfrac 
     205         conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep 
     206         tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zmortzgoc - zgrazffeg + zgrapoc2 - zfrac 
     207         prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zmortzgoc + zgrapoc2 
     208         consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfrac 
     209         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zgrazpof - zgrazfffp + zfracfe 
     210         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + ferat3 * zmortzgoc - zgrazfffg     & 
     211           &                + zgraztotf * unass2 - zfracfe 
     212         zfracal = tr(ji,jj,jk,jpcal,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + tr(ji,jj,jk,jpgoc,Kbb) + rtrn ) 
     213         zgrazcal = (zgrazffeg + zgrazpoc) * (1. - part2) * zfracal 
     214         ! calcite production 
     215         zprcaca = xfracal(ji,jj,jk) * zgrazn 
     216         prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
     217         ! 
     218         zprcaca = part2 * zprcaca 
     219         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrazcal - zprcaca 
     220         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * ( zgrazcal + zprcaca ) 
     221         tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) - zgrazcal + zprcaca 
     222      END_3D 
    225223      ! 
    226224      IF( lk_iomput .AND. knt == nrdttrc ) THEN 

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

    r12258 r12340  
    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) 
    … …  
    7678      IF( ln_timing )   CALL timing_start('p4z_micro') 
    7779      ! 
    78       DO jk = 1, jpkm1 
    79          DO jj = 1, jpj 
    80             DO ji = 1, jpi 
    81                zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - 1.e-9 ), 0.e0 ) 
    82                zfact   = xstep * tgfunc2(ji,jj,jk) * zcompaz 
    83  
    84                !  Respiration rates of both zooplankton 
    85                !  ------------------------------------- 
    86                zrespz = resrat * zfact * tr(ji,jj,jk,jpzoo,Kbb) / ( xkmort + tr(ji,jj,jk,jpzoo,Kbb) )  & 
    87                   &   + resrat * zfact * 3. * nitrfac(ji,jj,jk) 
    88  
    89                !  Zooplankton mortality. A square function has been selected with 
    90                !  no real reason except that it seems to be more stable and may mimic predation. 
    91                !  --------------------------------------------------------------- 
    92                ztortz = mzrat * 1.e6 * zfact * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk)) 
    93  
    94                zcompadi  = MIN( MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthreshdia ), 0.e0 ), xsizedia ) 
    95                zcompaph  = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthreshphy ), 0.e0 ) 
    96                zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthreshpoc ), 0.e0 ) 
    97                 
    98                !     Microzooplankton grazing 
    99                !     ------------------------ 
    100                zfood     = xprefn * zcompaph + xprefc * zcompapoc + xprefd * zcompadi 
    101                zfoodlim  = MAX( 0. , zfood - min(xthresh,0.5*zfood) ) 
    102                zdenom    = zfoodlim / ( xkgraz + zfoodlim ) 
    103                zdenom2   = zdenom / ( zfood + rtrn ) 
    104                zgraze    = grazrat * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk)) 
    105  
    106                zgrazp    = zgraze  * xprefn * zcompaph  * zdenom2  
    107                zgrazm    = zgraze  * xprefc * zcompapoc * zdenom2  
    108                zgrazsd   = zgraze  * xprefd * zcompadi  * zdenom2  
    109  
    110                zgrazpf   = zgrazp  * tr(ji,jj,jk,jpnfe,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
    111                zgrazmf   = zgrazm  * tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
    112                zgrazsf   = zgrazsd * tr(ji,jj,jk,jpdfe,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
    113                ! 
    114                zgraztotc = zgrazp  + zgrazm  + zgrazsd  
    115                zgraztotf = zgrazpf + zgrazsf + zgrazmf  
    116                zgraztotn = zgrazp * quotan(ji,jj,jk) + zgrazm + zgrazsd * quotad(ji,jj,jk) 
    117  
    118                ! Grazing by microzooplankton 
    119                zgrazing(ji,jj,jk) = zgraztotc 
    120  
    121                !    Various remineralization and excretion terms 
    122                !    -------------------------------------------- 
    123                zgrasrat  = ( zgraztotf + rtrn ) / ( zgraztotc + rtrn ) 
    124                zgrasratn = ( zgraztotn + rtrn ) / ( zgraztotc + rtrn ) 
    125                zepshert  =  MIN( 1., zgrasratn, zgrasrat / ferat3) 
    126                zbeta     = MAX(0., (epsher - epshermin) ) 
    127                zepsherf  = epshermin + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 
    128                zepsherv  = zepsherf * zepshert  
    129  
    130                zgrafer   = zgraztotc * MAX( 0. , ( 1. - unass ) * zgrasrat - ferat3 * zepsherv )  
    131                zgrarem   = zgraztotc * ( 1. - zepsherv - unass ) 
    132                zgrapoc   = zgraztotc * unass 
    133  
    134                !  Update of the TRA arrays 
    135                !  ------------------------ 
    136                zgrarsig  = zgrarem * sigma1 
    137                tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarsig 
    138                tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgrarsig 
    139                tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgrarem - zgrarsig 
    140                ! 
    141                IF( ln_ligand ) THEN 
    142                   tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + (zgrarem - zgrarsig) * ldocz 
    143                   zzligprod(ji,jj,jk) = (zgrarem - zgrarsig) * ldocz 
    144                ENDIF 
    145                ! 
    146                tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarsig 
    147                tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgrafer 
    148                zfezoo(ji,jj,jk)    = zgrafer 
    149                tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zgrapoc 
    150                prodpoc(ji,jj,jk)   = prodpoc(ji,jj,jk) + zgrapoc 
    151                tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zgraztotf * unass 
    152                tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarsig 
    153                tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zgrarsig 
    154                !   Update the arrays TRA which contain the biological sources and sinks 
    155                !   -------------------------------------------------------------------- 
    156                zmortz = ztortz + zrespz 
    157                tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) - zmortz + zepsherv * zgraztotc  
    158                tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgrazp 
    159                tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazsd 
    160                tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgrazp  * tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 
    161                tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazsd * tr(ji,jj,jk,jpdch,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 
    162                tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazsd * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 
    163                tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazsd * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 
    164                tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgrazpf 
    165                tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazsf 
    166                tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortz - zgrazm 
    167                prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortz 
    168                conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazm 
    169                tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ferat3 * zmortz - zgrazmf 
    170                ! 
    171                ! calcite production 
    172                zprcaca = xfracal(ji,jj,jk) * zgrazp 
    173                prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    174                ! 
    175                zprcaca = part * zprcaca 
    176                tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprcaca 
    177                tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca 
    178                tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca 
    179             END DO 
    180          END DO 
    181       END DO 
     80      DO_3D_11_11( 1, jpkm1 ) 
     81         zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - 1.e-9 ), 0.e0 ) 
     82         zfact   = xstep * tgfunc2(ji,jj,jk) * zcompaz 
     83 
     84         !  Respiration rates of both zooplankton 
     85         !  ------------------------------------- 
     86         zrespz = resrat * zfact * tr(ji,jj,jk,jpzoo,Kbb) / ( xkmort + tr(ji,jj,jk,jpzoo,Kbb) )  & 
     87            &   + resrat * zfact * 3. * nitrfac(ji,jj,jk) 
     88 
     89         !  Zooplankton mortality. A square function has been selected with 
     90         !  no real reason except that it seems to be more stable and may mimic predation. 
     91         !  --------------------------------------------------------------- 
     92         ztortz = mzrat * 1.e6 * zfact * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk)) 
     93 
     94         zcompadi  = MIN( MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthreshdia ), 0.e0 ), xsizedia ) 
     95         zcompaph  = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthreshphy ), 0.e0 ) 
     96         zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthreshpoc ), 0.e0 ) 
     97          
     98         !     Microzooplankton grazing 
     99         !     ------------------------ 
     100         zfood     = xprefn * zcompaph + xprefc * zcompapoc + xprefd * zcompadi 
     101         zfoodlim  = MAX( 0. , zfood - min(xthresh,0.5*zfood) ) 
     102         zdenom    = zfoodlim / ( xkgraz + zfoodlim ) 
     103         zdenom2   = zdenom / ( zfood + rtrn ) 
     104         zgraze    = grazrat * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk)) 
     105 
     106         zgrazp    = zgraze  * xprefn * zcompaph  * zdenom2  
     107         zgrazm    = zgraze  * xprefc * zcompapoc * zdenom2  
     108         zgrazsd   = zgraze  * xprefd * zcompadi  * zdenom2  
     109 
     110         zgrazpf   = zgrazp  * tr(ji,jj,jk,jpnfe,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
     111         zgrazmf   = zgrazm  * tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
     112         zgrazsf   = zgrazsd * tr(ji,jj,jk,jpdfe,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
     113         ! 
     114         zgraztotc = zgrazp  + zgrazm  + zgrazsd  
     115         zgraztotf = zgrazpf + zgrazsf + zgrazmf  
     116         zgraztotn = zgrazp * quotan(ji,jj,jk) + zgrazm + zgrazsd * quotad(ji,jj,jk) 
     117 
     118         ! Grazing by microzooplankton 
     119         zgrazing(ji,jj,jk) = zgraztotc 
     120 
     121         !    Various remineralization and excretion terms 
     122         !    -------------------------------------------- 
     123         zgrasrat  = ( zgraztotf + rtrn ) / ( zgraztotc + rtrn ) 
     124         zgrasratn = ( zgraztotn + rtrn ) / ( zgraztotc + rtrn ) 
     125         zepshert  =  MIN( 1., zgrasratn, zgrasrat / ferat3) 
     126         zbeta     = MAX(0., (epsher - epshermin) ) 
     127         zepsherf  = epshermin + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 
     128         zepsherv  = zepsherf * zepshert  
     129 
     130         zgrafer   = zgraztotc * MAX( 0. , ( 1. - unass ) * zgrasrat - ferat3 * zepsherv )  
     131         zgrarem   = zgraztotc * ( 1. - zepsherv - unass ) 
     132         zgrapoc   = zgraztotc * unass 
     133 
     134         !  Update of the TRA arrays 
     135         !  ------------------------ 
     136         zgrarsig  = zgrarem * sigma1 
     137         tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarsig 
     138         tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgrarsig 
     139         tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgrarem - zgrarsig 
     140         ! 
     141         IF( ln_ligand ) THEN 
     142            tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + (zgrarem - zgrarsig) * ldocz 
     143            zzligprod(ji,jj,jk) = (zgrarem - zgrarsig) * ldocz 
     144         ENDIF 
     145         ! 
     146         tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarsig 
     147         tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgrafer 
     148         zfezoo(ji,jj,jk)    = zgrafer 
     149         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zgrapoc 
     150         prodpoc(ji,jj,jk)   = prodpoc(ji,jj,jk) + zgrapoc 
     151         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zgraztotf * unass 
     152         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarsig 
     153         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zgrarsig 
     154         !   Update the arrays TRA which contain the biological sources and sinks 
     155         !   -------------------------------------------------------------------- 
     156         zmortz = ztortz + zrespz 
     157         tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) - zmortz + zepsherv * zgraztotc  
     158         tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgrazp 
     159         tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazsd 
     160         tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgrazp  * tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 
     161         tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazsd * tr(ji,jj,jk,jpdch,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 
     162         tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazsd * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 
     163         tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazsd * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 
     164         tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgrazpf 
     165         tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazsf 
     166         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortz - zgrazm 
     167         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortz 
     168         conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazm 
     169         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ferat3 * zmortz - zgrazmf 
     170         ! 
     171         ! calcite production 
     172         zprcaca = xfracal(ji,jj,jk) * zgrazp 
     173         prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
     174         ! 
     175         zprcaca = part * zprcaca 
     176         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprcaca 
     177         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca 
     178         tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca 
     179      END_3D 
    182180      ! 
    183181      IF( lk_iomput .AND. knt == nrdttrc ) THEN 

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

    r12236 r12340  
    2929   REAL(wp), PUBLIC ::   mprat2   !: 
    3030 
     31   !! * Substitutions 
     32#  include "do_loop_substitute.h90" 
    3133   !!---------------------------------------------------------------------- 
    3234   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    7577      ! 
    7678      prodcal(:,:,:) = 0._wp   ! calcite production variable set to zero 
    77       DO jk = 1, jpkm1 
    78          DO jj = 1, jpj 
    79             DO ji = 1, jpi 
    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 DO 
    119          END DO 
    120       END DO 
     79      DO_3D_11_11( 1, jpkm1 ) 
     80         zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-8 ), 0.e0 ) 
     81         !     When highly limited by macronutrients, very small cells  
     82         !     dominate the community. As a consequence, aggregation 
     83         !     due to turbulence is negligible. Mortality is also set 
     84         !     to 0 
     85         zsizerat = MIN(1., MAX( 0., (quotan(ji,jj,jk) - 0.2) / 0.3) ) * tr(ji,jj,jk,jpphy,Kbb) 
     86         !     Squared mortality of Phyto similar to a sedimentation term during 
     87         !     blooms (Doney et al. 1996) 
     88         zrespp = wchl * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * zsizerat  
     89 
     90         !     Phytoplankton mortality. This mortality loss is slightly 
     91         !     increased when nutrients are limiting phytoplankton growth 
     92         !     as observed for instance in case of iron limitation. 
     93         ztortp = mprat * xstep * zcompaph / ( xkmort + tr(ji,jj,jk,jpphy,Kbb) ) * zsizerat 
     94 
     95         zmortp = zrespp + ztortp 
     96 
     97         !   Update the arrays TRA which contains the biological sources and sinks 
     98 
     99         zfactfe = tr(ji,jj,jk,jpnfe,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 
     100         zfactch = tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 
     101         tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zmortp 
     102         tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zmortp * zfactch 
     103         tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zmortp * zfactfe 
     104         zprcaca = xfracal(ji,jj,jk) * zmortp 
     105         ! 
     106         prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
     107         ! 
     108         zfracal = 0.5 * xfracal(ji,jj,jk) 
     109         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprcaca 
     110         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca 
     111         tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca 
     112         tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfracal * zmortp 
     113         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + ( 1. - zfracal ) * zmortp 
     114         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ( 1. - zfracal ) * zmortp 
     115         prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zfracal * zmortp 
     116         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ( 1. - zfracal ) * zmortp * zfactfe 
     117         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zfracal * zmortp * zfactfe 
     118      END_3D 
    121119      ! 
    122120       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    … …  
    154152      !     ------------------------------------------------------------ 
    155153 
    156       DO jk = 1, jpkm1 
    157          DO jj = 1, jpj 
    158             DO ji = 1, jpi 
    159  
    160                zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1e-9), 0. ) 
    161  
    162                !    Aggregation term for diatoms is increased in case of nutrient 
    163                !    stress as observed in reality. The stressed cells become more 
    164                !    sticky and coagulate to sink quickly out of the euphotic zone 
    165                !     ------------------------------------------------------------ 
    166                !  Phytoplankton respiration  
    167                !     ------------------------ 
    168                zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk) 
    169                zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 )  
    170                zrespp2 = 1.e6 * xstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * tr(ji,jj,jk,jpdia,Kbb) 
    171  
    172                !     Phytoplankton mortality.  
    173                !     ------------------------ 
    174                ztortp2 = mprat2 * xstep * tr(ji,jj,jk,jpdia,Kbb)  / ( xkmort + tr(ji,jj,jk,jpdia,Kbb) ) * zcompadi  
    175  
    176                zmortp2 = zrespp2 + ztortp2 
    177  
    178                !   Update the arrays tr(:,:,:,:,Krhs) which contains the biological sources and sinks 
    179                !   --------------------------------------------------------------------- 
    180                zfactch = tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
    181                zfactfe = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
    182                zfactsi = tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
    183                tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zmortp2  
    184                tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zmortp2 * zfactch 
    185                tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zmortp2 * zfactfe 
    186                tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zmortp2 * zfactsi 
    187                tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zmortp2 * zfactsi 
    188                tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zrespp2 + 0.5 * ztortp2 
    189                tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + 0.5 * ztortp2 
    190                prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + 0.5 * ztortp2 
    191                prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zrespp2 + 0.5 * ztortp2 
    192                tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 0.5 * ztortp2 * zfactfe 
    193                tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + ( zrespp2 + 0.5 * ztortp2 ) * zfactfe 
    194             END DO 
    195          END DO 
    196       END DO 
     154      DO_3D_11_11( 1, jpkm1 ) 
     155 
     156         zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1e-9), 0. ) 
     157 
     158         !    Aggregation term for diatoms is increased in case of nutrient 
     159         !    stress as observed in reality. The stressed cells become more 
     160         !    sticky and coagulate to sink quickly out of the euphotic zone 
     161         !     ------------------------------------------------------------ 
     162         !  Phytoplankton respiration  
     163         !     ------------------------ 
     164         zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk) 
     165         zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 )  
     166         zrespp2 = 1.e6 * xstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * tr(ji,jj,jk,jpdia,Kbb) 
     167 
     168         !     Phytoplankton mortality.  
     169         !     ------------------------ 
     170         ztortp2 = mprat2 * xstep * tr(ji,jj,jk,jpdia,Kbb)  / ( xkmort + tr(ji,jj,jk,jpdia,Kbb) ) * zcompadi  
     171 
     172         zmortp2 = zrespp2 + ztortp2 
     173 
     174         !   Update the arrays tr(:,:,:,:,Krhs) which contains the biological sources and sinks 
     175         !   --------------------------------------------------------------------- 
     176         zfactch = tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     177         zfactfe = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     178         zfactsi = tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     179         tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zmortp2  
     180         tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zmortp2 * zfactch 
     181         tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zmortp2 * zfactfe 
     182         tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zmortp2 * zfactsi 
     183         tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zmortp2 * zfactsi 
     184         tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zrespp2 + 0.5 * ztortp2 
     185         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + 0.5 * ztortp2 
     186         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + 0.5 * ztortp2 
     187         prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zrespp2 + 0.5 * ztortp2 
     188         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 0.5 * ztortp2 * zfactfe 
     189         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + ( zrespp2 + 0.5 * ztortp2 ) * zfactfe 
     190      END_3D 
    197191      ! 
    198192      IF(sn_cfctl%l_prttrc) THEN      ! print mean trends (used for debugging) 

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

    r12258 r12340  
    4242   REAL(wp), DIMENSION(3,61) ::   xkrgb   ! tabulated attenuation coefficients for RGB absorption 
    4343    
     44   !! * Substitutions 
     45#  include "do_loop_substitute.h90" 
    4446   !!---------------------------------------------------------------------- 
    4547   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    8688      IF( ln_p5z )   zchl3d(:,:,:) = zchl3d(:,:,:)    + tr(:,:,:,jppch,Kbb) 
    8789      ! 
    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(ji,jj,jk,Kmm) 
    96                ekg(ji,jj,jk) = xkrgb(2,irgb) * e3t(ji,jj,jk,Kmm) 
    97                ekr(ji,jj,jk) = xkrgb(3,irgb) * e3t(ji,jj,jk,Kmm) 
    98             END DO 
    99          END DO 
    100       END DO 
     90      DO_3D_11_11( 1, jpkm1 ) 
     91         zchl = ( zchl3d(ji,jj,jk) + rtrn ) * 1.e6 
     92         zchl = MIN(  10. , MAX( 0.05, zchl )  ) 
     93         irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 
     94         !                                                          
     95         ekb(ji,jj,jk) = xkrgb(1,irgb) * e3t(ji,jj,jk,Kmm) 
     96         ekg(ji,jj,jk) = xkrgb(2,irgb) * e3t(ji,jj,jk,Kmm) 
     97         ekr(ji,jj,jk) = xkrgb(3,irgb) * e3t(ji,jj,jk,Kmm) 
     98      END_3D 
    10199      !                                        !* Photosynthetically Available Radiation (PAR) 
    102100      !                                        !  -------------------------------------- 
    … …  
    161159      heup_01(:,:) = gdepw(:,:,2,Kmm) 
    162160 
    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(ji,jj,jk+1,Kmm)     ! 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(ji,jj,jk+1,Kmm)  ! Euphotic layer depth (light level definition) 
    173               ENDIF 
    174            END DO 
    175         END DO 
    176       END DO 
     161      DO_3D_11_11( 2, nksrp ) 
     162        IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >=  zqsr100(ji,jj) )  THEN 
     163           neln(ji,jj) = jk+1                    ! Euphotic level : 1rst T-level strictly below Euphotic layer 
     164           !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint 
     165           heup(ji,jj) = gdepw(ji,jj,jk+1,Kmm)     ! Euphotic layer depth 
     166        ENDIF 
     167        IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.50 )  THEN 
     168           heup_01(ji,jj) = gdepw(ji,jj,jk+1,Kmm)  ! Euphotic layer depth (light level definition) 
     169        ENDIF 
     170      END_3D 
    177171      ! 
    178172      heup   (:,:) = MIN( 300., heup   (:,:) ) 
    … …  
    183177      zetmp2 (:,:)   = 0.e0 
    184178 
    185       DO jk = 1, nksrp 
    186          DO jj = 1, jpj 
    187             DO ji = 1, jpi 
    188                IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
    189                   zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! remineralisation 
    190                   zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
    191                   zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t(ji,jj,jk,Kmm) 
    192                ENDIF 
    193             END DO 
    194          END DO 
    195       END DO 
     179      DO_3D_11_11( 1, nksrp ) 
     180         IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
     181            zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! remineralisation 
     182            zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
     183            zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t(ji,jj,jk,Kmm) 
     184         ENDIF 
     185      END_3D 
    196186      ! 
    197187      emoy(:,:,:) = etot(:,:,:)       ! remineralisation 
    198188      zpar(:,:,:) = etot_ndcy(:,:,:)  ! diagnostic : PAR with no diurnal cycle  
    199189      ! 
    200       DO jk = 1, nksrp 
    201          DO jj = 1, jpj 
    202             DO ji = 1, jpi 
    203                IF( gdepw(ji,jj,jk+1,Kmm) <= 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 
     190      DO_3D_11_11( 1, nksrp ) 
     191         IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
     192            z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
     193            emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep 
     194            zpar (ji,jj,jk) = zetmp2(ji,jj) * z1_dep 
     195         ENDIF 
     196      END_3D 
    211197      ! 
    212198      zdepmoy(:,:)   = 0.e0 
    … …  
    214200      zetmp4 (:,:)   = 0.e0 
    215201      ! 
    216       DO jk = 1, nksrp 
    217          DO jj = 1, jpj 
    218             DO ji = 1, jpi 
    219                IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 
    220                   zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
    221                   zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat    (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
    222                   zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t(ji,jj,jk,Kmm) 
    223                ENDIF 
    224             END DO 
    225          END DO 
    226       END DO 
     202      DO_3D_11_11( 1, nksrp ) 
     203         IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 
     204            zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
     205            zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat    (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
     206            zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t(ji,jj,jk,Kmm) 
     207         ENDIF 
     208      END_3D 
    227209      enanom(:,:,:) = enano(:,:,:) 
    228210      ediatm(:,:,:) = ediat(:,:,:) 
    229211      ! 
    230       DO jk = 1, nksrp 
    231          DO jj = 1, jpj 
    232             DO ji = 1, jpi 
    233                IF( gdepw(ji,jj,jk+1,Kmm) <= 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 
     212      DO_3D_11_11( 1, nksrp ) 
     213         IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
     214            z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
     215            enanom(ji,jj,jk) = zetmp3(ji,jj) * z1_dep 
     216            ediatm(ji,jj,jk) = zetmp4(ji,jj) * z1_dep 
     217         ENDIF 
     218      END_3D 
    241219      ! 
    242220      IF( ln_p5z ) THEN 
    243221         ALLOCATE( zetmp5(jpi,jpj) )  ;   zetmp5 (:,:) = 0.e0 
    244          DO jk = 1, nksrp 
    245             DO jj = 1, jpj 
    246                DO ji = 1, jpi 
    247                   IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 
    248                      zetmp5(ji,jj)  = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
    249                   ENDIF 
    250                END DO 
    251             END DO 
    252          END DO 
     222         DO_3D_11_11( 1, nksrp ) 
     223            IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 
     224               zetmp5(ji,jj)  = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
     225            ENDIF 
     226         END_3D 
    253227         ! 
    254228         epicom(:,:,:) = epico(:,:,:) 
    255229         ! 
    256          DO jk = 1, nksrp 
    257             DO jj = 1, jpj 
    258                DO ji = 1, jpi 
    259                   IF( gdepw(ji,jj,jk+1,Kmm) <= 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 
     230         DO_3D_11_11( 1, nksrp ) 
     231            IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
     232               z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
     233               epicom(ji,jj,jk) = zetmp5(ji,jj) * z1_dep 
     234            ENDIF 
     235         END_3D 
    266236         DEALLOCATE( zetmp5 ) 
    267237      ENDIF 
    … …  
    331301        pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) ) 
    332302        ! 
    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     
     303        DO_3D_11_11( 2, nksrp ) 
     304           pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) 
     305           pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) ) 
     306           pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) ) 
     307        END_3D 
    342308        ! 
    343309      ENDIF 

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

    r12236 r12340  
    3737 
    3838 
     39   !! * Substitutions 
     40#  include "do_loop_substitute.h90" 
    3941   !!---------------------------------------------------------------------- 
    4042   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    104106     ! ----------------------------------------------------------------------- 
    105107     ztremint(:,:,:) = zremigoc(:,:,:) 
    106      DO jk = 2, jpkm1 
    107         DO jj = 1, jpj 
    108            DO ji = 1, jpi 
    109               IF (tmask(ji,jj,jk) == 1.) THEN 
    110                 zdep = hmld(ji,jj) 
    111                 ! 
    112                 ! In the case of GOC, lability is constant in the mixed layer  
    113                 ! It is computed only below the mixed layer depth 
    114                 ! ------------------------------------------------------------ 
    115                 ! 
    116                 IF( gdept(ji,jj,jk,Kmm) > zdep ) THEN 
    117                   alphat = 0. 
    118                   remint = 0. 
    119                   ! 
    120                   zsizek1  = e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 
    121                   zsizek = e3t(ji,jj,jk,Kmm) / 2. / (wsbio4(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 
    122                   ! 
    123                   IF ( gdept(ji,jj,jk-1,Kmm) <= zdep ) THEN 
    124                     !  
    125                     ! The first level just below the mixed layer needs a  
    126                     ! specific treatment because lability is supposed constant 
    127                     ! everywhere within the mixed layer. This means that  
    128                     ! change in lability in the bottom part of the previous cell 
    129                     ! should not be computed 
    130                     ! ---------------------------------------------------------- 
    131                     ! 
    132                     ! POC concentration is computed using the lagrangian  
    133                     ! framework. It is only used for the lability param 
    134                     zpoc = tr(ji,jj,jk-1,jpgoc,Kbb) + consgoc(ji,jj,jk) * rday / rfact2               & 
    135                     &   * e3t(ji,jj,jk,Kmm) / 2. / (wsbio4(ji,jj,jk) + rtrn) 
    136                     zpoc = MAX(0., zpoc) 
    137                     ! 
    138                     DO jn = 1, jcpoc 
    139                        ! 
    140                        ! Lagrangian based algorithm. The fraction of each  
    141                        ! lability class is computed starting from the previous 
    142                        ! level 
    143                        ! ----------------------------------------------------- 
    144                        ! 
    145                        ! the concentration of each lability class is calculated 
    146                        ! as the sum of the different sources and sinks 
    147                        ! Please note that production of new GOC experiences 
    148                        ! degradation  
    149                        alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc & 
    150                        &   + prodgoc(ji,jj,jk) * alphan(jn) / tgfunc(ji,jj,jk) / reminp(jn)             & 
    151                        &   * ( 1. - exp( -reminp(jn) * zsizek ) ) * rday / rfact2  
    152                        alphat = alphat + alphag(ji,jj,jk,jn) 
    153                        remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) 
    154                     END DO 
    155                   ELSE 
    156                     ! 
    157                     ! standard algorithm in the rest of the water column 
    158                     ! See the comments in the previous block. 
    159                     ! --------------------------------------------------- 
    160                     ! 
    161                     zpoc = tr(ji,jj,jk-1,jpgoc,Kbb) + consgoc(ji,jj,jk-1) * rday / rfact2               & 
    162                     &   * e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) + consgoc(ji,jj,jk)   & 
    163                     &   * rday / rfact2 * e3t(ji,jj,jk,Kmm) / 2. / (wsbio4(ji,jj,jk) + rtrn) 
    164                     zpoc = max(0., zpoc) 
    165                     ! 
    166                     DO jn = 1, jcpoc 
    167                        alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * ( zsizek              & 
    168                        &   + zsizek1 ) ) * zpoc + ( prodgoc(ji,jj,jk-1) / tgfunc(ji,jj,jk-1) * ( 1.           & 
    169                        &   - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn) * zsizek ) + prodgoc(ji,jj,jk) & 
    170                        &   / tgfunc(ji,jj,jk) * ( 1. - exp( -reminp(jn) * zsizek ) ) ) * rday / rfact2 / reminp(jn) * alphan(jn)  
    171                        alphat = alphat + alphag(ji,jj,jk,jn) 
    172                        remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) 
    173                     END DO 
    174                   ENDIF 
    175                   ! 
    176                   DO jn = 1, jcpoc 
    177                      ! The contribution of each lability class at the current 
    178                      ! level is computed 
    179                      alphag(ji,jj,jk,jn) = alphag(ji,jj,jk,jn) / ( alphat + rtrn) 
    180                   END DO 
    181                   ! Computation of the mean remineralisation rate 
    182                   ztremint(ji,jj,jk) =  MAX(0., remint / ( alphat + rtrn) ) 
    183                   ! 
    184                 ENDIF 
    185               ENDIF 
     108     DO_3D_11_11( 2, jpkm1 ) 
     109        IF (tmask(ji,jj,jk) == 1.) THEN 
     110          zdep = hmld(ji,jj) 
     111          ! 
     112          ! In the case of GOC, lability is constant in the mixed layer  
     113          ! It is computed only below the mixed layer depth 
     114          ! ------------------------------------------------------------ 
     115          ! 
     116          IF( gdept(ji,jj,jk,Kmm) > zdep ) THEN 
     117            alphat = 0. 
     118            remint = 0. 
     119            ! 
     120            zsizek1  = e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 
     121            zsizek = e3t(ji,jj,jk,Kmm) / 2. / (wsbio4(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 
     122            ! 
     123            IF ( gdept(ji,jj,jk-1,Kmm) <= zdep ) THEN 
     124              !  
     125              ! The first level just below the mixed layer needs a  
     126              ! specific treatment because lability is supposed constant 
     127              ! everywhere within the mixed layer. This means that  
     128              ! change in lability in the bottom part of the previous cell 
     129              ! should not be computed 
     130              ! ---------------------------------------------------------- 
     131              ! 
     132              ! POC concentration is computed using the lagrangian  
     133              ! framework. It is only used for the lability param 
     134              zpoc = tr(ji,jj,jk-1,jpgoc,Kbb) + consgoc(ji,jj,jk) * rday / rfact2               & 
     135              &   * e3t(ji,jj,jk,Kmm) / 2. / (wsbio4(ji,jj,jk) + rtrn) 
     136              zpoc = MAX(0., zpoc) 
     137              ! 
     138              DO jn = 1, jcpoc 
     139                 ! 
     140                 ! Lagrangian based algorithm. The fraction of each  
     141                 ! lability class is computed starting from the previous 
     142                 ! level 
     143                 ! ----------------------------------------------------- 
     144                 ! 
     145                 ! the concentration of each lability class is calculated 
     146                 ! as the sum of the different sources and sinks 
     147                 ! Please note that production of new GOC experiences 
     148                 ! degradation  
     149                 alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc & 
     150                 &   + prodgoc(ji,jj,jk) * alphan(jn) / tgfunc(ji,jj,jk) / reminp(jn)             & 
     151                 &   * ( 1. - exp( -reminp(jn) * zsizek ) ) * rday / rfact2  
     152                 alphat = alphat + alphag(ji,jj,jk,jn) 
     153                 remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) 
     154              END DO 
     155            ELSE 
     156              ! 
     157              ! standard algorithm in the rest of the water column 
     158              ! See the comments in the previous block. 
     159              ! --------------------------------------------------- 
     160              ! 
     161              zpoc = tr(ji,jj,jk-1,jpgoc,Kbb) + consgoc(ji,jj,jk-1) * rday / rfact2               & 
     162              &   * e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) + consgoc(ji,jj,jk)   & 
     163              &   * rday / rfact2 * e3t(ji,jj,jk,Kmm) / 2. / (wsbio4(ji,jj,jk) + rtrn) 
     164              zpoc = max(0., zpoc) 
     165              ! 
     166              DO jn = 1, jcpoc 
     167                 alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * ( zsizek              & 
     168                 &   + zsizek1 ) ) * zpoc + ( prodgoc(ji,jj,jk-1) / tgfunc(ji,jj,jk-1) * ( 1.           & 
     169                 &   - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn) * zsizek ) + prodgoc(ji,jj,jk) & 
     170                 &   / tgfunc(ji,jj,jk) * ( 1. - exp( -reminp(jn) * zsizek ) ) ) * rday / rfact2 / reminp(jn) * alphan(jn)  
     171                 alphat = alphat + alphag(ji,jj,jk,jn) 
     172                 remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) 
     173              END DO 
     174            ENDIF 
     175            ! 
     176            DO jn = 1, jcpoc 
     177               ! The contribution of each lability class at the current 
     178               ! level is computed 
     179               alphag(ji,jj,jk,jn) = alphag(ji,jj,jk,jn) / ( alphat + rtrn) 
    186180            END DO 
    187          END DO 
    188       END DO 
     181            ! Computation of the mean remineralisation rate 
     182            ztremint(ji,jj,jk) =  MAX(0., remint / ( alphat + rtrn) ) 
     183            ! 
     184          ENDIF 
     185        ENDIF 
     186     END_3D 
    189187 
    190188      IF( ln_p4z ) THEN   ;   zremigoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 
    … …  
    193191 
    194192      IF( ln_p4z ) THEN 
    195          DO jk = 1, jpkm1 
    196             DO jj = 1, jpj 
    197                DO ji = 1, jpi 
    198                   ! POC disaggregation by turbulence and bacterial activity.  
    199                   ! -------------------------------------------------------- 
    200                   zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
    201                   zorem2  = zremig * tr(ji,jj,jk,jpgoc,Kbb) 
    202                   orem(ji,jj,jk)      = zorem2 
    203                   zorem3(ji,jj,jk) = zremig * solgoc * tr(ji,jj,jk,jpgoc,Kbb) 
    204                   zofer2 = zremig * tr(ji,jj,jk,jpbfe,Kbb) 
    205                   zofer3 = zremig * solgoc * tr(ji,jj,jk,jpbfe,Kbb) 
    206  
    207                   ! ------------------------------------- 
    208                   tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zorem3(ji,jj,jk) 
    209                   tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) - zorem2 - zorem3(ji,jj,jk) 
    210                   tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zofer3 
    211                   tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zofer2 - zofer3 
    212                   tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zorem2 
    213                   tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer2 
    214                   zfolimi(ji,jj,jk)   = zofer2 
    215                END DO 
    216             END DO 
    217          END DO 
     193         DO_3D_11_11( 1, jpkm1 ) 
     194            ! POC disaggregation by turbulence and bacterial activity.  
     195            ! -------------------------------------------------------- 
     196            zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
     197            zorem2  = zremig * tr(ji,jj,jk,jpgoc,Kbb) 
     198            orem(ji,jj,jk)      = zorem2 
     199            zorem3(ji,jj,jk) = zremig * solgoc * tr(ji,jj,jk,jpgoc,Kbb) 
     200            zofer2 = zremig * tr(ji,jj,jk,jpbfe,Kbb) 
     201            zofer3 = zremig * solgoc * tr(ji,jj,jk,jpbfe,Kbb) 
     202 
     203            ! ------------------------------------- 
     204            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zorem3(ji,jj,jk) 
     205            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) - zorem2 - zorem3(ji,jj,jk) 
     206            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zofer3 
     207            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zofer2 - zofer3 
     208            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zorem2 
     209            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer2 
     210            zfolimi(ji,jj,jk)   = zofer2 
     211         END_3D 
    218212      ELSE 
    219          DO jk = 1, jpkm1 
    220             DO jj = 1, jpj 
    221                DO ji = 1, jpi 
    222                    ! POC disaggregation by turbulence and bacterial activity.  
    223                   ! -------------------------------------------------------- 
    224                   zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
    225                   zopoc2 = zremig  * tr(ji,jj,jk,jpgoc,Kbb) 
    226                   orem(ji,jj,jk) = zopoc2 
    227                   zorem3(ji,jj,jk) = zremig * solgoc * tr(ji,jj,jk,jpgoc,Kbb) 
    228                   zopon2 = xremipn / xremipc * zremig * tr(ji,jj,jk,jpgon,Kbb) 
    229                   zopop2 = xremipp / xremipc * zremig * tr(ji,jj,jk,jpgop,Kbb) 
    230                   zofer2 = xremipn / xremipc * zremig * tr(ji,jj,jk,jpbfe,Kbb) 
    231  
    232                   ! ------------------------------------- 
    233                   tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zorem3(ji,jj,jk) 
    234                   tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + solgoc * zopon2  
    235                   tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + solgoc * zopop2 
    236                   tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + solgoc * zofer2 
    237                   tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zopoc2 
    238                   tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zopon2 
    239                   tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zopop2 
    240                   tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer2 
    241                   tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) - zopoc2 - zorem3(ji,jj,jk) 
    242                   tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) - zopon2 * (1. + solgoc) 
    243                   tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) - zopop2 * (1. + solgoc) 
    244                   tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zofer2 * (1. + solgoc) 
    245                   zfolimi(ji,jj,jk)   = zofer2 
    246                END DO 
    247             END DO 
    248          END DO 
     213         DO_3D_11_11( 1, jpkm1 ) 
     214             ! POC disaggregation by turbulence and bacterial activity.  
     215            ! -------------------------------------------------------- 
     216            zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
     217            zopoc2 = zremig  * tr(ji,jj,jk,jpgoc,Kbb) 
     218            orem(ji,jj,jk) = zopoc2 
     219            zorem3(ji,jj,jk) = zremig * solgoc * tr(ji,jj,jk,jpgoc,Kbb) 
     220            zopon2 = xremipn / xremipc * zremig * tr(ji,jj,jk,jpgon,Kbb) 
     221            zopop2 = xremipp / xremipc * zremig * tr(ji,jj,jk,jpgop,Kbb) 
     222            zofer2 = xremipn / xremipc * zremig * tr(ji,jj,jk,jpbfe,Kbb) 
     223 
     224            ! ------------------------------------- 
     225            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zorem3(ji,jj,jk) 
     226            tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + solgoc * zopon2  
     227            tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + solgoc * zopop2 
     228            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + solgoc * zofer2 
     229            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zopoc2 
     230            tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zopon2 
     231            tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zopop2 
     232            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer2 
     233            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) - zopoc2 - zorem3(ji,jj,jk) 
     234            tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) - zopon2 * (1. + solgoc) 
     235            tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) - zopop2 * (1. + solgoc) 
     236            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zofer2 * (1. + solgoc) 
     237            zfolimi(ji,jj,jk)   = zofer2 
     238         END_3D 
    249239      ENDIF 
    250240 
    … …  
    269259     ! ---------------------------------------------------------------- 
    270260     !  
    271      DO jk = 1, jpkm1 
    272         DO jj = 1, jpj 
    273            DO ji = 1, jpi 
    274               zdep = hmld(ji,jj) 
    275               IF (tmask(ji,jj,jk) == 1. .AND. gdept(ji,jj,jk,Kmm) <= zdep ) THEN 
    276                 totprod(ji,jj) = totprod(ji,jj) + prodpoc(ji,jj,jk) * e3t(ji,jj,jk,Kmm) * rday/ rfact2 
    277                 ! The temperature effect is included here 
    278                 totthick(ji,jj) = totthick(ji,jj) + e3t(ji,jj,jk,Kmm)* tgfunc(ji,jj,jk) 
    279                 totcons(ji,jj) = totcons(ji,jj) - conspoc(ji,jj,jk) * e3t(ji,jj,jk,Kmm) * rday/ rfact2    & 
    280                 &                / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 
    281               ENDIF 
    282            END DO 
    283         END DO 
    284      END DO 
     261     DO_3D_11_11( 1, jpkm1 ) 
     262        zdep = hmld(ji,jj) 
     263        IF (tmask(ji,jj,jk) == 1. .AND. gdept(ji,jj,jk,Kmm) <= zdep ) THEN 
     264          totprod(ji,jj) = totprod(ji,jj) + prodpoc(ji,jj,jk) * e3t(ji,jj,jk,Kmm) * rday/ rfact2 
     265          ! The temperature effect is included here 
     266          totthick(ji,jj) = totthick(ji,jj) + e3t(ji,jj,jk,Kmm)* tgfunc(ji,jj,jk) 
     267          totcons(ji,jj) = totcons(ji,jj) - conspoc(ji,jj,jk) * e3t(ji,jj,jk,Kmm) * rday/ rfact2    & 
     268          &                / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 
     269        ENDIF 
     270     END_3D 
    285271 
    286272     ! Computation of the lability spectrum in the mixed layer. In the mixed  
    … …  
    288274     ! --------------------------------------------------------------------- 
    289275     ztremint(:,:,:) = zremipoc(:,:,:) 
    290      DO jk = 1, jpkm1 
    291         DO jj = 1, jpj 
    292            DO ji = 1, jpi 
    293               IF (tmask(ji,jj,jk) == 1.) THEN 
    294                 zdep = hmld(ji,jj) 
    295                 alphat = 0.0 
    296                 remint = 0.0 
    297                 IF( gdept(ji,jj,jk,Kmm) <= zdep ) THEN 
    298                    DO jn = 1, jcpoc 
    299                       ! For each lability class, the system is supposed to be  
    300                       ! at equilibrium: Prod - Sink - w alphap = 0. 
    301                       alphap(ji,jj,jk,jn) = totprod(ji,jj) * alphan(jn) / ( reminp(jn)    & 
    302                       &                     * totthick(ji,jj) + totcons(ji,jj) + wsbio + rtrn ) 
    303                       alphat = alphat + alphap(ji,jj,jk,jn) 
    304                    END DO 
    305                    DO jn = 1, jcpoc 
    306                       alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 
    307                       remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 
    308                    END DO 
    309                    ! Mean remineralization rate in the mixed layer 
    310                    ztremint(ji,jj,jk) =  MAX( 0., remint ) 
    311                 ENDIF 
    312               ENDIF 
    313            END DO 
    314         END DO 
    315      END DO 
     276     DO_3D_11_11( 1, jpkm1 ) 
     277        IF (tmask(ji,jj,jk) == 1.) THEN 
     278          zdep = hmld(ji,jj) 
     279          alphat = 0.0 
     280          remint = 0.0 
     281          IF( gdept(ji,jj,jk,Kmm) <= zdep ) THEN 
     282             DO jn = 1, jcpoc 
     283                ! For each lability class, the system is supposed to be  
     284                ! at equilibrium: Prod - Sink - w alphap = 0. 
     285                alphap(ji,jj,jk,jn) = totprod(ji,jj) * alphan(jn) / ( reminp(jn)    & 
     286                &                     * totthick(ji,jj) + totcons(ji,jj) + wsbio + rtrn ) 
     287                alphat = alphat + alphap(ji,jj,jk,jn) 
     288             END DO 
     289             DO jn = 1, jcpoc 
     290                alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 
     291                remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 
     292             END DO 
     293             ! Mean remineralization rate in the mixed layer 
     294             ztremint(ji,jj,jk) =  MAX( 0., remint ) 
     295          ENDIF 
     296        ENDIF 
     297     END_3D 
    316298     ! 
    317299     IF( ln_p4z ) THEN   ;  zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 
    … …  
    327309     ! ----------------------------------------------------------------------- 
    328310     ! 
    329      DO jk = 2, jpkm1 
    330         DO jj = 1, jpj 
    331            DO ji = 1, jpi 
    332               IF (tmask(ji,jj,jk) == 1.) THEN 
    333                 zdep = hmld(ji,jj) 
    334                 IF( gdept(ji,jj,jk,Kmm) > zdep ) THEN 
    335                   alphat = 0. 
    336                   remint = 0. 
    337                   ! 
    338                   ! the scale factors are corrected with temperature 
    339                   zsizek1  = e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 
    340                   zsizek = e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 
    341                   ! 
    342                   ! Special treatment of the level just below the MXL 
    343                   ! See the comments in the GOC section 
    344                   ! --------------------------------------------------- 
    345                   ! 
    346                   IF ( gdept(ji,jj,jk-1,Kmm) <= zdep ) THEN 
    347                     ! 
    348                     ! Computation of the POC concentration using the  
    349                     ! lagrangian algorithm 
    350                     zpoc = tr(ji,jj,jk-1,jppoc,Kbb) + conspoc(ji,jj,jk) * rday / rfact2               & 
    351                     &   * e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn) 
    352                     zpoc = max(0., zpoc) 
    353                     !  
    354                     DO jn = 1, jcpoc 
    355                        ! computation of the lability spectrum applying the  
    356                        ! different sources and sinks 
    357                        alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc  & 
    358                        &   + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk) * alphag(ji,jj,jk,jn) ) & 
    359                        &   / tgfunc(ji,jj,jk) / reminp(jn) * rday / rfact2 * ( 1. - exp( -reminp(jn)     & 
    360                        &   * zsizek ) ) 
    361                        alphap(ji,jj,jk,jn) = MAX( 0., alphap(ji,jj,jk,jn) ) 
    362                        alphat = alphat + alphap(ji,jj,jk,jn) 
    363                     END DO 
    364                   ELSE 
    365                     ! 
    366                     ! Lability parameterization for the interior of the ocean 
    367                     ! This is very similar to what is done in the previous  
    368                     ! block 
    369                     ! -------------------------------------------------------- 
    370                     ! 
    371                     zpoc = tr(ji,jj,jk-1,jppoc,Kbb) + conspoc(ji,jj,jk-1) * rday / rfact2               & 
    372                     &   * e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) + conspoc(ji,jj,jk)   & 
    373                     &   * rday / rfact2 * e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn) 
    374                     zpoc = max(0., zpoc) 
    375                     ! 
    376                     DO jn = 1, jcpoc 
    377                        alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn)                       & 
    378                        &   * ( zsizek + zsizek1 ) ) * zpoc + ( prodpoc(ji,jj,jk-1) * alphan(jn)             &  
    379                        &   + zorem3(ji,jj,jk-1) * alphag(ji,jj,jk-1,jn) ) * rday / rfact2 / reminp(jn)      & 
    380                        &   / tgfunc(ji,jj,jk-1) * ( 1. - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn)  & 
    381                        &   * zsizek ) + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk)                 & 
    382                        &   * alphag(ji,jj,jk,jn) ) * rday / rfact2 / reminp(jn) / tgfunc(ji,jj,jk) * ( 1.   & 
    383                        &   - exp( -reminp(jn) * zsizek ) ) 
    384                        alphap(ji,jj,jk,jn) = max(0., alphap(ji,jj,jk,jn) ) 
    385                        alphat = alphat + alphap(ji,jj,jk,jn) 
    386                     END DO 
    387                   ENDIF 
    388                   ! Normalization of the lability spectrum so that the  
    389                   ! integral is equal to 1 
    390                   DO jn = 1, jcpoc 
    391                      alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 
    392                      remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 
    393                   END DO 
    394                   ! Mean remineralization rate in the water column 
    395                   ztremint(ji,jj,jk) =  MAX( 0., remint ) 
    396                 ENDIF 
    397               ENDIF 
     311     DO_3D_11_11( 2, jpkm1 ) 
     312        IF (tmask(ji,jj,jk) == 1.) THEN 
     313          zdep = hmld(ji,jj) 
     314          IF( gdept(ji,jj,jk,Kmm) > zdep ) THEN 
     315            alphat = 0. 
     316            remint = 0. 
     317            ! 
     318            ! the scale factors are corrected with temperature 
     319            zsizek1  = e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 
     320            zsizek = e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 
     321            ! 
     322            ! Special treatment of the level just below the MXL 
     323            ! See the comments in the GOC section 
     324            ! --------------------------------------------------- 
     325            ! 
     326            IF ( gdept(ji,jj,jk-1,Kmm) <= zdep ) THEN 
     327              ! 
     328              ! Computation of the POC concentration using the  
     329              ! lagrangian algorithm 
     330              zpoc = tr(ji,jj,jk-1,jppoc,Kbb) + conspoc(ji,jj,jk) * rday / rfact2               & 
     331              &   * e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn) 
     332              zpoc = max(0., zpoc) 
     333              !  
     334              DO jn = 1, jcpoc 
     335                 ! computation of the lability spectrum applying the  
     336                 ! different sources and sinks 
     337                 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc  & 
     338                 &   + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk) * alphag(ji,jj,jk,jn) ) & 
     339                 &   / tgfunc(ji,jj,jk) / reminp(jn) * rday / rfact2 * ( 1. - exp( -reminp(jn)     & 
     340                 &   * zsizek ) ) 
     341                 alphap(ji,jj,jk,jn) = MAX( 0., alphap(ji,jj,jk,jn) ) 
     342                 alphat = alphat + alphap(ji,jj,jk,jn) 
     343              END DO 
     344            ELSE 
     345              ! 
     346              ! Lability parameterization for the interior of the ocean 
     347              ! This is very similar to what is done in the previous  
     348              ! block 
     349              ! -------------------------------------------------------- 
     350              ! 
     351              zpoc = tr(ji,jj,jk-1,jppoc,Kbb) + conspoc(ji,jj,jk-1) * rday / rfact2               & 
     352              &   * e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) + conspoc(ji,jj,jk)   & 
     353              &   * rday / rfact2 * e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn) 
     354              zpoc = max(0., zpoc) 
     355              ! 
     356              DO jn = 1, jcpoc 
     357                 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn)                       & 
     358                 &   * ( zsizek + zsizek1 ) ) * zpoc + ( prodpoc(ji,jj,jk-1) * alphan(jn)             &  
     359                 &   + zorem3(ji,jj,jk-1) * alphag(ji,jj,jk-1,jn) ) * rday / rfact2 / reminp(jn)      & 
     360                 &   / tgfunc(ji,jj,jk-1) * ( 1. - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn)  & 
     361                 &   * zsizek ) + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk)                 & 
     362                 &   * alphag(ji,jj,jk,jn) ) * rday / rfact2 / reminp(jn) / tgfunc(ji,jj,jk) * ( 1.   & 
     363                 &   - exp( -reminp(jn) * zsizek ) ) 
     364                 alphap(ji,jj,jk,jn) = max(0., alphap(ji,jj,jk,jn) ) 
     365                 alphat = alphat + alphap(ji,jj,jk,jn) 
     366              END DO 
     367            ENDIF 
     368            ! Normalization of the lability spectrum so that the  
     369            ! integral is equal to 1 
     370            DO jn = 1, jcpoc 
     371               alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 
     372               remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 
    398373            END DO 
    399          END DO 
    400       END DO 
     374            ! Mean remineralization rate in the water column 
     375            ztremint(ji,jj,jk) =  MAX( 0., remint ) 
     376          ENDIF 
     377        ENDIF 
     378     END_3D 
    401379 
    402380     IF( ln_p4z ) THEN   ;   zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 
    … …  
    405383 
    406384     IF( ln_p4z ) THEN 
    407          DO jk = 1, jpkm1 
    408             DO jj = 1, jpj 
    409                DO ji = 1, jpi 
    410                   IF (tmask(ji,jj,jk) == 1.) THEN 
    411                     ! POC disaggregation by turbulence and bacterial activity.  
    412                     ! -------------------------------------------------------- 
    413                     zremip          = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
    414                     zorem           = zremip * tr(ji,jj,jk,jppoc,Kbb) 
    415                     zofer           = zremip * tr(ji,jj,jk,jpsfe,Kbb) 
    416  
    417                     tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zorem 
    418                     orem(ji,jj,jk)      = orem(ji,jj,jk) + zorem 
    419                     tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer 
    420                     tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zorem 
    421                     tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zofer 
    422                     zfolimi(ji,jj,jk)   = zfolimi(ji,jj,jk) + zofer 
    423                   ENDIF 
    424                END DO 
    425             END DO 
    426          END DO 
     385         DO_3D_11_11( 1, jpkm1 ) 
     386            IF (tmask(ji,jj,jk) == 1.) THEN 
     387              ! POC disaggregation by turbulence and bacterial activity.  
     388              ! -------------------------------------------------------- 
     389              zremip          = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
     390              zorem           = zremip * tr(ji,jj,jk,jppoc,Kbb) 
     391              zofer           = zremip * tr(ji,jj,jk,jpsfe,Kbb) 
     392 
     393              tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zorem 
     394              orem(ji,jj,jk)      = orem(ji,jj,jk) + zorem 
     395              tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer 
     396              tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zorem 
     397              tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zofer 
     398              zfolimi(ji,jj,jk)   = zfolimi(ji,jj,jk) + zofer 
     399            ENDIF 
     400         END_3D 
    427401     ELSE 
    428        DO jk = 1, jpkm1 
    429           DO jj = 1, jpj 
    430              DO ji = 1, jpi 
    431                 ! POC disaggregation by turbulence and bacterial activity.  
    432                 ! -------------------------------------------------------- 
    433                 zremip = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
    434                 zopoc  = zremip * tr(ji,jj,jk,jppoc,Kbb) 
    435                 orem(ji,jj,jk)  = orem(ji,jj,jk) + zopoc 
    436                 zopon  = xremipn / xremipc * zremip * tr(ji,jj,jk,jppon,Kbb) 
    437                 zopop  = xremipp / xremipc * zremip * tr(ji,jj,jk,jppop,Kbb) 
    438                 zofer  = xremipn / xremipc * zremip * tr(ji,jj,jk,jpsfe,Kbb) 
    439  
    440                 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zopoc 
    441                 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) - zopon 
    442                 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) - zopop 
    443                 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zofer 
    444                 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zopoc 
    445                 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zopon  
    446                 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zopop  
    447                 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer  
    448                 zfolimi(ji,jj,jk)   = zfolimi(ji,jj,jk) + zofer 
    449              END DO 
    450            END DO 
    451         END DO 
     402       DO_3D_11_11( 1, jpkm1 ) 
     403          ! POC disaggregation by turbulence and bacterial activity.  
     404          ! -------------------------------------------------------- 
     405          zremip = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
     406          zopoc  = zremip * tr(ji,jj,jk,jppoc,Kbb) 
     407          orem(ji,jj,jk)  = orem(ji,jj,jk) + zopoc 
     408          zopon  = xremipn / xremipc * zremip * tr(ji,jj,jk,jppon,Kbb) 
     409          zopop  = xremipp / xremipc * zremip * tr(ji,jj,jk,jppop,Kbb) 
     410          zofer  = xremipn / xremipc * zremip * tr(ji,jj,jk,jpsfe,Kbb) 
     411 
     412          tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zopoc 
     413          tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) - zopon 
     414          tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) - zopop 
     415          tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zofer 
     416          tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zopoc 
     417          tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zopon  
     418          tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zopop  
     419          tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer  
     420          zfolimi(ji,jj,jk)   = zfolimi(ji,jj,jk) + zofer 
     421       END_3D 
    452422     ENDIF 
    453423 

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

    r12281 r12340  
    4646   REAL(wp) ::   texcretd   ! 1 - excretd         
    4747 
     48   !! * Substitutions 
     49#  include "do_loop_substitute.h90" 
    4850   !!---------------------------------------------------------------------- 
    4951   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    107109      ! day length in hours 
    108110      zstrn(:,:) = 0. 
    109       DO jj = 1, jpj 
    110          DO ji = 1, jpi 
    111             zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 
    112             zargu = MAX( -1., MIN(  1., zargu ) ) 
    113             zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 
    114          END DO 
    115       END DO 
     111      DO_2D_11_11 
     112         zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 
     113         zargu = MAX( -1., MIN(  1., zargu ) ) 
     114         zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 
     115      END_2D 
    116116 
    117117      ! Impact of the day duration and light intermittency on phytoplankton growth 
    118       DO jk = 1, jpkm1 
    119          DO jj = 1 ,jpj 
    120             DO ji = 1, jpi 
    121                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    122                   zval = MAX( 1., zstrn(ji,jj) ) 
    123                   IF( gdept(ji,jj,jk,Kmm) <= hmld(ji,jj) ) THEN 
    124                      zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 
    125                   ENDIF 
    126                   zmxl_chl(ji,jj,jk) = zval / 24. 
    127                   zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval ) 
    128                ENDIF 
    129             END DO 
    130          END DO 
    131       END DO 
     118      DO_3D_11_11( 1, jpkm1 ) 
     119         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     120            zval = MAX( 1., zstrn(ji,jj) ) 
     121            IF( gdept(ji,jj,jk,Kmm) <= hmld(ji,jj) ) THEN 
     122               zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 
     123            ENDIF 
     124            zmxl_chl(ji,jj,jk) = zval / 24. 
     125            zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval ) 
     126         ENDIF 
     127      END_3D 
    132128 
    133129      zprbio(:,:,:) = zprmaxn(:,:,:) * zmxl_fac(:,:,:) 
    … …  
    138134 
    139135      ! Computation of the P-I slope for nanos and diatoms 
    140       DO jk = 1, jpkm1 
    141          DO jj = 1, jpj 
    142             DO ji = 1, jpi 
    143                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    144                   ztn         = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. ) 
    145                   zadap       = xadap * ztn / ( 2.+ ztn ) 
    146                   zconctemp   = MAX( 0.e0 , tr(ji,jj,jk,jpdia,Kbb) - xsizedia ) 
    147                   zconctemp2  = tr(ji,jj,jk,jpdia,Kbb) - zconctemp 
    148                   ! 
    149                   zpislopeadn(ji,jj,jk) = pislopen * ( 1.+ zadap  * EXP( -0.25 * enano(ji,jj,jk) ) )  & 
    150                   &                   * tr(ji,jj,jk,jpnch,Kbb) /( tr(ji,jj,jk,jpphy,Kbb) * 12. + rtrn) 
    151                   ! 
    152                   zpislopeadd(ji,jj,jk) = (pislopen * zconctemp2 + pisloped * zconctemp) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )   & 
    153                   &                   * tr(ji,jj,jk,jpdch,Kbb) /( tr(ji,jj,jk,jpdia,Kbb) * 12. + rtrn) 
    154                ENDIF 
    155             END DO 
    156          END DO 
    157       END DO 
    158  
    159       DO jk = 1, jpkm1 
    160          DO jj = 1, jpj 
    161             DO ji = 1, jpi 
    162                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    163                    ! Computation of production function for Carbon 
    164                    !  --------------------------------------------- 
    165                    zpislopen = zpislopeadn(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 
    166                    &            * zmxl_fac(ji,jj,jk) * rday + rtrn) 
    167                    zpisloped = zpislopeadd(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 
    168                    &            * zmxl_fac(ji,jj,jk) * rday + rtrn) 
    169                    zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) )  ) 
    170                    zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) )  ) 
    171                    !  Computation of production function for Chlorophyll 
    172                    !-------------------------------------------------- 
    173                    zpislopen = zpislopeadn(ji,jj,jk) / ( zprmaxn(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 
    174                    zpisloped = zpislopeadd(ji,jj,jk) / ( zprmaxd(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 
    175                    zprnch(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) ) ) 
    176                    zprdch(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) ) ) 
    177                ENDIF 
    178             END DO 
    179          END DO 
    180       END DO 
     136      DO_3D_11_11( 1, jpkm1 ) 
     137         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     138            ztn         = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. ) 
     139            zadap       = xadap * ztn / ( 2.+ ztn ) 
     140            zconctemp   = MAX( 0.e0 , tr(ji,jj,jk,jpdia,Kbb) - xsizedia ) 
     141            zconctemp2  = tr(ji,jj,jk,jpdia,Kbb) - zconctemp 
     142            ! 
     143            zpislopeadn(ji,jj,jk) = pislopen * ( 1.+ zadap  * EXP( -0.25 * enano(ji,jj,jk) ) )  & 
     144            &                   * tr(ji,jj,jk,jpnch,Kbb) /( tr(ji,jj,jk,jpphy,Kbb) * 12. + rtrn) 
     145            ! 
     146            zpislopeadd(ji,jj,jk) = (pislopen * zconctemp2 + pisloped * zconctemp) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )   & 
     147            &                   * tr(ji,jj,jk,jpdch,Kbb) /( tr(ji,jj,jk,jpdia,Kbb) * 12. + rtrn) 
     148         ENDIF 
     149      END_3D 
     150 
     151      DO_3D_11_11( 1, jpkm1 ) 
     152         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     153             ! Computation of production function for Carbon 
     154             !  --------------------------------------------- 
     155             zpislopen = zpislopeadn(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 
     156             &            * zmxl_fac(ji,jj,jk) * rday + rtrn) 
     157             zpisloped = zpislopeadd(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 
     158             &            * zmxl_fac(ji,jj,jk) * rday + rtrn) 
     159             zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) )  ) 
     160             zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) )  ) 
     161             !  Computation of production function for Chlorophyll 
     162             !-------------------------------------------------- 
     163             zpislopen = zpislopeadn(ji,jj,jk) / ( zprmaxn(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 
     164             zpisloped = zpislopeadd(ji,jj,jk) / ( zprmaxd(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 
     165             zprnch(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) ) ) 
     166             zprdch(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) ) ) 
     167         ENDIF 
     168      END_3D 
    181169 
    182170      !  Computation of a proxy of the N/C ratio 
    183171      !  --------------------------------------- 
    184       DO jk = 1, jpkm1 
    185          DO jj = 1, jpj 
    186             DO ji = 1, jpi 
    187                 zval = MIN( xnanopo4(ji,jj,jk), ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) )   & 
    188                 &      * zprmaxn(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn ) 
    189                 quotan(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval ) 
    190                 zval = MIN( xdiatpo4(ji,jj,jk), ( xdiatnh4(ji,jj,jk) + xdiatno3(ji,jj,jk) ) )   & 
    191                 &      * zprmaxd(ji,jj,jk) / ( zprdia(ji,jj,jk) + rtrn ) 
    192                 quotad(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval ) 
    193             END DO 
    194          END DO 
    195       END DO 
    196  
    197  
    198       DO jk = 1, jpkm1 
    199          DO jj = 1, jpj 
    200             DO ji = 1, jpi 
    201  
    202                 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    203                    !    Si/C of diatoms 
    204                    !    ------------------------ 
    205                    !    Si/C increases with iron stress and silicate availability 
    206                    !    Si/C is arbitrariliy increased for very high Si concentrations 
    207                    !    to mimic the very high ratios observed in the Southern Ocean (silpot2) 
    208                   zlim  = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi1 ) 
    209                   zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 
    210                   zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0 
    211                   zsiborn = tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) 
    212                   IF (gphit(ji,jj) < -30 ) THEN 
    213                     zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 ) 
    214                   ELSE 
    215                     zsilfac2 = 1. +      zsiborn / ( zsiborn + xksi2**3 ) 
    216                   ENDIF 
    217                   zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2 
    218               ENDIF 
    219             END DO 
    220          END DO 
    221       END DO 
     172      DO_3D_11_11( 1, jpkm1 ) 
     173          zval = MIN( xnanopo4(ji,jj,jk), ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) )   & 
     174          &      * zprmaxn(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn ) 
     175          quotan(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval ) 
     176          zval = MIN( xdiatpo4(ji,jj,jk), ( xdiatnh4(ji,jj,jk) + xdiatno3(ji,jj,jk) ) )   & 
     177          &      * zprmaxd(ji,jj,jk) / ( zprdia(ji,jj,jk) + rtrn ) 
     178          quotad(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval ) 
     179      END_3D 
     180 
     181 
     182      DO_3D_11_11( 1, jpkm1 ) 
     183 
     184          IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     185             !    Si/C of diatoms 
     186             !    ------------------------ 
     187             !    Si/C increases with iron stress and silicate availability 
     188             !    Si/C is arbitrariliy increased for very high Si concentrations 
     189             !    to mimic the very high ratios observed in the Southern Ocean (silpot2) 
     190            zlim  = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi1 ) 
     191            zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 
     192            zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0 
     193            zsiborn = tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) 
     194            IF (gphit(ji,jj) < -30 ) THEN 
     195              zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 ) 
     196            ELSE 
     197              zsilfac2 = 1. +      zsiborn / ( zsiborn + xksi2**3 ) 
     198            ENDIF 
     199            zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2 
     200        ENDIF 
     201      END_3D 
    222202 
    223203      !  Mixed-layer effect on production  
    224204      !  Sea-ice effect on production 
    225205 
    226       DO jk = 1, jpkm1 
    227          DO jj = 1, jpj 
    228             DO ji = 1, jpi 
    229                zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
    230                zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
    231             END DO 
    232          END DO 
    233       END DO 
     206      DO_3D_11_11( 1, jpkm1 ) 
     207         zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
     208         zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
     209      END_3D 
    234210 
    235211      ! Computation of the various production terms  
    236       DO jk = 1, jpkm1 
    237          DO jj = 1, jpj 
    238             DO ji = 1, jpi 
    239                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    240                   !  production terms for nanophyto. (C) 
    241                   zprorcan(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * tr(ji,jj,jk,jpphy,Kbb) * rfact2 
    242                   zpronewn(ji,jj,jk)  = zprorcan(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 
    243                   ! 
    244                   zratio = tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) * fecnm + rtrn ) 
    245                   zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )  
    246                   zprofen(ji,jj,jk) = fecnm * zprmaxn(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) )  & 
    247                   &             * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) )    & 
    248                   &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) )  & 
    249                   &             * zmax * tr(ji,jj,jk,jpphy,Kbb) * rfact2 
    250                   !  production terms for diatoms (C) 
    251                   zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr(ji,jj,jk,jpdia,Kbb) * rfact2 
    252                   zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 
    253                   ! 
    254                   zratio = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) * fecdm + rtrn ) 
    255                   zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )  
    256                   zprofed(ji,jj,jk) = fecdm * zprmaxd(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) )  & 
    257                   &             * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) )    & 
    258                   &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) )  & 
    259                   &             * zmax * tr(ji,jj,jk,jpdia,Kbb) * rfact2 
    260                ENDIF 
    261             END DO 
    262          END DO 
    263       END DO 
     212      DO_3D_11_11( 1, jpkm1 ) 
     213         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     214            !  production terms for nanophyto. (C) 
     215            zprorcan(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * tr(ji,jj,jk,jpphy,Kbb) * rfact2 
     216            zpronewn(ji,jj,jk)  = zprorcan(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 
     217            ! 
     218            zratio = tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) * fecnm + rtrn ) 
     219            zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )  
     220            zprofen(ji,jj,jk) = fecnm * zprmaxn(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) )  & 
     221            &             * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) )    & 
     222            &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) )  & 
     223            &             * zmax * tr(ji,jj,jk,jpphy,Kbb) * rfact2 
     224            !  production terms for diatoms (C) 
     225            zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr(ji,jj,jk,jpdia,Kbb) * rfact2 
     226            zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 
     227            ! 
     228            zratio = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) * fecdm + rtrn ) 
     229            zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )  
     230            zprofed(ji,jj,jk) = fecdm * zprmaxd(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) )  & 
     231            &             * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) )    & 
     232            &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) )  & 
     233            &             * zmax * tr(ji,jj,jk,jpdia,Kbb) * rfact2 
     234         ENDIF 
     235      END_3D 
    264236 
    265237      ! Computation of the chlorophyll production terms 
    266       DO jk = 1, jpkm1 
    267          DO jj = 1, jpj 
    268             DO ji = 1, jpi 
    269                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    270                   !  production terms for nanophyto. ( chlorophyll ) 
    271                   znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
    272                   zprod    = rday * zprorcan(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 
    273                   zprochln = chlcmin * 12. * zprorcan (ji,jj,jk) 
    274                   chlcnm_n   = MIN ( chlcnm, ( chlcnm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm))) * (1. - 1.14 / 43.4 * 20.)) 
    275                   zprochln = zprochln + (chlcnm_n-chlcmin) * 12. * zprod / & 
    276                                         & (  zpislopeadn(ji,jj,jk) * znanotot +rtrn) 
    277                   !  production terms for diatoms ( chlorophyll ) 
    278                   zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
    279                   zprod    = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 
    280                   zprochld = chlcmin * 12. * zprorcad(ji,jj,jk) 
    281                   chlcdm_n   = MIN ( chlcdm, ( chlcdm / (1. - 1.14 / 43.4 * ts(ji,jj,jk,jp_tem,Kmm))) * (1. - 1.14 / 43.4 * 20.)) 
    282                   zprochld = zprochld + (chlcdm_n-chlcmin) * 12. * zprod / & 
    283                                         & ( zpislopeadd(ji,jj,jk) * zdiattot +rtrn ) 
    284                   !   Update the arrays TRA which contain the Chla sources and sinks 
    285                   tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) + zprochln * texcretn 
    286                   tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) + zprochld * texcretd 
    287                ENDIF 
    288             END DO 
    289          END DO 
    290       END DO 
     238      DO_3D_11_11( 1, jpkm1 ) 
     239         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     240            !  production terms for nanophyto. ( chlorophyll ) 
     241            znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     242            zprod    = rday * zprorcan(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 
     243            zprochln = chlcmin * 12. * zprorcan (ji,jj,jk) 
     244            chlcnm_n   = MIN ( chlcnm, ( chlcnm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm))) * (1. - 1.14 / 43.4 * 20.)) 
     245            zprochln = zprochln + (chlcnm_n-chlcmin) * 12. * zprod / & 
     246                                  & (  zpislopeadn(ji,jj,jk) * znanotot +rtrn) 
     247            !  production terms for diatoms ( chlorophyll ) 
     248            zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     249            zprod    = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 
     250            zprochld = chlcmin * 12. * zprorcad(ji,jj,jk) 
     251            chlcdm_n   = MIN ( chlcdm, ( chlcdm / (1. - 1.14 / 43.4 * ts(ji,jj,jk,jp_tem,Kmm))) * (1. - 1.14 / 43.4 * 20.)) 
     252            zprochld = zprochld + (chlcdm_n-chlcmin) * 12. * zprod / & 
     253                                  & ( zpislopeadd(ji,jj,jk) * zdiattot +rtrn ) 
     254            !   Update the arrays TRA which contain the Chla sources and sinks 
     255            tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) + zprochln * texcretn 
     256            tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) + zprochld * texcretd 
     257         ENDIF 
     258      END_3D 
    291259 
    292260      !   Update the arrays TRA which contain the biological sources and sinks 
    293       DO jk = 1, jpkm1 
    294          DO jj = 1, jpj 
    295            DO ji =1 ,jpi 
    296               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    297                  zproreg  = zprorcan(ji,jj,jk) - zpronewn(ji,jj,jk) 
    298                  zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk) 
    299                  zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 
    300                  tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 
    301                  tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk) 
    302                  tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zproreg - zproreg2 
    303                  tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zprorcan(ji,jj,jk) * texcretn 
    304                  tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) + zprofen(ji,jj,jk) * texcretn 
    305                  tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) + zprorcad(ji,jj,jk) * texcretd 
    306                  tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) + zprofed(ji,jj,jk) * texcretd 
    307                  tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 
    308                  tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zdocprod 
    309                  tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + o2ut * ( zproreg + zproreg2) & 
    310                  &                   + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) 
    311                  ! 
    312                  zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 
    313                  tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zfeup 
    314                  tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 
    315                  tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 
    316                  tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 
    317                  &                                         - rno3 * ( zproreg + zproreg2 ) 
    318               ENDIF 
    319            END DO 
    320         END DO 
    321      END DO 
     261      DO_3D_11_11( 1, jpkm1 ) 
     262        IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     263           zproreg  = zprorcan(ji,jj,jk) - zpronewn(ji,jj,jk) 
     264           zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk) 
     265           zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 
     266           tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 
     267           tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk) 
     268           tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zproreg - zproreg2 
     269           tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zprorcan(ji,jj,jk) * texcretn 
     270           tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) + zprofen(ji,jj,jk) * texcretn 
     271           tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) + zprorcad(ji,jj,jk) * texcretd 
     272           tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) + zprofed(ji,jj,jk) * texcretd 
     273           tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 
     274           tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zdocprod 
     275           tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + o2ut * ( zproreg + zproreg2) & 
     276           &                   + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) 
     277           ! 
     278           zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 
     279           tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zfeup 
     280           tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 
     281           tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 
     282           tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 
     283           &                                         - rno3 * ( zproreg + zproreg2 ) 
     284        ENDIF 
     285      END_3D 
    322286     ! 
    323287     IF( ln_ligand ) THEN 
    324288         zpligprod1(:,:,:) = 0._wp    ;    zpligprod2(:,:,:) = 0._wp 
    325          DO jk = 1, jpkm1 
    326             DO jj = 1, jpj 
    327               DO ji =1 ,jpi 
    328                  IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    329                     zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 
    330                     zfeup    = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 
    331                     tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 
    332                     zpligprod1(ji,jj,jk) = zdocprod * ldocp 
    333                     zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet 
    334                  ENDIF 
    335               END DO 
    336            END DO 
    337         END DO 
     289         DO_3D_11_11( 1, jpkm1 ) 
     290           IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     291              zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 
     292              zfeup    = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 
     293              tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 
     294              zpligprod1(ji,jj,jk) = zdocprod * ldocp 
     295              zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet 
     296           ENDIF 
     297         END_3D 
    338298     ENDIF 
    339299 

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

    r12258 r12340  
    4242   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitr   !: denitrification array 
    4343 
     44   !! * Substitutions 
     45#  include "do_loop_substitute.h90" 
    4446   !!---------------------------------------------------------------------- 
    4547   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    8688      ! that was modeling explicitely bacteria 
    8789      ! ------------------------------------------------------- 
    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(ji,jj,jk,Kmm) < zdep ) THEN 
    93                   zdepbac(ji,jj,jk) = MIN( 0.7 * ( tr(ji,jj,jk,jpzoo,Kbb) + 2.* tr(ji,jj,jk,jpmes,Kbb) ), 4.e-6 ) 
    94                   ztempbac(ji,jj)   = zdepbac(ji,jj,jk) 
    95                ELSE 
    96                   zdepmin = MIN( 1., zdep / gdept(ji,jj,jk,Kmm) ) 
    97                   zdepbac (ji,jj,jk) = zdepmin**0.683 * ztempbac(ji,jj) 
    98                   zdepprod(ji,jj,jk) = zdepmin**0.273 
    99                   zdepeff (ji,jj,jk) = zdepeff(ji,jj,jk) * zdepmin**0.3 
    100                ENDIF 
    101             END DO 
    102          END DO 
    103       END DO 
     90      DO_3D_11_11( 1, jpkm1 ) 
     91         zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 
     92         IF( gdept(ji,jj,jk,Kmm) < zdep ) THEN 
     93            zdepbac(ji,jj,jk) = MIN( 0.7 * ( tr(ji,jj,jk,jpzoo,Kbb) + 2.* tr(ji,jj,jk,jpmes,Kbb) ), 4.e-6 ) 
     94            ztempbac(ji,jj)   = zdepbac(ji,jj,jk) 
     95         ELSE 
     96            zdepmin = MIN( 1., zdep / gdept(ji,jj,jk,Kmm) ) 
     97            zdepbac (ji,jj,jk) = zdepmin**0.683 * ztempbac(ji,jj) 
     98            zdepprod(ji,jj,jk) = zdepmin**0.273 
     99            zdepeff (ji,jj,jk) = zdepeff(ji,jj,jk) * zdepmin**0.3 
     100         ENDIF 
     101      END_3D 
    104102 
    105103      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) ) * tr(ji,jj,jk,jpdoc,Kbb)  
    116                   zolimi(ji,jj,jk) = MIN( ( tr(ji,jj,jk,jpoxy,Kbb) - rtrn ) / o2ut, zolimit )  
    117                   ! Ammonification in suboxic waters with denitrification 
    118                   ! ------------------------------------------------------- 
    119                   zammonic = zremik * nitrfac(ji,jj,jk) * tr(ji,jj,jk,jpdoc,Kbb) 
    120                   denitr(ji,jj,jk)  = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 
    121                   denitr(ji,jj,jk)  = MIN( ( tr(ji,jj,jk,jpno3,Kbb) - 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                   tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 
    130                   tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 
    131                   tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - denitr (ji,jj,jk) * rdenit 
    132                   tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zolimi (ji,jj,jk) - denitr(ji,jj,jk) - zoxyremc 
    133                   tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - zolimi (ji,jj,jk) * o2ut 
    134                   tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 
    135                   tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zolimi(ji,jj,jk) + zoxyremc    & 
    136                   &                     + ( rdenit + 1.) * denitr(ji,jj,jk) ) 
    137                END DO 
    138             END DO 
    139          END DO 
     104         DO_3D_11_11( 1, jpkm1 ) 
     105            ! DOC ammonification. Depends on depth, phytoplankton biomass 
     106            ! and a limitation term which is supposed to be a parameterization of the bacterial activity.  
     107            zremik = xremik * xstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk)  
     108            zremik = MAX( zremik, 2.74e-4 * xstep ) 
     109            ! Ammonification in oxic waters with oxygen consumption 
     110            ! ----------------------------------------------------- 
     111            zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * tr(ji,jj,jk,jpdoc,Kbb)  
     112            zolimi(ji,jj,jk) = MIN( ( tr(ji,jj,jk,jpoxy,Kbb) - rtrn ) / o2ut, zolimit )  
     113            ! Ammonification in suboxic waters with denitrification 
     114            ! ------------------------------------------------------- 
     115            zammonic = zremik * nitrfac(ji,jj,jk) * tr(ji,jj,jk,jpdoc,Kbb) 
     116            denitr(ji,jj,jk)  = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 
     117            denitr(ji,jj,jk)  = MIN( ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenit, denitr(ji,jj,jk) ) 
     118            zoxyremc          = zammonic - denitr(ji,jj,jk) 
     119            ! 
     120            zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) ) 
     121            denitr (ji,jj,jk) = MAX( 0.e0, denitr (ji,jj,jk) ) 
     122            zoxyremc          = MAX( 0.e0, zoxyremc ) 
     123 
     124            ! 
     125            tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 
     126            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 
     127            tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - denitr (ji,jj,jk) * rdenit 
     128            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zolimi (ji,jj,jk) - denitr(ji,jj,jk) - zoxyremc 
     129            tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - zolimi (ji,jj,jk) * o2ut 
     130            tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 
     131            tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zolimi(ji,jj,jk) + zoxyremc    & 
     132            &                     + ( rdenit + 1.) * denitr(ji,jj,jk) ) 
     133         END_3D 
    140134      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) ) * tr(ji,jj,jk,jpdoc,Kbb)  
    157                   zolimic = MAX( 0.e0, MIN( ( tr(ji,jj,jk,jpoxy,Kbb) - rtrn ) / o2ut, zolimit ) )  
    158                   zolimi(ji,jj,jk) = zolimic 
    159                   zolimin = zremikn * zolimic * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
    160                   zolimip = zremikp * zolimic * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn )  
    161  
    162                   ! Ammonification in suboxic waters with denitrification 
    163                   ! ------------------------------------------------------- 
    164                   zammonic = zremikc * nitrfac(ji,jj,jk) * tr(ji,jj,jk,jpdoc,Kbb) 
    165                   denitr(ji,jj,jk)  = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 
    166                   denitr(ji,jj,jk)  = MAX(0., MIN(  ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenit, denitr(ji,jj,jk) ) ) 
    167                   zoxyremc          = MAX(0., zammonic - denitr(ji,jj,jk)) 
    168                   zdenitrn  = zremikn * denitr(ji,jj,jk) * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
    169                   zdenitrp  = zremikp * denitr(ji,jj,jk) * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
    170                   zoxyremn  = zremikn * zoxyremc * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
    171                   zoxyremp  = zremikp * zoxyremc * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
    172  
    173                   tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zolimip + zdenitrp + zoxyremp 
    174                   tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zolimin + zdenitrn + zoxyremn 
    175                   tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - denitr(ji,jj,jk) * rdenit 
    176                   tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zolimic - denitr(ji,jj,jk) - zoxyremc 
    177                   tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) - zolimin - zdenitrn - zoxyremn 
    178                   tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) - zolimip - zdenitrp - zoxyremp 
    179                   tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - zolimic * o2ut 
    180                   tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zolimic + denitr(ji,jj,jk) + zoxyremc 
    181                   tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zolimin + zoxyremn + ( rdenit + 1.) * zdenitrn ) 
    182                END DO 
    183             END DO 
    184          END DO 
     135         DO_3D_11_11( 1, jpkm1 ) 
     136            ! DOC ammonification. Depends on depth, phytoplankton biomass 
     137            ! and a limitation term which is supposed to be a parameterization of the bacterial activity.  
     138            ! ----------------------------------------------------------------- 
     139            zremik = xstep / 1.e-6 * MAX(0.01, xlimbac(ji,jj,jk)) * zdepbac(ji,jj,jk)  
     140            zremik = MAX( zremik, 2.74e-4 * xstep / xremikc ) 
     141 
     142            zremikc = xremikc * zremik 
     143            zremikn = xremikn / xremikc 
     144            zremikp = xremikp / xremikc 
     145 
     146            ! Ammonification in oxic waters with oxygen consumption 
     147            ! ----------------------------------------------------- 
     148            zolimit = zremikc * ( 1.- nitrfac(ji,jj,jk) ) * tr(ji,jj,jk,jpdoc,Kbb)  
     149            zolimic = MAX( 0.e0, MIN( ( tr(ji,jj,jk,jpoxy,Kbb) - rtrn ) / o2ut, zolimit ) )  
     150            zolimi(ji,jj,jk) = zolimic 
     151            zolimin = zremikn * zolimic * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
     152            zolimip = zremikp * zolimic * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn )  
     153 
     154            ! Ammonification in suboxic waters with denitrification 
     155            ! ------------------------------------------------------- 
     156            zammonic = zremikc * nitrfac(ji,jj,jk) * tr(ji,jj,jk,jpdoc,Kbb) 
     157            denitr(ji,jj,jk)  = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 
     158            denitr(ji,jj,jk)  = MAX(0., MIN(  ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenit, denitr(ji,jj,jk) ) ) 
     159            zoxyremc          = MAX(0., zammonic - denitr(ji,jj,jk)) 
     160            zdenitrn  = zremikn * denitr(ji,jj,jk) * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
     161            zdenitrp  = zremikp * denitr(ji,jj,jk) * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
     162            zoxyremn  = zremikn * zoxyremc * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
     163            zoxyremp  = zremikp * zoxyremc * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
     164 
     165            tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zolimip + zdenitrp + zoxyremp 
     166            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zolimin + zdenitrn + zoxyremn 
     167            tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - denitr(ji,jj,jk) * rdenit 
     168            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zolimic - denitr(ji,jj,jk) - zoxyremc 
     169            tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) - zolimin - zdenitrn - zoxyremn 
     170            tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) - zolimip - zdenitrp - zoxyremp 
     171            tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - zolimic * o2ut 
     172            tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zolimic + denitr(ji,jj,jk) + zoxyremc 
     173            tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zolimin + zoxyremn + ( rdenit + 1.) * zdenitrn ) 
     174         END_3D 
    185175         ! 
    186176      ENDIF 
    187177 
    188178 
    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 * tr(ji,jj,jk,jpnh4,Kbb) * ( 1.- nitrfac(ji,jj,jk) )  & 
    196                &         / ( 1.+ emoy(ji,jj,jk) ) * ( 1. + fr_i(ji,jj) * emoy(ji,jj,jk) )  
    197                zdenitnh4 = nitrif * xstep * tr(ji,jj,jk,jpnh4,Kbb) * nitrfac(ji,jj,jk) 
    198                zdenitnh4 = MIN(  ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenita, zdenitnh4 )  
    199                ! Update of the tracers trends 
    200                ! ---------------------------- 
    201                tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zonitr - zdenitnh4 
    202                tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + zonitr - rdenita * zdenitnh4 
    203                tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2nit * zonitr 
    204                tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * zdenitnh4 
    205             END DO 
    206          END DO 
    207       END DO 
     179      DO_3D_11_11( 1, jpkm1 ) 
     180         ! NH4 nitrification to NO3. Ceased for oxygen concentrations 
     181         ! below 2 umol/L. Inhibited at strong light  
     182         ! ---------------------------------------------------------- 
     183         zonitr  = nitrif * xstep * tr(ji,jj,jk,jpnh4,Kbb) * ( 1.- nitrfac(ji,jj,jk) )  & 
     184         &         / ( 1.+ emoy(ji,jj,jk) ) * ( 1. + fr_i(ji,jj) * emoy(ji,jj,jk) )  
     185         zdenitnh4 = nitrif * xstep * tr(ji,jj,jk,jpnh4,Kbb) * nitrfac(ji,jj,jk) 
     186         zdenitnh4 = MIN(  ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenita, zdenitnh4 )  
     187         ! Update of the tracers trends 
     188         ! ---------------------------- 
     189         tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zonitr - zdenitnh4 
     190         tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + zonitr - rdenita * zdenitnh4 
     191         tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2nit * zonitr 
     192         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * zdenitnh4 
     193      END_3D 
    208194 
    209195       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    … …  
    213199       ENDIF 
    214200 
    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                   &              * tr(ji,jj,jk,jpfer,Kbb) / ( xkferb + tr(ji,jj,jk,jpfer,Kbb) )    & 
    225                   &              * zdepprod(ji,jj,jk) * zdepeff(ji,jj,jk) * zdepbac(ji,jj,jk) 
    226                tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zbactfer*0.33 
    227                tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zbactfer*0.25 
    228                tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + 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 
     201      DO_3D_11_11( 1, jpkm1 ) 
     202 
     203         ! Bacterial uptake of iron. No iron is available in DOC. So 
     204         ! Bacteries are obliged to take up iron from the water. Some 
     205         ! studies (especially at Papa) have shown this uptake to be significant 
     206         ! ---------------------------------------------------------- 
     207         zbactfer = feratb *  rfact2 * 0.6_wp / rday * tgfunc(ji,jj,jk) * xlimbacl(ji,jj,jk)     & 
     208            &              * tr(ji,jj,jk,jpfer,Kbb) / ( xkferb + tr(ji,jj,jk,jpfer,Kbb) )    & 
     209            &              * zdepprod(ji,jj,jk) * zdepeff(ji,jj,jk) * zdepbac(ji,jj,jk) 
     210         tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zbactfer*0.33 
     211         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zbactfer*0.25 
     212         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zbactfer*0.08 
     213         zfebact(ji,jj,jk)   = zbactfer * 0.33 
     214         blim(ji,jj,jk)      = xlimbacl(ji,jj,jk)  * zdepbac(ji,jj,jk) / 1.e-6 * zdepprod(ji,jj,jk) 
     215      END_3D 
    234216 
    235217       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    … …  
    243225      ! --------------------------------------------------------------- 
    244226 
    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) - tr(ji,jj,jk,jpsil,Kbb) ) / ( sio3eq(ji,jj,jk) + rtrn ) ) 
    250                zsatur2  = ( 1. + ts(ji,jj,jk,jp_tem,Kmm) / 400.)**37 
    251                znusil   = 0.225  * ( 1. + ts(ji,jj,jk,jp_tem,Kmm) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25 
    252                ! Remineralization rate of BSi depedant on T and saturation 
    253                ! --------------------------------------------------------- 
    254                IF ( gdept(ji,jj,jk,Kmm) > zdep ) THEN 
    255                   zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk-1) * EXP( -0.5 * ( xsiremlab - xsirem )  & 
    256                   &                   * znusil * e3t(ji,jj,jk,Kmm) / 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(ji,jj,jk,Kmm) / wsbio4(ji,jj,jk) ) 
    260                ENDIF 
    261                zsiremin = ( xsiremlab * zfacsi(ji,jj,jk) + xsirem * ( 1. - zfacsi(ji,jj,jk) ) ) * xstep * znusil 
    262                zosil    = zsiremin * tr(ji,jj,jk,jpgsi,Kbb) 
    263                ! 
    264                tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) - zosil 
    265                tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) + zosil 
    266             END DO 
    267          END DO 
    268       END DO 
     227      DO_3D_11_11( 1, jpkm1 ) 
     228         zdep     = MAX( hmld(ji,jj), heup_01(ji,jj) ) 
     229         zsatur   = MAX( rtrn, ( sio3eq(ji,jj,jk) - tr(ji,jj,jk,jpsil,Kbb) ) / ( sio3eq(ji,jj,jk) + rtrn ) ) 
     230         zsatur2  = ( 1. + ts(ji,jj,jk,jp_tem,Kmm) / 400.)**37 
     231         znusil   = 0.225  * ( 1. + ts(ji,jj,jk,jp_tem,Kmm) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25 
     232         ! Remineralization rate of BSi depedant on T and saturation 
     233         ! --------------------------------------------------------- 
     234         IF ( gdept(ji,jj,jk,Kmm) > zdep ) THEN 
     235            zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk-1) * EXP( -0.5 * ( xsiremlab - xsirem )  & 
     236            &                   * znusil * e3t(ji,jj,jk,Kmm) / wsbio4(ji,jj,jk) ) 
     237            zfacsi(ji,jj,jk)  = zfacsib(ji,jj,jk) / ( 1.0 + zfacsib(ji,jj,jk) ) 
     238            zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk) * EXP( -0.5 * ( xsiremlab - xsirem )    & 
     239            &                   * znusil * e3t(ji,jj,jk,Kmm) / wsbio4(ji,jj,jk) ) 
     240         ENDIF 
     241         zsiremin = ( xsiremlab * zfacsi(ji,jj,jk) + xsirem * ( 1. - zfacsi(ji,jj,jk) ) ) * xstep * znusil 
     242         zosil    = zsiremin * tr(ji,jj,jk,jpgsi,Kbb) 
     243         ! 
     244         tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) - zosil 
     245         tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) + zosil 
     246      END_3D 
    269247 
    270248      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 

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

    r12258 r12340  
    3737   REAL(wp), SAVE :: sedsilfrac, sedcalfrac 
    3838 
     39   !! * Substitutions 
     40#  include "do_loop_substitute.h90" 
    3941   !!---------------------------------------------------------------------- 
    4042   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    9193         ! OA: Warning, the following part is necessary to avoid CFL problems above the sediments 
    9294         ! -------------------------------------------------------------------- 
    93          DO jj = 1, jpj 
    94             DO ji = 1, jpi 
    95                ikt  = mbkt(ji,jj) 
    96                zdep = e3t(ji,jj,ikt,Kmm) / xstep 
    97                zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) ) 
    98                zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) ) 
    99             END DO 
    100          END DO 
     95         DO_2D_11_11 
     96            ikt  = mbkt(ji,jj) 
     97            zdep = e3t(ji,jj,ikt,Kmm) / xstep 
     98            zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) ) 
     99            zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) ) 
     100         END_2D 
    101101 
    102102         ! Computation of the sediment denitrification proportion: The metamodel from midlleburg (2006) is being used 
    103103         ! Computation of the fraction of organic matter that is permanently buried from Dunne's model 
    104104         ! ------------------------------------------------------- 
    105          DO jj = 1, jpj 
    106             DO ji = 1, jpi 
    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 DO 
    124          END DO  
     105         DO_2D_11_11 
     106           IF( tmask(ji,jj,1) == 1 ) THEN 
     107              ikt = mbkt(ji,jj) 
     108              zflx = (  tr(ji,jj,ikt,jpgoc,Kbb) * zwsbio4(ji,jj)   & 
     109                &     + tr(ji,jj,ikt,jppoc,Kbb) * zwsbio3(ji,jj) )  * 1E3 * 1E6 / 1E4 
     110              zflx  = LOG10( MAX( 1E-3, zflx ) ) 
     111              zo2   = LOG10( MAX( 10. , tr(ji,jj,ikt,jpoxy,Kbb) * 1E6 ) ) 
     112              zno3  = LOG10( MAX( 1.  , tr(ji,jj,ikt,jpno3,Kbb) * 1E6 * rno3 ) ) 
     113              zdep  = LOG10( gdepw(ji,jj,ikt+1,Kmm) ) 
     114              zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3    & 
     115                &                + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2 
     116              zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) ) 
     117                ! 
     118              zflx = (  tr(ji,jj,ikt,jpgoc,Kbb) * zwsbio4(ji,jj)   & 
     119                &     + tr(ji,jj,ikt,jppoc,Kbb) * zwsbio3(ji,jj) ) * 1E6 
     120              zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2 
     121           ENDIF 
     122         END_2D 
    125123         ! 
    126124      ENDIF 
    … …  
    131129      IF( .NOT.lk_sed )  zrivsil = 1._wp - sedsilfrac 
    132130 
    133       DO jj = 1, jpj 
    134          DO ji = 1, jpi 
     131      DO_2D_11_11 
     132         ikt  = mbkt(ji,jj) 
     133         zdep = xstep / e3t(ji,jj,ikt,Kmm)  
     134         zwsc = zwsbio4(ji,jj) * zdep 
     135         zsiloss = tr(ji,jj,ikt,jpgsi,Kbb) * zwsc 
     136         zcaloss = tr(ji,jj,ikt,jpcal,Kbb) * zwsc 
     137         ! 
     138         tr(ji,jj,ikt,jpgsi,Krhs) = tr(ji,jj,ikt,jpgsi,Krhs) - zsiloss 
     139         tr(ji,jj,ikt,jpcal,Krhs) = tr(ji,jj,ikt,jpcal,Krhs) - zcaloss 
     140      END_2D 
     141      ! 
     142      IF( .NOT.lk_sed ) THEN 
     143         DO_2D_11_11 
    135144            ikt  = mbkt(ji,jj) 
    136145            zdep = xstep / e3t(ji,jj,ikt,Kmm)  
    … …  
    138147            zsiloss = tr(ji,jj,ikt,jpgsi,Kbb) * zwsc 
    139148            zcaloss = tr(ji,jj,ikt,jpcal,Kbb) * zwsc 
     149            tr(ji,jj,ikt,jpsil,Krhs) = tr(ji,jj,ikt,jpsil,Krhs) + zsiloss * zrivsil  
    140150            ! 
    141             tr(ji,jj,ikt,jpgsi,Krhs) = tr(ji,jj,ikt,jpgsi,Krhs) - zsiloss 
    142             tr(ji,jj,ikt,jpcal,Krhs) = tr(ji,jj,ikt,jpcal,Krhs) - zcaloss 
    143          END DO 
    144       END DO 
    145       ! 
    146       IF( .NOT.lk_sed ) THEN 
    147          DO jj = 1, jpj 
    148             DO ji = 1, jpi 
    149                ikt  = mbkt(ji,jj) 
    150                zdep = xstep / e3t(ji,jj,ikt,Kmm)  
    151                zwsc = zwsbio4(ji,jj) * zdep 
    152                zsiloss = tr(ji,jj,ikt,jpgsi,Kbb) * zwsc 
    153                zcaloss = tr(ji,jj,ikt,jpcal,Kbb) * zwsc 
    154                tr(ji,jj,ikt,jpsil,Krhs) = tr(ji,jj,ikt,jpsil,Krhs) + zsiloss * zrivsil  
    155                ! 
    156                zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 
    157                zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 
    158                zrivalk  = sedcalfrac * zfactcal 
    159                tr(ji,jj,ikt,jptal,Krhs) =  tr(ji,jj,ikt,jptal,Krhs) + zcaloss * zrivalk * 2.0 
    160                tr(ji,jj,ikt,jpdic,Krhs) =  tr(ji,jj,ikt,jpdic,Krhs) + zcaloss * zrivalk 
    161                zsedcal(ji,jj) = (1.0 - zrivalk) * zcaloss * e3t(ji,jj,ikt,Kmm)  
    162                zsedsi (ji,jj) = (1.0 - zrivsil) * zsiloss * e3t(ji,jj,ikt,Kmm)  
    163             END DO 
    164          END DO 
    165       ENDIF 
    166       ! 
    167       DO jj = 1, jpj 
    168          DO ji = 1, jpi 
     151            zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 
     152            zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 
     153            zrivalk  = sedcalfrac * zfactcal 
     154            tr(ji,jj,ikt,jptal,Krhs) =  tr(ji,jj,ikt,jptal,Krhs) + zcaloss * zrivalk * 2.0 
     155            tr(ji,jj,ikt,jpdic,Krhs) =  tr(ji,jj,ikt,jpdic,Krhs) + zcaloss * zrivalk 
     156            zsedcal(ji,jj) = (1.0 - zrivalk) * zcaloss * e3t(ji,jj,ikt,Kmm)  
     157            zsedsi (ji,jj) = (1.0 - zrivsil) * zsiloss * e3t(ji,jj,ikt,Kmm)  
     158         END_2D 
     159      ENDIF 
     160      ! 
     161      DO_2D_11_11 
     162         ikt  = mbkt(ji,jj) 
     163         zdep = xstep / e3t(ji,jj,ikt,Kmm)  
     164         zws4 = zwsbio4(ji,jj) * zdep 
     165         zws3 = zwsbio3(ji,jj) * zdep 
     166         tr(ji,jj,ikt,jpgoc,Krhs) = tr(ji,jj,ikt,jpgoc,Krhs) - tr(ji,jj,ikt,jpgoc,Kbb) * zws4  
     167         tr(ji,jj,ikt,jppoc,Krhs) = tr(ji,jj,ikt,jppoc,Krhs) - tr(ji,jj,ikt,jppoc,Kbb) * zws3 
     168         tr(ji,jj,ikt,jpbfe,Krhs) = tr(ji,jj,ikt,jpbfe,Krhs) - tr(ji,jj,ikt,jpbfe,Kbb) * zws4 
     169         tr(ji,jj,ikt,jpsfe,Krhs) = tr(ji,jj,ikt,jpsfe,Krhs) - tr(ji,jj,ikt,jpsfe,Kbb) * zws3 
     170      END_2D 
     171      ! 
     172      IF( ln_p5z ) THEN 
     173         DO_2D_11_11 
    169174            ikt  = mbkt(ji,jj) 
    170175            zdep = xstep / e3t(ji,jj,ikt,Kmm)  
    171176            zws4 = zwsbio4(ji,jj) * zdep 
    172177            zws3 = zwsbio3(ji,jj) * zdep 
    173             tr(ji,jj,ikt,jpgoc,Krhs) = tr(ji,jj,ikt,jpgoc,Krhs) - tr(ji,jj,ikt,jpgoc,Kbb) * zws4  
    174             tr(ji,jj,ikt,jppoc,Krhs) = tr(ji,jj,ikt,jppoc,Krhs) - tr(ji,jj,ikt,jppoc,Kbb) * zws3 
    175             tr(ji,jj,ikt,jpbfe,Krhs) = tr(ji,jj,ikt,jpbfe,Krhs) - tr(ji,jj,ikt,jpbfe,Kbb) * zws4 
    176             tr(ji,jj,ikt,jpsfe,Krhs) = tr(ji,jj,ikt,jpsfe,Krhs) - tr(ji,jj,ikt,jpsfe,Kbb) * zws3 
    177          END DO 
    178       END DO 
    179       ! 
    180       IF( ln_p5z ) THEN 
    181          DO jj = 1, jpj 
    182             DO ji = 1, jpi 
    183                ikt  = mbkt(ji,jj) 
    184                zdep = xstep / e3t(ji,jj,ikt,Kmm)  
    185                zws4 = zwsbio4(ji,jj) * zdep 
    186                zws3 = zwsbio3(ji,jj) * zdep 
    187                tr(ji,jj,ikt,jpgon,Krhs) = tr(ji,jj,ikt,jpgon,Krhs) - tr(ji,jj,ikt,jpgon,Kbb) * zws4 
    188                tr(ji,jj,ikt,jppon,Krhs) = tr(ji,jj,ikt,jppon,Krhs) - tr(ji,jj,ikt,jppon,Kbb) * zws3 
    189                tr(ji,jj,ikt,jpgop,Krhs) = tr(ji,jj,ikt,jpgop,Krhs) - tr(ji,jj,ikt,jpgop,Kbb) * zws4 
    190                tr(ji,jj,ikt,jppop,Krhs) = tr(ji,jj,ikt,jppop,Krhs) - tr(ji,jj,ikt,jppop,Kbb) * zws3 
    191             END DO 
    192          END DO 
     178            tr(ji,jj,ikt,jpgon,Krhs) = tr(ji,jj,ikt,jpgon,Krhs) - tr(ji,jj,ikt,jpgon,Kbb) * zws4 
     179            tr(ji,jj,ikt,jppon,Krhs) = tr(ji,jj,ikt,jppon,Krhs) - tr(ji,jj,ikt,jppon,Kbb) * zws3 
     180            tr(ji,jj,ikt,jpgop,Krhs) = tr(ji,jj,ikt,jpgop,Krhs) - tr(ji,jj,ikt,jpgop,Kbb) * zws4 
     181            tr(ji,jj,ikt,jppop,Krhs) = tr(ji,jj,ikt,jppop,Krhs) - tr(ji,jj,ikt,jppop,Kbb) * zws3 
     182         END_2D 
    193183      ENDIF 
    194184 
    … …  
    196186         ! The 0.5 factor in zpdenit is to avoid negative NO3 concentration after 
    197187         ! denitrification in the sediments. Not very clever, but simpliest option. 
    198          DO jj = 1, jpj 
    199             DO ji = 1, jpi 
    200                ikt  = mbkt(ji,jj) 
    201                zdep = xstep / e3t(ji,jj,ikt,Kmm)  
    202                zws4 = zwsbio4(ji,jj) * zdep 
    203                zws3 = zwsbio3(ji,jj) * zdep 
    204                zrivno3 = 1. - zbureff(ji,jj) 
    205                zwstpoc = tr(ji,jj,ikt,jpgoc,Kbb) * zws4 + tr(ji,jj,ikt,jppoc,Kbb) * zws3 
    206                zpdenit  = MIN( 0.5 * ( tr(ji,jj,ikt,jpno3,Kbb) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 ) 
    207                z1pdenit = zwstpoc * zrivno3 - zpdenit 
    208                zolimit = MIN( ( tr(ji,jj,ikt,jpoxy,Kbb) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) ) 
    209                tr(ji,jj,ikt,jpdoc,Krhs) = tr(ji,jj,ikt,jpdoc,Krhs) + z1pdenit - zolimit 
    210                tr(ji,jj,ikt,jppo4,Krhs) = tr(ji,jj,ikt,jppo4,Krhs) + zpdenit + zolimit 
    211                tr(ji,jj,ikt,jpnh4,Krhs) = tr(ji,jj,ikt,jpnh4,Krhs) + zpdenit + zolimit 
    212                tr(ji,jj,ikt,jpno3,Krhs) = tr(ji,jj,ikt,jpno3,Krhs) - rdenit * zpdenit 
    213                tr(ji,jj,ikt,jpoxy,Krhs) = tr(ji,jj,ikt,jpoxy,Krhs) - zolimit * o2ut 
    214                tr(ji,jj,ikt,jptal,Krhs) = tr(ji,jj,ikt,jptal,Krhs) + rno3 * (zolimit + (1.+rdenit) * zpdenit ) 
    215                tr(ji,jj,ikt,jpdic,Krhs) = tr(ji,jj,ikt,jpdic,Krhs) + zpdenit + zolimit  
    216                sdenit(ji,jj) = rdenit * zpdenit * e3t(ji,jj,ikt,Kmm) 
    217                zsedc(ji,jj)   = (1. - zrivno3) * zwstpoc * e3t(ji,jj,ikt,Kmm) 
    218                IF( ln_p5z ) THEN 
    219                   zwstpop              = tr(ji,jj,ikt,jpgop,Kbb) * zws4 + tr(ji,jj,ikt,jppop,Kbb) * zws3 
    220                   zwstpon              = tr(ji,jj,ikt,jpgon,Kbb) * zws4 + tr(ji,jj,ikt,jppon,Kbb) * zws3 
    221                   tr(ji,jj,ikt,jpdon,Krhs) = tr(ji,jj,ikt,jpdon,Krhs) + ( z1pdenit - zolimit ) * zwstpon / (zwstpoc + rtrn) 
    222                   tr(ji,jj,ikt,jpdop,Krhs) = tr(ji,jj,ikt,jpdop,Krhs) + ( z1pdenit - zolimit ) * zwstpop / (zwstpoc + rtrn) 
    223                ENDIF 
    224             END DO 
    225          END DO 
     188         DO_2D_11_11 
     189            ikt  = mbkt(ji,jj) 
     190            zdep = xstep / e3t(ji,jj,ikt,Kmm)  
     191            zws4 = zwsbio4(ji,jj) * zdep 
     192            zws3 = zwsbio3(ji,jj) * zdep 
     193            zrivno3 = 1. - zbureff(ji,jj) 
     194            zwstpoc = tr(ji,jj,ikt,jpgoc,Kbb) * zws4 + tr(ji,jj,ikt,jppoc,Kbb) * zws3 
     195            zpdenit  = MIN( 0.5 * ( tr(ji,jj,ikt,jpno3,Kbb) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 ) 
     196            z1pdenit = zwstpoc * zrivno3 - zpdenit 
     197            zolimit = MIN( ( tr(ji,jj,ikt,jpoxy,Kbb) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) ) 
     198            tr(ji,jj,ikt,jpdoc,Krhs) = tr(ji,jj,ikt,jpdoc,Krhs) + z1pdenit - zolimit 
     199            tr(ji,jj,ikt,jppo4,Krhs) = tr(ji,jj,ikt,jppo4,Krhs) + zpdenit + zolimit 
     200            tr(ji,jj,ikt,jpnh4,Krhs) = tr(ji,jj,ikt,jpnh4,Krhs) + zpdenit + zolimit 
     201            tr(ji,jj,ikt,jpno3,Krhs) = tr(ji,jj,ikt,jpno3,Krhs) - rdenit * zpdenit 
     202            tr(ji,jj,ikt,jpoxy,Krhs) = tr(ji,jj,ikt,jpoxy,Krhs) - zolimit * o2ut 
     203            tr(ji,jj,ikt,jptal,Krhs) = tr(ji,jj,ikt,jptal,Krhs) + rno3 * (zolimit + (1.+rdenit) * zpdenit ) 
     204            tr(ji,jj,ikt,jpdic,Krhs) = tr(ji,jj,ikt,jpdic,Krhs) + zpdenit + zolimit  
     205            sdenit(ji,jj) = rdenit * zpdenit * e3t(ji,jj,ikt,Kmm) 
     206            zsedc(ji,jj)   = (1. - zrivno3) * zwstpoc * e3t(ji,jj,ikt,Kmm) 
     207            IF( ln_p5z ) THEN 
     208               zwstpop              = tr(ji,jj,ikt,jpgop,Kbb) * zws4 + tr(ji,jj,ikt,jppop,Kbb) * zws3 
     209               zwstpon              = tr(ji,jj,ikt,jpgon,Kbb) * zws4 + tr(ji,jj,ikt,jppon,Kbb) * zws3 
     210               tr(ji,jj,ikt,jpdon,Krhs) = tr(ji,jj,ikt,jpdon,Krhs) + ( z1pdenit - zolimit ) * zwstpon / (zwstpoc + rtrn) 
     211               tr(ji,jj,ikt,jpdop,Krhs) = tr(ji,jj,ikt,jpdop,Krhs) + ( z1pdenit - zolimit ) * zwstpop / (zwstpoc + rtrn) 
     212            ENDIF 
     213         END_2D 
    226214       ENDIF 
    227215 
    … …  
    235223      ENDDO 
    236224      IF( ln_p4z ) THEN 
    237          DO jk = 1, jpkm1 
    238             DO jj = 1, jpj 
    239                DO ji = 1, jpi 
    240                   !                      ! Potential nitrogen fixation dependant on temperature and iron 
    241                   ztemp = ts(ji,jj,jk,jp_tem,Kmm) 
    242                   zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 
    243                   !       Potential nitrogen fixation dependant on temperature and iron 
    244                   xdianh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 
    245                   xdiano3 = tr(ji,jj,jk,jpno3,Kbb) / ( concnno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - xdianh4) 
    246                   zlim = ( 1.- xdiano3 - xdianh4 ) 
    247                   IF( zlim <= 0.1 )   zlim = 0.01 
    248                   zfact = zlim * rfact2 
    249                   ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 
    250                   ztrpo4(ji,jj,jk) = tr(ji,jj,jk,jppo4,Kbb) / ( 1E-6 + tr(ji,jj,jk,jppo4,Kbb) ) 
    251                   ztrdp = ztrpo4(ji,jj,jk) 
    252                   nitrpot(ji,jj,jk) =  zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 
    253                END DO 
    254             END DO 
    255          END DO 
     225         DO_3D_11_11( 1, jpkm1 ) 
     226            !                      ! Potential nitrogen fixation dependant on temperature and iron 
     227            ztemp = ts(ji,jj,jk,jp_tem,Kmm) 
     228            zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 
     229            !       Potential nitrogen fixation dependant on temperature and iron 
     230            xdianh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 
     231            xdiano3 = tr(ji,jj,jk,jpno3,Kbb) / ( concnno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - xdianh4) 
     232            zlim = ( 1.- xdiano3 - xdianh4 ) 
     233            IF( zlim <= 0.1 )   zlim = 0.01 
     234            zfact = zlim * rfact2 
     235            ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 
     236            ztrpo4(ji,jj,jk) = tr(ji,jj,jk,jppo4,Kbb) / ( 1E-6 + tr(ji,jj,jk,jppo4,Kbb) ) 
     237            ztrdp = ztrpo4(ji,jj,jk) 
     238            nitrpot(ji,jj,jk) =  zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 
     239         END_3D 
    256240      ELSE       ! p5z 
    257          DO jk = 1, jpkm1 
    258             DO jj = 1, jpj 
    259                DO ji = 1, jpi 
    260                   !                      ! Potential nitrogen fixation dependant on temperature and iron 
    261                   ztemp = ts(ji,jj,jk,jp_tem,Kmm) 
    262                   zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 
    263                   !       Potential nitrogen fixation dependant on temperature and iron 
    264                   xdianh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 
    265                   xdiano3 = tr(ji,jj,jk,jpno3,Kbb) / ( concnno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - xdianh4) 
    266                   zlim = ( 1.- xdiano3 - xdianh4 ) 
    267                   IF( zlim <= 0.1 )   zlim = 0.01 
    268                   zfact = zlim * rfact2 
    269                   ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 
    270                   ztrpo4(ji,jj,jk) = tr(ji,jj,jk,jppo4,Kbb) / ( 1E-6 + tr(ji,jj,jk,jppo4,Kbb) ) 
    271                   ztrdop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( 1E-6 + tr(ji,jj,jk,jpdop,Kbb) ) * (1. - ztrpo4(ji,jj,jk)) 
    272                   ztrdp = ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) 
    273                   nitrpot(ji,jj,jk) =  zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 
    274                END DO 
    275             END DO 
    276          END DO 
     241         DO_3D_11_11( 1, jpkm1 ) 
     242            !                      ! Potential nitrogen fixation dependant on temperature and iron 
     243            ztemp = ts(ji,jj,jk,jp_tem,Kmm) 
     244            zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 
     245            !       Potential nitrogen fixation dependant on temperature and iron 
     246            xdianh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 
     247            xdiano3 = tr(ji,jj,jk,jpno3,Kbb) / ( concnno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - xdianh4) 
     248            zlim = ( 1.- xdiano3 - xdianh4 ) 
     249            IF( zlim <= 0.1 )   zlim = 0.01 
     250            zfact = zlim * rfact2 
     251            ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 
     252            ztrpo4(ji,jj,jk) = tr(ji,jj,jk,jppo4,Kbb) / ( 1E-6 + tr(ji,jj,jk,jppo4,Kbb) ) 
     253            ztrdop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( 1E-6 + tr(ji,jj,jk,jpdop,Kbb) ) * (1. - ztrpo4(ji,jj,jk)) 
     254            ztrdp = ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) 
     255            nitrpot(ji,jj,jk) =  zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 
     256         END_3D 
    277257      ENDIF 
    278258 
    … …  
    280260      ! ---------------------------------------- 
    281261      IF( ln_p4z ) THEN 
    282          DO jk = 1, jpkm1 
    283             DO jj = 1, jpj 
    284                DO ji = 1, jpi 
    285                   zfact = nitrpot(ji,jj,jk) * nitrfix 
    286                   tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0 
    287                   tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zfact / 3.0 
    288                   tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zfact * 2.0 / 3.0 
    289                   tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zfact * 1.0 / 3.0 
    290                   tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zfact * 1.0 / 3.0 * 2.0 / 3.0 
    291                   tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfact * 1.0 / 3.0 * 1.0 / 3.0 
    292                   tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 
    293                   tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - 30E-6 * zfact * 1.0 / 3.0 
    294                   tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 
    295                   tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 
    296                   tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 
    297                   tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + concdnh4 / ( concdnh4 + tr(ji,jj,jk,jppo4,Kbb) ) & 
    298                   &                     * 0.001 * tr(ji,jj,jk,jpdoc,Kbb) * xstep 
    299               END DO 
    300             END DO  
    301          END DO 
     262         DO_3D_11_11( 1, jpkm1 ) 
     263            zfact = nitrpot(ji,jj,jk) * nitrfix 
     264            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0 
     265            tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zfact / 3.0 
     266            tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zfact * 2.0 / 3.0 
     267            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zfact * 1.0 / 3.0 
     268            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zfact * 1.0 / 3.0 * 2.0 / 3.0 
     269            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfact * 1.0 / 3.0 * 1.0 / 3.0 
     270            tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 
     271            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - 30E-6 * zfact * 1.0 / 3.0 
     272            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 
     273            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 
     274            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 
     275            tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + concdnh4 / ( concdnh4 + tr(ji,jj,jk,jppo4,Kbb) ) & 
     276            &                     * 0.001 * tr(ji,jj,jk,jpdoc,Kbb) * xstep 
     277         END_3D 
    302278      ELSE    ! p5z 
    303          DO jk = 1, jpkm1 
    304             DO jj = 1, jpj 
    305                DO ji = 1, jpi 
    306                   zfact = nitrpot(ji,jj,jk) * nitrfix 
    307                   tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0 
    308                   tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zfact / 3.0 
    309                   tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - 16.0 / 46.0 * zfact * ( 1.0 - 1.0 / 3.0 ) & 
    310                   &                     * ztrpo4(ji,jj,jk) / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 
    311                   tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zfact * 1.0 / 3.0 
    312                   tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zfact * 1.0 / 3.0 
    313                   tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + 16.0 / 46.0 * zfact / 3.0  & 
    314                   &                     - 16.0 / 46.0 * zfact * ztrdop(ji,jj,jk)   & 
    315                   &                     / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 
    316                   tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zfact * 1.0 / 3.0 * 2.0 / 3.0 
    317                   tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zfact * 1.0 / 3.0 * 2.0 /3.0 
    318                   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 
    319                   tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfact * 1.0 / 3.0 * 1.0 / 3.0 
    320                   tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zfact * 1.0 / 3.0 * 1.0 /3.0 
    321                   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 
    322                   tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 
    323                   tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - 30E-6 * zfact * 1.0 / 3.0  
    324                   tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 
    325                   tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 
    326                   tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 
    327               END DO 
    328             END DO  
    329          END DO 
     279         DO_3D_11_11( 1, jpkm1 ) 
     280            zfact = nitrpot(ji,jj,jk) * nitrfix 
     281            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0 
     282            tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zfact / 3.0 
     283            tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - 16.0 / 46.0 * zfact * ( 1.0 - 1.0 / 3.0 ) & 
     284            &                     * ztrpo4(ji,jj,jk) / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 
     285            tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zfact * 1.0 / 3.0 
     286            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zfact * 1.0 / 3.0 
     287            tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + 16.0 / 46.0 * zfact / 3.0  & 
     288            &                     - 16.0 / 46.0 * zfact * ztrdop(ji,jj,jk)   & 
     289            &                     / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 
     290            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zfact * 1.0 / 3.0 * 2.0 / 3.0 
     291            tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zfact * 1.0 / 3.0 * 2.0 /3.0 
     292            tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 2.0 /3.0 
     293            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfact * 1.0 / 3.0 * 1.0 / 3.0 
     294            tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zfact * 1.0 / 3.0 * 1.0 /3.0 
     295            tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 1.0 /3.0 
     296            tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 
     297            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - 30E-6 * zfact * 1.0 / 3.0  
     298            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 
     299            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 
     300            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 
     301         END_3D 
    330302         ! 
    331303      ENDIF 

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

    r12258 r12340  
    3838   INTEGER  :: ik100 
    3939 
     40   !! * Substitutions 
     41#  include "do_loop_substitute.h90" 
    4042   !!---------------------------------------------------------------------- 
    4143   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    7880      !    by data and from the coagulation theory 
    7981      !    ----------------------------------------------------------- 
    80       DO jk = 1, jpkm1 
    81          DO jj = 1, jpj 
    82             DO ji = 1,jpi 
    83                zmax  = MAX( heup_01(ji,jj), hmld(ji,jj) ) 
    84                zfact = MAX( 0., gdepw(ji,jj,jk+1,Kmm) - zmax ) / wsbio2scale 
    85                wsbio4(ji,jj,jk) = wsbio2 + MAX(0., ( wsbio2max - wsbio2 )) * zfact 
    86             END DO 
    87          END DO 
    88       END DO 
     82      DO_3D_11_11( 1, jpkm1 ) 
     83         zmax  = MAX( heup_01(ji,jj), hmld(ji,jj) ) 
     84         zfact = MAX( 0., gdepw(ji,jj,jk+1,Kmm) - zmax ) / wsbio2scale 
     85         wsbio4(ji,jj,jk) = wsbio2 + MAX(0., ( wsbio2max - wsbio2 )) * zfact 
     86      END_3D 
    8987 
    9088      ! limit the values of the sinking speeds to avoid numerical instabilities   

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

    r12193 r12340  
    3939   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xnegtr     ! Array used to indicate negative tracer values 
    4040 
     41   !! * Substitutions 
     42#  include "do_loop_substitute.h90" 
    4143   !!---------------------------------------------------------------------- 
    4244   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    130132         xnegtr(:,:,:) = 1.e0 
    131133         DO jn = jp_pcs0, jp_pcs1 
    132             DO jk = 1, jpk 
    133                DO jj = 1, jpj 
    134                   DO ji = 1, jpi 
    135                      IF( ( tr(ji,jj,jk,jn,Kbb) + tr(ji,jj,jk,jn,Krhs) ) < 0.e0 ) THEN 
    136                         ztra             = ABS( tr(ji,jj,jk,jn,Kbb) ) / ( ABS( tr(ji,jj,jk,jn,Krhs) ) + rtrn ) 
    137                         xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk),  ztra ) 
    138                      ENDIF 
    139                  END DO 
    140                END DO 
    141             END DO 
     134            DO_3D_11_11( 1, jpk ) 
     135               IF( ( tr(ji,jj,jk,jn,Kbb) + tr(ji,jj,jk,jn,Krhs) ) < 0.e0 ) THEN 
     136                  ztra             = ABS( tr(ji,jj,jk,jn,Kbb) ) / ( ABS( tr(ji,jj,jk,jn,Krhs) ) + rtrn ) 
     137                  xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk),  ztra ) 
     138               ENDIF 
     139            END_3D 
    142140         END DO 
    143141         !                                ! where at least 1 tracer concentration becomes negative 

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

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

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

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

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

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

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

    r12236 r12340  
    3333   REAL(wp), PUBLIC :: mpratd  !: 
    3434 
     35   !! * Substitutions 
     36#  include "do_loop_substitute.h90" 
    3537   !!---------------------------------------------------------------------- 
    3638   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    8082      ! 
    8183      prodcal(:,:,:) = 0.  !: calcite production variable set to zero 
    82       DO jk = 1, jpkm1 
    83          DO jj = 1, jpj 
    84             DO ji = 1, jpi 
    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 DO 
    120          END DO 
    121       END DO 
     84      DO_3D_11_11( 1, jpkm1 ) 
     85         zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-9 ), 0.e0 ) 
     86         !   Squared mortality of Phyto similar to a sedimentation term during 
     87         !   blooms (Doney et al. 1996) 
     88         !   ----------------------------------------------------------------- 
     89         zrespp = wchln * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * tr(ji,jj,jk,jpphy,Kbb) 
     90 
     91         !   Phytoplankton linear mortality 
     92         !   ------------------------------ 
     93         ztortp = mpratn * xstep  * zcompaph 
     94         zmortp = zrespp + ztortp 
     95 
     96         !   Update the arrays TRA which contains the biological sources and sinks 
     97 
     98         zfactn  = tr(ji,jj,jk,jpnph,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 
     99         zfactp  = tr(ji,jj,jk,jppph,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 
     100         zfactfe = tr(ji,jj,jk,jpnfe,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 
     101         zfactch = tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 
     102         tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zmortp 
     103         tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) - zmortp * zfactn 
     104         tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) - zmortp * zfactp 
     105         tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zmortp * zfactch 
     106         tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zmortp * zfactfe 
     107         zprcaca = xfracal(ji,jj,jk) * zmortp 
     108         ! 
     109         prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
     110         ! 
     111         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprcaca 
     112         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca 
     113         tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca 
     114         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortp 
     115         tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zmortp * zfactn 
     116         tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + zmortp * zfactp 
     117         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp 
     118         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zmortp * zfactfe 
     119      END_3D 
    122120      ! 
    123121       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    … …  
    150148      IF( ln_timing )   CALL timing_start('p5z_pico') 
    151149      ! 
    152       DO jk = 1, jpkm1 
    153          DO jj = 1, jpj 
    154             DO ji = 1, jpi 
    155                zcompaph = MAX( ( tr(ji,jj,jk,jppic,Kbb) - 1e-9 ), 0.e0 ) 
    156                !  Squared mortality of Phyto similar to a sedimentation term during 
    157                !  blooms (Doney et al. 1996) 
    158                !  ----------------------------------------------------------------- 
    159                zrespp = wchlp * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * tr(ji,jj,jk,jppic,Kbb) 
    160  
    161                !     Phytoplankton mortality  
    162                ztortp = mpratp * xstep  * zcompaph 
    163                zmortp = zrespp + ztortp 
    164  
    165                !   Update the arrays TRA which contains the biological sources and sinks 
    166  
    167                zfactn = tr(ji,jj,jk,jpnpi,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 
    168                zfactp = tr(ji,jj,jk,jpppi,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 
    169                zfactfe = tr(ji,jj,jk,jppfe,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 
    170                zfactch = tr(ji,jj,jk,jppch,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 
    171                tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) - zmortp 
    172                tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) - zmortp * zfactn 
    173                tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) - zmortp * zfactp 
    174                tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) - zmortp * zfactch 
    175                tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) - zmortp * zfactfe 
    176                tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortp 
    177                tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zmortp * zfactn 
    178                tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + zmortp * zfactp 
    179                tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zmortp * zfactfe 
    180                prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp 
    181             END DO 
    182          END DO 
    183       END DO 
     150      DO_3D_11_11( 1, jpkm1 ) 
     151         zcompaph = MAX( ( tr(ji,jj,jk,jppic,Kbb) - 1e-9 ), 0.e0 ) 
     152         !  Squared mortality of Phyto similar to a sedimentation term during 
     153         !  blooms (Doney et al. 1996) 
     154         !  ----------------------------------------------------------------- 
     155         zrespp = wchlp * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * tr(ji,jj,jk,jppic,Kbb) 
     156 
     157         !     Phytoplankton mortality  
     158         ztortp = mpratp * xstep  * zcompaph 
     159         zmortp = zrespp + ztortp 
     160 
     161         !   Update the arrays TRA which contains the biological sources and sinks 
     162 
     163         zfactn = tr(ji,jj,jk,jpnpi,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 
     164         zfactp = tr(ji,jj,jk,jpppi,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 
     165         zfactfe = tr(ji,jj,jk,jppfe,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 
     166         zfactch = tr(ji,jj,jk,jppch,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 
     167         tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) - zmortp 
     168         tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) - zmortp * zfactn 
     169         tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) - zmortp * zfactp 
     170         tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) - zmortp * zfactch 
     171         tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) - zmortp * zfactfe 
     172         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortp 
     173         tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zmortp * zfactn 
     174         tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + zmortp * zfactp 
     175         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zmortp * zfactfe 
     176         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp 
     177      END_3D 
    184178      ! 
    185179       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    … …  
    213207      ! 
    214208 
    215       DO jk = 1, jpkm1 
    216          DO jj = 1, jpj 
    217             DO ji = 1, jpi 
    218  
    219                zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1E-9), 0. ) 
    220  
    221                !   Aggregation term for diatoms is increased in case of nutrient 
    222                !   stress as observed in reality. The stressed cells become more 
    223                !   sticky and coagulate to sink quickly out of the euphotic zone 
    224                !   ------------------------------------------------------------- 
    225                !  Phytoplankton squared mortality 
    226                !  ------------------------------- 
    227                zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk) 
    228                zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 )  
    229                zrespp2 = 1.e6 * xstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * tr(ji,jj,jk,jpdia,Kbb) 
    230  
    231                !  Phytoplankton linear mortality  
    232                !  ------------------------------ 
    233                ztortp2 = mpratd * xstep  * zcompadi 
    234                zmortp2 = zrespp2 + ztortp2 
    235  
    236                !   Update the arrays tr(:,:,:,:,Krhs) which contains the biological sources and sinks 
    237                !   --------------------------------------------------------------------- 
    238                zfactn  = tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
    239                zfactp  = tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
    240                zfactch = tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
    241                zfactfe = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
    242                zfactsi = tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
    243                tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zmortp2  
    244                tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zmortp2 * zfactn 
    245                tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zmortp2 * zfactp 
    246                tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zmortp2 * zfactch 
    247                tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zmortp2 * zfactfe 
    248                tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zmortp2 * zfactsi 
    249                tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zmortp2 * zfactsi 
    250                tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zrespp2  
    251                tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zrespp2 * zfactn 
    252                tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + zrespp2 * zfactp 
    253                tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zrespp2 * zfactfe 
    254                tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + ztortp2 
    255                tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + ztortp2 * zfactn 
    256                tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + ztortp2 * zfactp 
    257                tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ztortp2 * zfactfe 
    258                prodpoc(ji,jj,jk)   = prodpoc(ji,jj,jk) + ztortp2 
    259                prodgoc(ji,jj,jk)   = prodgoc(ji,jj,jk) + zrespp2 
    260             END DO 
    261          END DO 
    262       END DO 
     209      DO_3D_11_11( 1, jpkm1 ) 
     210 
     211         zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1E-9), 0. ) 
     212 
     213         !   Aggregation term for diatoms is increased in case of nutrient 
     214         !   stress as observed in reality. The stressed cells become more 
     215         !   sticky and coagulate to sink quickly out of the euphotic zone 
     216         !   ------------------------------------------------------------- 
     217         !  Phytoplankton squared mortality 
     218         !  ------------------------------- 
     219         zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk) 
     220         zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 )  
     221         zrespp2 = 1.e6 * xstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * tr(ji,jj,jk,jpdia,Kbb) 
     222 
     223         !  Phytoplankton linear mortality  
     224         !  ------------------------------ 
     225         ztortp2 = mpratd * xstep  * zcompadi 
     226         zmortp2 = zrespp2 + ztortp2 
     227 
     228         !   Update the arrays tr(:,:,:,:,Krhs) which contains the biological sources and sinks 
     229         !   --------------------------------------------------------------------- 
     230         zfactn  = tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     231         zfactp  = tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     232         zfactch = tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     233         zfactfe = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     234         zfactsi = tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     235         tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zmortp2  
     236         tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zmortp2 * zfactn 
     237         tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zmortp2 * zfactp 
     238         tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zmortp2 * zfactch 
     239         tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zmortp2 * zfactfe 
     240         tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zmortp2 * zfactsi 
     241         tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zmortp2 * zfactsi 
     242         tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zrespp2  
     243         tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zrespp2 * zfactn 
     244         tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + zrespp2 * zfactp 
     245         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zrespp2 * zfactfe 
     246         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + ztortp2 
     247         tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + ztortp2 * zfactn 
     248         tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + ztortp2 * zfactp 
     249         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ztortp2 * zfactfe 
     250         prodpoc(ji,jj,jk)   = prodpoc(ji,jj,jk) + ztortp2 
     251         prodgoc(ji,jj,jk)   = prodgoc(ji,jj,jk) + zrespp2 
     252      END_3D 
    263253      ! 
    264254      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 

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

    r12281 r12340  
    5050   REAL(wp) :: texcretd               !: 1 - excret2         
    5151 
     52   !! * Substitutions 
     53#  include "do_loop_substitute.h90" 
    5254   !!---------------------------------------------------------------------- 
    5355   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    122124      ! day length in hours 
    123125      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 
     126      DO_2D_11_11 
     127         zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 
     128         zargu = MAX( -1., MIN(  1., zargu ) ) 
     129         zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 
     130      END_2D 
    131131 
    132132         ! 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(ji,jj,jk+1,Kmm) <= 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 
     133      DO_3D_11_11( 1, jpkm1 ) 
     134         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     135            zval = MAX( 1., zstrn(ji,jj) ) 
     136            IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
     137               zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 
     138            ENDIF 
     139            zmxl_chl(ji,jj,jk) = zval / 24. 
     140            zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval ) 
     141         ENDIF 
     142      END_3D 
    147143 
    148144      zprbio(:,:,:) = zprmaxn(:,:,:) * zmxl_fac(:,:,:) 
    … …  
    155151      WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 
    156152 
    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., ts(ji,jj,jk,jp_tem,Kmm) - 15. ) 
    163                   zadap       = xadap * ztn / ( 2.+ ztn ) 
    164                   ! 
    165                   zpislopeadn(ji,jj,jk) = pislopen * tr(ji,jj,jk,jpnch,Kbb)    & 
    166                   &                       /( tr(ji,jj,jk,jpphy,Kbb) * 12. + rtrn) 
    167                   zpislopeadp(ji,jj,jk) = pislopep * ( 1. + zadap * EXP( -0.25 * epico(ji,jj,jk) ) )   & 
    168                   &                       * tr(ji,jj,jk,jppch,Kbb) /( tr(ji,jj,jk,jppic,Kbb) * 12. + rtrn) 
    169                   zpislopeadd(ji,jj,jk) = pisloped * tr(ji,jj,jk,jpdch,Kbb)    & 
    170                      &                    /( tr(ji,jj,jk,jpdia,Kbb) * 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  = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + 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 = tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) 
    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 
     153      DO_3D_11_11( 1, jpkm1 ) 
     154         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     155            ! Computation of the P-I slope for nanos and diatoms 
     156            ztn         = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. ) 
     157            zadap       = xadap * ztn / ( 2.+ ztn ) 
     158            ! 
     159            zpislopeadn(ji,jj,jk) = pislopen * tr(ji,jj,jk,jpnch,Kbb)    & 
     160            &                       /( tr(ji,jj,jk,jpphy,Kbb) * 12. + rtrn) 
     161            zpislopeadp(ji,jj,jk) = pislopep * ( 1. + zadap * EXP( -0.25 * epico(ji,jj,jk) ) )   & 
     162            &                       * tr(ji,jj,jk,jppch,Kbb) /( tr(ji,jj,jk,jppic,Kbb) * 12. + rtrn) 
     163            zpislopeadd(ji,jj,jk) = pisloped * tr(ji,jj,jk,jpdch,Kbb)    & 
     164               &                    /( tr(ji,jj,jk,jpdia,Kbb) * 12. + rtrn) 
     165            ! 
     166            zpislopen = zpislopeadn(ji,jj,jk) / ( zprbio(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 
     167            zpislopep = zpislopeadp(ji,jj,jk) / ( zprpic(ji,jj,jk) * rday * xlimpic(ji,jj,jk) + rtrn ) 
     168            zpisloped = zpislopeadd(ji,jj,jk) / ( zprdia(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 
     169 
     170            ! Computation of production function for Carbon 
     171            !  --------------------------------------------- 
     172            zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) )  ) 
     173            zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1.- EXP( -zpislopep * epico(ji,jj,jk) )  ) 
     174            zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) )  ) 
     175 
     176            ! Computation of production function for Chlorophyll 
     177            !  ------------------------------------------------- 
     178            zpislopen = zpislopen * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     179            zpisloped = zpisloped * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     180            zpislopep = zpislopep * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     181            zprchln(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) )  ) 
     182            zprchlp(ji,jj,jk) = zprmaxp(ji,jj,jk) * ( 1.- EXP( -zpislopep * epicom(ji,jj,jk) )  ) 
     183            zprchld(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) )  ) 
     184         ENDIF 
     185      END_3D 
     186 
     187      DO_3D_11_11( 1, jpkm1 ) 
     188 
     189          IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     190            !    Si/C of diatoms 
     191            !    ------------------------ 
     192            !    Si/C increases with iron stress and silicate availability 
     193            !    Si/C is arbitrariliy increased for very high Si concentrations 
     194            !    to mimic the very high ratios observed in the Southern Ocean (silpot2) 
     195            zlim  = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi1 ) 
     196            zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 
     197            zsilfac = 3.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0 
     198            zsiborn = tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) 
     199            IF (gphit(ji,jj) < -30 ) THEN 
     200              zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 ) 
     201            ELSE 
     202              zsilfac2 = 1. +      zsiborn / ( zsiborn + xksi2**3 ) 
     203            ENDIF 
     204            zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2 
     205        ENDIF 
     206      END_3D 
    219207 
    220208      !  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 
     209      DO_3D_11_11( 1, jpkm1 ) 
     210         zprbio(ji,jj,jk)  = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
     211         zprpic(ji,jj,jk)  = zprpic(ji,jj,jk) * ( 1. - fr_i(ji,jj) )  
     212         zprdia(ji,jj,jk)  = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) )  
     213         zprnut(ji,jj,jk)  = zprnut(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
     214      END_3D 
    231215 
    232216      ! 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) * tr(ji,jj,jk,jpphy,Kbb) * rfact2 
    239                   ! 
    240                   zration = tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
    241                   zratiop = tr(ji,jj,jk,jppph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
    242                   zratiof = tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
    243                   zprnutmax = zprnut(ji,jj,jk) * fvnuptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jpphy,Kbb) * 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 
     217      DO_3D_11_11( 1, jpkm1 ) 
     218         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     219            !  production terms for nanophyto. 
     220            zprorcan(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * tr(ji,jj,jk,jpphy,Kbb) * rfact2 
     221            ! 
     222            zration = tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
     223            zratiop = tr(ji,jj,jk,jppph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
     224            zratiof = tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
     225            zprnutmax = zprnut(ji,jj,jk) * fvnuptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jpphy,Kbb) * rfact2 
     226            ! Uptake of nitrogen 
     227            zrat = MIN( 1., zration / (xqnnmax(ji,jj,jk) + rtrn) )  
     228            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
     229            zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpnmin(ji,jj,jk) )   & 
     230            &          / ( xqpnmax(ji,jj,jk) - xqpnmin(ji,jj,jk) + rtrn ), xlimnfe(ji,jj,jk) ) ) 
     231            zpronewn(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xnanono3(ji,jj,jk) 
     232            zproregn(ji,jj,jk) = zpronmax * xnanonh4(ji,jj,jk) 
     233            ! Uptake of phosphorus 
     234            zrat = MIN( 1., zratiop / (xqpnmax(ji,jj,jk) + rtrn) ) 
     235            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
     236            zpropmax = zprnutmax * zmax * xlimnfe(ji,jj,jk) 
     237            zpropo4n(ji,jj,jk) = zpropmax * xnanopo4(ji,jj,jk) 
     238            zprodopn(ji,jj,jk) = zpropmax * xnanodop(ji,jj,jk) 
     239            ! Uptake of iron 
     240            zrat = MIN( 1., zratiof / qfnmax ) 
     241            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
     242            zprofmax = zprnutmax * qfnmax * zmax 
     243            zprofen(ji,jj,jk) = zprofmax * xnanofer(ji,jj,jk) * ( 3. - 2.4 * xlimnfe(ji,jj,jk)    & 
     244            &          / ( xlimnfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xnanono3(ji,jj,jk) / ( rtrn  & 
     245            &          + xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) ) * (1. - xnanofer(ji,jj,jk) ) ) 
     246         ENDIF 
     247      END_3D 
    268248 
    269249      ! 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) * tr(ji,jj,jk,jppic,Kbb) * rfact2 
    276                   ! 
    277                   zration = tr(ji,jj,jk,jpnpi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 
    278                   zratiop = tr(ji,jj,jk,jpppi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 
    279                   zratiof = tr(ji,jj,jk,jppfe,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 
    280                   zprnutmax = zprnut(ji,jj,jk) * fvpuptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jppic,Kbb) * 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 
     250      DO_3D_11_11( 1, jpkm1 ) 
     251         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     252            !  production terms for picophyto. 
     253            zprorcap(ji,jj,jk) = zprpic(ji,jj,jk)  * xlimpic(ji,jj,jk) * tr(ji,jj,jk,jppic,Kbb) * rfact2 
     254            ! 
     255            zration = tr(ji,jj,jk,jpnpi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 
     256            zratiop = tr(ji,jj,jk,jpppi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 
     257            zratiof = tr(ji,jj,jk,jppfe,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 
     258            zprnutmax = zprnut(ji,jj,jk) * fvpuptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jppic,Kbb) * rfact2 
     259            ! Uptake of nitrogen 
     260            zrat = MIN( 1., zration / (xqnpmax(ji,jj,jk) + rtrn) ) 
     261            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
     262            zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqppmin(ji,jj,jk) )   & 
     263            &          / ( xqppmax(ji,jj,jk) - xqppmin(ji,jj,jk) + rtrn ), xlimpfe(ji,jj,jk) ) ) 
     264            zpronewp(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xpicono3(ji,jj,jk)  
     265            zproregp(ji,jj,jk) = zpronmax * xpiconh4(ji,jj,jk) 
     266            ! Uptake of phosphorus 
     267            zrat = MIN( 1., zratiop / (xqppmax(ji,jj,jk) + rtrn) ) 
     268            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
     269            zpropmax = zprnutmax * zmax * xlimpfe(ji,jj,jk) 
     270            zpropo4p(ji,jj,jk) = zpropmax * xpicopo4(ji,jj,jk) 
     271            zprodopp(ji,jj,jk) = zpropmax * xpicodop(ji,jj,jk) 
     272            ! Uptake of iron 
     273            zrat = MIN( 1., zratiof / qfpmax ) 
     274            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
     275            zprofmax = zprnutmax * qfpmax * zmax 
     276            zprofep(ji,jj,jk) = zprofmax * xpicofer(ji,jj,jk) * ( 3. - 2.4 * xlimpfe(ji,jj,jk)   & 
     277            &          / ( xlimpfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xpicono3(ji,jj,jk) / ( rtrn   & 
     278            &          + xpicono3(ji,jj,jk) + xpiconh4(ji,jj,jk) ) * (1. - xpicofer(ji,jj,jk) ) ) 
     279         ENDIF 
     280      END_3D 
    305281 
    306282      ! 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) * tr(ji,jj,jk,jpdia,Kbb) * rfact2 
    313                   ! Computation of the respiration term according to pahlow  
    314                   ! & oschlies (2013) 
    315                   ! 
    316                   zration = tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
    317                   zratiop = tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
    318                   zratiof = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
    319                   zprnutmax = zprnut(ji,jj,jk) * fvduptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jpdia,Kbb) * 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 *ts(ji,jj,jk,jp_tem,Kmm)))   & 
    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 *ts(ji,jj,jk,jp_tem,Kmm)))   & 
    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 *ts(ji,jj,jk,jp_tem,Kmm)))   & 
    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                   tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) + zprochln * texcretn 
    372                   tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) + zprochld * texcretd 
    373                   tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) + zprochlp * texcretp 
    374                ENDIF 
    375             END DO 
    376          END DO 
    377       END DO 
     283      DO_3D_11_11( 1, jpkm1 ) 
     284         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     285            !  production terms for diatomees 
     286            zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr(ji,jj,jk,jpdia,Kbb) * rfact2 
     287            ! Computation of the respiration term according to pahlow  
     288            ! & oschlies (2013) 
     289            ! 
     290            zration = tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     291            zratiop = tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     292            zratiof = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     293            zprnutmax = zprnut(ji,jj,jk) * fvduptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jpdia,Kbb) * rfact2 
     294            ! Uptake of nitrogen 
     295            zrat = MIN( 1., zration / (xqndmax(ji,jj,jk) + rtrn) ) 
     296            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))  
     297            zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpdmin(ji,jj,jk) )   & 
     298            &          / ( xqpdmax(ji,jj,jk) - xqpdmin(ji,jj,jk) + rtrn ), xlimdfe(ji,jj,jk) ) ) 
     299            zpronewd(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xdiatno3(ji,jj,jk) 
     300            zproregd(ji,jj,jk) = zpronmax * xdiatnh4(ji,jj,jk) 
     301            ! Uptake of phosphorus 
     302            zrat = MIN( 1., zratiop / (xqpdmax(ji,jj,jk) + rtrn) ) 
     303            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))  
     304            zpropmax = zprnutmax * zmax * xlimdfe(ji,jj,jk) 
     305            zpropo4d(ji,jj,jk) = zpropmax * xdiatpo4(ji,jj,jk) 
     306            zprodopd(ji,jj,jk) = zpropmax * xdiatdop(ji,jj,jk) 
     307            ! Uptake of iron 
     308            zrat = MIN( 1., zratiof / qfdmax ) 
     309            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
     310            zprofmax = zprnutmax * qfdmax * zmax 
     311            zprofed(ji,jj,jk) = zprofmax * xdiatfer(ji,jj,jk) * ( 3. - 2.4 * xlimdfe(ji,jj,jk)     & 
     312            &          / ( xlimdfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xdiatno3(ji,jj,jk) / ( rtrn   & 
     313            &          + xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) ) * (1. - xdiatfer(ji,jj,jk) ) ) 
     314         ENDIF 
     315      END_3D 
     316 
     317      DO_3D_11_11( 1, jpkm1 ) 
     318         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     319               !  production terms for nanophyto. ( chlorophyll ) 
     320            znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     321            zprod = rday * (zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)) * zprchln(ji,jj,jk) * xlimphy(ji,jj,jk) 
     322            thetannm_n   = MIN ( thetannm, ( thetannm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm)))   & 
     323            &               * (1. - 1.14 / 43.4 * 20.)) 
     324            zprochln = thetannm_n * zprod / ( zpislopeadn(ji,jj,jk) * znanotot + rtrn ) 
     325            zprochln = MAX(zprochln, chlcmin * 12. * zprorcan (ji,jj,jk) ) 
     326               !  production terms for picophyto. ( chlorophyll ) 
     327            zpicotot = epicom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     328            zprod = rday * (zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)) * zprchlp(ji,jj,jk) * xlimpic(ji,jj,jk) 
     329            thetanpm_n   = MIN ( thetanpm, ( thetanpm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm)))   & 
     330            &               * (1. - 1.14 / 43.4 * 20.)) 
     331            zprochlp = thetanpm_n * zprod / ( zpislopeadp(ji,jj,jk) * zpicotot + rtrn ) 
     332            zprochlp = MAX(zprochlp, chlcmin * 12. * zprorcap(ji,jj,jk) ) 
     333            !  production terms for diatomees ( chlorophyll ) 
     334            zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     335            zprod = rday * (zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)) * zprchld(ji,jj,jk) * xlimdia(ji,jj,jk) 
     336            thetandm_n   = MIN ( thetandm, ( thetandm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm)))   & 
     337            &               * (1. - 1.14 / 43.4 * 20.)) 
     338            zprochld = thetandm_n * zprod / ( zpislopeadd(ji,jj,jk) * zdiattot + rtrn ) 
     339            zprochld = MAX(zprochld, chlcmin * 12. * zprorcad(ji,jj,jk) ) 
     340            !   Update the arrays TRA which contain the Chla sources and sinks 
     341            tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) + zprochln * texcretn 
     342            tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) + zprochld * texcretd 
     343            tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) + zprochlp * texcretp 
     344         ENDIF 
     345      END_3D 
    378346 
    379347      !   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               tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zpropo4n(ji,jj,jk) - zpropo4d(ji,jj,jk)  & 
    389               &                     - zpropo4p(ji,jj,jk) 
    390               tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk)  & 
    391               &                     - zpronewp(ji,jj,jk) 
    392               tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zproregn(ji,jj,jk) - zproregd(ji,jj,jk)  & 
    393               &                     - zproregp(ji,jj,jk) 
    394               tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + 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) = tr(ji,jj,jk,jpphy,Krhs) / rfact2/ (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
    398               tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) + zprontot * texcretn 
    399               tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) + zpropo4n(ji,jj,jk) * texcretn   & 
    400               &                     + zprodopn(ji,jj,jk) * texcretn 
    401               tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) + zprofen(ji,jj,jk) * texcretn 
    402               tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) + 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) = tr(ji,jj,jk,jppic,Krhs) / rfact2/ (tr(ji,jj,jk,jppic,Kbb) + rtrn) 
    406               tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) + zproptot * texcretp 
    407               tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) + zpropo4p(ji,jj,jk) * texcretp   & 
    408               &                     + zprodopp(ji,jj,jk) * texcretp 
    409               tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) + zprofep(ji,jj,jk) * texcretp 
    410               tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) + 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) = tr(ji,jj,jk,jpdia,Krhs) / rfact2 / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
    414               tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) + zprodtot * texcretd 
    415               tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) + zpropo4d(ji,jj,jk) * texcretd   & 
    416               &                     + zprodopd(ji,jj,jk) * texcretd 
    417               tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) + zprofed(ji,jj,jk) * texcretd 
    418               tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 
    419               tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)  & 
    420               &                     + excretp * zprorcap(ji,jj,jk) 
    421               tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + excretd * zprodtot + excretn * zprontot   & 
    422               &                     + excretp * zproptot 
    423               tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + 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               tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + 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               tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zfeup 
    432               tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 
    433               tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - 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               tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + 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 
     348      DO_3D_11_11( 1, jpkm1 ) 
     349        zprontot = zpronewn(ji,jj,jk) + zproregn(ji,jj,jk) 
     350        zproptot = zpronewp(ji,jj,jk) + zproregp(ji,jj,jk) 
     351        zprodtot = zpronewd(ji,jj,jk) + zproregd(ji,jj,jk) 
     352        zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)  & 
     353        &          + excretp * zprorcap(ji,jj,jk) 
     354        tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zpropo4n(ji,jj,jk) - zpropo4d(ji,jj,jk)  & 
     355        &                     - zpropo4p(ji,jj,jk) 
     356        tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk)  & 
     357        &                     - zpronewp(ji,jj,jk) 
     358        tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zproregn(ji,jj,jk) - zproregd(ji,jj,jk)  & 
     359        &                     - zproregp(ji,jj,jk) 
     360        tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zprorcan(ji,jj,jk) * texcretn    & 
     361           &                  - zpsino3 * zpronewn(ji,jj,jk) - zpsinh4 * zproregn(ji,jj,jk)   & 
     362           &                  - zrespn(ji,jj,jk)  
     363        zcroissn(ji,jj,jk) = tr(ji,jj,jk,jpphy,Krhs) / rfact2/ (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
     364        tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) + zprontot * texcretn 
     365        tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) + zpropo4n(ji,jj,jk) * texcretn   & 
     366        &                     + zprodopn(ji,jj,jk) * texcretn 
     367        tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) + zprofen(ji,jj,jk) * texcretn 
     368        tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) + zprorcap(ji,jj,jk) * texcretp     & 
     369           &                  - zpsino3 * zpronewp(ji,jj,jk) - zpsinh4 * zproregp(ji,jj,jk)   & 
     370           &                  - zrespp(ji,jj,jk)  
     371        zcroissp(ji,jj,jk) = tr(ji,jj,jk,jppic,Krhs) / rfact2/ (tr(ji,jj,jk,jppic,Kbb) + rtrn) 
     372        tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) + zproptot * texcretp 
     373        tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) + zpropo4p(ji,jj,jk) * texcretp   & 
     374        &                     + zprodopp(ji,jj,jk) * texcretp 
     375        tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) + zprofep(ji,jj,jk) * texcretp 
     376        tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) + zprorcad(ji,jj,jk) * texcretd   & 
     377           &                  - zpsino3 * zpronewd(ji,jj,jk) - zpsinh4 * zproregd(ji,jj,jk)   & 
     378           &                  - zrespd(ji,jj,jk)  
     379        zcroissd(ji,jj,jk) = tr(ji,jj,jk,jpdia,Krhs) / rfact2 / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
     380        tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) + zprodtot * texcretd 
     381        tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) + zpropo4d(ji,jj,jk) * texcretd   & 
     382        &                     + zprodopd(ji,jj,jk) * texcretd 
     383        tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) + zprofed(ji,jj,jk) * texcretd 
     384        tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 
     385        tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)  & 
     386        &                     + excretp * zprorcap(ji,jj,jk) 
     387        tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + excretd * zprodtot + excretn * zprontot   & 
     388        &                     + excretp * zproptot 
     389        tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + excretd * zpropo4d(ji,jj,jk) + excretn * zpropo4n(ji,jj,jk)   & 
     390        &    - texcretn * zprodopn(ji,jj,jk) - texcretd * zprodopd(ji,jj,jk) + excretp * zpropo4p(ji,jj,jk)     & 
     391        &    - texcretp * zprodopp(ji,jj,jk) 
     392        tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + o2ut * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk)   & 
     393           &                + zproregp(ji,jj,jk) ) + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk)           & 
     394           &                + zpronewd(ji,jj,jk) + zpronewp(ji,jj,jk) )   & 
     395           &                - o2ut * ( zrespn(ji,jj,jk) + zrespp(ji,jj,jk) + zrespd(ji,jj,jk) ) 
     396        zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) 
     397        tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zfeup 
     398        tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 
     399        tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) - zprorcap(ji,jj,jk)  & 
     400        &                     + zpsino3 * zpronewn(ji,jj,jk) + zpsinh4 * zproregn(ji,jj,jk)   & 
     401        &                     + zpsino3 * zpronewp(ji,jj,jk) + zpsinh4 * zproregp(ji,jj,jk)   & 
     402        &                     + zpsino3 * zpronewd(ji,jj,jk) + zpsinh4 * zproregd(ji,jj,jk)  & 
     403        &                     + zrespn(ji,jj,jk) + zrespd(ji,jj,jk) + zrespp(ji,jj,jk)  
     404        tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk)  & 
     405        &                     + zpronewp(ji,jj,jk) ) - rno3 * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk)     & 
     406        &                     + zproregp(ji,jj,jk) )  
     407      END_3D 
    444408     ! 
    445409     IF( ln_ligand ) THEN 
    446410         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                  tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + 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         DO_3D_11_11( 1, jpkm1 ) 
     412           zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) + excretp * zprorcap(ji,jj,jk) 
     413           zfeup    = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) 
     414           tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 
     415           zpligprod1(ji,jj,jk) = zdocprod * ldocp 
     416           zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet 
     417         END_3D 
    458418     ENDIF 
    459419 

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

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

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

    r11949 r12340  
    2222   REAL(wp) ::  conv2    ! [kg/m2/month]-->[g/cm2/s] ( 1 month has 30 days ) 
    2323 
     24   !! * Substitutions 
     25#  include "do_loop_substitute.h90" 
    2426   !! $Id$ 
    2527CONTAINS 
    … …  
    9395      !    ----------------------------------------------------------- 
    9496      IF (ln_sediment_offline) THEN 
    95          DO jj = 1, jpj 
    96             DO ji = 1, jpi 
    97                ikt = mbkt(ji,jj) 
    98                zwsbio4(ji,jj) = wsbio2 / rday 
    99                zwsbio3(ji,jj) = wsbio  / rday 
    100             END DO 
    101          END DO 
     97         DO_2D_11_11 
     98            ikt = mbkt(ji,jj) 
     99            zwsbio4(ji,jj) = wsbio2 / rday 
     100            zwsbio3(ji,jj) = wsbio  / rday 
     101         END_2D 
    102102      ELSE 
    103          DO jj = 1, jpj 
    104             DO ji = 1, jpi 
    105                ikt = mbkt(ji,jj) 
    106                zdep = e3t(ji,jj,ikt,Kmm) / r2dttrc 
    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 DO 
    110          END DO 
     103         DO_2D_11_11 
     104            ikt = mbkt(ji,jj) 
     105            zdep = e3t(ji,jj,ikt,Kmm) / r2dttrc 
     106            zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) / rday ) 
     107            zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) / rday ) 
     108         END_2D 
    111109      ENDIF 
    112110 
    113111      trc_data(:,:,:) = 0. 
    114       DO jj = 1,jpj 
    115          DO ji = 1, jpi 
    116             ikt = mbkt(ji,jj) 
    117             IF ( tmask(ji,jj,ikt) == 1 ) THEN 
    118                trc_data(ji,jj,1)   = tr(ji,jj,ikt,jpsil,Kbb) 
    119                trc_data(ji,jj,2)   = tr(ji,jj,ikt,jpoxy,Kbb) 
    120                trc_data(ji,jj,3)   = tr(ji,jj,ikt,jpdic,Kbb) 
    121                trc_data(ji,jj,4)   = tr(ji,jj,ikt,jpno3,Kbb) / 7.625 
    122                trc_data(ji,jj,5)   = tr(ji,jj,ikt,jppo4,Kbb) / 122. 
    123                trc_data(ji,jj,6)   = tr(ji,jj,ikt,jptal,Kbb) 
    124                trc_data(ji,jj,7)   = tr(ji,jj,ikt,jpnh4,Kbb) / 7.625 
    125                trc_data(ji,jj,8)   = 0.0 
    126                trc_data(ji,jj,9)   = 28.0E-3 
    127                trc_data(ji,jj,10)  = tr(ji,jj,ikt,jpfer,Kbb) 
    128                trc_data(ji,jj,11 ) = MIN(tr(ji,jj,ikt,jpgsi,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 
    129                trc_data(ji,jj,12 ) = MIN(tr(ji,jj,ikt,jppoc,Kbb), 1E-4) * zwsbio3(ji,jj) * 1E3 
    130                trc_data(ji,jj,13 ) = MIN(tr(ji,jj,ikt,jpgoc,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 
    131                trc_data(ji,jj,14)  = MIN(tr(ji,jj,ikt,jpcal,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 
    132                trc_data(ji,jj,15)  = ts(ji,jj,ikt,jp_tem,Kmm) 
    133                trc_data(ji,jj,16)  = ts(ji,jj,ikt,jp_sal,Kmm) 
    134                trc_data(ji,jj,17 ) = ( tr(ji,jj,ikt,jpsfe,Kbb) * zwsbio3(ji,jj) + tr(ji,jj,ikt,jpbfe,Kbb)  & 
    135                &                     * zwsbio4(ji,jj)  ) * 1E3 / ( trc_data(ji,jj,12 ) + trc_data(ji,jj,13 ) + rtrn ) 
    136                trc_data(ji,jj,17 ) = MIN(1E-3, trc_data(ji,jj,17 ) ) 
    137             ENDIF 
    138          ENDDO 
    139       ENDDO 
     112      DO_2D_11_11 
     113         ikt = mbkt(ji,jj) 
     114         IF ( tmask(ji,jj,ikt) == 1 ) THEN 
     115            trc_data(ji,jj,1)   = tr(ji,jj,ikt,jpsil,Kbb) 
     116            trc_data(ji,jj,2)   = tr(ji,jj,ikt,jpoxy,Kbb) 
     117            trc_data(ji,jj,3)   = tr(ji,jj,ikt,jpdic,Kbb) 
     118            trc_data(ji,jj,4)   = tr(ji,jj,ikt,jpno3,Kbb) / 7.625 
     119            trc_data(ji,jj,5)   = tr(ji,jj,ikt,jppo4,Kbb) / 122. 
     120            trc_data(ji,jj,6)   = tr(ji,jj,ikt,jptal,Kbb) 
     121            trc_data(ji,jj,7)   = tr(ji,jj,ikt,jpnh4,Kbb) / 7.625 
     122            trc_data(ji,jj,8)   = 0.0 
     123            trc_data(ji,jj,9)   = 28.0E-3 
     124            trc_data(ji,jj,10)  = tr(ji,jj,ikt,jpfer,Kbb) 
     125            trc_data(ji,jj,11 ) = MIN(tr(ji,jj,ikt,jpgsi,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 
     126            trc_data(ji,jj,12 ) = MIN(tr(ji,jj,ikt,jppoc,Kbb), 1E-4) * zwsbio3(ji,jj) * 1E3 
     127            trc_data(ji,jj,13 ) = MIN(tr(ji,jj,ikt,jpgoc,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 
     128            trc_data(ji,jj,14)  = MIN(tr(ji,jj,ikt,jpcal,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 
     129            trc_data(ji,jj,15)  = ts(ji,jj,ikt,jp_tem,Kmm) 
     130            trc_data(ji,jj,16)  = ts(ji,jj,ikt,jp_sal,Kmm) 
     131            trc_data(ji,jj,17 ) = ( tr(ji,jj,ikt,jpsfe,Kbb) * zwsbio3(ji,jj) + tr(ji,jj,ikt,jpbfe,Kbb)  & 
     132            &                     * zwsbio4(ji,jj)  ) * 1E3 / ( trc_data(ji,jj,12 ) + trc_data(ji,jj,13 ) + rtrn ) 
     133            trc_data(ji,jj,17 ) = MIN(1E-3, trc_data(ji,jj,17 ) ) 
     134         ENDIF 
     135      END_2D 
    140136 
    141137      ! Pore water initial concentration [mol/l] in  k=1 

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

    r11960 r12340  
    2222   PRIVATE 
    2323 
     24   !! * Substitutions 
     25#  include "do_loop_substitute.h90" 
    2426   !! Module variables 
    2527   REAL(wp)    ::  & 
    … …  
    133135      ! Determination of sediments number of points and allocate global variables 
    134136      epkbot(:,:) = 0. 
    135       DO jj = 1, jpj 
    136          DO ji = 1, jpi 
    137             ikt = mbkt(ji,jj)  
    138             IF( tmask(ji,jj,ikt) == 1 ) epkbot(ji,jj) = e3t_1d(ikt) 
    139             gdepbot(ji,jj) = gdepw_0(ji,jj,ikt) 
    140          ENDDO 
    141       ENDDO 
     137      DO_2D_11_11 
     138         ikt = mbkt(ji,jj)  
     139         IF( tmask(ji,jj,ikt) == 1 ) epkbot(ji,jj) = e3t_1d(ikt) 
     140         gdepbot(ji,jj) = gdepw_0(ji,jj,ikt) 
     141      END_2D 
    142142 
    143143      ! computation of total number of ocean points 
    … …  
    247247      ! Computation of 1D array of sediments points 
    248248      indoce = 0 
    249       DO jj = 1, jpj 
    250          DO ji = 1, jpi 
    251             IF (  epkbot(ji,jj) > 0. ) THEN 
    252                indoce          = indoce + 1 
    253                iarroce(indoce) = (jj - 1) * jpi + ji 
    254             ENDIF 
    255          END DO 
    256       END DO 
     249      DO_2D_11_11 
     250         IF (  epkbot(ji,jj) > 0. ) THEN 
     251            indoce          = indoce + 1 
     252            iarroce(indoce) = (jj - 1) * jpi + ji 
     253         ENDIF 
     254      END_2D 
    257255 
    258256      IF ( indoce .EQ. 0 ) THEN 

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

    r11949 r12340  
    1111   PUBLIC sed_sfc 
    1212 
     13   !! * Substitutions 
     14#  include "do_loop_substitute.h90" 
    1315   !! $Id$ 
    1416CONTAINS 
    … …  
    4648 
    4749 
    48       DO jj = 1,jpj 
    49          DO ji = 1, jpi 
    50             ikt = mbkt(ji,jj) 
    51             IF ( tmask(ji,jj,ikt) == 1 ) THEN 
    52                tr(ji,jj,ikt,jptal,Kbb) = trc_data(ji,jj,1) 
    53                tr(ji,jj,ikt,jpdic,Kbb) = trc_data(ji,jj,2) 
    54                tr(ji,jj,ikt,jpno3,Kbb) = trc_data(ji,jj,3) * 7.625 
    55                tr(ji,jj,ikt,jppo4,Kbb) = trc_data(ji,jj,4) * 122. 
    56                tr(ji,jj,ikt,jpoxy,Kbb) = trc_data(ji,jj,5) 
    57                tr(ji,jj,ikt,jpsil,Kbb) = trc_data(ji,jj,6) 
    58                tr(ji,jj,ikt,jpnh4,Kbb) = trc_data(ji,jj,7) * 7.625 
    59                tr(ji,jj,ikt,jpfer,Kbb) = trc_data(ji,jj,8) 
    60             ENDIF 
    61          ENDDO 
    62       ENDDO 
     50      DO_2D_11_11 
     51         ikt = mbkt(ji,jj) 
     52         IF ( tmask(ji,jj,ikt) == 1 ) THEN 
     53            tr(ji,jj,ikt,jptal,Kbb) = trc_data(ji,jj,1) 
     54            tr(ji,jj,ikt,jpdic,Kbb) = trc_data(ji,jj,2) 
     55            tr(ji,jj,ikt,jpno3,Kbb) = trc_data(ji,jj,3) * 7.625 
     56            tr(ji,jj,ikt,jppo4,Kbb) = trc_data(ji,jj,4) * 122. 
     57            tr(ji,jj,ikt,jpoxy,Kbb) = trc_data(ji,jj,5) 
     58            tr(ji,jj,ikt,jpsil,Kbb) = trc_data(ji,jj,6) 
     59            tr(ji,jj,ikt,jpnh4,Kbb) = trc_data(ji,jj,7) * 7.625 
     60            tr(ji,jj,ikt,jpfer,Kbb) = trc_data(ji,jj,8) 
     61         ENDIF 
     62      END_2D 
    6363 
    6464      IF( ln_timing )  CALL timing_stop('sed_sfc') 

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

    r12236 r12340  
    3636   !! * Substitutions 
    3737#  include "vectopt_loop_substitute.h90" 
     38#  include "do_loop_substitute.h90" 
    3839   !!---------------------------------------------------------------------- 
    3940   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    9394               CALL trc_dta( kt, Kmm, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000 
    9495               ! 
    95                DO jj = 1, jpj 
    96                   DO ji = 1, jpi   ! vector opt. 
    97                      ikt = mbkt(ji,jj) 
    98                      tr(ji,jj,ikt,jn,Kbb) = ztrcdta(ji,jj,ikt) + ( tr(ji,jj,ikt,jn,Kbb) -  ztrcdta(ji,jj,ikt) )     & 
    99                      &                  * exp( -restosed(ji,jj,ikt) * dtsed ) 
    100                   END DO 
    101                END DO 
     96               DO_2D_11_11 
     97                  ikt = mbkt(ji,jj) 
     98                  tr(ji,jj,ikt,jn,Kbb) = ztrcdta(ji,jj,ikt) + ( tr(ji,jj,ikt,jn,Kbb) -  ztrcdta(ji,jj,ikt) )     & 
     99                  &                  * exp( -restosed(ji,jj,ikt) * dtsed ) 
     100               END_2D 
    102101               !  
    103102            ENDIF 

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/trcwri_pisces.F90

    r11949 r12340  
    1919   PUBLIC trc_wri_pisces  
    2020 
     21   !! * Substitutions 
     22#  include "do_loop_substitute.h90" 
    2123   !!---------------------------------------------------------------------- 
    2224   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    6668            zo2min   (:,:) = tr(:,:,1,jpoxy,Kmm) * tmask(:,:,1) 
    6769            zdepo2min(:,:) = gdepw(:,:,1,Kmm)   * tmask(:,:,1) 
    68             DO jk = 2, jpkm1 
    69                DO jj = 1, jpj 
    70                   DO ji = 1, jpi 
    71                      IF( tmask(ji,jj,jk) == 1 ) then 
    72                         IF( tr(ji,jj,jk,jpoxy,Kmm) < zo2min(ji,jj) ) then 
    73                            zo2min   (ji,jj) = tr(ji,jj,jk,jpoxy,Kmm) 
    74                            zdepo2min(ji,jj) = gdepw(ji,jj,jk,Kmm) 
    75                         ENDIF 
    76                      ENDIF 
    77                   END DO 
    78                END DO 
    79             END DO 
     70            DO_3D_11_11( 2, jpkm1 ) 
     71               IF( tmask(ji,jj,jk) == 1 ) then 
     72                  IF( tr(ji,jj,jk,jpoxy,Kmm) < zo2min(ji,jj) ) then 
     73                     zo2min   (ji,jj) = tr(ji,jj,jk,jpoxy,Kmm) 
     74                     zdepo2min(ji,jj) = gdepw(ji,jj,jk,Kmm) 
     75                  ENDIF 
     76               ENDIF 
     77            END_3D 
    8078            ! 
    8179            CALL iom_put('O2MIN' , zo2min     )                              ! oxygen minimum concentration 

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/TRP/trcatf.F90

    r12236 r12340  
    4848   REAL(wp) ::   rfact1, rfact2 
    4949 
     50   !! * Substitutions 
     51#  include "do_loop_substitute.h90" 
    5052   !!---------------------------------------------------------------------- 
    5153   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    227229      ! 
    228230      DO jn = 1, jptra       
    229          DO jk = 1, jpkm1 
    230             DO jj = 1, jpj 
    231                DO ji = 1, jpi 
    232                   ze3t_b = e3t(ji,jj,jk,Kbb) 
    233                   ze3t_n = e3t(ji,jj,jk,Kmm) 
    234                   ze3t_a = e3t(ji,jj,jk,Kaa) 
    235                   !                                         ! tracer content at Before, now and after 
    236                   ztc_b  = ptr(ji,jj,jk,jn,Kbb)  * ze3t_b 
    237                   ztc_n  = ptr(ji,jj,jk,jn,Kmm)  * ze3t_n 
    238                   ztc_a  = ptr(ji,jj,jk,jn,Kaa) * ze3t_a 
    239                   ! 
    240                   ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b 
    241                   ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b 
    242                   ! 
    243                   ze3t_f = ze3t_n + atfp * ze3t_d 
    244                   ztc_f  = ztc_n  + atfp * ztc_d 
    245                   ! 
    246                   IF( .NOT. ln_linssh .AND. jk == mikt(ji,jj) ) THEN           ! first level  
    247                      ze3t_f = ze3t_f - rfact2 * ( emp_b(ji,jj)      - emp(ji,jj)   )  
    248                      ztc_f  = ztc_f  - rfact1 * ( sbc_trc(ji,jj,jn) - sbc_trc_b(ji,jj,jn) ) 
    249                   ENDIF 
    250  
    251                   ze3t_f = 1.e0 / ze3t_f 
    252                   ptr(ji,jj,jk,jn,Kmm) = ztc_f * ze3t_f     ! time filtered "now" field 
    253                   ! 
    254                END DO 
    255             END DO 
    256          END DO 
     231         DO_3D_11_11( 1, jpkm1 ) 
     232            ze3t_b = e3t(ji,jj,jk,Kbb) 
     233            ze3t_n = e3t(ji,jj,jk,Kmm) 
     234            ze3t_a = e3t(ji,jj,jk,Kaa) 
     235            !                                         ! tracer content at Before, now and after 
     236            ztc_b  = ptr(ji,jj,jk,jn,Kbb)  * ze3t_b 
     237            ztc_n  = ptr(ji,jj,jk,jn,Kmm)  * ze3t_n 
     238            ztc_a  = ptr(ji,jj,jk,jn,Kaa) * ze3t_a 
     239            ! 
     240            ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b 
     241            ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b 
     242            ! 
     243            ze3t_f = ze3t_n + atfp * ze3t_d 
     244            ztc_f  = ztc_n  + atfp * ztc_d 
     245            ! 
     246            IF( .NOT. ln_linssh .AND. jk == mikt(ji,jj) ) THEN           ! first level  
     247               ze3t_f = ze3t_f - rfact2 * ( emp_b(ji,jj)      - emp(ji,jj)   )  
     248               ztc_f  = ztc_f  - rfact1 * ( sbc_trc(ji,jj,jn) - sbc_trc_b(ji,jj,jn) ) 
     249            ENDIF 
     250 
     251            ze3t_f = 1.e0 / ze3t_f 
     252            ptr(ji,jj,jk,jn,Kmm) = ztc_f * ze3t_f     ! time filtered "now" field 
     253            ! 
     254         END_3D 
    257255         !  
    258256      END DO 

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/TRP/trcdmp.F90

    r12236 r12340  
    4545   !! * Substitutions 
    4646#  include "vectopt_loop_substitute.h90" 
     47#  include "do_loop_substitute.h90" 
    4748   !!---------------------------------------------------------------------- 
    4849   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    112113               ! 
    113114               CASE( 0 )                !==  newtonian damping throughout the water column  ==! 
    114                   DO jk = 1, jpkm1 
    115                      DO jj = 2, jpjm1 
    116                         DO ji = fs_2, fs_jpim1   ! vector opt. 
    117                            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) ) 
    118                         END DO 
    119                      END DO 
    120                   END DO 
     115                  DO_3D_00_00( 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 
    121118                  ! 
    122119               CASE ( 1 )                !==  no damping in the turbocline (avt > 5 cm2/s)  ==! 
    123                   DO jk = 1, jpkm1 
    124                      DO jj = 2, jpjm1 
    125                         DO ji = fs_2, fs_jpim1   ! vector opt. 
    126                            IF( avt(ji,jj,jk) <= avt_c )  THEN  
    127                               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) ) 
    128                            ENDIF 
    129                         END DO 
    130                      END DO 
    131                   END DO 
     120                  DO_3D_00_00( 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 
    132125                  ! 
    133126               CASE ( 2 )               !==  no damping in the mixed layer   ==!  
    134                   DO jk = 1, jpkm1 
    135                      DO jj = 2, jpjm1 
    136                         DO ji = fs_2, fs_jpim1   ! vector opt. 
    137                            IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 
    138                               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) ) 
    139                            END IF 
    140                         END DO 
    141                      END DO 
    142                   END DO 
     127                  DO_3D_00_00( 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 
    143132                  !   
    144133               END SELECT 

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

    r12236 r12340  
    4444   !! * Substitutions 
    4545#  include "vectopt_loop_substitute.h90" 
     46#  include "do_loop_substitute.h90" 
    4647   !!---------------------------------------------------------------------- 
    4748   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    8182      zahv(:,:,:) = rldf * ahtv(:,:,:) 
    8283      !                                  !* Enhanced zonal diffusivity coefficent in the equatorial domain 
    83       DO jk= 1, jpk 
    84          DO jj = 1, jpj 
    85             DO ji = 1, jpi 
    86                IF( gdept(ji,jj,jk,Kmm) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN 
    87                   zdep = MAX( gdept(ji,jj,jk,Kmm) - 1000., 0. ) / 1000. 
    88                   zahu(ji,jj,jk) = zahu(ji,jj,jk) * MAX( 1., rn_fact_lap * EXP( -zdep ) ) 
    89                ENDIF 
    90             END DO 
    91          END DO 
    92       END DO 
     84      DO_3D_11_11( 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 
    9390      ! 
    9491      SELECT CASE ( nldf_trc )                 !* compute lateral mixing trend and add it to the general trend 

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

    r12236 r12340  
    3131   REAL(wp), DIMENSION(:,:), ALLOCATABLE::   gainmass 
    3232 
     33   !! * Substitutions 
     34#  include "do_loop_substitute.h90" 
    3335   !!---------------------------------------------------------------------- 
    3436   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    166168              IF( l_trdtrc )   ztrtrd(:,:,:) = ptr(:,:,:,jn,itime)                       ! save input tr(:,:,:,:,Kbb) for trend computation            
    167169              ! 
    168               DO jk = 1, jpkm1 
    169                  DO jj = 1, jpj 
    170                     DO ji = 1, jpi 
    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                           ! 
     170              DO_3D_11_11( 1, jpkm1 ) 
     171                 IF( ztrneg(ji,jj,jn) /= 0. ) THEN                                 ! if negative values over the 3x3 box 
     172                    ! 
     173                    ptr(ji,jj,jk,jn,itime) = ptr(ji,jj,jk,jn,itime) * tmask(ji,jj,jk)   ! really needed? 
     174                    IF( ptr(ji,jj,jk,jn,itime) < 0. ) ptr(ji,jj,jk,jn,itime) = 0.       ! suppress negative values 
     175                    IF( ptr(ji,jj,jk,jn,itime) > 0. ) THEN                    ! use positive values to compensate mass gain 
     176                       zcoef = 1. + ztrneg(ji,jj,jn) / ztrpos(ji,jj,jn)       ! ztrpos > 0 as ptr > 0 
     177                       ptr(ji,jj,jk,jn,itime) = ptr(ji,jj,jk,jn,itime) * zcoef 
     178                       IF( zcoef < 0. ) THEN                                  ! if the compensation exceed the positive value 
     179                          gainmass(jn,1) = gainmass(jn,1) - ptr(ji,jj,jk,jn,itime) * cvol(ji,jj,jk)   ! we are adding mass... 
     180                          ptr(ji,jj,jk,jn,itime) = 0.                         ! limit the compensation to keep positive value 
    184181                       ENDIF 
    185                     END DO 
    186                  END DO 
    187               END DO 
     182                    ENDIF 
     183                    ! 
     184                 ENDIF 
     185              END_3D 
    188186              ! 
    189187              IF( l_trdtrc ) THEN 

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/TRP/trcsbc.F90

    r12236 r12340  
    3030   !! * Substitutions 
    3131#  include "vectopt_loop_substitute.h90" 
     32#  include "do_loop_substitute.h90" 
    3233   !!---------------------------------------------------------------------- 
    3334   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    120121         ! 
    121122         DO jn = 1, jptra 
    122             DO jj = 2, jpj 
    123                DO ji = fs_2, fs_jpim1   ! vector opt. 
    124                   sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rau0 * ptr(ji,jj,1,jn,Kmm) 
    125                END DO 
    126             END DO 
     123            DO_2D_01_00 
     124               sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rau0 * ptr(ji,jj,1,jn,Kmm) 
     125            END_2D 
    127126         END DO 
    128127         ! 
    … …  
    130129         ! 
    131130         DO jn = 1, jptra 
    132             DO jj = 2, jpj 
    133                DO ji = fs_2, fs_jpim1   ! vector opt. 
    134                   sbc_trc(ji,jj,jn) = ( zsfx(ji,jj) + fmmflx(ji,jj) ) * r1_rau0 * ptr(ji,jj,1,jn,Kmm) 
    135                END DO 
    136             END DO 
     131            DO_2D_01_00 
     132               sbc_trc(ji,jj,jn) = ( zsfx(ji,jj) + fmmflx(ji,jj) ) * r1_rau0 * ptr(ji,jj,1,jn,Kmm) 
     133            END_2D 
    137134         END DO 
    138135         ! 
    … …  
    140137         ! 
    141138         DO jn = 1, jptra 
    142             DO jj = 2, jpj 
    143                DO ji = fs_2, fs_jpim1   ! vector opt. 
    144                   zse3t = 1. / e3t(ji,jj,1,Kmm) 
    145                   ! tracer flux at the ice/ocean interface (tracer/m2/s) 
    146                   zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice 
    147                   !                                         ! only used in the levitating sea ice case 
    148                   ! tracer flux only       : add concentration dilution term in net tracer flux, no F-M in volume flux 
    149                   ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux 
    150                   ztfx  = zftra                        ! net tracer flux 
    151                   ! 
    152                   zdtra = r1_rau0 * ( ztfx + ( zsfx(ji,jj) + fmmflx(ji,jj) ) * ptr(ji,jj,1,jn,Kmm) )  
    153                   IF ( zdtra < 0. ) THEN 
    154                      zdtra  = MAX(zdtra, -ptr(ji,jj,1,jn,Kmm) * e3t(ji,jj,1,Kmm) / r2dttrc )   ! avoid negative concentrations to arise 
    155                   ENDIF 
    156                   sbc_trc(ji,jj,jn) =  zdtra  
    157                END DO 
    158             END DO 
     139            DO_2D_01_00 
     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_rau0 * ( 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) / r2dttrc )   ! avoid negative concentrations to arise 
     151               ENDIF 
     152               sbc_trc(ji,jj,jn) =  zdtra  
     153            END_2D 
    159154         END DO 
    160155      END SELECT 
    … …  
    166161         IF( l_trdtrc )   ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs)  ! save trends 
    167162         ! 
    168          DO jj = 2, jpj 
    169             DO ji = fs_2, fs_jpim1   ! vector opt. 
    170                zse3t = zfact / e3t(ji,jj,1,Kmm) 
    171                ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t 
    172             END DO 
    173          END DO 
     163         DO_2D_01_00 
     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 
    174167         ! 
    175168         IF( l_trdtrc ) THEN 

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

    r11960 r12340  
    2424   INTEGER, PUBLIC :: nitermax      !: Maximum number of iterations for sinking 
    2525 
     26   !! * Substitutions 
     27#  include "do_loop_substitute.h90" 
    2628   !!---------------------------------------------------------------------- 
    2729   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    7173         iiter(:,:) = 1 
    7274      ELSE 
    73          DO jj = 1, jpj 
    74             DO ji = 1, jpi 
    75                iiter(ji,jj) = 1 
    76                DO jk = 1, jpkm1 
    77                   IF( tmask(ji,jj,jk) == 1.0 ) THEN 
    78                       zwsmax =  0.5 * e3t(ji,jj,jk,Kmm) * rday / rsfact 
    79                       iiter(ji,jj) =  MAX( iiter(ji,jj), INT( pwsink(ji,jj,jk) / zwsmax ) ) 
    80                   ENDIF 
    81                END DO 
    82             END DO 
    83          END DO 
     75         DO_2D_11_11 
     76            iiter(ji,jj) = 1 
     77            DO jk = 1, jpkm1 
     78               IF( tmask(ji,jj,jk) == 1.0 ) THEN 
     79                   zwsmax =  0.5 * e3t(ji,jj,jk,Kmm) * rday / rsfact 
     80                   iiter(ji,jj) =  MAX( iiter(ji,jj), INT( pwsink(ji,jj,jk) / zwsmax ) ) 
     81               ENDIF 
     82            END DO 
     83         END_2D 
    8484         iiter(:,:) = MIN( iiter(:,:), nitermax ) 
    8585      ENDIF 
    8686 
    87       DO jk = 1,jpkm1 
    88          DO jj = 1, jpj 
    89             DO ji = 1, jpi 
    90                IF( tmask(ji,jj,jk) == 1.0 ) THEN 
    91                  zwsmax = 0.5 * e3t(ji,jj,jk,Kmm) * rday / rsfact 
    92                  zwsink(ji,jj,jk) = MIN( pwsink(ji,jj,jk), zwsmax * REAL( iiter(ji,jj), wp ) ) 
    93                ELSE 
    94                  ! provide a default value so there is no use of undefinite value in trc_sink2 for zwsink2 initialization 
    95                  zwsink(ji,jj,jk) = 0. 
    96                ENDIF 
    97             END DO 
    98          END DO 
    99       END DO 
     87      DO_3D_11_11( 1,jpkm1 ) 
     88         IF( tmask(ji,jj,jk) == 1.0 ) THEN 
     89           zwsmax = 0.5 * e3t(ji,jj,jk,Kmm) * rday / rsfact 
     90           zwsink(ji,jj,jk) = MIN( pwsink(ji,jj,jk), zwsmax * REAL( iiter(ji,jj), wp ) ) 
     91         ELSE 
     92           ! provide a default value so there is no use of undefinite value in trc_sink2 for zwsink2 initialization 
     93           zwsink(ji,jj,jk) = 0. 
     94         ENDIF 
     95      END_3D 
    10096 
    10197      !  Initializa to zero all the sinking arrays  
    … …  
    149145      DO jn = 1, 2 
    150146         !  first guess of the slopes interior values 
    151          DO jj = 1, jpj 
    152             DO ji = 1, jpi 
    153                ! 
    154                zstep = rsfact / REAL( kiter(ji,jj), wp ) / 2. 
    155                !               
    156                DO jk = 2, jpkm1 
    157                   ztraz(ji,jj,jk) = ( tr(ji,jj,jk-1,jp_tra,Kbb) - tr(ji,jj,jk,jp_tra,Kbb) ) * tmask(ji,jj,jk) 
    158                END DO 
    159                ztraz(ji,jj,1  ) = 0.0 
    160                ztraz(ji,jj,jpk) = 0.0 
    161  
    162                ! slopes 
    163                DO jk = 2, jpkm1 
    164                   zign = 0.25 + SIGN( 0.25, ztraz(ji,jj,jk) * ztraz(ji,jj,jk+1) ) 
    165                   zakz(ji,jj,jk) = ( ztraz(ji,jj,jk) + ztraz(ji,jj,jk+1) ) * zign 
    166                END DO 
    167           
    168                ! Slopes limitation 
    169                DO jk = 2, jpkm1 
    170                   zakz(ji,jj,jk) = SIGN( 1., zakz(ji,jj,jk) ) *        & 
    171                      &             MIN( ABS( zakz(ji,jj,jk) ), 2. * ABS(ztraz(ji,jj,jk+1)), 2. * ABS(ztraz(ji,jj,jk) ) ) 
    172                END DO 
    173           
    174                ! vertical advective flux 
    175                DO jk = 1, jpkm1 
    176                   zigma = zwsink2(ji,jj,jk+1) * zstep / e3w(ji,jj,jk+1,Kmm) 
    177                   zew   = zwsink2(ji,jj,jk+1) 
    178                   psinkflx(ji,jj,jk+1) = -zew * ( tr(ji,jj,jk,jp_tra,Kbb) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep 
    179                END DO 
    180                ! 
    181                ! Boundary conditions 
    182                psinkflx(ji,jj,1  ) = 0.e0 
    183                psinkflx(ji,jj,jpk) = 0.e0 
    184           
    185                DO jk=1,jpkm1 
    186                   zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 
    187                   tr(ji,jj,jk,jp_tra,Kbb) = tr(ji,jj,jk,jp_tra,Kbb) + zflx 
    188                END DO 
    189             END DO 
    190          END DO 
     147         DO_2D_11_11 
     148            ! 
     149            zstep = rsfact / REAL( kiter(ji,jj), wp ) / 2. 
     150            !               
     151            DO jk = 2, jpkm1 
     152               ztraz(ji,jj,jk) = ( tr(ji,jj,jk-1,jp_tra,Kbb) - tr(ji,jj,jk,jp_tra,Kbb) ) * tmask(ji,jj,jk) 
     153            END DO 
     154            ztraz(ji,jj,1  ) = 0.0 
     155            ztraz(ji,jj,jpk) = 0.0 
     156 
     157            ! slopes 
     158            DO jk = 2, jpkm1 
     159               zign = 0.25 + SIGN( 0.25, ztraz(ji,jj,jk) * ztraz(ji,jj,jk+1) ) 
     160               zakz(ji,jj,jk) = ( ztraz(ji,jj,jk) + ztraz(ji,jj,jk+1) ) * zign 
     161            END DO 
     162       
     163            ! Slopes limitation 
     164            DO jk = 2, jpkm1 
     165               zakz(ji,jj,jk) = SIGN( 1., zakz(ji,jj,jk) ) *        & 
     166                  &             MIN( ABS( zakz(ji,jj,jk) ), 2. * ABS(ztraz(ji,jj,jk+1)), 2. * ABS(ztraz(ji,jj,jk) ) ) 
     167            END DO 
     168       
     169            ! vertical advective flux 
     170            DO jk = 1, jpkm1 
     171               zigma = zwsink2(ji,jj,jk+1) * zstep / e3w(ji,jj,jk+1,Kmm) 
     172               zew   = zwsink2(ji,jj,jk+1) 
     173               psinkflx(ji,jj,jk+1) = -zew * ( tr(ji,jj,jk,jp_tra,Kbb) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep 
     174            END DO 
     175            ! 
     176            ! Boundary conditions 
     177            psinkflx(ji,jj,1  ) = 0.e0 
     178            psinkflx(ji,jj,jpk) = 0.e0 
     179       
     180            DO jk=1,jpkm1 
     181               zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 
     182               tr(ji,jj,jk,jp_tra,Kbb) = tr(ji,jj,jk,jp_tra,Kbb) + zflx 
     183            END DO 
     184         END_2D 
    191185      END DO 
    192186 
    193       DO jk = 1,jpkm1 
    194          DO jj = 1,jpj 
    195             DO ji = 1, jpi 
    196                zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 
    197                ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx 
    198             END DO 
    199          END DO 
    200       END DO 
     187      DO_3D_11_11( 1,jpkm1 ) 
     188         zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 
     189         ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx 
     190      END_3D 
    201191 
    202192      tr(:,:,:,jp_tra,Kbb) = ztrb(:,:,:) 

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

    r11949 r12340  
    4949   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  ztmltrd2   ! 
    5050 
     51   !! * Substitutions 
     52#  include "do_loop_substitute.h90" 
    5153   !!---------------------------------------------------------------------- 
    5254   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    122124 
    123125            IF( jpktrd_trc < jpk ) THEN                           ! description ??? 
    124                DO jj = 1, jpj 
    125                   DO ji = 1, jpi 
    126                      IF( nmld_trc(ji,jj) <= jpktrd_trc ) THEN 
    127                         zvlmsk(ji,jj) = tmask(ji,jj,1) 
    128                      ELSE 
    129                         isum = isum + 1 
    130                         zvlmsk(ji,jj) = 0.e0 
    131                      ENDIF 
    132                   END DO 
    133                END DO 
     126               DO_2D_11_11 
     127                  IF( nmld_trc(ji,jj) <= jpktrd_trc ) THEN 
     128                     zvlmsk(ji,jj) = tmask(ji,jj,1) 
     129                  ELSE 
     130                     isum = isum + 1 
     131                     zvlmsk(ji,jj) = 0.e0 
     132                  ENDIF 
     133               END_2D 
    134134            ENDIF 
    135135 
    … …  
    147147         ! ... Weights for vertical averaging 
    148148         wkx_trc(:,:,:) = 0.e0 
    149          DO jk = 1, jpktrd_trc                                    ! initialize wkx_trc with vertical scale factor in mixed-layer 
    150             DO jj = 1, jpj 
    151                DO ji = 1, jpi 
    152                   IF( jk - nmld_trc(ji,jj) < 0 )   wkx_trc(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 
    153                END DO 
    154             END DO 
    155          END DO 
     149         DO_3D_11_11( 1, jpktrd_trc ) 
     150            IF( jk - nmld_trc(ji,jj) < 0 )   wkx_trc(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 
     151         END_3D 
    156152          
    157153         rmld_trc(:,:) = 0.e0 
    … …  
    262258         ! 
    263259         DO jn = 1, jptra 
    264             DO jj = 1, jpj 
    265                DO ji = 1, jpi 
    266                   ik = nmld_trc(ji,jj) 
    267                   IF( ln_trdtrc(jn) )    & 
    268                   tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - avs(ji,jj,ik) / e3w(ji,jj,ik,Kmm) * tmask(ji,jj,ik)  & 
    269                        &                    * ( tr(ji,jj,ik-1,jn,Kmm) - tr(ji,jj,ik,jn,Kmm) )            & 
    270                        &                    / MAX( 1., rmld_trc(ji,jj) ) * tmask(ji,jj,1) 
    271                END DO 
    272             END DO 
     260            DO_2D_11_11 
     261               ik = nmld_trc(ji,jj) 
     262               IF( ln_trdtrc(jn) )    & 
     263               tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - avs(ji,jj,ik) / e3w(ji,jj,ik,Kmm) * tmask(ji,jj,ik)  & 
     264                    &                    * ( tr(ji,jj,ik-1,jn,Kmm) - tr(ji,jj,ik,jn,Kmm) )            & 
     265                    &                    / MAX( 1., rmld_trc(ji,jj) ) * tmask(ji,jj,1) 
     266            END_2D 
    273267         END DO 
    274268 

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

    r12193 r12340  
    131131!$AGRIF_END_DO_NOT_TREAT 
    132132   ! 
     133   !! Substitutions 
     134#include "do_loop_substitute.h90" 
    133135   !!---------------------------------------------------------------------- 
    134136   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 

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

    r12328 r12340  
    4848   !! * Substitutions 
    4949#  include "vectopt_loop_substitute.h90" 
     50#  include "do_loop_substitute.h90" 
    5051   !!---------------------------------------------------------------------- 
    5152   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    414415         ! Remove river dilution for tracers with absent river load 
    415416         IF( ln_rnf_ctl .AND. .NOT.ln_trc_cbc(jn) ) THEN 
    416             DO jj = 2, jpj 
    417                DO ji = fs_2, fs_jpim1 
    418                   DO jk = 1, nk_rnf(ji,jj) 
    419                      zrnf = (rnf(ji,jj) + rnf_b(ji,jj)) * 0.5_wp * r1_rau0 / h_rnf(ji,jj) 
    420                      ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs)  + (ptr(ji,jj,jk,jn,Kmm) * zrnf) 
    421                   END DO 
     417            DO_2D_01_00 
     418               DO jk = 1, nk_rnf(ji,jj) 
     419                  zrnf = (rnf(ji,jj) + rnf_b(ji,jj)) * 0.5_wp * r1_rau0 / h_rnf(ji,jj) 
     420                  ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs)  + (ptr(ji,jj,jk,jn,Kmm) * zrnf) 
    422421               END DO 
    423             END DO 
     422            END_2D 
    424423         ENDIF 
    425424         ! 
    … …  
    430429            jl = n_trc_indsbc(jn) 
    431430            sf_trcsbc(jl)%fnow(:,:,1) = MAX( rtrn, sf_trcsbc(jl)%fnow(:,:,1) ) ! avoid nedgative value due to interpolation 
    432             DO jj = 2, jpj 
    433                DO ji = fs_2, fs_jpim1   ! vector opt. 
    434                   zfact = 1. / ( e3t(ji,jj,1,Kmm) * rn_sbc_time ) 
    435                   ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) * zfact 
    436                END DO 
    437             END DO 
     431            DO_2D_01_00 
     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 
    438435         ENDIF 
    439436         ! 
    … …  
    442439            IF( l_offline )   rn_rfact = 1._wp 
    443440            jl = n_trc_indcbc(jn) 
    444             DO jj = 2, jpj 
    445                DO ji = fs_2, fs_jpim1   ! vector opt. 
    446                   DO jk = 1, nk_rnf(ji,jj) 
    447                      zfact = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_cbc_time ) * tmask(ji,jj,1) 
    448                      ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zfact 
    449                   END DO 
     441            DO_2D_01_00 
     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 
    450445               END DO 
    451             END DO 
     446            END_2D 
    452447         ENDIF 
    453448         !                                                       ! =========== 

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

    r12193 r12340  
    3939!$AGRIF_END_DO_NOT_TREAT 
    4040 
     41   !! Substitutions 
     42#include "do_loop_substitute.h90" 
    4143   !!---------------------------------------------------------------------- 
    4244   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    196198               WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh' 
    197199            ENDIF 
    198             DO jj = 1, jpj                         ! vertical interpolation of T & S 
    199                DO ji = 1, jpi 
    200                   DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
    201                      zl = gdept(ji,jj,jk,Kmm) 
    202                      IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data 
    203                         ztp(jk) = ptrcdta(ji,jj,1) 
    204                      ELSEIF( zl > gdept_1d(jpk) ) THEN         ! below the last level of data 
    205                         ztp(jk) = ptrcdta(ji,jj,jpkm1) 
    206                      ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1 
    207                         DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1) 
    208                            IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 
    209                               zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 
    210                               ztp(jk) = ptrcdta(ji,jj,jkk) + ( ptrcdta(ji,jj,jkk+1) - ptrcdta(ji,jj,jkk) ) * zi 
    211                            ENDIF 
    212                         END DO 
    213                      ENDIF 
    214                   END DO 
    215                   DO jk = 1, jpkm1 
    216                      ptrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord 
    217                   END DO 
    218                   ptrcdta(ji,jj,jpk) = 0._wp 
    219                 END DO 
    220             END DO 
     200            DO_2D_11_11 
     201               DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
     202                  zl = gdept(ji,jj,jk,Kmm) 
     203                  IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data 
     204                     ztp(jk) = ptrcdta(ji,jj,1) 
     205                  ELSEIF( zl > gdept_1d(jpk) ) THEN         ! below the last level of data 
     206                     ztp(jk) = ptrcdta(ji,jj,jpkm1) 
     207                  ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1 
     208                     DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1) 
     209                        IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 
     210                           zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 
     211                           ztp(jk) = ptrcdta(ji,jj,jkk) + ( ptrcdta(ji,jj,jkk+1) - ptrcdta(ji,jj,jkk) ) * zi 
     212                        ENDIF 
     213                     END DO 
     214                  ENDIF 
     215               END DO 
     216               DO jk = 1, jpkm1 
     217                  ptrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord 
     218               END DO 
     219               ptrcdta(ji,jj,jpk) = 0._wp 
     220            END_2D 
    221221            !  
    222222         ELSE                                !==   z- or zps- coordinate   ==! 
Note: See TracChangeset for help on using the changeset viewer.