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

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

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

svn merge —ignore-ancestry \

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

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

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

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

Location:
NEMO/trunk
Files:
1 deleted
46 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/P2Z/p2zbio.F90

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    r12280 r12377  
    4646   REAL(wp) ::   texcretd   ! 1 - excretd         
    4747 
     48   !! * Substitutions 
     49#  include "do_loop_substitute.h90" 
    4850   !!---------------------------------------------------------------------- 
    4951   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
     
    5355CONTAINS 
    5456 
    55    SUBROUTINE p4z_prod( kt , knt ) 
     57   SUBROUTINE p4z_prod( kt , knt, Kbb, Kmm, Krhs ) 
    5658      !!--------------------------------------------------------------------- 
    5759      !!                     ***  ROUTINE p4z_prod  *** 
     
    6365      !!--------------------------------------------------------------------- 
    6466      INTEGER, INTENT(in) ::   kt, knt   ! 
     67&nbs