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

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

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

svn merge —ignore-ancestry \

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

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

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

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

Location:
NEMO/trunk
Files:
1 deleted
25 edited
1 copied

Legend:

Unmodified
Added
Removed
  • NEMO/trunk

    • Property svn:externals
      •  

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    r12276 r12377  
    1515   USE sms_pisces      !  PISCES Source Minus Sink variables 
    1616   USE p4zlim          !  Co-limitations of differents nutrients 
    17    USE p4zsbc          !  External source of nutrients  
    1817   USE p4zint          !  interpolation and computation of various fields 
    1918   USE sed             !  Sediment module 
     
    2524 
    2625   PUBLIC   p4z_sed   
     26   PUBLIC   p4z_sed_init 
    2727   PUBLIC   p4z_sed_alloc 
    2828  
     29   REAL(wp), PUBLIC ::   nitrfix      !: Nitrogen fixation rate 
     30   REAL(wp), PUBLIC ::   diazolight   !: Nitrogen fixation sensitivty to light 
     31   REAL(wp), PUBLIC ::   concfediaz   !: Fe half-saturation Cste for diazotrophs 
     32 
    2933   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nitrpot    !: Nitrogen fixation  
    3034   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:  ) :: sdenit     !: Nitrate reduction in the sediments 
    31    REAL(wp) :: r1_rday                  !: inverse of rday 
    32    LOGICAL, SAVE :: lk_sed 
    33  
     35   ! 
     36   REAL(wp), SAVE :: r1_rday           
     37   REAL(wp), SAVE :: sedsilfrac, sedcalfrac 
     38 
     39   !! * Substitutions 
     40#  include "do_loop_substitute.h90" 
    3441   !!---------------------------------------------------------------------- 
    3542   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
     
    3946CONTAINS 
    4047 
    41    SUBROUTINE p4z_sed( kt, knt ) 
     48   SUBROUTINE p4z_sed( kt, knt, Kbb, Kmm, Krhs ) 
    4249      !!--------------------------------------------------------------------- 
    4350      !!                     ***  ROUTINE p4z_sed  *** 
     
    5158      ! 
    5259      INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
     60      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices 
    5361      INTEGER  ::  ji, jj, jk, ikt 
    5462      REAL(wp) ::  zrivalk, zrivsil, zrivno3 
    55       REAL(wp) ::  zwflux, zlim, zfact, zfactcal 
     63      REAL(wp) ::  zlim, zfact, zfactcal 
    5664      REAL(wp) ::  zo2, zno3, zflx, zpdenit, z1pdenit, zolimit 
    5765      REAL(wp) ::  zsiloss, zcaloss, zws3, zws4, zwsc, zdep 
     
    6674      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zsoufer, zlight 
    6775      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrpo4, ztrdop, zirondep, zpdep 
    68       REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) :: zsidep, zironice 
    6976      !!--------------------------------------------------------------------- 
    7077      ! 
    7178      IF( ln_timing )  CALL timing_start('p4z_sed') 
    7279      ! 
    73       IF( kt == nittrc000 .AND. knt == 1 )   THEN 
    74           r1_rday  = 1. / rday 
    75           IF (ln_sediment .AND. ln_sed_2way) THEN 
    76              lk_sed = .TRUE. 
    77           ELSE 
    78              lk_sed = .FALSE. 
    79           ENDIF 
    80       ENDIF 
    81       ! 
    82       IF( kt == nittrc000 .AND. knt == 1 )   r1_rday  = 1. / rday 
    83       ! 
     80 
    8481      ! Allocate temporary workspace 
    8582      ALLOCATE( ztrpo4(jpi,jpj,jpk) ) 
     
    9390      zsedc   (:,:) = 0.e0 
    9491 
    95       ! Iron input/uptake due to sea ice : Crude parameterization based on Lancelot et al. 
    96       ! ---------------------------------------------------- 
    97       IF( ln_ironice ) THEN   
    98          !                                               
    99          ALLOCATE( zironice(jpi,jpj) ) 
    100          !                                               
    101          DO jj = 1, jpj 
    102             DO ji = 1, jpi 
    103                zdep    = rfact2 / e3t_n(ji,jj,1) 
    104                zwflux  = fmmflx(ji,jj) / 1000._wp 
    105                zironice(ji,jj) =  MAX( -0.99 * trb(ji,jj,1,jpfer), -zwflux * icefeinput * zdep ) 
    106             END DO 
    107          END DO 
    108          ! 
    109          tra(:,:,1,jpfer) = tra(:,:,1,jpfer) + zironice(:,:)  
    110          !  
    111          IF( lk_iomput .AND. knt == nrdttrc )   & 
    112             &   CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! iron flux from ice 
    113          ! 
    114          DEALLOCATE( zironice ) 
    115          !                                               
    116       ENDIF 
    117  
    118       ! Add the external input of nutrients from dust deposition 
    119       ! ---------------------------------------------------------- 
    120       IF( ln_dust ) THEN 
    121          !                                               
    122          ALLOCATE( zsidep(jpi,jpj), zpdep(jpi,jpj,jpk), zirondep(jpi,jpj,jpk) ) 
    123          !                                              ! Iron and Si deposition at the surface 
    124          IF( ln_solub ) THEN 
    125             zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss  
    126          ELSE 
    127             zirondep(:,:,1) = dustsolub  * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss  
    128          ENDIF 
    129          zsidep(:,:)   = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 28.1  
    130          zpdep (:,:,1) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 31. / po4r  
    131          !                                              ! Iron solubilization of particles in the water column 
    132          !                                              ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ;  wdust in m/j 
    133          zwdust = 0.03 * rday / ( wdust * 55.85 ) / ( 270. * rday ) 
    134          DO jk = 2, jpkm1 
    135             zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -gdept_n(:,:,jk) / 540. ) 
    136             zpdep   (:,:,jk) = zirondep(:,:,jk) * 0.023 
    137          END DO 
    138          !                                              ! Iron solubilization of particles in the water column 
    139          tra(:,:,1,jpsil) = tra(:,:,1,jpsil) + zsidep  (:,:) 
    140          DO jk = 1, jpkm1 
    141             tra(:,:,jk,jppo4) = tra(:,:,jk,jppo4) + zpdep   (:,:,jk) 
    142             tra(:,:,jk,jpfer) = tra(:,:,jk,jpfer) + zirondep(:,:,jk)  
    143          ENDDO 
    144          !  
    145          IF( lk_iomput .AND. knt == nrdttrc ) THEN 
    146              CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron 
    147              CALL iom_put( "pdust"  , dust(:,:) / ( wdust * rday )  * tmask(:,:,1) ) ! dust concentration at surface 
    148          ENDIF 
    149          DEALLOCATE( zsidep, zpdep, zirondep ) 
    150          !                                               
    151       ENDIF 
    152       
    153       ! Add the external input of nutrients from river 
    154       ! ---------------------------------------------------------- 
    155       IF( ln_river ) THEN 
    156          DO jj = 1, jpj 
    157             DO ji = 1, jpi 
    158                DO jk = 1, nk_rnf(ji,jj) 
    159                   tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) +  rivdip(ji,jj) * rfact2 
    160                   tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) +  rivdin(ji,jj) * rfact2 
    161                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) +  rivdic(ji,jj) * 5.e-5 * rfact2 
    162                   tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) +  rivdsi(ji,jj) * rfact2 
    163                   tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +  rivdic(ji,jj) * rfact2 
    164                   tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) +  ( rivalk(ji,jj) - rno3 * rivdin(ji,jj) ) * rfact2 
    165                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) +  rivdoc(ji,jj) * rfact2 
    166                ENDDO 
    167             ENDDO 
    168          ENDDO 
    169          IF (ln_ligand) THEN 
    170             DO jj = 1, jpj 
    171                DO ji = 1, jpi 
    172                   DO jk = 1, nk_rnf(ji,jj) 
    173                      tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) +  rivdic(ji,jj) * 5.e-5 * rfact2 
    174                   ENDDO 
    175                ENDDO 
    176             ENDDO 
    177          ENDIF 
    178          IF( ln_p5z ) THEN 
    179             DO jj = 1, jpj 
    180                DO ji = 1, jpi 
    181                   DO jk = 1, nk_rnf(ji,jj) 
    182                      tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + rivdop(ji,jj) * rfact2 
    183                      tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + rivdon(ji,jj) * rfact2 
    184                   ENDDO 
    185                ENDDO 
    186             ENDDO 
    187          ENDIF 
    188       ENDIF 
    189        
    190       ! Add the external input of nutrients from nitrogen deposition 
    191       ! ---------------------------------------------------------- 
    192       IF( ln_ndepo ) THEN 
    193          tra(:,:,1,jpno3) = tra(:,:,1,jpno3) + nitdep(:,:) * rfact2 
    194          tra(:,:,1,jptal) = tra(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2 
    195       ENDIF 
    196  
    197       ! Add the external input of iron from hydrothermal vents 
    198       ! ------------------------------------------------------ 
    199       IF( ln_hydrofe ) THEN 
    200             tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2 
    201          IF( ln_ligand ) THEN 
    202             tra(:,:,:,jplgw) = tra(:,:,:,jplgw) + ( hydrofe(:,:,:) * lgw_rath ) * rfact2 
    203          ENDIF 
    204          ! 
    205          IF( lk_iomput .AND. knt == nrdttrc )   & 
    206             &   CALL iom_put( "HYDR", hydrofe(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! hydrothermal iron input 
    207       ENDIF 
    208  
    209       ! OA: Warning, the following part is necessary to avoid CFL problems above the sediments 
    210       ! -------------------------------------------------------------------- 
    211       DO jj = 1, jpj