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

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

Ignore:
Timestamp:
2015-12-21T12:35:23+01:00 (8 years ago)
Author:
timgraham
Message:

Merge of branches/2015/dev_merge_2015 back into trunk. Merge excludes NEMOGCM/TOOLS/OBSTOOLS/ for now due to issues with the change of file type. Will sort these manually with further commits.

Branch merged as follows:
In the working copy of branch ran:
svn merge ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
Small conflicts due to bug fixes applied to trunk since the dev_merge_2015 was copied. Bug fixes were applied to the branch as well so these were easy to resolve.
Branch committed at this stage

In working copy run:
svn switch ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge --reintegrate ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2015/dev_merge_2015
to merge the branch into the trunk and then commit - no conflicts at this stage.

Location:
trunk/NEMOGCM/NEMO/TOP_SRC
Files:
39 edited
1 copied

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90

    r5836 r6140  
    4949   REAL(wp) ::   xconv3 = 1.e+3_wp             ! conversion from mol/l/atm to mol/m3/atm 
    5050 
    51    !! * Substitutions 
    52 #  include "domzgr_substitute.h90" 
    5351   !!---------------------------------------------------------------------- 
    5452   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    257255                  &                      * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) / 2. 
    258256            ! Add the surface flux to the trend 
    259             tra(ji,jj,1,jpc14) = tra(ji,jj,1,jpc14) + qtr_c14(ji,jj) / fse3t(ji,jj,1)  
     257            tra(ji,jj,1,jpc14) = tra(ji,jj,1,jpc14) + qtr_c14(ji,jj) / e3t_n(ji,jj,1)  
    260258             
    261259            ! cumulation of surface flux at each time step 

  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r5836 r6140  
    5050   REAL(wp) ::   xconv4 = 1.0e-12      ! conversion from mol/m3/atm to mol/m3/pptv  
    5151 
    52    !! * Substitutions 
    53 #  include "domzgr_substitute.h90" 
    5452   !!---------------------------------------------------------------------- 
    5553   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    7573      !!                CFC concentration in pico-mol/m3 
    7674      !!---------------------------------------------------------------------- 
    77       ! 
    7875      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    7976      ! 
    … …  
    167164                  &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) 
    168165               ! Add the surface flux to the trend 
    169                tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / fse3t(ji,jj,1)  
     166               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / e3t_n(ji,jj,1)  
    170167 
    171168               ! cumulation of surface flux at each time step 

  • trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90

    r5385 r6140  
    1818   USE trd_oce 
    1919   USE trdtrc 
     20   USE trcbc, only : trc_bc_read 
    2021 
    2122   IMPLICIT NONE 
    … …  
    5657      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrmyt ) 
    5758 
    58       IF( l_trdtrc ) THEN      ! Save the trends in the ixed layer 
     59      CALL trc_bc_read  ( kt )       ! tracers: surface and lateral Boundary Conditions 
     60 
     61      ! add here the call to BGC model 
     62 
     63      ! Save the trends in the mixed layer 
     64      IF( l_trdtrc ) THEN 
    5965          DO jn = jp_myt0, jp_myt1 
    6066            ztrmyt(:,:,:) = tra(:,:,:,jn) 

  • trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90

    r5836 r6140  
    3636      DO jn = jp_myt0, jp_myt1 
    3737         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
    38          CALL iom_put( cltra, trn(:,:,:,jn) ) 
     38         IF( ln_trc_wri(jn) ) CALL iom_put( cltra, trn(:,:,:,jn) ) 
    3939      END DO 
    4040      ! 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90

    r5836 r6140  
    6060 
    6161   !! * Substitutions 
    62 #  include "domzgr_substitute.h90" 
    6362#  include "vectopt_loop_substitute.h90" 
    6463   !!---------------------------------------------------------------------- 
    … …  
    6766   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6867   !!---------------------------------------------------------------------- 
    69  
    7068CONTAINS 
    7169 
    … …  
    187185               !    closure : flux grazing is redistributed below level jpkbio 
    188186               zzoobod = tmminz * zzoo * zzoo 
    189                xksi(ji,jj) = xksi(ji,jj) + (1-fdbod) * zzoobod * fse3t(ji,jj,jk) 
     187               xksi(ji,jj) = xksi(ji,jj) + (1-fdbod) * zzoobod * e3t_n(ji,jj,jk) 
    190188               zboddet = fdbod * zzoobod 
    191189 
    … …  
    242240                IF( ln_diatrc .OR. lk_iomput ) THEN 
    243241                  ! convert fluxes in per day 
    244                   ze3t = fse3t(ji,jj,jk) * 86400. 
     242                  ze3t = e3t_n(ji,jj,jk) * 86400._wp 
    245243                  zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t 
    246244                  zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t 
    … …  
    363361                IF( ln_diatrc .OR. lk_iomput ) THEN 
    364362                  ! convert fluxes in per day 
    365                   ze3t = fse3t(ji,jj,jk) * 86400. 
     363                  ze3t = e3t_n(ji,jj,jk) * 86400._wp 
    366364                  zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t 
    367365                  zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t 
    … …  
    382380                  zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 
    383381                  !    
    384                   zw3d(ji,jj,jk,1) = zno3phy * 86400 
    385                   zw3d(ji,jj,jk,2) = znh4phy * 86400 
    386                   zw3d(ji,jj,jk,3) = znh4no3 * 86400 
     382                  zw3d(ji,jj,jk,1) = zno3phy * 86400._wp 
     383                  zw3d(ji,jj,jk,2) = znh4phy * 86400._wp 
     384                  zw3d(ji,jj,jk,3) = znh4no3 * 86400._wp 
    387385                   ! 
    388386                ENDIF 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90

    r5836 r6140  
    4242 
    4343   !! * Substitutions 
    44 #  include "domzgr_substitute.h90" 
    4544#  include "vectopt_loop_substitute.h90" 
    4645   !!---------------------------------------------------------------------- 
    … …  
    4948   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5049   !!---------------------------------------------------------------------- 
    51  
    5250CONTAINS 
    5351 
    … …  
    9593         DO jj = 2, jpjm1 
    9694            DO ji = fs_2, fs_jpim1 
    97                ze3t = 1. / fse3t(ji,jj,jk) 
     95               ze3t = 1. / e3t_n(ji,jj,jk) 
    9896               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj) 
    9997            END DO 
    … …  
    110108         DO ji = fs_2, fs_jpim1 
    111109            ikt = mbkt(ji,jj)  
    112             tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) + sedlam * sedpocn(ji,jj) / fse3t(ji,jj,ikt)  
     110            tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) + sedlam * sedpocn(ji,jj) / e3t_n(ji,jj,ikt)  
    113111            ! Deposition of organic matter in the sediment 
    114112            zwork = vsed * trn(ji,jj,ikt,jpdet) 
    … …  
    121119      DO jj = 2, jpjm1 
    122120         DO ji = fs_2, fs_jpim1 
    123             tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc * cmask(ji,jj) / areacot / fse3t(ji,jj,1) 
     121            tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc * cmask(ji,jj) / areacot / e3t_n(ji,jj,1) 
    124122         END DO 
    125123      END DO 
    … …  
    212210         DO jj = 1, jpj 
    213211            DO ji = 1, jpi 
    214                zfluo = ( fsdepw(ji,jj,jk  ) / fsdepw(ji,jj,jpkb) )**xhr 
    215                zfluu = ( fsdepw(ji,jj,jk+1) / fsdepw(ji,jj,jpkb) )**xhr 
     212               zfluo = ( gdepw_n(ji,jj,jk  ) / gdepw_n(ji,jj,jpkb) )**xhr 
     213               zfluu = ( gdepw_n(ji,jj,jk+1) / gdepw_n(ji,jj,jpkb) )**xhr 
    216214               IF( zfluo.GT.1. )   zfluo = 1._wp 
    217215               zdm0(ji,jj,jk) = zfluo - zfluu 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90

    r5836 r6140  
    4040   REAL(wp), PUBLIC ::  reddom    ! redfield ratio (C:N) for DOM 
    4141 
    42    !! * Substitutions 
    43 #  include "domzgr_substitute.h90" 
    4442   !!---------------------------------------------------------------------- 
    4543   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    4745   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4846   !!---------------------------------------------------------------------- 
    49  
    5047CONTAINS 
    5148 
    … …  
    105102               zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
    106103               zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
    107                zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * fse3t(ji,jj,jk-1) ) 
    108                zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * fse3t(ji,jj,jk-1) ) 
     104               zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * e3t_n(ji,jj,jk-1) ) 
     105               zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t_n(ji,jj,jk-1) ) 
    109106            END DO 
    110107        END DO 
    … …  
    116113               zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
    117114               zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
    118                zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkr * fse3t(ji,jj,jk) ) ) 
    119                zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkg * fse3t(ji,jj,jk) ) ) 
     115               zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * e3t_n(ji,jj,jk) ) * ( 1 - EXP( -zkr * e3t_n(ji,jj,jk) ) ) 
     116               zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * e3t_n(ji,jj,jk) ) * ( 1 - EXP( -zkg * e3t_n(ji,jj,jk) ) ) 
    120117               etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 ) 
    121118            END DO 
    … …  
    138135      DO jj = 1, jpj 
    139136         DO ji = 1, jpi 
    140             heup(ji,jj) = fsdepw(ji,jj,neln(ji,jj)) 
     137            heup(ji,jj) = gdepw_n(ji,jj,neln(ji,jj)) 
    141138         END DO 
    142139      END DO  

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90

    r5836 r6140  
    3434   REAL(wp), PUBLIC ::   xhr         ! coeff for martin''s remineralisation profile 
    3535 
    36    !! * Substitutions 
    37 #  include "domzgr_substitute.h90" 
    3836   !!---------------------------------------------------------------------- 
    3937   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    102100         DO jj = 1, jpj 
    103101            DO ji = 1, jpi 
    104                ztra(ji,jj,jk)  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 
     102               ztra(ji,jj,jk)  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / e3t_n(ji,jj,jk) 
    105103               tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra(ji,jj,jk)  
    106104            END DO 
    … …  
    111109         IF( iom_use( "TDETSED" ) ) THEN 
    112110            CALL wrk_alloc( jpi, jpj, zw2d ) 
    113             zw2d(:,:) =  ztra(:,:,1) * fse3t(:,:,1) * 86400. 
     111            zw2d(:,:) =  ztra(:,:,1) * e3t_n(:,:,1) * 86400._wp 
    114112            DO jk = 2, jpkm1 
    115                zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * fse3t(:,:,jk) * 86400. 
     113               zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400._wp 
    116114            END DO 
    117115            CALL iom_put( "TDETSED", zw2d ) 
    … …  
    121119         IF( ln_diatrc ) THEN  
    122120            CALL wrk_alloc( jpi, jpj, zw2d ) 
    123             zw2d(:,:) =  ztra(:,:,1) * fse3t(:,:,1) * 86400. 
     121            zw2d(:,:) =  ztra(:,:,1) * e3t_n(:,:,1) * 86400._wp 
    124122            DO jk = 2, jpkm1 
    125                zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * fse3t(:,:,jk) * 86400. 
     123               zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400._wp 
    126124            END DO 
    127125            trc2d(:,:,jp_pcs0_2d + 7) = zw2d(:,:) 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90

    r5836 r6140  
    3434   PUBLIC  p4z_bio     
    3535 
    36    !! * Substitutions 
    37 #  include "domzgr_substitute.h90" 
    3836   !!---------------------------------------------------------------------- 
    3937   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    4139   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4240   !!---------------------------------------------------------------------- 
    43  
    4441CONTAINS 
    4542 
    … …  
    7067         DO jj = 1, jpj 
    7168            DO ji = 1, jpi 
    72                IF( fsdepw(ji,jj,jk+1) > hmld(ji,jj) )   xdiss(ji,jj,jk) = 0.01 
     69!!gm  :  use nmln  and test on jk ...  less memory acces 
     70               IF( gdepw_n(ji,jj,jk+1) > hmld(ji,jj) )   xdiss(ji,jj,jk) = 0.01 
    7371            END DO  
    7472         END DO 
    7573      END DO 
    7674 
    77            
    7875      CALL p4z_opt  ( kt, knt )     ! Optic: PAR in the water column 
    7976      CALL p4z_sink ( kt, knt )     ! vertical flux of particulate organic matter 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90

    r5836 r6140  
    164164   REAL(wp) :: devk55  = 0.3692E-3       
    165165 
    166    !! * Substitutions 
    167 #  include "domzgr_substitute.h90" 
    168166   !!---------------------------------------------------------------------- 
    169167   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    244242 
    245243 
    246  
    247244      ! CHEMICAL CONSTANTS - DEEP OCEAN 
    248245      ! ------------------------------- 
    … …  
    252249 
    253250               ! SET PRESSION 
    254                zpres   = 1.025e-1 * fsdept(ji,jj,jk) 
     251               zpres   = 1.025e-1 * gdept_n(ji,jj,jk) 
    255252 
    256253               ! SET ABSOLUTE TEMPERATURE 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90

    r5836 r6140  
    3030   PUBLIC   p4z_fechem_init ! called in trcsms_pisces.F90 
    3131 
    32    !! * Shared module variables 
    33    LOGICAL          ::  ln_fechem    !: boolean for complex iron chemistry following Tagliabue and voelker 
    34    LOGICAL          ::  ln_ligvar    !: boolean for variable ligand concentration following Tagliabue and voelker 
    35    REAL(wp), PUBLIC ::  xlam1        !: scavenging rate of Iron  
    36    REAL(wp), PUBLIC ::  xlamdust     !: scavenging rate of Iron by dust  
    37    REAL(wp), PUBLIC ::  ligand       !: ligand concentration in the ocean  
    38  
     32   LOGICAL          ::   ln_fechem    !: boolean for complex iron chemistry following Tagliabue and voelker 
     33   LOGICAL          ::   ln_ligvar    !: boolean for variable ligand concentration following Tagliabue and voelker 
     34   REAL(wp), PUBLIC ::   xlam1        !: scavenging rate of Iron  
     35   REAL(wp), PUBLIC ::   xlamdust     !: scavenging rate of Iron by dust  
     36   REAL(wp), PUBLIC ::   ligand       !: ligand concentration in the ocean  
     37 
     38!!gm Not DOCTOR norm !!! 
    3939   REAL(wp) :: kl1, kl2, kb1, kb2, ks, kpr, spd, con, kth 
    4040 
    41    !! * Substitutions 
    42 #  include "domzgr_substitute.h90" 
    4341   !!---------------------------------------------------------------------- 
    4442   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    6159      !!                    and one particulate form (ln_fechem) 
    6260      !!--------------------------------------------------------------------- 
    63       ! 
    64       INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
     61      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step 
    6562      ! 
    6663      INTEGER  ::   ji, jj, jk, jic 
     64      CHARACTER (len=25) :: charout 
    6765      REAL(wp) ::   zdep, zlam1a, zlam1b, zlamfac 
    6866      REAL(wp) ::   zkeq, zfeequi, zfesatur, zfecoll 
    … …  
    7977      REAL(wp) :: ztfe, zoxy 
    8078      REAL(wp) :: zstep 
    81       CHARACTER (len=25) :: charout 
    8279      !!--------------------------------------------------------------------- 
    8380      ! 
    8481      IF( nn_timing == 1 )  CALL timing_start('p4z_fechem') 
    8582      ! 
    86       ! Allocate temporary workspace 
    87       CALL wrk_alloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig ) 
     83      CALL wrk_alloc( jpi,jpj,jpk,   zFe3, zFeL1, zTL1, ztotlig ) 
    8884      zFe3 (:,:,:) = 0. 
    8985      zFeL1(:,:,:) = 0. 
    9086      zTL1 (:,:,:) = 0. 
    9187      IF( ln_fechem ) THEN 
    92          CALL wrk_alloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP ) 
     88         CALL wrk_alloc( jpi,jpj,jpk,  zFe2, zFeL2, zTL2, zFeP ) 
    9389         zFe2 (:,:,:) = 0. 
    9490         zFeL2(:,:,:) = 0. 
    … …  
    253249               zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 
    254250               zlamfac = MIN( 1.  , zlamfac ) 
    255                zdep    = MIN( 1., 1000. / fsdept(ji,jj,jk) ) 
     251!!gm very small BUG :  it is unlikely but possible that gdept_n = 0  ..... 
     252               zdep    = MIN( 1., 1000. / gdept_n(ji,jj,jk) ) 
    256253               zlam1b  = xlam1 * MAX( 0.e0, ( trb(ji,jj,jk,jpfer) * 1.e9 - ztotlig(ji,jj,jk) ) ) 
    257254               zcoag   = zfeequi * zlam1b * zstep + 1E-4 * ( 1. - zlamfac ) * zdep * zstep * trb(ji,jj,jk,jpfer) 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90

    r5836 r6140  
    5959   REAL(wp) ::  xconv  = 0.01_wp / 3600._wp !: coefficients for conversion  
    6060 
    61    !! * Substitutions 
    62 #  include "domzgr_substitute.h90" 
    6361   !!---------------------------------------------------------------------- 
    6462   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    182180            oce_co2(ji,jj) = ( zfld - zflu ) * rfact2 * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000. 
    183181            ! compute the trend 
    184             tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) * rfact2 / fse3t(ji,jj,1) 
     182            tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) * rfact2 / e3t_n(ji,jj,1) 
    185183 
    186184            ! Compute O2 flux  
    … …  
    188186            zflu16 = trb(ji,jj,1,jpoxy) * tmask(ji,jj,1) * zkgo2(ji,jj) 
    189187            zoflx(ji,jj) = zfld16 - zflu16 
    190             tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) * rfact2 / fse3t(ji,jj,1) 
     188            tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) * rfact2 / e3t_n(ji,jj,1) 
    191189         END DO 
    192190      END DO 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90

    r5836 r6140  
    5151   REAL(wp), DIMENSION(3,61), PUBLIC ::   xkrgb   !: tabulated attenuation coefficients for RGB absorption 
    5252    
    53    !! * Substitutions 
    54 #  include "domzgr_substitute.h90" 
    5553   !!---------------------------------------------------------------------- 
    5654   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    10199               irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 
    102100               !                                                          
    103                ekb(ji,jj,jk) = xkrgb(1,irgb) * fse3t(ji,jj,jk) 
    104                ekg(ji,jj,jk) = xkrgb(2,irgb) * fse3t(ji,jj,jk) 
    105                ekr(ji,jj,jk) = xkrgb(3,irgb) * fse3t(ji,jj,jk) 
     101               ekb(ji,jj,jk) = xkrgb(1,irgb) * e3t_n(ji,jj,jk) 
     102               ekg(ji,jj,jk) = xkrgb(2,irgb) * e3t_n(ji,jj,jk) 
     103               ekr(ji,jj,jk) = xkrgb(3,irgb) * e3t_n(ji,jj,jk) 
    106104            END DO 
    107105         END DO 
    … …  
    162160                 neln(ji,jj) = jk+1                    ! Euphotic level : 1rst T-level strictly below Euphotic layer 
    163161                 !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint 
    164                  heup(ji,jj) = fsdepw(ji,jj,jk+1)      ! Euphotic layer depth 
     162                 heup(ji,jj) = gdepw_n(ji,jj,jk+1)     ! Euphotic layer depth 
    165163              ENDIF 
    166164           END DO 
    … …  
    179177         DO jj = 1, jpj 
    180178            DO ji = 1, jpi 
    181                IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    182                   zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * fse3t(ji,jj,jk) ! remineralisation 
    183                   zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * fse3t(ji,jj,jk) ! production 
    184                   zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * fse3t(ji,jj,jk) ! production 
    185                   zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat    (ji,jj,jk) * fse3t(ji,jj,jk) ! production 
    186                   zdepmoy(ji,jj) = zdepmoy(ji,jj) + fse3t(ji,jj,jk) 
     179               IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
     180                  zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * e3t_n(ji,jj,jk) ! remineralisation 
     181                  zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t_n(ji,jj,jk) ! production 
     182                  zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * e3t_n(ji,jj,jk) ! production 
     183                  zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat    (ji,jj,jk) * e3t_n(ji,jj,jk) ! production 
     184                  zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t_n(ji,jj,jk) 
    187185               ENDIF 
    188186            END DO 
    … …  
    196194         DO jj = 1, jpj 
    197195            DO ji = 1, jpi 
    198                IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
     196               IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    199197                  z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
    200198                  emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep 
    … …  
    260258            DO jj = 1, jpj 
    261259               DO ji = 1, jpi 
    262                   pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) * xsi0r ) 
     260                  pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t_n(ji,jj,jk-1) * xsi0r ) 
    263261                  pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb(ji,jj,jk-1 ) ) 
    264262                  pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg(ji,jj,jk-1 ) ) 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90

    r5836 r6140  
    5454   REAL(wp) :: texcret2               !: 1 - excret2         
    5555 
    56    !! * Substitutions 
    57 #  include "domzgr_substitute.h90" 
    5856   !!---------------------------------------------------------------------- 
    5957   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    277275         DO jj = 1, jpj 
    278276            DO ji = 1, jpi 
    279                IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
     277               IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    280278                  zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * zmixnano(ji,jj) 
    281279                  zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * zmixdiat(ji,jj) 
    … …  
    321319            DO jj = 1, jpj 
    322320               DO ji = 1, jpi 
    323                   IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
     321                  IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    324322                     zprnch(ji,jj,jk) = zprnch(ji,jj,jk) * zmixnano(ji,jj) 
    325323                     zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj) 
    … …  
    462460             zw2d(:,:) = 0. 
    463461             DO jk = 1, jpkm1 
    464                zw2d(:,:) = zw2d(:,:) + zprorca (:,:,jk) * fse3t(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated  primary produc. by nano 
     462               zw2d(:,:) = zw2d(:,:) + zprorca (:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated  primary produc. by nano 
    465463             ENDDO 
    466464             CALL iom_put( "INTPPPHY" , zw2d ) 
    … …  
    468466             zw2d(:,:) = 0. 
    469467             DO jk = 1, jpkm1 
    470                 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated  primary produc. by diatom 
     468                zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated  primary produc. by diatom 
    471469             ENDDO 
    472470             CALL iom_put( "INTPPPHY2" , zw2d ) 
    … …  
    475473             zw2d(:,:) = 0. 
    476474             DO jk = 1, jpkm1 
    477                 zw2d(:,:) = zw2d(:,:) + ( zprorca(:,:,jk) + zprorcad(:,:,jk) ) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp 
     475                zw2d(:,:) = zw2d(:,:) + ( zprorca(:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp 
    478476             ENDDO 
    479477             CALL iom_put( "INTPP" , zw2d ) 
    … …  
    482480             zw2d(:,:) = 0. 
    483481             DO jk = 1, jpkm1 
    484                 zw2d(:,:) = zw2d(:,:) + ( zpronew(:,:,jk) + zpronewd(:,:,jk) ) * fse3t(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated new prod 
     482                zw2d(:,:) = zw2d(:,:) + ( zpronew(:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated new prod 
    485483             ENDDO 
    486484             CALL iom_put( "INTPNEW" , zw2d ) 
    … …  
    489487             zw2d(:,:) = 0. 
    490488             DO jk = 1, jpkm1 
    491                 zw2d(:,:) = zw2d(:,:) + ( zprofen(:,:,jk) + zprofed(:,:,jk) ) * fse3t(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bfe prod 
     489                zw2d(:,:) = zw2d(:,:) + ( zprofen(:,:,jk) + zprofed(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bfe prod 
    492490             ENDDO 
    493491            CALL iom_put( "INTPBFE" , zw2d ) 
    … …  
    496494             zw2d(:,:) = 0. 
    497495             DO jk = 1, jpkm1 
    498                 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * zysopt(:,:,jk) * fse3t(:,:,jk) * zfact * tmask(:,:,jk)  ! vert integr. bsi prod 
     496                zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * zysopt(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert integr. bsi prod 
    499497             ENDDO 
    500498             CALL iom_put( "INTPBSI" , zw2d ) 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90

    r5836 r6140  
    5050   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitnh4   !: -    -    -    -   - 
    5151 
    52    !! * Substitutions 
    53 #  include "domzgr_substitute.h90" 
    5452   !!---------------------------------------------------------------------- 
    5553   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    103101            DO ji = 1, jpi 
    104102               zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 
    105                IF( fsdept(ji,jj,jk) < zdep ) THEN 
     103               IF( gdept_n(ji,jj,jk) < zdep ) THEN 
    106104                  zdepbac(ji,jj,jk) = MIN( 0.7 * ( trb(ji,jj,jk,jpzoo) + 2.* trb(ji,jj,jk,jpmes) ), 4.e-6 ) 
    107105                  ztempbac(ji,jj)   = zdepbac(ji,jj,jk) 
    108106               ELSE 
    109                   zdepmin = MIN( 1., zdep / fsdept(ji,jj,jk) ) 
     107                  zdepmin = MIN( 1., zdep / gdept_n(ji,jj,jk) ) 
    110108                  zdepbac (ji,jj,jk) = zdepmin**0.683 * ztempbac(ji,jj) 
    111109                  zdepprod(ji,jj,jk) = zdepmin**0.273 
    … …  
    283281               ! ---------------------------------------------------------- 
    284282               zdep     = MAX( hmld(ji,jj), heup(ji,jj) )  
    285                zdep     = MAX( 0., fsdept(ji,jj,jk) - zdep ) 
     283               zdep     = MAX( 0., gdept_n(ji,jj,jk) - zdep ) 
    286284               ztem     = MAX( tsn(ji,jj,1,jp_tem), 0. ) 
    287285               zfactdep = xsilab * EXP(-( xsiremlab - xsirem ) * znusil2 * zdep / wsbio2 ) * ztem / ( ztem + 10. ) 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90

    r5836 r6140  
    2525   PUBLIC   p4z_sbc_init    
    2626 
    27    !! * Shared module variables 
    2827   LOGICAL , PUBLIC  :: ln_dust     !: boolean for dust input from the atmosphere 
    2928   LOGICAL , PUBLIC  :: ln_solub    !: boolean for variable solubility of atmospheric iron 
    … …  
    4544   LOGICAL , PUBLIC  :: ll_sbc 
    4645 
    47    !! * Module variables 
    4846   LOGICAL  ::  ll_solub 
    4947 
    … …  
    8078   REAL(wp), PUBLIC :: rivdininput, rivdipinput, rivdsiinput 
    8179 
    82  
    8380   !! * Substitutions 
    84 #  include "domzgr_substitute.h90" 
    8581#  include "vectopt_loop_substitute.h90" 
    8682   !!---------------------------------------------------------------------- 
    … …  
    8985   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    9086   !!---------------------------------------------------------------------- 
    91  
    9287CONTAINS 
    9388 
    … …  
    163158            DO jj = 1, jpj 
    164159               DO ji = 1, jpi 
    165                   nitdep(ji,jj) = sf_ndepo(1)%fnow(ji,jj,1) / rno3 / ( 14E6 * ryyss * fse3t(ji,jj,1) + rtrn ) 
     160                  nitdep(ji,jj) = sf_ndepo(1)%fnow(ji,jj,1) / rno3 / ( 14E6 * ryyss * e3t_n(ji,jj,1) + rtrn ) 
    166161               END DO 
    167162            END DO 
    … …  
    267262      IF( lk_offline ) THEN 
    268263        nk_rnf(:,:) = 1 
    269         h_rnf (:,:) = fsdept(:,:,1) 
     264        h_rnf (:,:) = gdept_n(:,:,1) 
    270265      ENDIF 
    271266 
    … …  
    456451            DO jj = 1, jpj 
    457452               DO ji = 1, jpi 
    458                   zexpide   = MIN( 8.,( fsdept(ji,jj,jk) / 500. )**(-1.5) ) 
     453                  zexpide   = MIN( 8.,( gdept_n(ji,jj,jk) / 500. )**(-1.5) ) 
    459454                  zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2 
    460455                  zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 ) 
    … …  
    466461         ironsed(:,:,jpk) = 0._wp 
    467462         DO jk = 1, jpkm1 
    468             ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( fse3t(:,:,jk) * rday ) 
     463            ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( e3t_n(:,:,jk) * rday ) 
    469464         END DO 
    470465         DEALLOCATE( zcmask) 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90

    r5836 r6140  
    3232   PUBLIC   p4z_sed_alloc 
    3333  
    34  
    35    !! * Module variables 
    3634   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nitrpot    !: Nitrogen fixation  
    3735   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:  ) :: sdenit     !: Nitrate reduction in the sediments 
    3836   REAL(wp) :: r1_rday                  !: inverse of rday 
    3937 
    40    !! * Substitutions 
    41 #  include "domzgr_substitute.h90" 
    4238   !!---------------------------------------------------------------------- 
    4339   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    10096         DO jj = 1, jpj 
    10197            DO ji = 1, jpi 
    102                zdep    = rfact2 / fse3t(ji,jj,1) 
     98               zdep    = rfact2 / e3t_n(ji,jj,1) 
    10399               zwflux  = fmmflx(ji,jj) / 1000._wp 
    104100               zfminus = MIN( 0._wp, -zwflux ) * trb(ji,jj,1,jpfer) * zdep 
    … …  
    111107         !  
    112108         IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironice" ) )   & 
    113             &   CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) ) ! iron flux from ice 
     109            &   CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! iron flux from ice 
    114110         ! 
    115111         CALL wrk_dealloc( jpi, jpj, zironice ) 
    … …  
    125121         !                                              ! Iron and Si deposition at the surface 
    126122         IF( ln_solub ) THEN 
    127             zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 55.85 + 3.e-10 * r1_ryyss  
     123            zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss  
    128124         ELSE 
    129             zirondep(:,:,1) = dustsolub  * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 55.85 + 3.e-10 * r1_ryyss  
     125            zirondep(:,:,1) = dustsolub  * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss  
    130126         ENDIF 
    131          zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 28.1  
    132          zpdep (:,:) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 31. / po4r  
     127         zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 28.1  
     128         zpdep (:,:) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 31. / po4r  
    133129         !                                              ! Iron solubilization of particles in the water column 
    134130         !                                              ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ;  wdust in m/j 
    135131         zwdust = 0.03 * rday / ( wdust * 55.85 ) / ( 270. * rday ) 
    136132         DO jk = 2, jpkm1 
    137             zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -fsdept(:,:,jk) / 540. ) 
     133            zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -gdept_n(:,:,jk) / 540. ) 
    138134         END DO 
    139135         !                                              ! Iron solubilization of particles in the water column 
    … …  
    145141            IF( knt == nrdttrc ) THEN 
    146142                IF( iom_use( "Irondep" ) )   & 
    147                 &  CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron 
     143                &  CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron 
    148144                IF( iom_use( "pdust" ) )   & 
    149145                &  CALL iom_put( "pdust"  , dust(:,:) / ( wdust * rday )  * tmask(:,:,1) ) ! dust concentration at surface 
    … …  
    151147         ELSE                                     
    152148            IF( ln_diatrc )  & 
    153               &  trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) 
     149              &  trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) 
    154150         ENDIF 
    155151         CALL wrk_dealloc( jpi, jpj,      zpdep, zsidep ) 
    … …  
    206202         DO ji = 1, jpi 
    207203            ikt  = mbkt(ji,jj) 
    208             zdep = fse3t(ji,jj,ikt) / xstep 
     204            zdep = e3t_n(ji,jj,ikt) / xstep 
    209205            zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) ) 
    210206            zwscal (ji,jj) = MIN( 0.99 * zdep, wscal (ji,jj,ikt) ) 
    … …  
    230226              zo2   = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) ) 
    231227              zno3  = LOG10( MAX( 1.  , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) ) 
    232               zdep  = LOG10( fsdepw(ji,jj,ikt+1) ) 
     228              zdep  = LOG10( gdepw_n(ji,jj,ikt+1) ) 
    233229              zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3    & 
    234230              &                + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2 
    … …  
    279275         DO ji = 1, jpi 
    280276            ikt  = mbkt(ji,jj) 
    281             zdep = xstep / fse3t(ji,jj,ikt)  
     277            zdep = xstep / e3t_n(ji,jj,ikt)  
    282278            zws4 = zwsbio4(ji,jj) * zdep 
    283279            zwsc = zwscal (ji,jj) * zdep 
    … …  
    305301         DO ji = 1, jpi 
    306302            ikt  = mbkt(ji,jj) 
    307             zdep = xstep / fse3t(ji,jj,ikt)  
     303            zdep = xstep / e3t_n(ji,jj,ikt)  
    308304            zws4 = zwsbio4(ji,jj) * zdep 
    309305            zws3 = zwsbio3(ji,jj) * zdep 
    … …  
    336332            tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * (zpdenit + zdenitt) ) 
    337333            tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit + zdenitt 
    338             sdenit(ji,jj) = rdenit * zpdenit * fse3t(ji,jj,ikt) 
     334            sdenit(ji,jj) = rdenit * zpdenit * e3t_n(ji,jj,ikt) 
    339335#endif 
    340336         END DO 
    … …  
    388384               zwork1(:,:) = 0. 
    389385               DO jk = 1, jpkm1 
    390                  zwork1(:,:) = zwork1(:,:) + nitrpot(:,:,jk) * nitrfix * zfact * fse3t(:,:,jk) * tmask(:,:,jk) 
     386                 zwork1(:,:) = zwork1(:,:) + nitrpot(:,:,jk) * nitrfix * zfact * e3t_n(:,:,jk) * tmask(:,:,jk) 
    391387               ENDDO 
    392388               CALL iom_put( "INTNFIX" , zwork1 )  
    … …  
    395391      ELSE 
    396392         IF( ln_diatrc )  & 
    397             &  trc2d(:,:,jp_pcs0_2d + 12) = nitrpot(:,:,1) * nitrfix * rno3 * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) 
     393            &  trc2d(:,:,jp_pcs0_2d + 12) = nitrpot(:,:,1) * nitrfix * rno3 * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) 
    398394      ENDIF 
    399395      ! 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90

    r5836 r6140  
    6565#endif 
    6666 
    67    !! * Substitutions 
    68 #  include "domzgr_substitute.h90" 
    6967   !!---------------------------------------------------------------------- 
    7068   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    108106            DO ji = 1,jpi 
    109107               zmax  = MAX( heup(ji,jj), hmld(ji,jj) ) 
    110                zfact = MAX( 0., fsdepw(ji,jj,jk+1) - zmax ) / 5000._wp 
     108               zfact = MAX( 0., gdepw_n(ji,jj,jk+1) - zmax ) / 5000._wp 
    111109               wsbio4(ji,jj,jk) = wsbio2 + ( 200.- wsbio2 ) * zfact 
    112110            END DO 
    … …  
    137135             DO ji = 1, jpi 
    138136                IF( tmask(ji,jj,jk) == 1) THEN 
    139                    zwsmax =  0.5 * fse3t(ji,jj,jk) / xstep 
     137                   zwsmax =  0.5 * e3t_n(ji,jj,jk) / xstep 
    140138                   iiter1 =  MAX( iiter1, INT( wsbio3(ji,jj,jk) / zwsmax ) ) 
    141139                   iiter2 =  MAX( iiter2, INT( wsbio4(ji,jj,jk) / zwsmax ) ) 
    … …  
    156154            DO ji = 1, jpi 
    157155               IF( tmask(ji,jj,jk) == 1 ) THEN 
    158                  zwsmax = 0.5 * fse3t(ji,jj,jk) / xstep 
     156                 zwsmax = 0.5 * e3t_n(ji,jj,jk) / xstep 
    159157                 wsbio3(ji,jj,jk) = MIN( wsbio3(ji,jj,jk), zwsmax * FLOAT( iiter1 ) ) 
    160158                 wsbio4(ji,jj,jk) = MIN( wsbio4(ji,jj,jk), zwsmax * FLOAT( iiter2 ) ) 
    … …  
    700698         zl = zmin 
    701699         zr = zmax 
    702          wmax = 0.5 * fse3t(1,1,jk) * rday * float(niter1max) / rfact2 
     700         wmax = 0.5 * e3t_n(1,1,jk) * rday * float(niter1max) / rfact2 
    703701         zdiv = xkr_zeta + xkr_eta - xkr_eta * zl 
    704702         znum = zl - 1. 
    … …  
    844842            DO jj = 1, jpj       
    845843               DO ji = 1, jpi     
    846                   zigma = zwsink2(ji,jj,jk+1) * zstep / fse3w(ji,jj,jk+1) 
     844                  zigma = zwsink2(ji,jj,jk+1) * zstep / e3w_n(ji,jj,jk+1) 
    847845                  zew   = zwsink2(ji,jj,jk+1) 
    848846                  psinkflx(ji,jj,jk+1) = -zew * ( trb(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep 
    … …  
    858856            DO jj = 1,jpj 
    859857               DO ji = 1, jpi 
    860                   zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 
     858                  zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t_n(ji,jj,jk) 
    861859                  trb(ji,jj,jk,jp_tra) = trb(ji,jj,jk,jp_tra) + zflx 
    862860               END DO 
    … …  
    869867         DO jj = 1,jpj 
    870868            DO ji = 1, jpi 
    871                zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 
     869               zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t_n(ji,jj,jk) 
    872870               ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx 
    873871            END DO 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90

    r5836 r6140  
    9292      ! 
    9393      !                                                                    !   set time step size (Euler/Leapfrog) 
    94       IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN   ;    rfact = rdttrc(1)     !  at nittrc000 
    95       ELSEIF( kt <= nittrc000 + nn_dttrc )                          THEN   ;    rfact = 2. * rdttrc(1)   ! at nittrc000 or nittrc000+nn_dttrc (Leapfrog) 
     94      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN   ;    rfact = rdttrc     !  at nittrc000 
     95      ELSEIF( kt <= nittrc000 + nn_dttrc )                          THEN   ;    rfact = 2. * rdttrc   ! at nittrc000 or nittrc000+nn_dttrc (Leapfrog) 
    9696      ENDIF 
    9797      ! 
    … …  
    102102         xstep = rfact2 / rday         ! Time step duration for biology 
    103103         IF(lwp) WRITE(numout,*)  
    104          IF(lwp) WRITE(numout,*) '    Passive Tracer  time step    rfact  = ', rfact, ' rdt = ', rdttra(1) 
     104         IF(lwp) WRITE(numout,*) '    Passive Tracer  time step    rfact  = ', rfact, ' rdt = ', rdt 
    105105         IF(lwp) write(numout,*) '    PISCES  Biology time step    rfact2 = ', rfact2 
    106106         IF(lwp) WRITE(numout,*) 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedrst.F90

    r5215 r6140  
    6060 
    6161      ALLOCATE( zdta(jpi,jpj,jpksed,jptrased), zdta1(jpi,jpj,jpksed,2), zhipor(jpoce,jpksed) )  
    62  
    63       IF ( jprstlib == jprstdimg ) THEN 
    64         ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
    65         ! if restart_sed.nc exists, then set jlibalt to jpnf90 
    66         INQUIRE( FILE = 'restart_sed.nc', EXIST = llok ) 
    67         IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF 
    68       ENDIF 
    6962 
    7063      CALL iom_open( 'restart_sed', numrsr, kiolib = jlibalt )      

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90

    r5836 r6140  
    2121   PUBLIC trc_wri_pisces  
    2222 
    23    !! * Substitutions 
    24 #  include "domzgr_substitute.h90" 
    25  
     23   !!---------------------------------------------------------------------- 
     24   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     25   !! $Id: trcnam.F90 5836 2015-10-26 14:49:40Z cetlod $ 
     26   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     27   !!---------------------------------------------------------------------- 
    2628CONTAINS 
    2729 
    … …  
    5759         zdic(:,:) = 0. 
    5860         DO jk = 1, jpkm1 
    59             zdic(:,:) = zdic(:,:) + trn(:,:,jk,jpdic) * fse3t(:,:,jk) * tmask(:,:,jk) * 12. 
     61            zdic(:,:) = zdic(:,:) + trn(:,:,jk,jpdic) * e3t_n(:,:,jk) * tmask(:,:,jk) * 12. 
    6062         ENDDO 
    6163         CALL iom_put( 'INTDIC', zdic )      
    … …  
    6466      IF( iom_use( "O2MIN" ) .OR. iom_use ( "ZO2MIN" ) ) THEN  ! Oxygen minimum concentration and depth  
    6567         zo2min   (:,:) = trn(:,:,1,jpoxy) * tmask(:,:,1) 
    66          zdepo2min(:,:) = fsdepw(:,:,1)    * tmask(:,:,1) 
     68         zdepo2min(:,:) = gdepw_n(:,:,1)   * tmask(:,:,1) 
    6769         DO jk = 2, jpkm1 
    6870            DO jj = 1, jpj 
    … …  
    7173                     IF( trn(ji,jj,jk,jpoxy) < zo2min(ji,jj) ) then 
    7274                        zo2min   (ji,jj) = trn(ji,jj,jk,jpoxy) 
    73                         zdepo2min(ji,jj) = fsdepw(ji,jj,jk) 
     75                        zdepo2min(ji,jj) = gdepw_n(ji,jj,jk) 
    7476                     ENDIF 
    7577                  ENDIF 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r5836 r6140  
    3232 
    3333   PUBLIC   trc_adv        
    34    PUBLIC   trc_adv_alloc  
    3534   PUBLIC   trc_adv_ini   
    3635 
    … …  
    5857   INTEGER ::              nadv             ! chosen advection scheme 
    5958   ! 
    60    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt  ! vertical profile time-step, = 2 rdttra 
    61    !                                                    ! except at nitrrc000 (=rdttra) if neuler=0 
     59   REAL(wp) ::   r2dttrc  ! vertical profile time-step, = 2 rdt 
     60   !                                                    ! except at nitrrc000 (=rdt) if neuler=0 
    6261 
    6362   !! * Substitutions 
    64 #  include "domzgr_substitute.h90" 
    6563#  include "vectopt_loop_substitute.h90" 
    6664   !!---------------------------------------------------------------------- 
    … …  
    7068   !!---------------------------------------------------------------------- 
    7169CONTAINS 
    72  
    73    INTEGER FUNCTION trc_adv_alloc() 
    74       !!---------------------------------------------------------------------- 
    75       !!                  ***  ROUTINE trc_adv_alloc  *** 
    76       !!---------------------------------------------------------------------- 
    77       ! 
    78       ALLOCATE( r2dt(jpk), STAT=trc_adv_alloc ) 
    79       ! 
    80       IF( trc_adv_alloc /= 0 ) CALL ctl_warn('trc_adv_alloc : failed to allocate array.') 
    81       ! 
    82    END FUNCTION trc_adv_alloc 
    83  
    8470 
    8571   SUBROUTINE trc_adv( kt ) 
    … …  
    10389      ! 
    10490      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000 
    105          r2dt(:) =  rdttrc(:)           ! = rdttrc (use or restarting with Euler time stepping) 
     91         r2dttrc =  rdttrc           ! = rdttrc (use or restarting with Euler time stepping) 
    10692      ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1 
    107          r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog) 
     93         r2dttrc = 2. * rdttrc       ! = 2 rdttrc (leapfrog) 
    10894      ENDIF 
    10995      !                                               !==  effective transport  ==! 
    11096      DO jk = 1, jpkm1 
    111          zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk)                   ! eulerian transport 
    112          zvn(:,:,jk) = e1v  (:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
     97         zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)                   ! eulerian transport 
     98         zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    11399         zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
    114100      END DO 
    … …  
    134120         CALL tra_adv_cen    ( kt, nittrc000,'TRC',       zun, zvn, zwn     , trn, tra, jptra, nn_cen_h, nn_cen_v ) 
    135121      CASE ( np_FCT )                                    ! FCT      : 2nd / 4th order 
    136          CALL tra_adv_fct    ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v ) 
     122         CALL tra_adv_fct    ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v ) 
    137123      CASE ( np_FCT_zts )                                ! 2nd order FCT with vertical time-splitting 
    138          CALL tra_adv_fct_zts( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra        , nn_fct_zts ) 
     124         CALL tra_adv_fct_zts( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra        , nn_fct_zts ) 
    139125      CASE ( np_MUS )                                    ! MUSCL 
    140          CALL tra_adv_mus    ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra        , ln_mus_ups )  
     126         CALL tra_adv_mus    ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb,      tra, jptra        , ln_mus_ups )  
    141127      CASE ( np_UBS )                                    ! UBS 
    142          CALL tra_adv_ubs    ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra        , nn_ubs_v   ) 
     128         CALL tra_adv_ubs    ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra        , nn_ubs_v   ) 
    143129      CASE ( np_QCK )                                    ! QUICKEST 
    144          CALL tra_adv_qck    ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra                     ) 
     130         CALL tra_adv_qck    ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra                     ) 
    145131      ! 
    146132      END SELECT 
    … …  
    231217            CALL ctl_stop( 'trc_adv_init: force 2nd order FCT scheme, 4th order does not exist with sub-timestepping' ) 
    232218         ENDIF 
    233          IF( lk_vvl ) THEN 
     219         IF( .NOT.ln_linssh ) THEN 
    234220            CALL ctl_stop( 'trc_adv_init: vertical sub-timestepping not allow in non-linear free surface' ) 
    235221         ENDIF 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    r5836 r6140  
    4343 
    4444   !! * Substitutions 
    45 #  include "domzgr_substitute.h90" 
    4645#  include "vectopt_loop_substitute.h90" 
    4746   !!---------------------------------------------------------------------- 
    … …  
    8281      !!              - save the trends ('key_trdmxl_trc') 
    8382      !!---------------------------------------------------------------------- 
    84       !! 
    85       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    86       !! 
    87       INTEGER  ::   ji, jj, jk, jn, jl       ! dummy loop indices 
    88       REAL(wp) ::   ztra                 ! temporary scalars 
    89       CHARACTER (len=22) :: charout 
     83      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     84      ! 
     85      INTEGER ::   ji, jj, jk, jn, jl   ! dummy loop indices 
     86      CHARACTER (len=22) ::   charout 
    9087      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrtrd 
    91       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta   ! 3D  workspace 
     88      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrcdta   ! 3D  workspace 
    9289      !!---------------------------------------------------------------------- 
    9390      ! 
    … …  
    105102            ! 
    106103            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
    107                 
     104               ! 
    108105               jl = n_trc_index(jn)  
    109106               CALL trc_dta( kt, sf_trcdta(jl),rf_trfac(jl) )   ! read tracer data at nit000 
    110107               ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) 
    111  
     108               ! 
    112109               SELECT CASE ( nn_zdmp_tr ) 
    113110               ! 
    … …  
    116113                     DO jj = 2, jpjm1 
    117114                        DO ji = fs_2, fs_jpim1   ! vector opt. 
    118                            ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    119                            tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
     115                           tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    120116                        END DO 
    121117                     END DO 
    122118                  END DO 
    123                ! 
     119                  ! 
    124120               CASE ( 1 )                !==  no damping in the turbocline (avt > 5 cm2/s)  ==! 
    125121                  DO jk = 1, jpkm1 
    … …  
    127123                        DO ji = fs_2, fs_jpim1   ! vector opt. 
    128124                           IF( avt(ji,jj,jk) <= 5.e-4_wp )  THEN  
    129                               ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    130                               tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
     125                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    131126                           ENDIF 
    132127                        END DO 
    133128                     END DO 
    134129                  END DO 
    135                ! 
     130                  ! 
    136131               CASE ( 2 )               !==  no damping in the mixed layer   ==!  
    137132                  DO jk = 1, jpkm1 
    138133                     DO jj = 2, jpjm1 
    139134                        DO ji = fs_2, fs_jpim1   ! vector opt. 
    140                            IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN 
    141                               ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    142                               tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
     135                           IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN 
     136                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    143137                           END IF 
    144138                        END DO 
    145139                     END DO 
    146140                  END DO 
    147                !   
     141                  !   
    148142               END SELECT 
    149143               !  
    … …  
    162156      IF( l_trdtrc )  CALL wrk_dealloc( jpi, jpj, jpk, ztrtrd ) 
    163157      !                                          ! print mean trends (used for debugging) 
    164       IF( ln_ctl )   THEN 
    165          WRITE(charout, FMT="('dmp ')") ;  CALL prt_ctl_trc_info(charout) 
    166                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     158      IF( ln_ctl ) THEN 
     159         WRITE(charout, FMT="('dmp ')") 
     160         CALL prt_ctl_trc_info(charout) 
     161         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    167162      ENDIF 
    168163      ! 
    … …  
    170165      ! 
    171166   END SUBROUTINE trc_dmp 
     167 
    172168 
    173169   SUBROUTINE trc_dmp_ini 
    … …  
    180176      !!              called by trc_dmp at the first timestep (nittrc000) 
    181177      !!---------------------------------------------------------------------- 
    182       ! 
    183       INTEGER ::  ios                 ! Local integer output status for namelist read 
    184       INTEGER :: imask  !local file handle 
    185       ! 
     178      INTEGER ::   ios, imask  ! local integers 
     179      !! 
    186180      NAMELIST/namtrc_dmp/ nn_zdmp_tr , cn_resto_tr 
    187181      !!---------------------------------------------------------------------- 
    188  
     182      ! 
    189183      IF( nn_timing == 1 )  CALL timing_start('trc_dmp_init') 
    190184      ! 
    191  
    192185      REWIND( numnat_ref )              ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping 
    193186      READ  ( numnat_ref, namtrc_dmp, IOSTAT = ios, ERR = 909) 
    … …  
    233226   END SUBROUTINE trc_dmp_ini 
    234227 
     228 
    235229   SUBROUTINE trc_dmp_clo( kt ) 
    236230      !!--------------------------------------------------------------------- 
    … …  
    245239      !!                nctsi2(), nctsj2() : north-east Closed sea limits (i,j) 
    246240      !!---------------------------------------------------------------------- 
    247       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    248       ! 
    249       INTEGER :: ji , jj, jk, jn, jl, jc                     ! dummy loop indicesa 
    250       INTEGER :: isrow                                      ! local index 
    251       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta       ! 3D  workspace 
    252  
    253       !!---------------------------------------------------------------------- 
    254  
     241      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     242      ! 
     243      INTEGER ::   ji , jj, jk, jn, jl, jc   ! dummy loop indicesa 
     244      INTEGER ::   isrow                     ! local index 
     245      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrcdta   ! 3D  workspace 
     246      !!---------------------------------------------------------------------- 
     247      ! 
    255248      IF( kt == nit000 ) THEN 
    256249         ! initial values 
    … …  
    364357   END SUBROUTINE trc_dmp_clo 
    365358 
    366  
    367359#else 
    368360   !!---------------------------------------------------------------------- 
    … …  
    376368#endif 
    377369 
    378  
    379370   !!====================================================================== 
    380371END MODULE trcdmp 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90

    r5836 r6140  
    1212   !!   'key_top'                                                TOP models 
    1313   !!---------------------------------------------------------------------- 
    14    !!   trc_ldf      : update the tracer trend with the lateral diffusion 
    15    !!   trc_ldf_ini  : initialization, namelist read, and parameters control 
    16    !!---------------------------------------------------------------------- 
    17    USE trc           ! ocean passive tracers variables 
    18    USE oce_trc       ! ocean dynamics and active tracers 
    19    USE ldfslp        ! lateral diffusion: iso-neutral slope 
    20    USE traldf_lap    ! lateral diffusion: laplacian iso-level            operator  (tra_ldf_lap   routine) 
    21    USE traldf_iso    ! lateral diffusion: laplacian iso-neutral standard operator  (tra_ldf_iso   routine) 
    22    USE traldf_triad  ! lateral diffusion: laplacian iso-neutral triad    operator  (tra_ldf_triad routine) 
    23    USE traldf_blp    ! lateral diffusion (iso-level lap/blp)                       (tra_ldf_lap   routine) 
    24    USE trd_oce       ! trends: ocean variables 
    25    USE trdtra        ! trends manager: tracers  
     14   !!   trc_ldf       : update the tracer trend with the lateral diffusion 
     15   !!   trc_ldf_ini   : initialization, namelist read, and parameters control 
     16   !!---------------------------------------------------------------------- 
     17   USE trc            ! ocean passive tracers variables 
     18   USE oce_trc        ! ocean dynamics and active tracers 
     19   USE ldfslp         ! lateral diffusion: iso-neutral slope 
     20   USE traldf_lap_blp ! lateral diffusion: lap/bilaplacian iso-level      operator  (tra_ldf_lap/_blp   routine) 
     21   USE traldf_iso     ! lateral diffusion: laplacian iso-neutral standard operator  (tra_ldf_iso        routine) 
     22   USE traldf_triad   ! lateral diffusion: laplacian iso-neutral triad    operator  (tra_ldf_     triad routine) 
     23   USE trd_oce        ! trends: ocean variables 
     24   USE trdtra         ! trends manager: tracers 
    2625   ! 
    27    USE prtctl_trc      ! Print control 
     26   USE prtctl_trc     ! Print control 
    2827 
    2928   IMPLICIT NONE 
    … …  
    4241   REAL(wp), PUBLIC ::   rn_bhtrc_0          !: bilaplacian      -          --     -       -   [m4/s] 
    4342   ! 
    44                                                  !!: ** lateral mixing namelist (nam_trcldf) ** 
    45    REAL(wp) ::  rldf    ! ratio between active and passive tracers diffusive coefficient 
     43   !                      !!: ** lateral mixing namelist (nam_trcldf) ** 
     44   REAL(wp) ::  rldf       ! ratio between active and passive tracers diffusive coefficient 
     45    
    4646   INTEGER  ::  nldf = 0   ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals) 
    4747    
    4848   !! * Substitutions 
    49 #  include "domzgr_substitute.h90" 
    5049#  include "vectopt_loop_substitute.h90" 
    5150   !!---------------------------------------------------------------------- 
    … …  
    6463      !!---------------------------------------------------------------------- 
    6564      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    66       !! 
     65      ! 
    6766      INTEGER            :: jn 
    6867      CHARACTER (len=22) :: charout 
    … …  
    9998      END SELECT 
    10099      ! 
    101       IF( l_trdtrc )   THEN                    ! save the horizontal diffusive trends for further diagnostics 
     100      IF( l_trdtrc )   THEN                    ! send the trends for further diagnostics 
    102101        DO jn = 1, jptra 
    103102           ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 
    … …  
    106105        CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) 
    107106      ENDIF 
    108       !                                        ! print mean trends (used for debugging) 
    109       IF( ln_ctl ) THEN 
    110          WRITE(charout, FMT="('ldf ')")   ;   CALL prt_ctl_trc_info(charout) 
    111                                               CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     107      !                 
     108      IF( ln_ctl ) THEN                        ! print mean trends (used for debugging) 
     109         WRITE(charout, FMT="('ldf ')") 
     110         CALL prt_ctl_trc_info(charout) 
     111         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    112112      ENDIF 
    113113      ! 
    … …  
    133133      INTEGER ::   ioptio, ierr   ! temporary integers 
    134134      INTEGER ::   ios            ! Local integer output status for namelist read 
    135       ! 
     135      !! 
    136136      NAMELIST/namtrc_ldf/ ln_trcldf_lap, ln_trcldf_blp,                                  & 
    137137         &                 ln_trcldf_lev, ln_trcldf_hor, ln_trcldf_iso, ln_trcldf_triad,  & 
    138138         &                 rn_ahtrc_0   , rn_bhtrc_0 
    139139      !!---------------------------------------------------------------------- 
    140       REWIND( numnat_ref )              !  namtrc_ldf in reference namelist  
     140      ! 
     141      REWIND( numnat_ref )             !  namtrc_ldf in reference namelist  
    141142      READ  ( numnat_ref, namtrc_ldf, IOSTAT = ios, ERR = 903) 
    142 903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in reference namelist', lwp ) 
    143  
    144       REWIND( numnat_cfg )              !  namtrc_ldf in configuration namelist  
     143903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_ldf in reference namelist', lwp ) 
     144      ! 
     145      REWIND( numnat_cfg )             !  namtrc_ldf in configuration namelist  
    145146      READ  ( numnat_cfg, namtrc_ldf, IOSTAT = ios, ERR = 904 ) 
    146 904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist', lwp ) 
     147904   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist', lwp ) 
    147148      IF(lwm) WRITE ( numont, namtrc_ldf ) 
    148  
    149       IF(lwp) THEN                    ! Namelist print 
     149      ! 
     150      IF(lwp) THEN                     ! Namelist print 
    150151         WRITE(numout,*) 
    151152         WRITE(numout,*) 'trc_ldf_ini : lateral tracer diffusive operator' 
    … …  
    174175      IF( ln_trcldf_lap .AND. ln_trcldf_blp )   CALL ctl_stop( 'trc_ldf_ctl: bilaplacian should be used on both TRC and TRA' ) 
    175176      IF( ln_trcldf_blp .AND. ln_trcldf_lap )   CALL ctl_stop( 'trc_ldf_ctl:   laplacian should be used on both TRC and TRA' ) 
    176        
     177      ! 
    177178      ioptio = 0 
    178179      IF( ln_trcldf_lev )   ioptio = ioptio + 1 
    … …  
    180181      IF( ln_trcldf_iso )   ioptio = ioptio + 1 
    181182      IF( ioptio /= 1   )   CALL ctl_stop( 'trc_ldf_ctl: use only ONE direction (level/hor/iso)' ) 
    182  
     183      ! 
    183184      ! defined the type of lateral diffusion from ln_trcldf_... logicals 
    184185      ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully 
    … …  
    204205         ENDIF 
    205206         !                                ! diffusivity ratio: passive / active tracers  
    206          IF( ABS(rn_aht_0) < 2._wp*TINY(1.e0) ) THEN 
    207             IF( ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0) ) THEN 
     207         IF( ABS(rn_aht_0) < 2._wp*TINY(1._wp) ) THEN 
     208            IF( ABS(rn_ahtrc_0) < 2._wp*TINY(1._wp) ) THEN 
    208209               rldf = 1.0_wp 
    209210            ELSE 
    210                CALL ctl_stop( 'STOP', 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
     211               CALL ctl_stop( 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
    211212            ENDIF 
    212213         ELSE 
    … …  
    235236         ENDIF 
    236237         !                                ! diffusivity ratio: passive / active tracers  
    237          IF( ABS(rn_bht_0) < 2._wp*TINY(1.e0) ) THEN 
    238             IF( ABS(rn_bhtrc_0) < 2._wp*TINY(1.e0) ) THEN 
     238         IF( ABS(rn_bht_0) < 2._wp*TINY(1._wp) ) THEN 
     239            IF( ABS(rn_bhtrc_0) < 2._wp*TINY(1._wp) ) THEN 
    239240               rldf = 1.0_wp 
    240241            ELSE 
    241                CALL ctl_stop( 'STOP', 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
     242               CALL ctl_stop( 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
    242243            ENDIF 
    243244         ELSE 
    … …  
    246247      ENDIF 
    247248      ! 
    248       IF( ierr == 1 )   CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' ) 
    249       IF( ln_ldfeiv .AND. .NOT.ln_trcldf_iso )   & 
    250            CALL ctl_stop( '          eddy induced velocity on tracers',   & 
    251            &              ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' ) 
    252       IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation 
    253          IF( .NOT.l_ldfslp )   CALL ctl_stop( '          the rotation of the diffusive tensor require l_ldfslp' ) 
    254       ENDIF 
     249      IF( ierr == 1 )   CALL ctl_stop( 'trc_ldf_ctl: iso-level in z-partial step, not allowed' ) 
     250      IF( ln_ldfeiv .AND. .NOT.ln_trcldf_iso )   CALL ctl_stop( 'trc_ldf_ctl: eiv requires isopycnal laplacian diffusion' ) 
     251      IF( nldf == 1 .OR. nldf == 3 )   l_ldfslp = .TRUE.    ! slope of neutral surfaces required  
    255252      ! 
    256253      IF(lwp) THEN 
    257254         WRITE(numout,*) 
    258          IF( nldf == np_no_ldf )   WRITE(numout,*) '          NO lateral diffusion' 
    259          IF( nldf == np_lap    )   WRITE(numout,*) '          laplacian iso-level operator' 
    260          IF( nldf == np_lap_i  )   WRITE(numout,*) '          Rotated laplacian operator (standard)' 
    261          IF( nldf == np_lap_it )   WRITE(numout,*) '          Rotated laplacian operator (triad)' 
    262          IF( nldf == np_blp    )   WRITE(numout,*) '          bilaplacian iso-level operator' 
    263          IF( nldf == np_blp_i  )   WRITE(numout,*) '          Rotated bilaplacian operator (standard)' 
    264          IF( nldf == np_blp_it )   WRITE(numout,*) '          Rotated bilaplacian operator (triad)' 
     255         SELECT CASE( nldf ) 
     256         CASE( np_no_ldf )   ;   WRITE(numout,*) '          NO lateral diffusion' 
     257         CASE( np_lap    )   ;   WRITE(numout,*) '          laplacian iso-level operator' 
     258         CASE( np_lap_i  )   ;   WRITE(numout,*) '          Rotated laplacian operator (standard)' 
     259         CASE( np_lap_it )   ;   WRITE(numout,*) '          Rotated laplacian operator (triad)' 
     260         CASE( np_blp    )   ;   WRITE(numout,*) '          bilaplacian iso-level operator' 
     261         CASE( np_blp_i  )   ;   WRITE(numout,*) '          Rotated bilaplacian operator (standard)' 
     262         CASE( np_blp_it )   ;   WRITE(numout,*) '          Rotated bilaplacian operator (triad)' 
     263         END SELECT 
    265264      ENDIF 
    266265      ! 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90

    r5656 r6140  
    3333   USE trdtra 
    3434   USE tranxt 
     35   USE trcbdy          ! BDY open boundaries 
     36   USE bdy_par, only: lk_bdy 
    3537# if defined key_agrif 
    3638   USE agrif_top_interp 
    … …  
    4143 
    4244   PUBLIC   trc_nxt          ! routine called by step.F90 
    43    PUBLIC   trc_nxt_alloc    ! routine called by nemogcm.F90 
    4445 
    45    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt 
     46   REAL(wp) ::   r2dttrc 
    4647 
    4748   !!---------------------------------------------------------------------- 
    … …  
    5152   !!---------------------------------------------------------------------- 
    5253CONTAINS 
    53  
    54    INTEGER FUNCTION trc_nxt_alloc() 
    55       !!---------------------------------------------------------------------- 
    56       !!                   ***  ROUTINE trc_nxt_alloc  *** 
    57       !!---------------------------------------------------------------------- 
    58       ALLOCATE( r2dt(jpk), STAT=trc_nxt_alloc ) 
    59       ! 
    60       IF( trc_nxt_alloc /= 0 )   CALL ctl_warn('trc_nxt_alloc : failed to allocate array') 
    61       ! 
    62    END FUNCTION trc_nxt_alloc 
    63  
    6454 
    6555   SUBROUTINE trc_nxt( kt ) 
    … …  
    10191         WRITE(numout,*) 'trc_nxt : time stepping on passive tracers' 
    10292      ENDIF 
    103  
     93      ! 
    10494#if defined key_agrif 
    10595      CALL Agrif_trc                   ! AGRIF zoom boundaries 
    10696#endif 
    107       ! Update after tracer on domain lateral boundaries 
    108       DO jn = 1, jptra 
     97      DO jn = 1, jptra                 ! Update after tracer on domain lateral boundaries 
    10998         CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. )    
    11099      END DO 
    111100 
     101      IF( lk_bdy )  CALL trc_bdy( kt ) 
    112102 
    113 #if defined key_bdy 
    114 !!      CALL bdy_trc( kt )               ! BDY open boundaries 
    115 #endif 
    116  
    117  
    118       ! set time step size (Euler/Leapfrog) 
    119       IF( neuler == 0 .AND. kt ==  nittrc000 ) THEN  ;  r2dt(:) =     rdttrc(:)   ! at nittrc000             (Euler) 
    120       ELSEIF( kt <= nittrc000 + nn_dttrc )     THEN  ;  r2dt(:) = 2.* rdttrc(:)   ! at nit000 or nit000+1 (Leapfrog) 
     103      !                                ! set time step size (Euler/Leapfrog) 
     104      IF( neuler == 0 .AND. kt ==  nittrc000 ) THEN  ;  r2dttrc =     rdttrc   ! at nittrc000             (Euler) 
     105      ELSEIF( kt <= nittrc000 + nn_dttrc )     THEN  ;  r2dttrc = 2.* rdttrc   ! at nit000 or nit000+1 (Leapfrog) 
    121106      ENDIF 
    122107 
    123       ! trends computation initialisation 
    124       IF( l_trdtrc )  THEN 
    125          CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrdt )  !* store now fields before applying the Asselin filter 
     108      IF( l_trdtrc )  THEN             ! trends: store now fields before the Asselin filter application 
     109         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrdt ) 
    126110         ztrdt(:,:,:,:)  = trn(:,:,:,:) 
    127111      ENDIF 
    128       ! Leap-Frog + Asselin filter time stepping 
    129       IF( neuler == 0 .AND. kt == nittrc000 ) THEN        ! Euler time-stepping at first time-step 
    130          !                                                ! (only swap) 
     112      !                                ! Leap-Frog + Asselin filter time stepping 
     113      IF( neuler == 0 .AND. kt == nittrc000 ) THEN    ! Euler time-stepping at first time-step (only swap) 
    131114         DO jn = 1, jptra 
    132115            DO jk = 1, jpkm1 
    … …  
    134117            END DO 
    135118         END DO 
    136          !                                               
    137       ELSE 
    138          ! Leap-Frog + Asselin filter time stepping 
    139          IF( lk_vvl ) THEN   ;   CALL tra_nxt_vvl( kt, nittrc000, rdttrc, 'TRC', trb, trn, tra,      & 
    140            &                                                                sbc_trc, sbc_trc_b, jptra )      ! variable volume level (vvl)  
    141          ELSE                ;   CALL tra_nxt_fix( kt, nittrc000,         'TRC', trb, trn, tra, jptra )      ! fixed    volume level  
     119      ELSE                                            ! Asselin filter + swap 
     120         IF( ln_linssh ) THEN   ;   CALL tra_nxt_fix( kt, nittrc000,         'TRC', trb, trn, tra, jptra )  !     linear ssh 
     121         ELSE                   ;   CALL tra_nxt_vvl( kt, nittrc000, rdttrc, 'TRC', trb, trn, tra,      & 
     122           &                                                                   sbc_trc, sbc_trc_b, jptra )  ! non-linear ssh 
    142123         ENDIF 
     124         ! 
     125         DO jn = 1, jptra 
     126            CALL lbc_lnk( trb(:,:,:,jn), 'T', 1._wp )  
     127            CALL lbc_lnk( trn(:,:,:,jn), 'T', 1._wp ) 
     128            CALL lbc_lnk( tra(:,:,:,jn), 'T', 1._wp ) 
     129         END DO 
    143130      ENDIF 
    144  
    145       ! trends computation 
    146       IF( l_trdtrc ) THEN                                      ! trends 
     131      ! 
     132      IF( l_trdtrc ) THEN              ! trends: send Asselin filter trends to trdtra manager for further diagnostics 
    147133         DO jn = 1, jptra 
    148134            DO jk = 1, jpkm1 
    149                zfact = 1.e0 / r2dt(jk)   
     135               zfact = 1._wp / r2dttrc   
    150136               ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact  
    151137               CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt ) 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r5836 r6140  
    2828   PUBLIC   trc_sbc   ! routine called by step.F90 
    2929 
    30    REAL(wp) ::   r2dt  !  time-step at surface 
    31  
    3230   !! * Substitutions 
    33 #  include "domzgr_substitute.h90" 
    3431#  include "vectopt_loop_substitute.h90" 
    3532   !!---------------------------------------------------------------------- 
    … …  
    7673      ! 
    7774      ! Allocate temporary workspace 
    78                       CALL wrk_alloc( jpi, jpj,      zsfx   ) 
    79       IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrtrd ) 
     75                      CALL wrk_alloc( jpi,jpj,       zsfx   ) 
     76      IF( l_trdtrc )  CALL wrk_alloc( jpi,jpj,jpk,  ztrtrd ) 
    8077      ! 
    8178      zrtrn = 1.e-15_wp 
    … …  
    8885 
    8986      IF( ln_top_euler) THEN 
    90          r2dt =  rdttrc(1)              ! = rdttrc (use Euler time stepping) 
     87         r2dt =  rdttrc              ! = rdttrc (use Euler time stepping) 
    9188      ELSE 
    9289         IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000 
    93             r2dt = rdttrc(1)           ! = rdttrc (restarting with Euler time stepping) 
     90            r2dt = rdttrc            ! = rdttrc (restarting with Euler time stepping) 
    9491         ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1 
    95             r2dt = 2. * rdttrc(1)       ! = 2 rdttrc (leapfrog) 
     92            r2dt = 2. * rdttrc       ! = 2 rdttrc (leapfrog) 
    9693         ENDIF 
    9794      ENDIF 
    … …  
    129126      ! Coupling offline : runoff are in emp which contains E-P-R 
    130127      ! 
    131       IF( .NOT. lk_offline .AND. lk_vvl ) THEN  ! online coupling with vvl 
     128      IF( .NOT. lk_offline .AND. .NOT.ln_linssh ) THEN  ! online coupling with vvl 
    132129         zsfx(:,:) = 0._wp 
    133130      ELSE                                      ! online coupling free surface or offline with free surface 
    … …  
    138135      DO jn = 1, jptra 
    139136         ! 
    140          IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends 
    141          !                                             ! add the trend to the general tracer trend 
     137         IF( l_trdtrc )   ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends 
    142138 
    143139         IF ( nn_ice_tr == -1 ) THEN  ! No tracers in sea ice (null concentration in sea ice) 
    … …  
    153149            DO jj = 2, jpj 
    154150               DO ji = fs_2, fs_jpim1   ! vector opt. 
    155                   zse3t = 1. / fse3t(ji,jj,1) 
     151                  zse3t = 1. / e3t_n(ji,jj,1) 
    156152                  ! tracer flux at the ice/ocean interface (tracer/m2/s) 
    157153                  zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice 
    … …  
    174170         DO jj = 2, jpj 
    175171            DO ji = fs_2, fs_jpim1   ! vector opt. 
    176                zse3t = zfact / fse3t(ji,jj,1) 
     172               zse3t = zfact / e3t_n(ji,jj,1) 
    177173               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t 
    178174            END DO 
    … …  
    203199                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    204200      ENDIF 
    205                       CALL wrk_dealloc( jpi, jpj,      zsfx   ) 
    206       IF( l_trdtrc )  CALL wrk_dealloc( jpi, jpj, jpk, ztrtrd ) 
     201                      CALL wrk_dealloc( jpi,jpj,       zsfx   ) 
     202      IF( l_trdtrc )  CALL wrk_dealloc( jpi,jpj,jpk,  ztrtrd ) 
    207203      ! 
    208204      IF( nn_timing == 1 )  CALL timing_stop('trc_sbc') 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    r5836 r6140  
    2525   USE trcsbc          ! surface boundary condition          (trc_sbc routine) 
    2626   USE zpshde          ! partial step: hor. derivative       (zps_hde routine) 
     27   USE trcbdy          ! BDY open boundaries 
     28   USE bdy_par, only: lk_bdy 
    2729 
    2830#if defined key_agrif 
    … …  
    6466         IF( ln_trcdmp )        CALL trc_dmp    ( kt )      ! internal damping trends 
    6567         IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kt )      ! internal damping trends on closed seas only 
     68         IF( lk_bdy )           CALL trc_bdy_dmp( kt )      ! BDY damping trends 
    6669                                CALL trc_adv    ( kt )      ! horizontal & vertical advection  
    6770         !                                                         ! Partial top/bottom cell: GRADh( trb )   

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90

    r5836 r6140  
    2828   PUBLIC   trc_zdf         ! called by step.F90  
    2929   PUBLIC   trc_zdf_ini     ! called by nemogcm.F90  
    30    PUBLIC   trc_zdf_alloc   ! called by nemogcm.F90  
    3130    
    3231   !                                        !!** Vertical diffusion (nam_trczdf) ** 
    … …  
    3635   INTEGER ::   nzdf = 0               ! type vertical diffusion algorithm used 
    3736      !                                ! defined from ln_zdf...  namlist logicals) 
    38    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  r2dt   ! vertical profile time-step, = 2 rdttra 
    39       !                                                 ! except at nittrc000 (=rdttra) if neuler=0 
     37   REAL(wp) ::  r2dttrc   ! vertical profile time-step, = 2 rdt 
     38      !                   ! except at nittrc000 (=rdt) if neuler=0 
    4039 
    4140   !! * Substitutions 
    42 #  include "domzgr_substitute.h90" 
    4341#  include "zdfddm_substitute.h90" 
    4442#  include "vectopt_loop_substitute.h90" 
    … …  
    4947   !!---------------------------------------------------------------------- 
    5048CONTAINS 
    51     
    52    INTEGER FUNCTION trc_zdf_alloc() 
    53       !!---------------------------------------------------------------------- 
    54       !!                  ***  ROUTINE trc_zdf_alloc  *** 
    55       !!---------------------------------------------------------------------- 
    56       ALLOCATE( r2dt(jpk) , STAT=trc_zdf_alloc ) 
    57       ! 
    58       IF( trc_zdf_alloc /= 0 )   CALL ctl_warn('trc_zdf_alloc : failed to allocate array.') 
    59       ! 
    60    END FUNCTION trc_zdf_alloc 
    61  
    6249 
    6350   SUBROUTINE trc_zdf( kt ) 
    … …  
    7764      ! 
    7865      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000 
    79          r2dt(:) =  rdttrc(:)           ! = rdttrc (use or restarting with Euler time stepping) 
     66         r2dttrc =  rdttrc           ! = rdttrc (use or restarting with Euler time stepping) 
    8067      ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1 
    81          r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog) 
     68         r2dttrc = 2. * rdttrc       ! = 2 rdttrc (leapfrog) 
    8269      ENDIF 
    8370 
    … …  
    8875 
    8976      SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend 
    90       CASE ( 0 ) ;  CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )    !   explicit scheme  
    91       CASE ( 1 ) ;  CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dt,                trb, tra, jptra )    !   implicit scheme           
     77      CASE ( 0 ) ;  CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dttrc, nn_trczdf_exp, trb, tra, jptra )    !   explicit scheme  
     78      CASE ( 1 ) ;  CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dttrc,                trb, tra, jptra )    !   implicit scheme           
    9279      END SELECT 
    9380 
    … …  
    9582         DO jn = 1, jptra 
    9683            DO jk = 1, jpkm1 
    97                ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dt(jk) ) - ztrtrd(:,:,jk,jn) 
     84               ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dttrc ) - ztrtrd(:,:,jk,jn) 
    9885            END DO 
    9986            CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) ) 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90

    r5836 r6140  
    6666 
    6767   !! * Substitutions 
    68 #  include "domzgr_substitute.h90" 
    6968#  include "zdfddm_substitute.h90" 
    7069   !!---------------------------------------------------------------------- 
    … …  
    175174            DO jj = 1, jpj 
    176175               DO ji = 1, jpi 
    177                   IF( jk - nmld_trc(ji,jj) < 0 )   wkx_trc(ji,jj,jk) = fse3t(ji,jj,jk) * tmask(ji,jj,jk) 
     176                  IF( jk - nmld_trc(ji,jj) < 0 )   wkx_trc(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
    178177               END DO 
    179178            END DO 
    … …  
    293292            DO jj = 1,jpj 
    294293              DO ji = 1,jpi 
    295                   IF( jk - nmld_trc(ji,jj) < 0. )   wkx_trc(ji,jj,jk) = fse3t(ji,jj,jk) * tmask(ji,jj,jk) 
     294                  IF( jk - nmld_trc(ji,jj) < 0. )   wkx_trc(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
    296295               END DO 
    297296            END DO 
    … …  
    330329      !!  
    331330      !! ** Purpose :  Compute and cumulate the mixed layer trends over an analysis 
    332       !!               period, and write NetCDF (or dimg) outputs. 
     331      !!               period, and write NetCDF outputs. 
    333332      !! 
    334333      !! ** Method/usage : 
    … …  
    390389      ! 
    391390      CHARACTER (LEN=10) ::   clvar 
    392 #if defined key_dimgout 
    393       INTEGER ::   iyear,imon,iday 
    394       CHARACTER(LEN=80) ::   cltext, clmode 
    395 #endif 
    396391      !!---------------------------------------------------------------------- 
    397392 
    … …  
    417412               DO jn = 1, jptra 
    418413                  IF( ln_trdtrc(jn) )    & 
    419                   tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - zavt / fse3w(ji,jj,ik) * tmask(ji,jj,ik)  & 
     414                  tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - zavt / e3w_n(ji,jj,ik) * tmask(ji,jj,ik)  & 
    420415                       &                    * ( trn(ji,jj,ik-1,jn) - trn(ji,jj,ik,jn) )            & 
    421416                       &                    / MAX( 1., rmld_trc(ji,jj) ) * tmask(ji,jj,1) 
    … …  
    774769      ! ====================================================================== 
    775770 
    776       ! IV.1 Code for dimg mpp output 
    777       ! ----------------------------- 
    778  
    779 # if defined key_dimgout 
    780       STOP 'Not implemented' 
    781 # else 
    782        
    783       ! IV.2 Code for IOIPSL/NetCDF output 
     771      ! IV.1 Code for IOIPSL/NetCDF output 
    784772      ! ---------------------------------- 
    785773 
    … …  
    865853      icount = 1 
    866854 
    867 # endif /* key_dimgout */ 
    868  
    869855      IF( MOD( itmod, nn_trd_trc ) == 0 ) THEN 
    870856         ! 
    … …  
    896882      !! 
    897883      !! ** Purpose :  Compute and cumulate the mixed layer biological trends over an analysis 
    898       !!               period, and write NetCDF (or dimg) outputs. 
     884      !!               period, and write NetCDF outputs. 
    899885      !! 
    900886      !! ** Method/usage : 
    … …  
    943929      LOGICAL  :: llwarn  = .TRUE., lldebug = .TRUE. 
    944930      REAL(wp) :: zfn, zfn2 
    945 #if defined key_dimgout 
    946       INTEGER ::  iyear,imon,iday 
    947       CHARACTER(LEN=80) :: cltext, clmode 
    948 #endif 
    949931      !!---------------------------------------------------------------------- 
    950932      ! ... Warnings 
    … …  
    10551037      ! ====================================================================== 
    10561038 
    1057       ! IV.1 Code for dimg mpp output 
    1058       ! ----------------------------- 
    1059  
    1060 # if defined key_dimgout 
    1061       STOP 'Not implemented' 
    1062 # else 
    1063  
    1064       ! IV.2 Code for IOIPSL/NetCDF output 
     1039      ! IV.1 Code for IOIPSL/NetCDF output 
    10651040      ! ---------------------------------- 
    10661041 
    … …  
    11071082 
    11081083 
    1109 # endif /* key_dimgout */ 
    11101084 
    11111085      IF( MOD( itmod, nn_trd_trc ) == 0 ) THEN 
    … …  
    12581232      ! ====================================================================== 
    12591233 
    1260 #if defined key_dimgout  
    1261       ??? 
    1262 #else 
    12631234      ! clmxl = legend root for netCDF output 
    12641235      IF( nn_ctls_trc == 0 ) THEN                                   ! control surface = mixed-layer with density criterion 
    … …  
    14031374#endif 
    14041375 
    1405 #endif        /* key_dimgout */ 
    14061376   END SUBROUTINE trd_mxl_trc_init 
    14071377 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90

    r5341 r6140  
    2121   
    2222   INTEGER ::   nummldw_trc               ! logical unit for mld restart 
     23    
    2324   !!--------------------------------------------------------------------------------- 
    2425   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    2627   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    2728   !!--------------------------------------------------------------------------------- 
    28    
    2929CONTAINS 
    30    
    3130 
    3231    SUBROUTINE trd_mxl_trc_rst_write( kt ) 
    … …  
    147146      clpath = TRIM(cn_trcrst_indir) 
    148147      IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 
    149  
    150       IF ( jprstlib == jprstdimg ) THEN 
    151         ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
    152         ! if {cn_trdrst_trc_in}.nc exists, then set jlibalt to jpnf90 
    153         INQUIRE( FILE = TRIM(clpath)//TRIM(cn_trdrst_trc_in)//'.nc', EXIST = llok ) 
    154         IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF 
    155       ENDIF 
    156  
    157148      CALL iom_open( TRIM(clpath)//TRIM(cn_trdrst_trc_in), inum, kiolib = jlibalt )  
    158149       

  • trunk/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r5836 r6140  
    1414   USE par_oce 
    1515   USE par_trc 
     16#if defined key_bdy 
     17   USE bdy_oce, only: nb_bdy, OBC_DATA 
     18#endif 
    1619    
    1720   IMPLICIT NONE 
    … …  
    6467   CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_out  !: suffix of pass. tracer restart name (output) 
    6568   CHARACTER(len = 256), PUBLIC                                    ::  cn_trcrst_outdir  !: restart output directory 
    66    REAL(wp)            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::  rdttrc         !: vertical profile of passive tracer time step 
     69   REAL(wp)            , PUBLIC                                    ::  rdttrc         !: passive tracer time step 
    6770   LOGICAL             , PUBLIC                                    ::  ln_top_euler  !: boolean term for euler integration  
    6871   LOGICAL             , PUBLIC                                    ::  ln_trcdta      !: Read inputs data from files 
    … …  
    9194       CHARACTER(len = 20)  :: clunit   !: unit 
    9295       LOGICAL              :: llinit   !: read in a file or not 
     96#if defined  key_my_trc 
     97       LOGICAL              :: llsbc   !: read in a file or not 
     98       LOGICAL              :: llcbc   !: read in a file or not 
     99       LOGICAL              :: llobc   !: read in a file or not 
     100#endif 
    93101       LOGICAL              :: llsave   !: save the tracer or not 
    94102   END TYPE PTRACER 
    … …  
    181189# endif 
    182190   ! 
     191#if defined key_bdy 
     192   CHARACTER(len=20), PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  cn_trc_dflt          ! Default OBC condition for all tracers 
     193   CHARACTER(len=20), PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  cn_trc               ! Choice of boundary condition for tracers 
     194   INTEGER,           PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  nn_trcdmp_bdy        !: =T Tracer damping 
     195   ! External data structure of BDY for TOP. Available elements: cn_obc, ll_trc, trcnow, dmp 
     196   TYPE(OBC_DATA),    PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET ::  trcdta_bdy           !: bdy external data (local process) 
     197#endif 
     198   ! 
    183199 
    184200   !!---------------------------------------------------------------------- 
    … …  
    201217         &      gtrui(jpi,jpj,jptra)  , gtrvi(jpi,jpj,jptra)                          ,       & 
    202218         &      sbc_trc_b(jpi,jpj,jptra), sbc_trc(jpi,jpj,jptra)                      ,       &   
    203          &      cvol(jpi,jpj,jpk)     , rdttrc(jpk)           , trai(jptra)           ,       & 
     219         &      cvol(jpi,jpj,jpk)     , trai(jptra)                                   ,       & 
    204220         &      ctrcnm(jptra)         , ctrcln(jptra)         , ctrcun(jptra)         ,       &  
    205          &      ln_trc_ini(jptra)     , ln_trc_wri(jptra)     , qsr_mean(jpi,jpj)     ,  STAT = trc_alloc  )   
     221         &      ln_trc_ini(jptra)     , ln_trc_wri(jptra)     , qsr_mean(jpi,jpj)     ,       & 
     222#if defined key_my_trc 
     223         &      ln_trc_sbc(jptra)     , ln_trc_cbc(jptra)     , ln_trc_obc(jptra)     ,       & 
     224#endif 
     225#if defined key_bdy 
     226         &      cn_trc_dflt(nb_bdy)   , cn_trc(nb_bdy)        , nn_trcdmp_bdy(nb_bdy) ,       & 
     227         &      trcdta_bdy(jptra,nb_bdy)                                              ,       & 
     228#endif 
     229         &      STAT = trc_alloc  ) 
    206230 
    207231      IF( trc_alloc /= 0 )   CALL ctl_warn('trc_alloc: failed to allocate arrays') 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcbc.F90

    r5215 r6140  
    11MODULE trcbc 
    22   !!====================================================================== 
    3    !!                     ***  MODULE  trcdta  *** 
     3   !!                     ***  MODULE  trcbc  *** 
    44   !! TOP :  module for passive tracer boundary conditions 
    55   !!===================================================================== 
    6    !!---------------------------------------------------------------------- 
    7 #if  defined key_top  
     6   !! History :  3.5 !  2014-04  (M. Vichi, T. Lovato)  Original 
     7   !!            3.6 !  2015-03  (T . Lovato) Revision and BDY support 
     8   !!---------------------------------------------------------------------- 
     9#if defined key_top 
    810   !!---------------------------------------------------------------------- 
    911   !!   'key_top'                                                TOP model  
    1012   !!---------------------------------------------------------------------- 
    11    !!   trc_dta    : read and time interpolated passive tracer data 
     13   !!   trc_bc       : read and time interpolated tracer Boundary Conditions 
    1214   !!---------------------------------------------------------------------- 
    1315   USE par_trc       !  passive tracers parameters 
    … …  
    1719   USE lib_mpp       !  MPP library 
    1820   USE fldread       !  read input fields 
     21#if defined key_bdy 
     22   USE bdy_oce, only: nb_bdy , idx_bdy, ln_coords_file, rn_time_dmp, rn_time_dmp_out 
     23#endif 
    1924 
    2025   IMPLICIT NONE 
    … …  
    2429   PUBLIC   trc_bc_read    ! called in trcstp.F90 or within 
    2530 
    26    INTEGER  , SAVE, PUBLIC                             :: nb_trcobc   ! number of tracers with open BC 
    27    INTEGER  , SAVE, PUBLIC                             :: nb_trcsbc   ! number of tracers with surface BC 
    28    INTEGER  , SAVE, PUBLIC                             :: nb_trccbc   ! number of tracers with coastal BC 
     31   INTEGER  , SAVE, PUBLIC                             :: nb_trcobc    ! number of tracers with open BC 
     32   INTEGER  , SAVE, PUBLIC                             :: nb_trcsbc    ! number of tracers with surface BC 
     33   INTEGER  , SAVE, PUBLIC                             :: nb_trccbc    ! number of tracers with coastal BC 
    2934   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_indobc ! index of tracer with OBC data 
    3035   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_indsbc ! index of tracer with SBC data 
    3136   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_indcbc ! index of tracer with CBC data 
    32    INTEGER  , SAVE, PUBLIC                             :: ntra_obc     ! MAX( 1, nb_trcxxx ) to avoid compilation error with bounds checking 
    33    INTEGER  , SAVE, PUBLIC                             :: ntra_sbc     ! MAX( 1, nb_trcxxx ) to avoid compilation error with bounds checking 
    34    INTEGER  , SAVE, PUBLIC                             :: ntra_cbc     ! MAX( 1, nb_trcxxx ) to avoid compilation error with bounds checking 
    35    REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trofac   ! multiplicative factor for OBCtracer values 
    36    TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcobc   ! structure of data input OBC (file informations, fields read) 
    37    REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trsfac   ! multiplicative factor for SBC tracer values 
    38    TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcsbc   ! structure of data input SBC (file informations, fields read) 
    39    REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trcfac   ! multiplicative factor for CBC tracer values 
    40    TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trccbc   ! structure of data input CBC (file informations, fields read) 
    41  
    42    !! * Substitutions 
    43 #  include "domzgr_substitute.h90" 
    44    !!---------------------------------------------------------------------- 
    45    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    46    !! $Id$  
     37   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trsfac    ! multiplicative factor for SBC tracer values 
     38   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcsbc    ! structure of data input SBC (file informations, fields read) 
     39   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trcfac    ! multiplicative factor for CBC tracer values 
     40   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trccbc    ! structure of data input CBC (file informations, fields read) 
     41   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trofac    ! multiplicative factor for OBCtracer values 
     42   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:), TARGET  :: sf_trcobc    ! structure of data input OBC (file informations, fields read) 
     43   TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr   ! array of pointers to nbmap 
     44 
     45   !!---------------------------------------------------------------------- 
     46   !! NEMO/OPA 3.6 , NEMO Consortium (2015) 
     47   !! $Id$ 
    4748   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4849   !!---------------------------------------------------------------------- 
    4950CONTAINS 
    5051 
    51    SUBROUTINE trc_bc_init(ntrc) 
     52   SUBROUTINE trc_bc_init( ntrc ) 
    5253      !!---------------------------------------------------------------------- 
    5354      !!                   ***  ROUTINE trc_bc_init  *** 
    … …  
    6061      ! 
    6162      INTEGER,INTENT(IN) :: ntrc                           ! number of tracers 
    62       INTEGER            :: jl, jn                         ! dummy loop indices 
     63      INTEGER            :: jl, jn , ib, ibd, ii, ij, ik   ! dummy loop indices 
    6364      INTEGER            :: ierr0, ierr1, ierr2, ierr3     ! temporary integers 
    64       INTEGER            ::  ios                           ! Local integer output status for namelist read 
     65      INTEGER            :: ios                            ! Local integer output status for namelist read 
     66      INTEGER            :: nblen, igrd                    ! support arrays for BDY 
    6567      CHARACTER(len=100) :: clndta, clntrc 
    6668      ! 
    67       CHARACTER(len=100) :: cn_dir 
     69      CHARACTER(len=100) :: cn_dir_sbc, cn_dir_cbc, cn_dir_obc 
     70 
    6871      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i  ! local array of namelist informations on the fields to read 
    6972      TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcobc    ! open 
    … …  
    7477      REAL(wp)   , DIMENSION(jpmaxtrc) :: rn_trcfac    ! multiplicative factor for tracer values 
    7578      !! 
    76       NAMELIST/namtrc_bc/ cn_dir, sn_trcobc, rn_trofac, sn_trcsbc, rn_trsfac, sn_trccbc, rn_trcfac  
     79      NAMELIST/namtrc_bc/ cn_dir_sbc, cn_dir_cbc, cn_dir_obc, sn_trcobc, rn_trofac, sn_trcsbc, rn_trsfac, sn_trccbc, rn_trcfac 
     80#if defined key_bdy 
     81      NAMELIST/namtrc_bdy/ cn_trc_dflt, cn_trc, nn_trcdmp_bdy 
     82#endif 
    7783      !!---------------------------------------------------------------------- 
    7884      IF( nn_timing == 1 )  CALL timing_start('trc_bc_init') 
    7985      ! 
     86      IF( lwp ) THEN 
     87         WRITE(numout,*) ' ' 
     88         WRITE(numout,*) 'trc_bc_init : Tracers Boundary Conditions (BC)' 
     89         WRITE(numout,*) '~~~~~~~~~~~ ' 
     90      ENDIF 
    8091      !  Initialisation and local array allocation 
    8192      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0   
    … …  
    107118      n_trc_indcbc(:) = 0 
    108119      ! 
    109       DO jn = 1, ntrc 
    110          IF( ln_trc_obc(jn) ) THEN 
    111              nb_trcobc       = nb_trcobc + 1  
    112              n_trc_indobc(jn) = nb_trcobc  
    113          ENDIF 
    114          IF( ln_trc_sbc(jn) ) THEN 
    115              nb_trcsbc       = nb_trcsbc + 1 
    116              n_trc_indsbc(jn) = nb_trcsbc 
    117          ENDIF 
    118          IF( ln_trc_cbc(jn) ) THEN 
    119              nb_trccbc       = nb_trccbc + 1 
    120              n_trc_indcbc(jn) = nb_trccbc 
    121          ENDIF 
    122       ENDDO 
    123       ntra_obc = MAX( 1, nb_trcobc )   ! To avoid compilation error with bounds checking 
    124       IF( lwp ) WRITE(numout,*) ' ' 
    125       IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with open boundary data :', nb_trcobc 
    126       IF( lwp ) WRITE(numout,*) ' ' 
    127       ntra_sbc = MAX( 1, nb_trcsbc )   ! To avoid compilation error with bounds checking 
    128       IF( lwp ) WRITE(numout,*) ' ' 
    129       IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with surface boundary data :', nb_trcsbc 
    130       IF( lwp ) WRITE(numout,*) ' ' 
    131       ntra_cbc = MAX( 1, nb_trccbc )   ! To avoid compilation error with bounds checking 
    132       IF( lwp ) WRITE(numout,*) ' ' 
    133       IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with coastal boundary data :', nb_trccbc 
    134       IF( lwp ) WRITE(numout,*) ' ' 
    135  
     120      ! Read Boundary Conditions Namelists 
    136121      REWIND( numnat_ref )              ! Namelist namtrc_bc in reference namelist : Passive tracer data structure 
    137122      READ  ( numnat_ref, namtrc_bc, IOSTAT = ios, ERR = 901) 
    … …  
    143128      IF(lwm) WRITE ( numont, namtrc_bc ) 
    144129 
    145       ! print some information for each  
     130#if defined key_bdy 
     131      REWIND( numnat_ref )              ! Namelist namtrc_bc in reference namelist : Passive tracer data structure 
     132      READ  ( numnat_ref, namtrc_bdy, IOSTAT = ios, ERR = 903) 
     133903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in reference namelist', lwp ) 
     134 
     135      REWIND( numnat_cfg )              ! Namelist namtrc_bc in configuration namelist : Passive tracer data structure 
     136      READ  ( numnat_cfg, namtrc_bdy, IOSTAT = ios, ERR = 904 ) 
     137904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in configuration namelist', lwp ) 
     138      IF(lwm) WRITE ( numont, namtrc_bdy ) 
     139      ! setup up preliminary informations for BDY structure 
     140      DO jn = 1, ntrc 
     141         DO ib = 1, nb_bdy 
     142            ! Set type of obc in BDY data structure (around here we may plug user override of obc type from nml) 
     143            IF ( ln_trc_obc(jn) ) THEN 
     144               trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc(ib) ) 
     145            ELSE 
     146               trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc_dflt(ib) ) 
     147            ENDIF 
     148            ! set damping use in BDY data structure 
     149            trcdta_bdy(jn,ib)%dmp = .false. 
     150            IF(nn_trcdmp_bdy(ib) .EQ. 1 .AND. ln_trc_obc(jn) ) trcdta_bdy(jn,ib)%dmp = .true. 
     151            IF(nn_trcdmp_bdy(ib) .EQ. 2 ) trcdta_bdy(jn,ib)%dmp = .true. 
     152            IF(trcdta_bdy(jn,ib)%cn_obc == 'frs' .AND. nn_trcdmp_bdy(ib) .NE. 0 )  & 
     153                & CALL ctl_stop( 'Use FRS OR relaxation' ) 
     154            IF (nn_trcdmp_bdy(ib) .LT. 0 .OR. nn_trcdmp_bdy(ib) .GT. 2)            & 
     155                & CALL ctl_stop( 'Not a valid option for nn_trcdmp_bdy. Allowed: 0,1,2.' ) 
     156         ENDDO 
     157      ENDDO 
     158 
     159#else 
     160      ! Force all tracers OBC to false if bdy not used 
     161      ln_trc_obc = .false. 
     162#endif 
     163      ! compose BC data indexes 
     164      DO jn = 1, ntrc 
     165         IF( ln_trc_obc(jn) ) THEN 
     166             nb_trcobc       = nb_trcobc + 1  ; n_trc_indobc(jn) = nb_trcobc 
     167         ENDIF 
     168         IF( ln_trc_sbc(jn) ) THEN 
     169             nb_trcsbc       = nb_trcsbc + 1  ; n_trc_indsbc(jn) = nb_trcsbc 
     170         ENDIF 
     171         IF( ln_trc_cbc(jn) ) THEN 
     172             nb_trccbc       = nb_trccbc + 1  ; n_trc_indcbc(jn) = nb_trccbc 
     173         ENDIF 
     174      ENDDO 
     175 
     176      ! Print summmary of Boundary Conditions 
    146177      IF( lwp ) THEN 
     178         WRITE(numout,*) ' ' 
     179         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with SURFACE BCs data:', nb_trcsbc 
     180         IF ( nb_trcsbc > 0 ) THEN 
     181            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact. ' 
     182            DO jn = 1, ntrc 
     183               IF ( ln_trc_sbc(jn) ) WRITE(numout,9001) jn, TRIM( sn_trcsbc(jn)%clvar ), 'SBC', rn_trsfac(jn) 
     184            ENDDO 
     185         ENDIF 
     186         WRITE(numout,'(2a)') '   SURFACE BC data repository : ', TRIM(cn_dir_sbc) 
     187 
     188         WRITE(numout,*) ' ' 
     189         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with COASTAL BCs data:', nb_trccbc 
     190         IF ( nb_trccbc > 0 ) THEN 
     191            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact. ' 
     192            DO jn = 1, ntrc 
     193               IF ( ln_trc_cbc(jn) ) WRITE(numout, 9001) jn, TRIM( sn_trccbc(jn)%clvar ), 'CBC', rn_trcfac(jn) 
     194            ENDDO 
     195         ENDIF 
     196         WRITE(numout,'(2a)') '   COASTAL BC data repository : ', TRIM(cn_dir_cbc) 
     197 
     198         WRITE(numout,*) ' ' 
     199         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with OPEN BCs data:', nb_trcobc 
     200#if defined key_bdy 
     201         IF ( nb_trcobc > 0 ) THEN 
     202            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact.   OBC Settings' 
     203            DO jn = 1, ntrc 
     204               IF ( ln_trc_obc(jn) )  WRITE(numout, 9001) jn, TRIM( sn_trcobc(jn)%clvar ), 'OBC', rn_trofac(jn), (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy) 
     205               IF ( .NOT. ln_trc_obc(jn) )  WRITE(numout, 9002) jn, 'Set data to IC and use default condition', (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy) 
     206            ENDDO 
     207            WRITE(numout,*) ' ' 
     208            DO ib = 1, nb_bdy 
     209                IF (nn_trcdmp_bdy(ib) .EQ. 0) WRITE(numout,9003) '   Boundary ',ib,' -> NO damping of tracers' 
     210                IF (nn_trcdmp_bdy(ib) .EQ. 1) WRITE(numout,9003) '   Boundary ',ib,' -> damping ONLY for tracers with external data provided' 
     211                IF (nn_trcdmp_bdy(ib) .EQ. 2) WRITE(numout,9003) '   Boundary ',ib,' -> damping of ALL tracers' 
     212                IF (nn_trcdmp_bdy(ib) .GT. 0) THEN 
     213                   WRITE(numout,9003) '     USE damping parameters from nambdy for boundary ', ib,' : ' 
     214                   WRITE(numout,'(a,f10.2,a)') '     - Inflow damping time scale  : ',rn_time_dmp(ib),' days' 
     215                   WRITE(numout,'(a,f10.2,a)') '     - Outflow damping time scale : ',rn_time_dmp_out(ib),' days' 
     216                ENDIF 
     217            ENDDO 
     218         ENDIF 
     219#endif 
     220         WRITE(numout,'(2a)') '   OPEN BC data repository : ', TRIM(cn_dir_obc) 
     221      ENDIF 
     2229001  FORMAT(2x,i5, 3x, a15, 3x, a5, 6x, e11.3, 4x, 10a13) 
     2239002  FORMAT(2x,i5, 3x, a41, 3x, 10a13) 
     2249003  FORMAT(a, i5, a) 
     225 
     226      ! 
     227#if defined key_bdy 
     228      ! OPEN Lateral boundary conditions 
     229      IF( nb_trcobc > 0 ) THEN  
     230         ALLOCATE ( sf_trcobc(nb_trcobc), rf_trofac(nb_trcobc), nbmap_ptr(nb_trcobc), STAT=ierr1 ) 
     231         IF( ierr1 > 0 ) THEN 
     232            CALL ctl_stop( 'trc_bc_init: unable to allocate sf_trcobc structure' )   ;   RETURN 
     233         ENDIF 
     234 
     235         igrd = 1                       ! Everything is at T-points here 
     236 
    147237         DO jn = 1, ntrc 
    148             IF( ln_trc_obc(jn) )  THEN     
    149                clndta = TRIM( sn_trcobc(jn)%clvar )  
    150                IF(lwp) WRITE(numout,*) 'Preparing to read OBC data file for passive tracer number :', jn, ' name : ', clndta, &  
    151                &               ' multiplicative factor : ', rn_trofac(jn) 
    152             ENDIF 
    153             IF( ln_trc_sbc(jn) )  THEN     
    154                clndta = TRIM( sn_trcsbc(jn)%clvar )  
    155                IF(lwp) WRITE(numout,*) 'Preparing to read SBC data file for passive tracer number :', jn, ' name : ', clndta, &  
    156                &               ' multiplicative factor : ', rn_trsfac(jn) 
    157             ENDIF 
    158             IF( ln_trc_cbc(jn) )  THEN     
    159                clndta = TRIM( sn_trccbc(jn)%clvar )  
    160                IF(lwp) WRITE(numout,*) 'Preparing to read CBC data file for passive tracer number :', jn, ' name : ', clndta, &  
    161                &               ' multiplicative factor : ', rn_trcfac(jn) 
    162             ENDIF 
    163          END DO 
    164       ENDIF 
    165       ! 
    166       ! The following code is written this way to reduce memory usage and repeated for each boundary data 
    167       ! MAV: note that this is just a placeholder and the dimensions must be changed according to  
    168       !      what will be done with BDY. A new structure will probably need to be included 
    169       ! 
    170       ! OPEN Lateral boundary conditions 
    171       IF( nb_trcobc > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero 
    172          ALLOCATE( sf_trcobc(nb_trcobc), rf_trofac(nb_trcobc), STAT=ierr1 ) 
    173          IF( ierr1 > 0 ) THEN 
    174             CALL ctl_stop( 'trc_bc_init: unable to allocate  sf_trcobc structure' )   ;   RETURN 
    175          ENDIF 
    176          ! 
    177          DO jn = 1, ntrc 
    178             IF( ln_trc_obc(jn) ) THEN      ! update passive tracers arrays with input data read from file 
    179                jl = n_trc_indobc(jn) 
    180                slf_i(jl)    = sn_trcobc(jn) 
    181                rf_trofac(jl) = rn_trofac(jn) 
    182                                             ALLOCATE( sf_trcobc(jl)%fnow(jpi,jpj,jpk)   , STAT=ierr2 ) 
    183                IF( sn_trcobc(jn)%ln_tint )  ALLOCATE( sf_trcobc(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 
    184                IF( ierr2 + ierr3 > 0 ) THEN 
    185                  CALL ctl_stop( 'trc_bc_init : unable to allocate passive tracer OBC data arrays' )   ;   RETURN 
     238            DO ib = 1, nb_bdy 
     239 
     240               nblen = idx_bdy(ib)%nblen(igrd) 
     241 
     242               IF ( ln_trc_obc(jn) ) THEN 
     243               ! Initialise from external data 
     244                  jl = n_trc_indobc(jn) 
     245                  slf_i(jl)    = sn_trcobc(jn) 
     246                  rf_trofac(jl) = rn_trofac(jn) 
     247                                               ALLOCATE( sf_trcobc(jl)%fnow(nblen,1,jpk)   , STAT=ierr2 ) 
     248                  IF( sn_trcobc(jn)%ln_tint )  ALLOCATE( sf_trcobc(jl)%fdta(nblen,1,jpk,2) , STAT=ierr3 ) 
     249                  IF( ierr2 + ierr3 > 0 ) THEN 
     250                    CALL ctl_stop( 'trc_bc_init : unable to allocate passive tracer OBC data arrays' )   ;   RETURN 
     251                  ENDIF 
     252                  trcdta_bdy(jn,ib)%trc => sf_trcobc(jl)%fnow(:,1,:) 
     253                  trcdta_bdy(jn,ib)%rn_fac = rf_trofac(jl) 
     254                  ! create OBC mapping array 
     255                  nbmap_ptr(jl)%ptr => idx_bdy(ib)%nbmap(:,igrd) 
     256                  nbmap_ptr(jl)%ll_unstruc = ln_coords_file(igrd) 
     257               ELSE 
     258               ! Initialise obc arrays from initial conditions 
     259                  ALLOCATE ( trcdta_bdy(jn,ib)%trc(nblen,jpk) ) 
     260                  DO ibd = 1, nblen 
     261                     DO ik = 1, jpkm1 
     262                        ii = idx_bdy(ib)%nbi(ibd,igrd) 
     263                        ij = idx_bdy(ib)%nbj(ibd,igrd) 
     264                        trcdta_bdy(jn,ib)%trc(ibd,ik) = trn(ii,ij,ik,jn) * tmask(ii,ij,ik) 
     265                     END DO 
     266                  END DO 
     267                  trcdta_bdy(jn,ib)%rn_fac = 1._wp 
    186268               ENDIF 
    187             ENDIF 
    188             !    
     269            ENDDO 
    189270         ENDDO 
    190          !                         ! fill sf_trcdta with slf_i and control print 
    191          CALL fld_fill( sf_trcobc, slf_i, cn_dir, 'trc_bc_init', 'Passive tracer OBC data', 'namtrc_bc' ) 
    192          ! 
    193       ENDIF 
    194       ! 
     271 
     272         CALL fld_fill( sf_trcobc, slf_i, cn_dir_obc, 'trc_bc_init', 'Passive tracer OBC data', 'namtrc_bc' ) 
     273      ENDIF 
     274#endif 
    195275      ! SURFACE Boundary conditions 
    196276      IF( nb_trcsbc > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero 
    … …  
    214294         ENDDO 
    215295         !                         ! fill sf_trcsbc with slf_i and control print 
    216          CALL fld_fill( sf_trcsbc, slf_i, cn_dir, 'trc_bc_init', 'Passive tracer SBC data', 'namtrc_bc' ) 
     296         CALL fld_fill( sf_trcsbc, slf_i, cn_dir_sbc, 'trc_bc_init', 'Passive tracer SBC data', 'namtrc_bc' ) 
    217297         ! 
    218298      ENDIF 
    … …  
    239319         ENDDO 
    240320         !                         ! fill sf_trccbc with slf_i and control print 
    241          CALL fld_fill( sf_trccbc, slf_i, cn_dir, 'trc_bc_init', 'Passive tracer CBC data', 'namtrc_bc' ) 
     321         CALL fld_fill( sf_trccbc, slf_i, cn_dir_cbc, 'trc_bc_init', 'Passive tracer CBC data', 'namtrc_bc' ) 
    242322         ! 
    243323      ENDIF 
    244   
     324      ! 
    245325      DEALLOCATE( slf_i )          ! deallocate local field structure 
    246326      IF( nn_timing == 1 )  CALL timing_stop('trc_bc_init') 
    247  
     327      ! 
    248328   END SUBROUTINE trc_bc_init 
    249329 
    250330 
    251    SUBROUTINE trc_bc_read(kt) 
     331   SUBROUTINE trc_bc_read(kt, jit) 
    252332      !!---------------------------------------------------------------------- 
    253333      !!                   ***  ROUTINE trc_bc_init  *** 
    … …  
    258338      !!               
    259339      !!---------------------------------------------------------------------- 
    260     
    261       ! NEMO 
    262340      USE fldread 
    263341       
    264342      !! * Arguments 
    265343      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    266  
     344      INTEGER, INTENT( in ), OPTIONAL ::   jit   ! subcycle time-step index (for timesplitting option) 
    267345      !!--------------------------------------------------------------------- 
    268346      ! 
    269347      IF( nn_timing == 1 )  CALL timing_start('trc_bc_read') 
    270348 
    271       IF( kt == nit000 ) THEN 
    272          IF(lwp) WRITE(numout,*) 
    273          IF(lwp) WRITE(numout,*) 'trc_bc_read : Surface boundary conditions for passive tracers.' 
    274          IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    275       ENDIF 
    276  
    277       ! OPEN boundary conditions: DOES NOT WORK. Waiting for stable BDY 
    278       IF( nb_trcobc > 0 ) THEN 
    279         if (lwp) write(numout,'(a,i5,a,i5)') '   reading OBC data for ', nb_trcobc ,' variables at step ', kt 
    280         CALL fld_read(kt,1,sf_trcobc) 
    281         ! vertical interpolation on s-grid and partial step to be added 
    282       ENDIF 
    283  
    284       ! SURFACE boundary conditions        
    285       IF( nb_trcsbc > 0 ) THEN 
    286         if (lwp) write(numout,'(a,i5,a,i5)') '   reading SBC data for ', nb_trcsbc ,' variables at step ', kt 
    287         CALL fld_read(kt,1,sf_trcsbc) 
    288       ENDIF 
    289  
    290       ! COASTAL boundary conditions        
    291       IF( nb_trccbc > 0 ) THEN 
    292         if (lwp) write(numout,'(a,i5,a,i5)') '   reading CBC data for ', nb_trccbc ,' variables at step ', kt 
    293         CALL fld_read(kt,1,sf_trccbc) 
    294       ENDIF    
     349      IF( kt == nit000 .AND. lwp) THEN 
     350         WRITE(numout,*) 
     351         WRITE(numout,*) 'trc_bc_read : Surface boundary conditions for passive tracers.' 
     352         WRITE(numout,*) '~~~~~~~~~~~ ' 
     353      ENDIF 
     354 
     355      IF ( PRESENT(jit) ) THEN  
     356 
     357         ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 
     358         IF( nb_trcobc > 0 ) THEN 
     359           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 
     360           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc, map=nbmap_ptr, kit=jit, kt_offset=+1) 
     361         ENDIF 
     362 
     363         ! SURFACE boundary conditions 
     364         IF( nb_trcsbc > 0 ) THEN 
     365           if (lwp) write(numout,'(a,i5,a,i10)') '   reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt 
     366           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcsbc, kit=jit) 
     367         ENDIF 
     368 
     369         ! COASTAL boundary conditions 
     370         IF( nb_trccbc > 0 ) THEN 
     371           if (lwp) write(numout,'(a,i5,a,i10)') '   reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt 
     372           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trccbc, kit=jit) 
     373         ENDIF 
     374 
     375      ELSE 
     376 
     377         ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 
     378         IF( nb_trcobc > 0 ) THEN 
     379           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 
     380           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc, map=nbmap_ptr, kt_offset=+1) 
     381         ENDIF 
     382 
     383         ! SURFACE boundary conditions 
     384         IF( nb_trcsbc > 0 ) THEN 
     385           if (lwp) write(numout,'(a,i5,a,i10)') '   reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt 
     386           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcsbc) 
     387         ENDIF 
     388 
     389         ! COASTAL boundary conditions 
     390         IF( nb_trccbc > 0 ) THEN 
     391           if (lwp) write(numout,'(a,i5,a,i10)') '   reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt 
     392           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trccbc) 
     393         ENDIF 
     394 
     395      ENDIF 
     396 
    295397      ! 
    296398      IF( nn_timing == 1 )  CALL timing_stop('trc_bc_read') 
    297       !        
    298  
     399      ! 
    299400   END SUBROUTINE trc_bc_read 
     401 
    300402#else 
    301403   !!---------------------------------------------------------------------- 
    … …  
    303405   !!---------------------------------------------------------------------- 
    304406CONTAINS 
     407 
     408   SUBROUTINE trc_bc_init( ntrc )        ! Empty routine 
     409      INTEGER,INTENT(IN) :: ntrc                           ! number of tracers 
     410      WRITE(*,*) 'trc_bc_init: You should not have seen this print! error?', kt 
     411   END SUBROUTINE trc_bc_init 
     412 
    305413   SUBROUTINE trc_bc_read( kt )        ! Empty routine 
    306414      WRITE(*,*) 'trc_bc_read: You should not have seen this print! error?', kt 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcdia.F90

    r5836 r6140  
    106106      CHARACTER (len=20) :: cltra, cltrau 
    107107      CHARACTER (len=80) :: cltral 
    108       REAL(wp) :: zsto, zout, zdt 
     108      REAL(wp) :: zsto, zout 
    109109      INTEGER  :: iimi, iima, ijmi, ijma, ipk, it, itmod, iiter 
    110110      !!---------------------------------------------------------------------- 
    … …  
    118118 
    119119      ! Define frequency of output and means 
    120       zdt = rdt 
    121120      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!) 
    122121      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time) 
    … …  
    126125      clop = "inst("//TRIM(clop)//")" 
    127126# else 
    128       zsto = zdt 
     127      zsto = rdt 
    129128      clop = "ave("//TRIM(clop)//")" 
    130129# endif 
    131       zout = nn_writetrc * zdt 
     130      zout = nn_writetrc * rdt 
    132131 
    133132      ! Define indices of the horizontal output zoom and vertical limit storage 
    … …  
    182181         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,     & 
    183182            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         &  
    184             &          iiter, zjulian, zdt, nhorit5, nit5 , domain_id=nidom, snc4chunks=snc4set) 
     183            &          iiter, zjulian, rdt, nhorit5, nit5 , domain_id=nidom, snc4chunks=snc4set) 
    185184 
    186185         ! Vertical grid for tracer : gdept 
    … …  
    250249      INTEGER  ::   jl 
    251250      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod, iiter 
    252       REAL(wp) ::   zsto, zout, zdt 
     251      REAL(wp) ::   zsto, zout 
    253252      !!---------------------------------------------------------------------- 
    254253 
    … …  
    261260      ! 
    262261      ! Define frequency of output and means 
    263       zdt = rdt 
    264262      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!) 
    265263      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time) 
    266264      ENDIF 
    267265#  if defined key_diainstant 
    268       zsto = nn_writedia * zdt 
     266      zsto = nn_writedia * rdt 
    269267      clop = "inst("//TRIM(clop)//")" 
    270268#  else 
    271       zsto = zdt 
     269      zsto = rdt 
    272270      clop = "ave("//TRIM(clop)//")" 
    273271#  endif 
    274       zout = nn_writedia * zdt 
     272      zout = nn_writedia * rdt 
    275273 
    276274      ! Define indices of the horizontal output zoom and vertical limit storage 
    … …  
    302300         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,             & 
    303301            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         & 
    304             &          iiter, zjulian, zdt, nhoritd, nitd , domain_id=nidom, snc4chunks=snc4set ) 
     302            &          iiter, zjulian, rdt, nhoritd, nitd , domain_id=nidom, snc4chunks=snc4set ) 
    305303 
    306304         ! Vertical grid for 2d and 3d arrays 
    … …  
    387385      INTEGER  ::   ji, jj, jk, jl 
    388386      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod, iiter 
    389       REAL(wp) ::   zsto, zout, zdt 
     387      REAL(wp) ::   zsto, zout 
    390388      !!---------------------------------------------------------------------- 
    391389 
    … …  
    398396 
    399397      ! Define frequency of output and means 
    400       zdt = rdt 
    401398      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!) 
    402399      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time) 
    403400      ENDIF 
    404401#        if defined key_diainstant 
    405       zsto = nn_writebio * zdt 
     402      zsto = nn_writebio * rdt 
    406403      clop = "inst("//TRIM(clop)//")" 
    407404#        else 
    408       zsto = zdt 
     405      zsto = rdt 
    409406      clop = "ave("//TRIM(clop)//")" 
    410407#        endif 
    411       zout = nn_writebio * zdt 
     408      zout = nn_writebio * rdt 
    412409 
    413410      ! Define indices of the horizontal output zoom and vertical limit storage 
    … …  
    435432         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,      & 
    436433            &    iimi, iima-iimi+1, ijmi, ijma-ijmi+1,          & 
    437             &    iiter, zjulian, zdt, nhoritb, nitb , domain_id=nidom, snc4chunks=snc4set ) 
     434            &    iiter, zjulian, rdt, nhoritb, nitb , domain_id=nidom, snc4chunks=snc4set ) 
    438435         ! Vertical grid for biological trends 
    439436         CALL histvert(nitb, 'deptht', 'Vertical T levels', 'm', ipk, gdept_1d, ndepitb) 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    r5385 r6140  
    99   !!            3.4   !  2010-11  (C. Ethe, G. Madec)  use of fldread + dynamical allocation  
    1010   !!            3.5   !  2013-08  (M. Vichi)  generalization for other BGC models 
    11    !!---------------------------------------------------------------------- 
    12 #if  defined key_top  
     11   !!            3.6   !  2015-03  (T. Lovato) revision of code log info 
     12   !!---------------------------------------------------------------------- 
     13#if defined key_top  
    1314   !!---------------------------------------------------------------------- 
    1415   !!   'key_top'                                                TOP model  
    … …  
    3637   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcdta   ! structure of input SST (file informations, fields read) 
    3738!$AGRIF_END_DO_NOT_TREAT 
    38    !! * Substitutions 
    39 #  include "domzgr_substitute.h90" 
     39 
    4040   !!---------------------------------------------------------------------- 
    4141   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    … …  
    7272      IF( nn_timing == 1 )  CALL timing_start('trc_dta_init') 
    7373      ! 
     74      IF( lwp ) THEN 
     75         WRITE(numout,*) ' ' 
     76         WRITE(numout,*) '  trc_dta_init : Tracers Initial Conditions (IC)' 
     77         WRITE(numout,*) '  ~~~~~~~~~~~ ' 
     78      ENDIF 
     79      ! 
    7480      !  Initialisation 
    7581      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0   
    … …  
    7783      ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 ) 
    7884      IF( ierr0 > 0 ) THEN 
    79          CALL ctl_stop( 'trc_nam: unable to allocate n_trc_index' )   ;   RETURN 
     85         CALL ctl_stop( 'trc_dta_init: unable to allocate n_trc_index' )   ;   RETURN 
    8086      ENDIF 
    8187      nb_trcdta      = 0 
    … …  
    97103      REWIND( numnat_ref )              ! Namelist namtrc_dta in reference namelist : Passive tracer input data 
    98104      READ  ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901) 
    99 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in reference namelist', lwp ) 
     105901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_init in reference namelist', lwp ) 
    100106 
    101107      REWIND( numnat_cfg )              ! Namelist namtrc_dta in configuration namelist : Passive tracer input data 
    102108      READ  ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 ) 
    103 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in configuration namelist', lwp ) 
     109902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_init in configuration namelist', lwp ) 
    104110      IF(lwm) WRITE ( numont, namtrc_dta ) 
    105111 
    … …  
    109115               clndta = TRIM( sn_trcdta(jn)%clvar )  
    110116               clntrc = TRIM( ctrcnm   (jn)       )  
     117               if (jn > jptra) clntrc='Dummy' ! By pass weird formats in ocean.output if ntrc > jptra 
    111118               zfact  = rn_trfac(jn) 
    112119               IF( clndta /=  clntrc ) THEN  
    113                   CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation :  ',   & 
    114                   &              'the variable name in the data file : '//clndta//   &  
    115                   &              '  must be the same than the name of the passive tracer : '//clntrc//' ') 
     120                  CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation    ',   & 
     121                  &              'Input name of data file : '//TRIM(clndta)//   & 
     122                  &              ' differs from that of tracer : '//TRIM(clntrc)//' ') 
    116123               ENDIF 
    117                WRITE(numout,*) ' read an initial file for passive tracer number :', jn, ' name : ', clndta, &  
    118                &               ' multiplicative factor : ', zfact 
     124               WRITE(numout,*) ' ' 
     125               WRITE(numout,'(a, i3,3a,e11.3)') ' Read IC file for tracer number :', & 
     126               &            jn, ', name : ', TRIM(clndta), ', Multiplicative Scaling factor : ', zfact 
    119127            ENDIF 
    120128         END DO 
    … …  
    124132         ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 ) 
    125133         IF( ierr1 > 0 ) THEN 
    126             CALL ctl_stop( 'trc_dta_ini: unable to allocate  sf_trcdta structure' )   ;   RETURN 
     134            CALL ctl_stop( 'trc_dta_init: unable to allocate  sf_trcdta structure' )   ;   RETURN 
    127135         ENDIF 
    128136         ! 
    … …  
    135143               IF( sn_trcdta(jn)%ln_tint )  ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 
    136144               IF( ierr2 + ierr3 > 0 ) THEN 
    137                  CALL ctl_stop( 'trc_dta : unable to allocate passive tracer data arrays' )   ;   RETURN 
     145                 CALL ctl_stop( 'trc_dta_init : unable to allocate passive tracer data arrays' )   ;   RETURN 
    138146               ENDIF 
    139147            ENDIF 
    … …  
    141149         ENDDO 
    142150         !                         ! fill sf_trcdta with slf_i and control print 
    143          CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta', 'Passive tracer data', 'namtrc' ) 
     151         CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_init', 'Passive tracer data', 'namtrc' ) 
    144152         ! 
    145153      ENDIF 
    … …  
    189197                  DO ji = 1, jpi 
    190198                     DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
    191                         zl = fsdept_n(ji,jj,jk) 
     199                        zl = gdept_n(ji,jj,jk) 
    192200                        IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data 
    193201                           ztp(jk) =  sf_dta(1)%fnow(ji,jj,1) 
    … …  
    220228                        ik = mbkt(ji,jj)  
    221229                        IF( ik > 1 ) THEN 
    222                            zl = ( gdept_1d(ik) - fsdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
     230                           zl = ( gdept_1d(ik) - gdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
    223231                           sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik-1) 
    224                         ENDIF 
    225                         ik = mikt(ji,jj) 
    226                         IF( ik > 1 ) THEN 
    227                            zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 
    228                            sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik+1) 
    229232                        ENDIF 
    230233                     END DO 
    … …  
    236239         sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * zrf_trfac   !  multiplicative factor 
    237240         ! 
    238          IF( lwp .AND. kt == nit000 ) THEN 
    239                clndta = TRIM( sf_dta(1)%clvar )  
    240                WRITE(numout,*) ''//clndta//' data ' 
    241                WRITE(numout,*) 
    242                WRITE(numout,*)'  level = 1' 
    243                CALL prihre( sf_dta(1)%fnow(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    244                WRITE(numout,*)'  level = ', jpk/2 
    245                CALL prihre( sf_dta(1)%fnow(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    246                WRITE(numout,*)'  level = ', jpkm1 
    247                CALL prihre( sf_dta(1)%fnow(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    248                WRITE(numout,*) 
    249          ENDIF 
    250241      ENDIF 
    251242      ! 
    … …  
    253244      ! 
    254245   END SUBROUTINE trc_dta 
     246    
    255247#else 
    256248   !!---------------------------------------------------------------------- 
    … …  
    262254   END SUBROUTINE trc_dta 
    263255#endif 
     256 
    264257   !!====================================================================== 
    265258END MODULE trcdta 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r5836 r6140  
    2626   USE sbc_oce 
    2727   USE trcice          ! tracers in sea ice 
     28   USE trcbc,   only : trc_bc_init ! generalized Boundary Conditions 
    2829  
    2930   IMPLICIT NONE 
    … …  
    3233   PUBLIC   trc_init   ! called by opa 
    3334 
    34     !! * Substitutions 
    35 #  include "domzgr_substitute.h90" 
    3635   !!---------------------------------------------------------------------- 
    3736   !! NEMO/TOP 4.0 , NEMO Consortium (2011) 
    … …  
    119118      !                                                              ! masked grid volume 
    120119      DO jk = 1, jpk 
    121          cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) 
     120         cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 
    122121      END DO 
    123       IF( lk_degrad ) cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)      ! degrad option: reduction by facvol 
     122      IF( lk_degrad )   cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)    ! degrad option: reduction by facvol 
    124123      !                                                              ! total volume of the ocean  
    125124      areatot = glob_sum( cvol(:,:,:) ) 
    … …  
    208207      !!---------------------------------------------------------------------- 
    209208      ! 
     209      ! Initialisation of tracers Initial Conditions 
    210210      IF( ln_trcdta )      CALL trc_dta_init(jptra) 
     211 
     212      ! Initialisation of tracers Boundary Conditions 
     213      IF( lk_my_trc )     CALL trc_bc_init(jptra) 
    211214 
    212215      IF( ln_rsttr ) THEN 
    … …  
    246249   END SUBROUTINE trc_ini_state 
    247250 
    248  
    249251   SUBROUTINE top_alloc 
    250252      !!---------------------------------------------------------------------- 
    … …  
    253255      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules 
    254256      !!---------------------------------------------------------------------- 
    255       USE trcadv        , ONLY:   trc_adv_alloc          ! TOP-related alloc routines... 
    256257      USE trc           , ONLY:   trc_alloc 
    257       USE trcnxt        , ONLY:   trc_nxt_alloc 
    258       USE trczdf        , ONLY:   trc_zdf_alloc 
    259258      USE trdtrc_oce    , ONLY:   trd_trc_oce_alloc 
    260259#if defined key_trdmxl_trc  
    … …  
    265264      !!---------------------------------------------------------------------- 
    266265      ! 
    267       ierr =        trc_adv_alloc()          ! Start of TOP-related alloc routines... 
    268       ierr = ierr + trc_alloc    () 
    269       ierr = ierr + trc_nxt_alloc() 
    270       ierr = ierr + trc_zdf_alloc() 
     266      ierr =        trc_alloc() 
    271267      ierr = ierr + trd_trc_oce_alloc() 
    272268#if defined key_trdmxl_trc  

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r5836 r6140  
    9898 
    9999       
    100       rdttrc(:) = rdttra(:) * FLOAT( nn_dttrc )   ! vertical profile of passive tracer time-step 
     100      rdttrc = rdt * FLOAT( nn_dttrc )   ! passive tracer time-step 
    101101   
    102102      IF(lwp) THEN                   ! control print 
    103103        WRITE(numout,*)  
    104         WRITE(numout,*) '    Passive Tracer  time step    rdttrc  = ', rdttrc(1) 
     104        WRITE(numout,*) '    Passive Tracer  time step    rdttrc  = ', rdttrc 
    105105        WRITE(numout,*)  
    106106      ENDIF 
    … …  
    173173      !!--------------------------------------------------------------------- 
    174174      ! 
    175       IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists' 
     175      IF(lwp) WRITE(numout,*) 'trc_nam_run : read the passive tracer namelists' 
    176176      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    177177 
    … …  
    271271      TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer  ! type of tracer for saving if not key_iomput 
    272272      !! 
    273       NAMELIST/namtrc/ sn_tracer, ln_trcdta,ln_trcdmp, ln_trcdmp_clo 
     273      NAMELIST/namtrc/ sn_tracer, ln_trcdta, ln_trcdmp, ln_trcdmp_clo 
    274274      !!--------------------------------------------------------------------- 
    275275      IF(lwp) WRITE(numout,*) 
    276       IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists' 
     276      IF(lwp) WRITE(numout,*) 'trc_nam_trc : read the passive tracer namelists' 
    277277      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    278278 
    … …  
    291291         ctrcun    (jn) = TRIM( sn_tracer(jn)%clunit  ) 
    292292         ln_trc_ini(jn) =       sn_tracer(jn)%llinit 
     293#if defined key_my_trc 
     294         ln_trc_sbc(jn) =       sn_tracer(jn)%llsbc 
     295         ln_trc_cbc(jn) =       sn_tracer(jn)%llcbc 
     296         ln_trc_obc(jn) =       sn_tracer(jn)%llobc 
     297#endif 
    293298         ln_trc_wri(jn) =       sn_tracer(jn)%llsave 
    294299      END DO 
    … …  
    317322      NAMELIST/namtrc_dia/ ln_diatrc, ln_diabio, nn_writedia, nn_writebio 
    318323      !!--------------------------------------------------------------------- 
    319  
    320       IF(lwp) WRITE(numout,*)  
    321       IF(lwp) WRITE(numout,*) 'trc_nam_dia : read the passive tracer diagnostics options' 
    322       IF(lwp) WRITE(numout,*) '~~~~~~~' 
    323324 
    324325      IF(lwp) WRITE(numout,*) 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r5836 r6140  
    1414   !!---------------------------------------------------------------------- 
    1515   !!---------------------------------------------------------------------- 
    16    !!   trc_rst :   Restart for passive tracer 
    17    !!---------------------------------------------------------------------- 
    18    !!---------------------------------------------------------------------- 
    19    !!   'key_top'                                                TOP models 
    20    !!---------------------------------------------------------------------- 
     16   !!   trc_rst        : Restart for passive tracer 
    2117   !!   trc_rst_opn    : open  restart file 
    2218   !!   trc_rst_read   : read  restart file 
    … …  
    2723   USE iom 
    2824   USE daymod 
     25    
    2926   IMPLICIT NONE 
    3027   PRIVATE 
    … …  
    3532   PUBLIC   trc_rst_cal 
    3633 
    37    !! * Substitutions 
    38 #  include "domzgr_substitute.h90" 
    39     
     34   !!---------------------------------------------------------------------- 
     35   !! NEMO/TOP 3.7 , NEMO Consortium (2010) 
     36   !! $Id$ 
     37   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     38   !!---------------------------------------------------------------------- 
    4039CONTAINS 
    4140    
    … …  
    131130      !!---------------------------------------------------------------------- 
    132131      ! 
    133       CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc(1) )   ! surface passive tracer time step 
     132      CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc )   ! passive tracer time step 
    134133      ! prognostic variables  
    135134      ! --------------------  
    … …  
    199198         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    200199 
    201          IF ( jprstlib == jprstdimg ) THEN 
    202            ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
    203            ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90  
    204            INQUIRE( FILE = TRIM(cn_trcrst_indir)//'/'//TRIM(cn_trcrst_in)//'.nc', EXIST = llok ) 
    205            IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF 
    206          ENDIF 
    207  
    208200         IF( ln_rsttr ) THEN 
    209201            CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr, kiolib = jlibalt ) 
    … …  
    235227             ELSE 
    236228               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam 
    237                adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday 
     229               adatrj = ( REAL( nittrc000-1, wp ) * rdt ) / rday 
    238230               ! note this is wrong if time step has changed during run 
    239231            ENDIF 
    … …  
    288280      ! 
    289281      DO jk = 1, jpk 
    290          zvol(:,:,jk) = e1e2t(:,:) * fse3t_a(:,:,jk) * tmask(:,:,jk) 
     282         zvol(:,:,jk) = e1e2t(:,:) * e3t_a(:,:,jk) * tmask(:,:,jk) 
    291283      END DO 
    292284      ! 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r5407 r6140  
    3636   LOGICAL  :: llnew 
    3737 
    38    !! * Substitutions 
    39 #  include "domzgr_substitute.h90" 
    4038   !!---------------------------------------------------------------------- 
    4139   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    6664      IF( kt == nittrc000 .AND. lk_trdmxl_trc )  CALL trd_mxl_trc_init    ! trends: Mixed-layer 
    6765      ! 
    68       IF( lk_vvl ) THEN                                                   ! update ocean volume due to ssh temporal evolution 
     66      IF( .NOT.ln_linssh ) THEN                                           ! update ocean volume due to ssh temporal evolution 
    6967         DO jk = 1, jpk 
    70             cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) 
     68            cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 
    7169         END DO 
    7270         IF( lk_degrad )  cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)       ! degrad option: reduction by facvol 
    … …  
    116114   END SUBROUTINE trc_stp 
    117115 
     116 
    118117   SUBROUTINE trc_mean_qsr( kt ) 
    119118      !!---------------------------------------------------------------------- 
    … …  
    130129      INTEGER, INTENT(in) ::   kt 
    131130      INTEGER  :: jn 
    132  
     131      !!---------------------------------------------------------------------- 
     132      ! 
    133133      IF( kt == nittrc000 ) THEN 
    134134         IF( ln_cpl )  THEN   
    … …  
    165165          DO jn = 1, nb_rec_per_days - 1 
    166166             qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1) 
    167           ENDDO 
     167          END DO 
    168168          qsr_arr (:,:,nb_rec_per_days) = qsr(:,:) 
    169169          qsr_mean(:,:                ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_days 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcsub.F90

    r5930 r6140  
    4040   PUBLIC   trc_sub_ssh      ! called by trc_stp to reset physics variables 
    4141 
    42    !!* Module variables 
    4342   REAL(wp)  :: r1_ndttrc     !    1 /  nn_dttrc  
    4443   REAL(wp)  :: r1_ndttrcp1   !    1 / (nn_dttrc+1)  
    … …  
    4847   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_tm  , vslp_tm  , wslpi_tm  , wslpj_tm     !: time mean  
    4948 
    50    !! * Substitutions 
    51 #  include "domzgr_substitute.h90" 
    5249   !!---------------------------------------------------------------------- 
    5350   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    8885       IF( MOD( kt , nn_dttrc ) /= 0 ) THEN 
    8986          ! 
    90           un_tm   (:,:,:)        = un_tm   (:,:,:)        + un   (:,:,:)        * fse3u(:,:,:)  
    91           vn_tm   (:,:,:)        = vn_tm   (:,:,:)        + vn   (:,:,:)        * fse3v(:,:,:)  
    92           tsn_tm  (:,:,:,jp_tem) = tsn_tm  (:,:,:,jp_tem) + tsn  (:,:,:,jp_tem) * fse3t(:,:,:)   
    93           tsn_tm  (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * fse3t(:,:,:)   
    94           rhop_tm (:,:,:)        = rhop_tm (:,:,:)        + rhop (:,:,:)        * fse3t(:,:,:)   
    95           avt_tm  (:,:,:)        = avt_tm  (:,:,:)        + avt  (:,:,:)        * fse3w(:,:,:)   
    96 # if defined key_zdfddm 
    97           avs_tm  (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * fse3w(:,:,:)   
     87          un_tm   (:,:,:)        = un_tm   (:,:,:)        + un   (:,:,:)        * e3u_n(:,:,:)  
     88          vn_tm   (:,:,:)        = vn_tm   (:,:,:)        + vn   (:,:,:)        * e3v_n(:,:,:)  
     89          tsn_tm  (:,:,:,jp_tem) = tsn_tm  (:,:,:,jp_tem) + tsn  (:,:,:,jp_tem) * e3t_n(:,:,:)   
     90          tsn_tm  (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)   
     91          rhop_tm (:,:,:)        = rhop_tm (:,:,:)        + rhop (:,:,:)        * e3t_n(:,:,:)   
     92          avt_tm  (:,:,:)        = avt_tm  (:,:,:)        + avt  (:,:,:)        * e3w_n(:,:,:)   
     93# if defined key_zdfddm 
     94          avs_tm  (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * e3w_n(:,:,:)   
    9895# endif 
    9996         IF( l_ldfslp ) THEN 
    … …  
    165162         ! 
    166163         ! 2. Create averages and reassign variables 
    167          un_tm    (:,:,:)        = un_tm   (:,:,:)        + un   (:,:,:)        * fse3u(:,:,:)  
    168          vn_tm    (:,:,:)        = vn_tm   (:,:,:)        + vn   (:,:,:)        * fse3v(:,:,:)  
    169          tsn_tm   (:,:,:,jp_tem) = tsn_tm  (:,:,:,jp_tem) + tsn  (:,:,:,jp_tem) * fse3t(:,:,:)   
    170          tsn_tm   (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * fse3t(:,:,:)   
    171          rhop_tm (:,:,:)         = rhop_tm (:,:,:)        + rhop (:,:,:)        * fse3t(:,:,:)   
    172          avt_tm   (:,:,:)        = avt_tm  (:,:,:)        + avt  (:,:,:)        * fse3w(:,:,:)   
    173 # if defined key_zdfddm 
    174          avs_tm   (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * fse3w(:,:,:)   
     164         un_tm    (:,:,:)        = un_tm   (:,:,:)        + un   (:,:,:)        * e3u_n(:,:,:)  
     165         vn_tm    (:,:,:)        = vn_tm   (:,:,:)        + vn   (:,:,:)        * e3v_n(:,:,:)  
     166         tsn_tm   (:,:,:,jp_tem) = tsn_tm  (:,:,:,jp_tem) + tsn  (:,:,:,jp_tem) * e3t_n(:,:,:)   
     167         tsn_tm   (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)   
     168         rhop_tm (:,:,:)         = rhop_tm (:,:,:)        + rhop (:,:,:)        * e3t_n(:,:,:)   
     169         avt_tm   (:,:,:)        = avt_tm  (:,:,:)        + avt  (:,:,:)        * e3w_n(:,:,:)   
     170# if defined key_zdfddm 
     171         avs_tm   (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * e3w_n(:,:,:)   
    175172# endif 
    176173         IF( l_ldfslp ) THEN 
    … …  
    244241            DO jj = 1, jpj 
    245242               DO ji = 1, jpi 
    246                   z1_ne3t = r1_ndttrcp1  / fse3t(ji,jj,jk) 
    247                   z1_ne3u = r1_ndttrcp1  / fse3u(ji,jj,jk) 
    248                   z1_ne3v = r1_ndttrcp1  / fse3v(ji,jj,jk) 
    249                   z1_ne3w = r1_ndttrcp1  / fse3w(ji,jj,jk) 
     243                  z1_ne3t = r1_ndttrcp1  / e3t_n(ji,jj,jk) 
     244                  z1_ne3u = r1_ndttrcp1  / e3u_n(ji,jj,jk) 
     245                  z1_ne3v = r1_ndttrcp1  / e3v_n(ji,jj,jk) 
     246                  z1_ne3w = r1_ndttrcp1  / e3w_n(ji,jj,jk) 
    250247                  ! 
    251248                  un   (ji,jj,jk)        = un_tm   (ji,jj,jk)        * z1_ne3u 
    … …  
    300297      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'top_sub_alloc : unable to allocate standard ocean arrays' ) 
    301298 
    302       un_tm   (:,:,:)        = un   (:,:,:)        * fse3u(:,:,:)  
    303       vn_tm   (:,:,:)        = vn   (:,:,:)        * fse3v(:,:,:)  
    304       tsn_tm  (:,:,:,jp_tem) = tsn  (:,:,:,jp_tem) * fse3t(:,:,:)   
    305       tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * fse3t(:,:,:)   
    306       rhop_tm (:,:,:)        = rhop (:,:,:)        * fse3t(:,:,:)   
     299      un_tm   (:,:,:)        = un   (:,:,:)        * e3u_n(:,:,:)  
     300      vn_tm   (:,:,:)        = vn   (:,:,:)        * e3v_n(:,:,:)  
     301      tsn_tm  (:,:,:,jp_tem) = tsn  (:,:,:,jp_tem) * e3t_n(:,:,:)   
     302      tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)   
     303      rhop_tm (:,:,:)        = rhop (:,:,:)        * e3t_n(:,:,:)   
    307304!!gm : BUG? ==>> for avt & avs I don't understand the division by e3w 
    308       avt_tm  (:,:,:)        = avt  (:,:,:)        * fse3w(:,:,:)   
    309 # if defined key_zdfddm 
    310       avs_tm  (:,:,:)        = avs  (:,:,:)        * fse3w(:,:,:)   
     305      avt_tm  (:,:,:)        = avt  (:,:,:)        * e3w_n(:,:,:)   
     306# if defined key_zdfddm 
     307      avs_tm  (:,:,:)        = avs  (:,:,:)        * e3w_n(:,:,:)   
    311308# endif 
    312309      IF( l_ldfslp ) THEN 
    … …  
    400397      !                                       
    401398      ! Start new averages 
    402          un_tm   (:,:,:)        = un   (:,:,:)        * fse3u(:,:,:)  
    403          vn_tm   (:,:,:)        = vn   (:,:,:)        * fse3v(:,:,:)  
    404          tsn_tm  (:,:,:,jp_tem) = tsn  (:,:,:,jp_tem) * fse3t(:,:,:)   
    405          tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * fse3t(:,:,:)   
    406          rhop_tm (:,:,:)        = rhop (:,:,:)        * fse3t(:,:,:)   
    407          avt_tm  (:,:,:)        = avt  (:,:,:)        * fse3w(:,:,:)   
    408 # if defined key_zdfddm 
    409          avs_tm  (:,:,:)        = avs  (:,:,:)        * fse3w(:,:,:)   
     399         un_tm   (:,:,:)        = un   (:,:,:)        * e3u_n(:,:,:)  
     400         vn_tm   (:,:,:)        = vn   (:,:,:)        * e3v_n(:,:,:)  
     401         tsn_tm  (:,:,:,jp_tem) = tsn  (:,:,:,jp_tem) * e3t_n(:,:,:)   
     402         tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)   
     403         rhop_tm (:,:,:)        = rhop (:,:,:)        * e3t_n(:,:,:)   
     404         avt_tm  (:,:,:)        = avt  (:,:,:)        * e3w_n(:,:,:)   
     405# if defined key_zdfddm 
     406         avs_tm  (:,:,:)        = avs  (:,:,:)        * e3w_n(:,:,:)   
    410407# endif 
    411408      IF( l_ldfslp ) THEN 
    … …  
    449446      !!                    
    450447      !! ** Purpose :   compute the after ssh (ssha), the now vertical velocity 
    451       !!              and update the now vertical coordinate (lk_vvl=T). 
     448      !!              and update the now vertical coordinate (ln_linssh=F). 
    452449      !! 
    453450      !! ** Method  : - Using the incompressibility hypothesis, the vertical  
    … …  
    458455      !! ** action  :   ssha    : after sea surface height 
    459456      !!                wn      : now vertical velocity 
    460       !!                sshu_a, sshv_a, sshf_a  : after sea surface height (lk_vvl=T) 
     457      !!                sshu_a, sshv_a, sshf_a  : after sea surface height (ln_linssh=F) 
    461458      !! 
    462459      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling. 
    463460      !!---------------------------------------------------------------------- 
    464       ! 
    465461      INTEGER, INTENT(in) ::   kt   ! time step 
    466462      ! 
    … …  
    473469      ! 
    474470      ! Allocate temporary workspace 
    475       CALL wrk_alloc( jpi, jpj, zhdiv ) 
     471      CALL wrk_alloc( jpi,jpj,  zhdiv ) 
    476472 
    477473      IF( kt == nittrc000 ) THEN 
    … …  
    485481      ENDIF 
    486482      ! 
     483!!gm BUG here !   hdivn will include the runoff divergence at the wrong timestep !!!! 
    487484      CALL div_hor( kt )                              ! Horizontal divergence & Relative vorticity 
    488485      ! 
    … …  
    495492      zhdiv(:,:) = 0._wp 
    496493      DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports 
    497         zhdiv(:,:) = zhdiv(:,:) + fse3t(:,:,jk) * hdivn(:,:,jk) 
     494        zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk) 
    498495      END DO 
    499496      !                                                ! Sea surface elevation time stepping 
    … …  
    502499      z1_rau0 = 0.5 / rau0 
    503500      ssha(:,:) = (  sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * tmask(:,:,1) 
    504  
     501#if ! defined key_dynspg_ts 
    505502      ! These lines are not necessary with time splitting since 
    506503      ! boundary condition on sea level is set during ts loop 
    … …  
    512509      CALL lbc_lnk( ssha, 'T', 1. )  
    513510#endif 
    514  
     511#endif 
     512      ! 
    515513      !                                           !------------------------------! 
    516514      !                                           !     Now Vertical Velocity    ! 
    … …  
    518516      z1_2dt = 1.e0 / z2dt 
    519517      DO jk = jpkm1, 1, -1                             ! integrate from the bottom the hor. divergence 
    520          ! - ML - need 3 lines here because replacement of fse3t by its expression yields too long lines otherwise 
    521          wn(:,:,jk) = wn(:,:,jk+1) -   fse3t_n(:,:,jk) * hdivn(:,:,jk)        & 
    522             &                      - ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) )    & 
     518         ! - ML - need 3 lines here because replacement of e3t by its expression yields too long lines otherwise 
     519         wn(:,:,jk) = wn(:,:,jk+1) -   e3t_n(:,:,jk) * hdivn(:,:,jk)        & 
     520            &                      - ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )    & 
    523521            &                         * tmask(:,:,jk) * z1_2dt 
    524522#if defined key_bdy 
    … …  
    526524#endif 
    527525      END DO 
    528  
    529       ! 
    530       CALL wrk_dealloc( jpi, jpj, zhdiv ) 
     526      ! 
     527      CALL wrk_dealloc( jpi,jpj,   zhdiv ) 
    531528      ! 
    532529      IF( nn_timing == 1 )  CALL timing_stop('trc_sub_ssh') 
    533530      ! 
    534531   END SUBROUTINE trc_sub_ssh 
     532 
    535533 
    536534   INTEGER FUNCTION trc_sub_alloc() 
    … …  
    598596      WRITE(*,*) 'trc_sub_ini: You should not have seen this print! error?', kt 
    599597   END SUBROUTINE trc_sub_ini 
    600  
    601598#endif 
    602599 
Note: See TracChangeset for help on using the changeset viewer.