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

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

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

svn merge —ignore-ancestry \

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

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

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

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

Location:
NEMO/trunk
Files:
6 edited

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 
Note: See TracChangeset for help on using the changeset viewer.