New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 12377 for NEMO/trunk/src/TOP/PISCES/P4Z – NEMO

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

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

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

svn merge --ignore-ancestry \

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

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

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

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

Location:
NEMO/trunk
Files:
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 
    212          DO ji = 1, jpi 
     92      IF( .NOT.lk_sed ) THEN 
     93         ! OA: Warning, the following part is necessary to avoid CFL problems above the sediments 
     94         ! -------------------------------------------------------------------- 
     95         DO_2D_11_11 
    21396            ikt  = mbkt(ji,jj) 
    214             zdep = e3t_n(ji,jj,ikt) / xstep 
     97            zdep = e3t(ji,jj,ikt,Kmm) / xstep 
    21598            zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) ) 
    21699            zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) ) 
    217          END DO 
    218       END DO 
    219       ! 
    220       IF( .NOT.lk_sed ) THEN 
    221 ! 
    222          ! Add the external input of iron from sediment mobilization 
    223          ! ------------------------------------------------------ 
    224          IF( ln_ironsed ) THEN 
    225                             tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2 
    226             ! 
    227             IF( lk_iomput .AND. knt == nrdttrc )   & 
    228                &   CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! iron inputs from sediments 
    229          ENDIF 
     100         END_2D 
    230101 
    231102         ! Computation of the sediment denitrification proportion: The metamodel from midlleburg (2006) is being used 
    232103         ! Computation of the fraction of organic matter that is permanently buried from Dunne's model 
    233104         ! ------------------------------------------------------- 
    234          DO jj = 1, jpj 
    235             DO ji = 1, jpi 
    236               IF( tmask(ji,jj,1) == 1 ) THEN 
    237                  ikt = mbkt(ji,jj) 
    238                  zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   & 
    239                    &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) )  * 1E3 * 1E6 / 1E4 
    240                  zflx  = LOG10( MAX( 1E-3, zflx ) ) 
    241                  zo2   = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) ) 
    242                  zno3  = LOG10( MAX( 1.  , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) ) 
    243                  zdep  = LOG10( gdepw_n(ji,jj,ikt+1) ) 
    244                  zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3    & 
    245                    &                + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2 
    246                  zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) ) 
    247                    ! 
    248                  zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   & 
    249                    &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6 
    250                  zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2 
    251               ENDIF 
    252             END DO 
    253          END DO  
     105         DO_2D_11_11 
     106           IF( tmask(ji,jj,1) == 1 ) THEN 
     107              ikt = mbkt(ji,jj) 
     108              zflx = (  tr(ji,jj,ikt,jpgoc,Kbb) * zwsbio4(ji,jj)   & 
     109                &     + tr(ji,jj,ikt,jppoc,Kbb) * zwsbio3(ji,jj) )  * 1E3 * 1E6 / 1E4 
     110              zflx  = LOG10( MAX( 1E-3, zflx ) ) 
     111              zo2   = LOG10( MAX( 10. , tr(ji,jj,ikt,jpoxy,Kbb) * 1E6 ) ) 
     112              zno3  = LOG10( MAX( 1.  , tr(ji,jj,ikt,jpno3,Kbb) * 1E6 * rno3 ) ) 
     113              zdep  = LOG10( gdepw(ji,jj,ikt+1,Kmm) ) 
     114              zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3    & 
     115                &                + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2 
     116              zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) ) 
     117                ! 
     118              zflx = (  tr(ji,jj,ikt,jpgoc,Kbb) * zwsbio4(ji,jj)   & 
     119                &     + tr(ji,jj,ikt,jppoc,Kbb) * zwsbio3(ji,jj) ) * 1E6 
     120              zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2 
     121           ENDIF 
     122         END_2D 
    254123         ! 
    255124      ENDIF 
    … …  
    260129      IF( .NOT.lk_sed )  zrivsil = 1._wp - sedsilfrac 
    261130 
    262       DO jj = 1, jpj 
    263          DO ji = 1, jpi 
     131      DO_2D_11_11 
     132         ikt  = mbkt(ji,jj) 
     133         zdep = xstep / e3t(ji,jj,ikt,Kmm)  
     134         zwsc = zwsbio4(ji,jj) * zdep 
     135         zsiloss = tr(ji,jj,ikt,jpgsi,Kbb) * zwsc 
     136         zcaloss = tr(ji,jj,ikt,jpcal,Kbb) * zwsc 
     137         ! 
     138         tr(ji,jj,ikt,jpgsi,Krhs) = tr(ji,jj,ikt,jpgsi,Krhs) - zsiloss 
     139         tr(ji,jj,ikt,jpcal,Krhs) = tr(ji,jj,ikt,jpcal,Krhs) - zcaloss 
     140      END_2D 
     141      ! 
     142      IF( .NOT.lk_sed ) THEN 
     143         DO_2D_11_11 
    264144            ikt  = mbkt(ji,jj) 
    265             zdep = xstep / e3t_n(ji,jj,ikt)  
     145            zdep = xstep / e3t(ji,jj,ikt,Kmm)  
    266146            zwsc = zwsbio4(ji,jj) * zdep 
    267             zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc 
    268             zcaloss = trb(ji,jj,ikt,jpcal) * zwsc 
     147            zsiloss = tr(ji,jj,ikt,jpgsi,Kbb) * zwsc 
     148            zcaloss = tr(ji,jj,ikt,jpcal,Kbb) * zwsc 
     149            tr(ji,jj,ikt,jpsil,Krhs) = tr(ji,jj,ikt,jpsil,Krhs) + zsiloss * zrivsil  
    269150            ! 
    270             tra(ji,jj,ikt,jpgsi) = tra(ji,jj,ikt,jpgsi) - zsiloss 
    271             tra(ji,jj,ikt,jpcal) = tra(ji,jj,ikt,jpcal) - zcaloss 
    272          END DO 
    273       END DO 
    274       ! 
    275       IF( .NOT.lk_sed ) THEN 
    276          DO jj = 1, jpj 
    277             DO ji = 1, jpi 
    278                ikt  = mbkt(ji,jj) 
    279                zdep = xstep / e3t_n(ji,jj,ikt)  
    280                zwsc = zwsbio4(ji,jj) * zdep 
    281                zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc 
    282                zcaloss = trb(ji,jj,ikt,jpcal) * zwsc 
    283                tra(ji,jj,ikt,jpsil) = tra(ji,jj,ikt,jpsil) + zsiloss * zrivsil  
    284                ! 
    285                zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 
    286                zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 
    287                zrivalk  = sedcalfrac * zfactcal 
    288                tra(ji,jj,ikt,jptal) =  tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0 
    289                tra(ji,jj,ikt,jpdic) =  tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk 
    290                zsedcal(ji,jj) = (1.0 - zrivalk) * zcaloss * e3t_n(ji,jj,ikt)  
    291                zsedsi (ji,jj) = (1.0 - zrivsil) * zsiloss * e3t_n(ji,jj,ikt)  
    292             END DO 
    293          END DO 
    294       ENDIF 
    295       ! 
    296       DO jj = 1, jpj 
    297          DO ji = 1, jpi 
     151            zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 
     152            zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 
     153            zrivalk  = sedcalfrac * zfactcal 
     154            tr(ji,jj,ikt,jptal,Krhs) =  tr(ji,jj,ikt,jptal,Krhs) + zcaloss * zrivalk * 2.0 
     155            tr(ji,jj,ikt,jpdic,Krhs) =  tr(ji,jj,ikt,jpdic,Krhs) + zcaloss * zrivalk 
     156            zsedcal(ji,jj) = (1.0 - zrivalk) * zcaloss * e3t(ji,jj,ikt,Kmm)  
     157            zsedsi (ji,jj) = (1.0 - zrivsil) * zsiloss * e3t(ji,jj,ikt,Kmm)  
     158         END_2D 
     159      ENDIF 
     160      ! 
     161      DO_2D_11_11 
     162         ikt  = mbkt(ji,jj) 
     163         zdep = xstep / e3t(ji,jj,ikt,Kmm)  
     164         zws4 = zwsbio4(ji,jj) * zdep 
     165         zws3 = zwsbio3(ji,jj) * zdep 
     166         tr(ji,jj,ikt,jpgoc,Krhs) = tr(ji,jj,ikt,jpgoc,Krhs) - tr(ji,jj,ikt,jpgoc,Kbb) * zws4  
     167         tr(ji,jj,ikt,jppoc,Krhs) = tr(ji,jj,ikt,jppoc,Krhs) - tr(ji,jj,ikt,jppoc,Kbb) * zws3 
     168         tr(ji,jj,ikt,jpbfe,Krhs) = tr(ji,jj,ikt,jpbfe,Krhs) - tr(ji,jj,ikt,jpbfe,Kbb) * zws4 
     169         tr(ji,jj,ikt,jpsfe,Krhs) = tr(ji,jj,ikt,jpsfe,Krhs) - tr(ji,jj,ikt,jpsfe,Kbb) * zws3 
     170      END_2D 
     171      ! 
     172      IF( ln_p5z ) THEN 
     173         DO_2D_11_11 
    298174            ikt  = mbkt(ji,jj) 
    299             zdep = xstep / e3t_n(ji,jj,ikt)  
     175            zdep = xstep / e3t(ji,jj,ikt,Kmm)  
    300176            zws4 = zwsbio4(ji,jj) * zdep 
    301177            zws3 = zwsbio3(ji,jj) * zdep 
    302             tra(ji,jj,ikt,jpgoc) = tra(ji,jj,ikt,jpgoc) - trb(ji,jj,ikt,jpgoc) * zws4  
    303             tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3 
    304             tra(ji,jj,ikt,jpbfe) = tra(ji,jj,ikt,jpbfe) - trb(ji,jj,ikt,jpbfe) * zws4 
    305             tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3 
    306          END DO 
    307       END DO 
    308       ! 
    309       IF( ln_p5z ) THEN 
    310          DO jj = 1, jpj 
    311             DO ji = 1, jpi 
    312                ikt  = mbkt(ji,jj) 
    313                zdep = xstep / e3t_n(ji,jj,ikt)  
    314                zws4 = zwsbio4(ji,jj) * zdep 
    315                zws3 = zwsbio3(ji,jj) * zdep 
    316                tra(ji,jj,ikt,jpgon) = tra(ji,jj,ikt,jpgon) - trb(ji,jj,ikt,jpgon) * zws4 
    317                tra(ji,jj,ikt,jppon) = tra(ji,jj,ikt,jppon) - trb(ji,jj,ikt,jppon) * zws3 
    318                tra(ji,jj,ikt,jpgop) = tra(ji,jj,ikt,jpgop) - trb(ji,jj,ikt,jpgop) * zws4 
    319                tra(ji,jj,ikt,jppop) = tra(ji,jj,ikt,jppop) - trb(ji,jj,ikt,jppop) * zws3 
    320             END DO 
    321          END DO 
     178            tr(ji,jj,ikt,jpgon,Krhs) = tr(ji,jj,ikt,jpgon,Krhs) - tr(ji,jj,ikt,jpgon,Kbb) * zws4 
     179            tr(ji,jj,ikt,jppon,Krhs) = tr(ji,jj,ikt,jppon,Krhs) - tr(ji,jj,ikt,jppon,Kbb) * zws3 
     180            tr(ji,jj,ikt,jpgop,Krhs) = tr(ji,jj,ikt,jpgop,Krhs) - tr(ji,jj,ikt,jpgop,Kbb) * zws4 
     181            tr(ji,jj,ikt,jppop,Krhs) = tr(ji,jj,ikt,jppop,Krhs) - tr(ji,jj,ikt,jppop,Kbb) * zws3 
     182         END_2D 
    322183      ENDIF 
    323184 
    … …  
    325186         ! The 0.5 factor in zpdenit is to avoid negative NO3 concentration after 
    326187         ! denitrification in the sediments. Not very clever, but simpliest option. 
    327          DO jj = 1, jpj 
    328             DO ji = 1, jpi 
    329                ikt  = mbkt(ji,jj) 
    330                zdep = xstep / e3t_n(ji,jj,ikt)  
    331                zws4 = zwsbio4(ji,jj) * zdep 
    332                zws3 = zwsbio3(ji,jj) * zdep 
    333                zrivno3 = 1. - zbureff(ji,jj) 
    334                zwstpoc = trb(ji,jj,ikt,jpgoc) * zws4 + trb(ji,jj,ikt,jppoc) * zws3 
    335                zpdenit  = MIN( 0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 ) 
    336                z1pdenit = zwstpoc * zrivno3 - zpdenit 
    337                zolimit = MIN( ( trb(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) ) 
    338                tra(ji,jj,ikt,jpdoc) = tra(ji,jj,ikt,jpdoc) + z1pdenit - zolimit 
    339                tra(ji,jj,ikt,jppo4) = tra(ji,jj,ikt,jppo4) + zpdenit + zolimit 
    340                tra(ji,jj,ikt,jpnh4) = tra(ji,jj,ikt,jpnh4) + zpdenit + zolimit 
    341                tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) - rdenit * zpdenit 
    342                tra(ji,jj,ikt,jpoxy) = tra(ji,jj,ikt,jpoxy) - zolimit * o2ut 
    343                tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * zpdenit ) 
    344                tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit  
    345                sdenit(ji,jj) = rdenit * zpdenit * e3t_n(ji,jj,ikt) 
    346                zsedc(ji,jj)   = (1. - zrivno3) * zwstpoc * e3t_n(ji,jj,ikt) 
    347                IF( ln_p5z ) THEN 
    348                   zwstpop              = trb(ji,jj,ikt,jpgop) * zws4 + trb(ji,jj,ikt,jppop) * zws3 
    349                   zwstpon              = trb(ji,jj,ikt,jpgon) * zws4 + trb(ji,jj,ikt,jppon) * zws3 
    350                   tra(ji,jj,ikt,jpdon) = tra(ji,jj,ikt,jpdon) + ( z1pdenit - zolimit ) * zwstpon / (zwstpoc + rtrn) 
    351                   tra(ji,jj,ikt,jpdop) = tra(ji,jj,ikt,jpdop) + ( z1pdenit - zolimit ) * zwstpop / (zwstpoc + rtrn) 
    352                ENDIF 
    353             END DO 
    354          END DO 
     188         DO_2D_11_11 
     189            ikt  = mbkt(ji,jj) 
     190            zdep = xstep / e3t(ji,jj,ikt,Kmm)  
     191            zws4 = zwsbio4(ji,jj) * zdep 
     192            zws3 = zwsbio3(ji,jj) * zdep 
     193            zrivno3 = 1. - zbureff(ji,jj) 
     194            zwstpoc = tr(ji,jj,ikt,jpgoc,Kbb) * zws4 + tr(ji,jj,ikt,jppoc,Kbb) * zws3 
     195            zpdenit  = MIN( 0.5 * ( tr(ji,jj,ikt,jpno3,Kbb) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 ) 
     196            z1pdenit = zwstpoc * zrivno3 - zpdenit 
     197            zolimit = MIN( ( tr(ji,jj,ikt,jpoxy,Kbb) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) ) 
     198            tr(ji,jj,ikt,jpdoc,Krhs) = tr(ji,jj,ikt,jpdoc,Krhs) + z1pdenit - zolimit 
     199            tr(ji,jj,ikt,jppo4,Krhs) = tr(ji,jj,ikt,jppo4,Krhs) + zpdenit + zolimit 
     200            tr(ji,jj,ikt,jpnh4,Krhs) = tr(ji,jj,ikt,jpnh4,Krhs) + zpdenit + zolimit 
     201            tr(ji,jj,ikt,jpno3,Krhs) = tr(ji,jj,ikt,jpno3,Krhs) - rdenit * zpdenit 
     202            tr(ji,jj,ikt,jpoxy,Krhs) = tr(ji,jj,ikt,jpoxy,Krhs) - zolimit * o2ut 
     203            tr(ji,jj,ikt,jptal,Krhs) = tr(ji,jj,ikt,jptal,Krhs) + rno3 * (zolimit + (1.+rdenit) * zpdenit ) 
     204            tr(ji,jj,ikt,jpdic,Krhs) = tr(ji,jj,ikt,jpdic,Krhs) + zpdenit + zolimit  
     205            sdenit(ji,jj) = rdenit * zpdenit * e3t(ji,jj,ikt,Kmm) 
     206            zsedc(ji,jj)   = (1. - zrivno3) * zwstpoc * e3t(ji,jj,ikt,Kmm) 
     207            IF( ln_p5z ) THEN 
     208               zwstpop              = tr(ji,jj,ikt,jpgop,Kbb) * zws4 + tr(ji,jj,ikt,jppop,Kbb) * zws3 
     209               zwstpon              = tr(ji,jj,ikt,jpgon,Kbb) * zws4 + tr(ji,jj,ikt,jppon,Kbb) * zws3 
     210               tr(ji,jj,ikt,jpdon,Krhs) = tr(ji,jj,ikt,jpdon,Krhs) + ( z1pdenit - zolimit ) * zwstpon / (zwstpoc + rtrn) 
     211               tr(ji,jj,ikt,jpdop,Krhs) = tr(ji,jj,ikt,jpdop,Krhs) + ( z1pdenit - zolimit ) * zwstpop / (zwstpoc + rtrn) 
     212            ENDIF 
     213         END_2D 
    355214       ENDIF 
    356215 
    … …  
    364223      ENDDO 
    365224      IF( ln_p4z ) THEN 
    366          DO jk = 1, jpkm1 
    367             DO jj = 1, jpj 
    368                DO ji = 1, jpi 
    369                   !                      ! Potential nitrogen fixation dependant on temperature and iron 
    370                   ztemp = tsn(ji,jj,jk,jp_tem) 
    371                   zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 
    372                   !       Potential nitrogen fixation dependant on temperature and iron 
    373                   xdianh4 = trb(ji,jj,jk,jpnh4) / ( concnnh4 + trb(ji,jj,jk,jpnh4) ) 
    374                   xdiano3 = trb(ji,jj,jk,jpno3) / ( concnno3 + trb(ji,jj,jk,jpno3) ) * (1. - xdianh4) 
    375                   zlim = ( 1.- xdiano3 - xdianh4 ) 
    376                   IF( zlim <= 0.1 )   zlim = 0.01 
    377                   zfact = zlim * rfact2 
    378                   ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 
    379                   ztrpo4(ji,jj,jk) = trb(ji,jj,jk,jppo4) / ( 1E-6 + trb(ji,jj,jk,jppo4) ) 
    380                   ztrdp = ztrpo4(ji,jj,jk) 
    381                   nitrpot(ji,jj,jk) =  zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 
    382                END DO 
    383             END DO 
    384          END DO 
     225         DO_3D_11_11( 1, jpkm1 ) 
     226            !                      ! Potential nitrogen fixation dependant on temperature and iron 
     227            ztemp = ts(ji,jj,jk,jp_tem,Kmm) 
     228            zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 
     229            !       Potential nitrogen fixation dependant on temperature and iron 
     230            xdianh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 
     231            xdiano3 = tr(ji,jj,jk,jpno3,Kbb) / ( concnno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - xdianh4) 
     232            zlim = ( 1.- xdiano3 - xdianh4 ) 
     233            IF( zlim <= 0.1 )   zlim = 0.01 
     234            zfact = zlim * rfact2 
     235            ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 
     236            ztrpo4(ji,jj,jk) = tr(ji,jj,jk,jppo4,Kbb) / ( 1E-6 + tr(ji,jj,jk,jppo4,Kbb) ) 
     237            ztrdp = ztrpo4(ji,jj,jk) 
     238            nitrpot(ji,jj,jk) =  zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 
     239         END_3D 
    385240      ELSE       ! p5z 
    386          DO jk = 1, jpkm1 
    387             DO jj = 1, jpj 
    388                DO ji = 1, jpi 
    389                   !                      ! Potential nitrogen fixation dependant on temperature and iron 
    390                   ztemp = tsn(ji,jj,jk,jp_tem) 
    391                   zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 
    392                   !       Potential nitrogen fixation dependant on temperature and iron 
    393                   xdianh4 = trb(ji,jj,jk,jpnh4) / ( concnnh4 + trb(ji,jj,jk,jpnh4) ) 
    394                   xdiano3 = trb(ji,jj,jk,jpno3) / ( concnno3 + trb(ji,jj,jk,jpno3) ) * (1. - xdianh4) 
    395                   zlim = ( 1.- xdiano3 - xdianh4 ) 
    396                   IF( zlim <= 0.1 )   zlim = 0.01 
    397                   zfact = zlim * rfact2 
    398                   ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 
    399                   ztrpo4(ji,jj,jk) = trb(ji,jj,jk,jppo4) / ( 1E-6 + trb(ji,jj,jk,jppo4) ) 
    400                   ztrdop(ji,jj,jk) = trb(ji,jj,jk,jpdop) / ( 1E-6 + trb(ji,jj,jk,jpdop) ) * (1. - ztrpo4(ji,jj,jk)) 
    401                   ztrdp = ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) 
    402                   nitrpot(ji,jj,jk) =  zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 
    403                END DO 
    404             END DO 
    405          END DO 
     241         DO_3D_11_11( 1, jpkm1 ) 
     242            !                      ! Potential nitrogen fixation dependant on temperature and iron 
     243            ztemp = ts(ji,jj,jk,jp_tem,Kmm) 
     244            zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 
     245            !       Potential nitrogen fixation dependant on temperature and iron 
     246            xdianh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 
     247            xdiano3 = tr(ji,jj,jk,jpno3,Kbb) / ( concnno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - xdianh4) 
     248            zlim = ( 1.- xdiano3 - xdianh4 ) 
     249            IF( zlim <= 0.1 )   zlim = 0.01 
     250            zfact = zlim * rfact2 
     251            ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 
     252            ztrpo4(ji,jj,jk) = tr(ji,jj,jk,jppo4,Kbb) / ( 1E-6 + tr(ji,jj,jk,jppo4,Kbb) ) 
     253            ztrdop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( 1E-6 + tr(ji,jj,jk,jpdop,Kbb) ) * (1. - ztrpo4(ji,jj,jk)) 
     254            ztrdp = ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) 
     255            nitrpot(ji,jj,jk) =  zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 
     256         END_3D 
    406257      ENDIF 
    407258 
    … …  
    409260      ! ---------------------------------------- 
    410261      IF( ln_p4z ) THEN 
    411          DO jk = 1, jpkm1 
    412             DO jj = 1, jpj 
    413                DO ji = 1, jpi 
    414                   zfact = nitrpot(ji,jj,jk) * nitrfix 
    415                   tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zfact / 3.0 
    416                   tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zfact / 3.0 
    417                   tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zfact * 2.0 / 3.0 
    418                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zfact * 1.0 / 3.0 
    419                   tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zfact * 1.0 / 3.0 * 2.0 / 3.0 
    420                   tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfact * 1.0 / 3.0 * 1.0 / 3.0 
    421                   tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 
    422                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - 30E-6 * zfact * 1.0 / 3.0 
    423                   tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 
    424                   tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 
    425                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 
    426                   tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trb(ji,jj,jk,jppo4) ) & 
    427                   &                     * 0.001 * trb(ji,jj,jk,jpdoc) * xstep 
    428               END DO 
    429             END DO  
    430          END DO 
     262         DO_3D_11_11( 1, jpkm1 ) 
     263            zfact = nitrpot(ji,jj,jk) * nitrfix 
     264            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0 
     265            tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zfact / 3.0 
     266            tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zfact * 2.0 / 3.0 
     267            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zfact * 1.0 / 3.0 
     268            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zfact * 1.0 / 3.0 * 2.0 / 3.0 
     269            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfact * 1.0 / 3.0 * 1.0 / 3.0 
     270            tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 
     271            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - 30E-6 * zfact * 1.0 / 3.0 
     272            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 
     273            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 
     274            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 
     275            tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + concdnh4 / ( concdnh4 + tr(ji,jj,jk,jppo4,Kbb) ) & 
     276            &                     * 0.001 * tr(ji,jj,jk,jpdoc,Kbb) * xstep 
     277         END_3D 
    431278      ELSE    ! p5z 
    432          DO jk = 1, jpkm1 
    433             DO jj = 1, jpj 
    434                DO ji = 1, jpi 
    435                   zfact = nitrpot(ji,jj,jk) * nitrfix 
    436                   tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zfact / 3.0 
    437                   tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zfact / 3.0 
    438                   tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - 16.0 / 46.0 * zfact * ( 1.0 - 1.0 / 3.0 ) & 
    439                   &                     * ztrpo4(ji,jj,jk) / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 
    440                   tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zfact * 1.0 / 3.0 
    441                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zfact * 1.0 / 3.0 
    442                   tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + 16.0 / 46.0 * zfact / 3.0  & 
    443                   &                     - 16.0 / 46.0 * zfact * ztrdop(ji,jj,jk)   & 
    444                   &                     / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 
    445                   tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zfact * 1.0 / 3.0 * 2.0 / 3.0 
    446                   tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zfact * 1.0 / 3.0 * 2.0 /3.0 
    447                   tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 2.0 /3.0 
    448                   tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfact * 1.0 / 3.0 * 1.0 / 3.0 
    449                   tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zfact * 1.0 / 3.0 * 1.0 /3.0 
    450                   tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 1.0 /3.0 
    451                   tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 
    452                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - 30E-6 * zfact * 1.0 / 3.0  
    453                   tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 
    454                   tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 
    455                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 
    456               END DO 
    457             END DO  
    458          END DO 
     279         DO_3D_11_11( 1, jpkm1 ) 
     280            zfact = nitrpot(ji,jj,jk) * nitrfix 
     281            tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0 
     282            tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zfact / 3.0 
     283            tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - 16.0 / 46.0 * zfact * ( 1.0 - 1.0 / 3.0 ) & 
     284            &                     * ztrpo4(ji,jj,jk) / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 
     285            tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zfact * 1.0 / 3.0 
     286            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zfact * 1.0 / 3.0 
     287            tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + 16.0 / 46.0 * zfact / 3.0  & 
     288            &                     - 16.0 / 46.0 * zfact * ztrdop(ji,jj,jk)   & 
     289            &                     / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 
     290            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zfact * 1.0 / 3.0 * 2.0 / 3.0 
     291            tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zfact * 1.0 / 3.0 * 2.0 /3.0 
     292            tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 2.0 /3.0 
     293            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfact * 1.0 / 3.0 * 1.0 / 3.0 
     294            tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zfact * 1.0 / 3.0 * 1.0 /3.0 
     295            tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 1.0 /3.0 
     296            tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 
     297            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - 30E-6 * zfact * 1.0 / 3.0  
     298            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 
     299            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 
     300            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 
     301         END_3D 
    459302         ! 
    460303      ENDIF 
    461304 
    462       IF( lk_iomput ) THEN 
    463          IF( knt == nrdttrc ) THEN 
    464             zfact = 1.e+3 * rfact2r !  conversion from molC/l/kt  to molN/m3/s 
    465             CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * rno3 * zfact * tmask(:,:,:) )  ! nitrogen fixation  
    466             CALL iom_put( "SedCal", zsedcal(:,:) * zfact ) 
    467             CALL iom_put( "SedSi",  zsedsi (:,:) * zfact ) 
    468             CALL iom_put( "SedC",   zsedc  (:,:) * zfact ) 
    469             CALL iom_put( "Sdenit", sdenit (:,:) * zfact * rno3 ) 
    470          ENDIF 
    471       ENDIF 
    472       ! 
    473       IF(ln_ctl) THEN  ! print mean trends (USEd for debugging) 
     305      IF( lk_iomput .AND. knt == nrdttrc ) THEN 
     306         zfact = 1.e+3 * rfact2r !  conversion from molC/l/kt  to molN/m3/s 
     307         CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * rno3 * zfact * tmask(:,:,:) )  ! nitrogen fixation  
     308         CALL iom_put( "SedCal", zsedcal(:,:) * zfact ) 
     309         CALL iom_put( "SedSi" , zsedsi (:,:) * zfact ) 
     310         CALL iom_put( "SedC"  , zsedc  (:,:) * zfact ) 
     311         CALL iom_put( "Sdenit", sdenit (:,:) * zfact * rno3 ) 
     312      ENDIF 
     313      ! 
     314      IF(sn_cfctl%l_prttrc) THEN  ! print mean trends (USEd for debugging) 
    474315         WRITE(charout, fmt="('sed ')") 
    475316         CALL prt_ctl_trc_info(charout) 
    476          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     317         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    477318      ENDIF 
    478319      ! 
    … …  
    483324   END SUBROUTINE p4z_sed 
    484325 
     326   SUBROUTINE p4z_sed_init 
     327      !!---------------------------------------------------------------------- 
     328      !!                  ***  routine p4z_sed_init  *** 
     329      !! 
     330      !! ** purpose :   initialization of some parameters 
     331      !! 
     332      !!---------------------------------------------------------------------- 
     333      !!---------------------------------------------------------------------- 
     334      INTEGER  :: ji, jj, jk, jm 
     335      INTEGER  :: ios                 ! Local integer output status for namelist read 
     336      ! 
     337      !! 
     338      NAMELIST/nampissed/ nitrfix, diazolight, concfediaz 
     339      !!---------------------------------------------------------------------- 
     340      ! 
     341      IF(lwp) THEN 
     342         WRITE(numout,*) 
     343         WRITE(numout,*) 'p4z_sed_init : initialization of sediment mobilisation ' 
     344         WRITE(numout,*) '~~~~~~~~~~~~ ' 
     345      ENDIF 
     346      !                            !* set file information 
     347      READ  ( numnatp_ref, nampissed, IOSTAT = ios, ERR = 901) 
     348901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampissed in reference namelist' ) 
     349      READ  ( numnatp_cfg, nampissed, IOSTAT = ios, ERR = 902 ) 
     350902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampissed in configuration namelist' ) 
     351      IF(lwm) WRITE ( numonp, nampissed ) 
     352 
     353      IF(lwp) THEN 
     354         WRITE(numout,*) '   Namelist : nampissed ' 
     355         WRITE(numout,*) '      nitrogen fixation rate                       nitrfix = ', nitrfix 
     356         WRITE(numout,*) '      nitrogen fixation sensitivty to light    diazolight  = ', diazolight 
     357         WRITE(numout,*) '      Fe half-saturation cste for diazotrophs  concfediaz  = ', concfediaz 
     358      ENDIF 
     359      ! 
     360      r1_rday  = 1. / rday 
     361      ! 
     362      sedsilfrac = 0.03     ! percentage of silica loss in the sediments 
     363      sedcalfrac = 0.6      ! percentage of calcite loss in the sediments 
     364      ! 
     365      lk_sed = ln_sediment .AND. ln_sed_2way  
     366      ! 
     367   END SUBROUTINE p4z_sed_init 
    485368 
    486369   INTEGER FUNCTION p4z_sed_alloc() 

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

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

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

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

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

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

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

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

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

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

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

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

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

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