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 5870 for branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC – NEMO

Ignore:
Timestamp:
2015-11-09T18:33:54+01:00 (9 years ago)
Author:
acc
Message:

Branch 2015/dev_r5803_NOC_WAD. Merge in trunk changes from 5803 to 5869 in preparation for merge. Also tidied and reorganised some wetting and drying code. Renamed wadlmt.F90 to wetdry.F90. Wetting drying code changes restricted to domzgr.F90, domvvl.F90 nemogcm.F90 sshwzv.F90, dynspg_ts.F90, wetdry.F90 and dynhpg.F90. Code passes full SETTE tests with ln_wd=.false.. Still awaiting test case for checking with ln_wd=.false.

Location:
branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC
Files:
2 deleted
46 edited

Legend:

Unmodified
Added
Removed

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90

    r5215 r5870  
    5050 
    5151   !! * Substitutions 
    52 #  include "top_substitute.h90" 
    53  
     52#  include "domzgr_substitute.h90" 
    5453   !!---------------------------------------------------------------------- 
    5554   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/C14b/trcwri_c14b.F90

    r5407 r5870  
    2020   PUBLIC trc_wri_c14b  
    2121 
    22 #  include "top_substitute.h90" 
    2322CONTAINS 
    2423 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r4996 r5870  
    5151 
    5252   !! * Substitutions 
    53 #  include "top_substitute.h90" 
     53#  include "domzgr_substitute.h90" 
    5454   !!---------------------------------------------------------------------- 
    5555   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/CFC/trcwri_cfc.F90

    r5407 r5870  
    2020   PUBLIC trc_wri_cfc  
    2121 
    22 #  include "top_substitute.h90" 
    2322CONTAINS 
    2423 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90

    r5407 r5870  
    2020   PUBLIC trc_wri_my_trc  
    2121 
    22 #  include "top_substitute.h90" 
    2322CONTAINS 
    2423 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90

    r5656 r5870  
    5959   REAL(wp) ::   fdbod      ! zooplankton mortality fraction that goes to detritus 
    6060 
    61    !!* Substitution 
    62 #  include "top_substitute.h90" 
     61   !! * Substitutions 
     62#  include "domzgr_substitute.h90" 
     63#  include "vectopt_loop_substitute.h90" 
    6364   !!---------------------------------------------------------------------- 
    6465   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90

    r5215 r5870  
    4141   REAL(wp)                                ::   areacot   !: surface coastal area 
    4242 
    43    !!* Substitution 
    44 #  include "top_substitute.h90" 
     43   !! * Substitutions 
     44#  include "domzgr_substitute.h90" 
     45#  include "vectopt_loop_substitute.h90" 
    4546   !!---------------------------------------------------------------------- 
    4647   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90

    r5385 r5870  
    4040   REAL(wp), PUBLIC ::  reddom    ! redfield ratio (C:N) for DOM 
    4141 
    42    !!* Substitution 
    43 #  include "top_substitute.h90" 
     42   !! * Substitutions 
     43#  include "domzgr_substitute.h90" 
    4444   !!---------------------------------------------------------------------- 
    4545   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90

    r5215 r5870  
    3434   REAL(wp), PUBLIC ::   xhr         ! coeff for martin''s remineralisation profile 
    3535 
    36    !!* Substitution 
    37 #  include "top_substitute.h90" 
     36   !! * Substitutions 
     37#  include "domzgr_substitute.h90" 
    3838   !!---------------------------------------------------------------------- 
    3939   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90

    r5656 r5870  
    3434   PUBLIC  p4z_bio     
    3535 
    36    !!* Substitution 
    37 #  include "top_substitute.h90" 
     36   !! * Substitutions 
     37#  include "domzgr_substitute.h90" 
    3838   !!---------------------------------------------------------------------- 
    3939   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90

    r5656 r5870  
    164164   REAL(wp) :: devk55  = 0.3692E-3       
    165165 
    166    !!* Substitution 
    167 #include "top_substitute.h90" 
     166   !! * Substitutions 
     167#  include "domzgr_substitute.h90" 
    168168   !!---------------------------------------------------------------------- 
    169169   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    195195      ! CHEMICAL CONSTANTS - SURFACE LAYER 
    196196      ! ---------------------------------- 
    197 !CDIR NOVERRCHK 
    198197      DO jj = 1, jpj 
    199 !CDIR NOVERRCHK 
    200198         DO ji = 1, jpi 
    201199            !                             ! SET ABSOLUTE TEMPERATURE 
    … …  
    227225      ! OXYGEN SOLUBILITY - DEEP OCEAN 
    228226      ! ------------------------------- 
    229 !CDIR NOVERRCHK 
    230227      DO jk = 1, jpk 
    231 !CDIR NOVERRCHK 
    232228         DO jj = 1, jpj 
    233 !CDIR NOVERRCHK 
    234229            DO ji = 1, jpi 
    235230              ztkel = tsn(ji,jj,jk,jp_tem) + 273.16 
    … …  
    252247      ! CHEMICAL CONSTANTS - DEEP OCEAN 
    253248      ! ------------------------------- 
    254 !CDIR NOVERRCHK 
    255249      DO jk = 1, jpk 
    256 !CDIR NOVERRCHK 
    257250         DO jj = 1, jpj 
    258 !CDIR NOVERRCHK 
    259251            DO ji = 1, jpi 
    260252 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90

    r5385 r5870  
    3939   REAL(wp) :: kl1, kl2, kb1, kb2, ks, kpr, spd, con, kth 
    4040 
    41    !!* Substitution 
    42 #  include "top_substitute.h90" 
     41   !! * Substitutions 
     42#  include "domzgr_substitute.h90" 
    4343   !!---------------------------------------------------------------------- 
    4444   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    113113         ! Chemistry is supposed to be fast enough to be at equilibrium 
    114114         ! ------------------------------------------------------------ 
    115 !CDIR NOVERRCHK 
    116115         DO jk = 1, jpkm1 
    117 !CDIR NOVERRCHK 
    118116            DO jj = 1, jpj 
    119 !CDIR NOVERRCHK 
    120117               DO ji = 1, jpi 
    121118                  ! Calculate ligand concentrations : assume 2/3rd of excess goes to 
    … …  
    195192         ! Chemistry is supposed to be fast enough to be at equilibrium 
    196193         ! ------------------------------------------------------------ 
    197 !CDIR NOVERRCHK 
    198194         DO jk = 1, jpkm1 
    199 !CDIR NOVERRCHK 
    200195            DO jj = 1, jpj 
    201 !CDIR NOVERRCHK 
    202196               DO ji = 1, jpi 
    203197                  zTL1(ji,jj,jk) = ztotlig(ji,jj,jk) 
    … …  
    216210         ! 
    217211      ENDIF 
    218  
     212      ! 
    219213      zdust = 0.         ! if no dust available 
    220 !CDIR NOVERRCHK 
     214      ! 
    221215      DO jk = 1, jpkm1 
    222 !CDIR NOVERRCHK 
    223216         DO jj = 1, jpj 
    224 !CDIR NOVERRCHK 
    225217            DO ji = 1, jpi 
    226218               zstep = xstep 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90

    r5656 r5870  
    5959   REAL(wp) ::  xconv  = 0.01_wp / 3600._wp !: coefficients for conversion  
    6060 
    61    !!* Substitution 
    62 #  include "top_substitute.h90" 
     61   !! * Substitutions 
     62#  include "domzgr_substitute.h90" 
    6363   !!---------------------------------------------------------------------- 
    6464   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    122122 
    123123      DO jm = 1, 10 
    124 !CDIR NOVERRCHK 
    125124         DO jj = 1, jpj 
    126 !CDIR NOVERRCHK 
    127125            DO ji = 1, jpi 
    128126 
    … …  
    155153      ! ------------------------------------------- 
    156154 
    157 !CDIR NOVERRCHK 
    158155      DO jj = 1, jpj 
    159 !CDIR NOVERRCHK 
    160156         DO ji = 1, jpi 
    161157            ztc  = MIN( 35., tsn(ji,jj,1,jp_tem) ) 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90

    r5656 r5870  
    5252   REAL(wp) ::  xcoef2   = 1.21E-5 * 14. / 55.85 / 7.625 * 0.5 * 1.5 
    5353   REAL(wp) ::  xcoef3   = 1.15E-4 * 14. / 55.85 / 7.625 * 0.5  
    54    !!* Substitution 
    55 #  include "top_substitute.h90" 
     54 
    5655   !!---------------------------------------------------------------------- 
    5756   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90

    r5656 r5870  
    8080      DO jn = 1, 5                               !  BEGIN OF ITERATION 
    8181         ! 
    82 !CDIR NOVERRCHK 
    8382         DO jk = 1, jpkm1 
    84 !CDIR NOVERRCHK 
    8583            DO jj = 1, jpj 
    86 !CDIR NOVERRCHK 
    8784               DO ji = 1, jpi 
    8885                  zfact = rhop(ji,jj,jk) / 1000. + rtrn 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90

    r5656 r5870  
    5050   REAL(wp), PUBLIC ::  grazflux     !: mesozoo flux feeding rate 
    5151 
    52    !!* Substitution 
    53 #  include "top_substitute.h90" 
    5452   !!---------------------------------------------------------------------- 
    5553   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90

    r5656 r5870  
    4949 
    5050 
    51    !!* Substitution 
    52 #  include "top_substitute.h90" 
    5351   !!---------------------------------------------------------------------- 
    5452   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90

    r5656 r5870  
    3535 
    3636 
    37    !!* Substitution 
    38 #  include "top_substitute.h90" 
    3937   !!---------------------------------------------------------------------- 
    4038   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90

    r5656 r5870  
    5151   REAL(wp), DIMENSION(3,61), PUBLIC ::   xkrgb   !: tabulated attenuation coefficients for RGB absorption 
    5252    
    53    !!* Substitution 
    54 #  include "top_substitute.h90" 
     53   !! * Substitutions 
     54#  include "domzgr_substitute.h90" 
    5555   !!---------------------------------------------------------------------- 
    5656   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    9595      !                                        !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 
    9696      DO jk = 1, jpkm1                         !  -------------------------------------------------------- 
    97 !CDIR NOVERRCHK 
    9897         DO jj = 1, jpj 
    99 !CDIR NOVERRCHK 
    10098            DO ji = 1, jpi 
    10199               zchl = ( trb(ji,jj,jk,jpnch) + trb(ji,jj,jk,jpdch) + rtrn ) * 1.e6 
    … …  
    179177 
    180178      DO jk = 1, nksrp 
    181 !CDIR NOVERRCHK 
    182179         DO jj = 1, jpj 
    183 !CDIR NOVERRCHK 
    184180            DO ji = 1, jpi 
    185181               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    … …  
    198194      ! 
    199195      DO jk = 1, nksrp 
    200 !CDIR NOVERRCHK 
    201196         DO jj = 1, jpj 
    202 !CDIR NOVERRCHK 
    203197            DO ji = 1, jpi 
    204198               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    … …  
    264258         ! 
    265259         DO jk = 2, nksrp + 1 
    266 !CDIR NOVERRCHK 
    267260            DO jj = 1, jpj 
    268 !CDIR NOVERRCHK 
    269261               DO ji = 1, jpi 
    270262                  pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) * xsi0r ) 
    … …  
    285277        ! 
    286278        DO jk = 2, nksrp       
    287 !CDIR NOVERRCHK 
    288279           DO jj = 1, jpj 
    289 !CDIR NOVERRCHK 
    290280              DO ji = 1, jpi 
    291281                 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90

    r5656 r5870  
    5454   REAL(wp) :: texcret2               !: 1 - excret2         
    5555 
    56  
    57    !!* Substitution 
    58 #  include "top_substitute.h90" 
     56   !! * Substitutions 
     57#  include "domzgr_substitute.h90" 
    5958   !!---------------------------------------------------------------------- 
    6059   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    148147 
    149148      IF( ln_newprod ) THEN 
    150 !CDIR NOVERRCHK 
    151149         DO jk = 1, jpkm1 
    152 !CDIR NOVERRCHK 
    153150            DO jj = 1, jpj 
    154 !CDIR NOVERRCHK 
    155151               DO ji = 1, jpi 
    156152                  ! Computation of the P-I slope for nanos and diatoms 
    … …  
    186182         END DO 
    187183      ELSE 
    188 !CDIR NOVERRCHK 
    189184         DO jk = 1, jpkm1 
    190 !CDIR NOVERRCHK 
    191185            DO jj = 1, jpj 
    192 !CDIR NOVERRCHK 
    193186               DO ji = 1, jpi 
    194187 
    … …  
    231224      !  Computation of a proxy of the N/C ratio 
    232225      !  --------------------------------------- 
    233 !CDIR NOVERRCHK 
    234226      DO jk = 1, jpkm1 
    235 !CDIR NOVERRCHK 
    236227         DO jj = 1, jpj 
    237 !CDIR NOVERRCHK 
    238228            DO ji = 1, jpi 
    239229                zval = MIN( xnanopo4(ji,jj,jk), ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) )   & 
    … …  
    296286 
    297287      ! Computation of the various production terms  
    298 !CDIR NOVERRCHK 
    299288      DO jk = 1, jpkm1 
    300 !CDIR NOVERRCHK 
    301289         DO jj = 1, jpj 
    302 !CDIR NOVERRCHK 
    303290            DO ji = 1, jpi 
    304291               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    … …  
    331318 
    332319      IF( ln_newprod ) THEN 
    333 !CDIR NOVERRCHK 
    334320         DO jk = 1, jpkm1 
    335 !CDIR NOVERRCHK 
    336321            DO jj = 1, jpj 
    337 !CDIR NOVERRCHK 
    338322               DO ji = 1, jpi 
    339323                  IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    … …  
    359343         END DO 
    360344      ELSE 
    361 !CDIR NOVERRCHK 
    362345         DO jk = 1, jpkm1 
    363 !CDIR NOVERRCHK 
    364346            DO jj = 1, jpj 
    365 !CDIR NOVERRCHK 
    366347               DO ji = 1, jpi 
    367348                  IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90

    r5385 r5870  
    5050   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitnh4   !: -    -    -    -   - 
    5151 
    52    !!* Substitution 
    53 #  include "top_substitute.h90" 
     52   !! * Substitutions 
     53#  include "domzgr_substitute.h90" 
    5454   !!---------------------------------------------------------------------- 
    5555   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90

    r5656 r5870  
    8181 
    8282 
    83    !!* Substitution 
    84 #  include "top_substitute.h90" 
     83   !! * Substitutions 
     84#  include "domzgr_substitute.h90" 
     85#  include "vectopt_loop_substitute.h90" 
    8586   !!---------------------------------------------------------------------- 
    8687   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90

    r5656 r5870  
    3838   REAL(wp) :: r1_rday                  !: inverse of rday 
    3939 
    40    !!* Substitution 
    41 #  include "top_substitute.h90" 
     40   !! * Substitutions 
     41#  include "domzgr_substitute.h90" 
    4242   !!---------------------------------------------------------------------- 
    4343   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90

    r5656 r5870  
    6565#endif 
    6666 
    67    !!* Substitution 
    68 #  include "top_substitute.h90" 
     67   !! * Substitutions 
     68#  include "domzgr_substitute.h90" 
    6969   !!---------------------------------------------------------------------- 
    7070   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90

    r5547 r5870  
    4545 
    4646 
    47    !! * Substitutions 
    48 #  include "top_substitute.h90" 
    4947   !!---------------------------------------------------------------------- 
    5048   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90

    r5385 r5870  
    2727   PUBLIC   trc_ini_pisces   ! called by trcini.F90 module 
    2828 
    29  
    30 #  include "top_substitute.h90" 
    3129   !!---------------------------------------------------------------------- 
    3230   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90

    r4996 r5870  
    2121   PUBLIC trc_wri_pisces  
    2222 
    23 #  include "top_substitute.h90" 
     23   !! * Substitutions 
     24#  include "domzgr_substitute.h90" 
     25 
    2426CONTAINS 
    2527 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r5385 r5870  
    44   !! Ocean passive tracers:  advection trend  
    55   !!============================================================================== 
    6    !! History :  2.0  !  05-11  (G. Madec)  Original code 
    7    !!            3.0  !  10-06  (C. Ethe)   Adapted to passive tracers 
     6   !! History :  2.0  !  2005-11  (G. Madec)  Original code 
     7   !!            3.0  !  2010-06  (C. Ethe)   Adapted to passive tracers 
     8   !!            3.7  !  2014-05  (G. Madec, C. Ethe)  Add 2nd/4th order cases for CEN and FCT schemes  
    89   !!---------------------------------------------------------------------- 
    910#if defined key_top 
    … …  
    1112   !!   'key_top'                                                TOP models 
    1213   !!---------------------------------------------------------------------- 
    13    !!   trc_adv      : compute ocean tracer advection trend 
    14    !!   trc_adv_ctl  : control the different options of advection scheme 
    15    !!---------------------------------------------------------------------- 
    16    USE oce_trc         ! ocean dynamics and active tracers 
    17    USE trc             ! ocean passive tracers variables 
    18    USE trcnam_trp      ! passive tracers transport namelist variables 
    19    USE traadv_cen2     ! 2nd order centered scheme (tra_adv_cen2   routine) 
    20    USE traadv_tvd      ! TVD      scheme           (tra_adv_tvd    routine) 
    21    USE traadv_muscl    ! MUSCL    scheme           (tra_adv_muscl  routine) 
    22    USE traadv_muscl2   ! MUSCL2   scheme           (tra_adv_muscl2 routine) 
    23    USE traadv_ubs      ! UBS      scheme           (tra_adv_ubs    routine) 
    24    USE traadv_qck      ! QUICKEST scheme           (tra_adv_qck    routine) 
    25    USE traadv_eiv      ! eddy induced velocity     (tra_adv_eiv    routine) 
    26    USE traadv_mle      ! ML eddy induced velocity  (tra_adv_mle    routine) 
    27    USE ldftra_oce      ! lateral diffusion coefficient on tracers 
    28    USE prtctl_trc      ! Print control 
     14   !!   trc_adv       : compute ocean tracer advection trend 
     15   !!   trc_adv_ini   : control the different options of advection scheme 
     16   !!---------------------------------------------------------------------- 
     17   USE oce_trc        ! ocean dynamics and active tracers 
     18   USE trc            ! ocean passive tracers variables 
     19   USE traadv_cen     ! centered scheme           (tra_adv_cen  routine) 
     20   USE traadv_fct     ! FCT      scheme           (tra_adv_fct  routine) 
     21   USE traadv_mus     ! MUSCL    scheme           (tra_adv_mus  routine) 
     22   USE traadv_ubs     ! UBS      scheme           (tra_adv_ubs  routine) 
     23   USE traadv_qck     ! QUICKEST scheme           (tra_adv_qck  routine) 
     24   USE traadv_mle     ! ML eddy induced velocity  (tra_adv_mle  routine) 
     25   USE ldftra         ! lateral diffusion coefficient on tracers 
     26   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces 
     27   ! 
     28   USE prtctl_trc     ! Print control 
    2929 
    3030   IMPLICIT NONE 
    3131   PRIVATE 
    3232 
    33    PUBLIC   trc_adv          ! routine called by step module 
    34    PUBLIC   trc_adv_alloc    ! routine called by nemogcm module 
    35  
    36    INTEGER ::   nadv   ! choice of the type of advection scheme 
     33   PUBLIC   trc_adv        
     34   PUBLIC   trc_adv_alloc  
     35   PUBLIC   trc_adv_ini   
     36 
     37   !                            !!* Namelist namtrc_adv * 
     38   LOGICAL ::   ln_trcadv_cen    ! centered scheme flag 
     39   INTEGER ::      nn_cen_h, nn_cen_v   ! =2/4 : horizontal and vertical choices of the order of CEN scheme 
     40   LOGICAL ::   ln_trcadv_fct    ! FCT scheme flag 
     41   INTEGER ::      nn_fct_h, nn_fct_v   ! =2/4 : horizontal and vertical choices of the order of FCT scheme 
     42   INTEGER ::      nn_fct_zts           ! >=1 : 2nd order FCT with vertical sub-timestepping 
     43   LOGICAL ::   ln_trcadv_mus    ! MUSCL scheme flag 
     44   LOGICAL ::      ln_mus_ups           ! use upstream scheme in vivcinity of river mouths 
     45   LOGICAL ::   ln_trcadv_ubs    ! UBS scheme flag 
     46   INTEGER ::      nn_ubs_v             ! =2/4 : vertical choice of the order of UBS scheme 
     47   LOGICAL ::   ln_trcadv_qck    ! QUICKEST scheme flag 
     48 
     49   !                                        ! choices of advection scheme: 
     50   INTEGER, PARAMETER ::   np_NO_adv  = 0   ! no T-S advection 
     51   INTEGER, PARAMETER ::   np_CEN     = 1   ! 2nd/4th order centered scheme 
     52   INTEGER, PARAMETER ::   np_FCT     = 2   ! 2nd/4th order Flux Corrected Transport scheme 
     53   INTEGER, PARAMETER ::   np_FCT_zts = 3   ! 2nd order FCT scheme with vertical sub-timestepping 
     54   INTEGER, PARAMETER ::   np_MUS     = 4   ! MUSCL scheme 
     55   INTEGER, PARAMETER ::   np_UBS     = 5   ! 3rd order Upstream Biased Scheme 
     56   INTEGER, PARAMETER ::   np_QCK     = 6   ! QUICK scheme 
     57 
     58   INTEGER ::              nadv             ! chosen advection scheme 
     59   ! 
    3760   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt  ! vertical profile time-step, = 2 rdttra 
    3861   !                                                    ! except at nitrrc000 (=rdttra) if neuler=0 
    … …  
    4265#  include "vectopt_loop_substitute.h90" 
    4366   !!---------------------------------------------------------------------- 
    44    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     67   !! NEMO/TOP 3.7 , NEMO Consortium (2015) 
    4568   !! $Id$  
    4669   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    5275      !!                  ***  ROUTINE trc_adv_alloc  *** 
    5376      !!---------------------------------------------------------------------- 
    54  
     77      ! 
    5578      ALLOCATE( r2dt(jpk), STAT=trc_adv_alloc ) 
    56  
     79      ! 
    5780      IF( trc_adv_alloc /= 0 ) CALL ctl_warn('trc_adv_alloc : failed to allocate array.') 
    58  
     81      ! 
    5982   END FUNCTION trc_adv_alloc 
    6083 
    … …  
    6891      !! ** Method  : - Update the tracer with the advection term following nadv 
    6992      !!---------------------------------------------------------------------- 
    70       !! 
    7193      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    7294      ! 
    73       INTEGER ::   jk  
     95      INTEGER ::   jk   ! dummy loop index 
    7496      CHARACTER (len=22) ::   charout 
    7597      REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn  ! effective velocity 
    7698      !!---------------------------------------------------------------------- 
    7799      ! 
    78       IF( nn_timing == 1 )  CALL timing_start('trc_adv') 
    79       ! 
    80       CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn ) 
    81       ! 
    82  
    83       IF( kt == nittrc000 )   CALL trc_adv_ctl          ! initialisation & control of options 
    84  
     100      IF( nn_timing == 1 )   CALL timing_start('trc_adv') 
     101      ! 
     102      CALL wrk_alloc( jpi,jpj,jpk,   zun, zvn, zwn ) 
     103      ! 
    85104      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000 
    86105         r2dt(:) =  rdttrc(:)           ! = rdttrc (use or restarting with Euler time stepping) 
    … …  
    88107         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog) 
    89108      ENDIF 
    90       !                                                   ! effective transport 
     109      !                                               !==  effective transport  ==! 
    91110      DO jk = 1, jpkm1 
    92          !                                                ! eulerian transport only 
    93          zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk) 
     111         zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk)                   ! eulerian transport 
    94112         zvn(:,:,jk) = e1v  (:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
    95113         zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
    96          ! 
    97114      END DO 
    98115      ! 
    99       IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 
     116      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                 ! add z-tilde and/or vvl corrections 
    100117         zun(:,:,:) = zun(:,:,:) + un_td(:,:,:) 
    101118         zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:) 
    102119      ENDIF 
    103120      ! 
    104       zun(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
    105       zvn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
    106       zwn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
    107  
    108       IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   &  ! add the eiv transport (if necessary) 
    109          &              CALL tra_adv_eiv( kt, nittrc000, zun, zvn, zwn, 'TRC' ) 
    110       ! 
    111       IF( ln_mle    )   CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' )    ! add the mle transport (if necessary) 
    112       ! 
    113       SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==! 
    114       CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )   !  2nd order centered 
    115       CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  TVD  
    116       CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra, ln_trcadv_msc_ups )   !  MUSCL  
    117       CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  MUSCL2  
    118       CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  UBS  
    119       CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  QUICKEST  
    120       ! 
    121       CASE (-1 )                                      !==  esopa: test all possibility with control print  ==! 
    122          CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )           
    123          WRITE(charout, FMT="('adv1')")  ; CALL prt_ctl_trc_info(charout) 
    124                                            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    125          CALL tra_adv_tvd   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
    126          WRITE(charout, FMT="('adv2')")  ; CALL prt_ctl_trc_info(charout) 
    127                                            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    128          CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra, ln_trcadv_msc_ups  )           
    129          WRITE(charout, FMT="('adv3')")  ; CALL prt_ctl_trc_info(charout) 
    130                                            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    131          CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
    132          WRITE(charout, FMT="('adv4')")  ; CALL prt_ctl_trc_info(charout) 
    133                                            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    134          CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
    135          WRITE(charout, FMT="('adv5')")  ; CALL prt_ctl_trc_info(charout) 
    136                                            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    137          CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
    138          WRITE(charout, FMT="('adv6')")  ; CALL prt_ctl_trc_info(charout) 
    139                                            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    140          ! 
     121      IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   &  
     122         &              CALL ldf_eiv_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the eiv transport 
     123      ! 
     124      IF( ln_mle    )   CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the mle transport 
     125      ! 
     126      zun(:,:,jpk) = 0._wp                                                       ! no transport trough the bottom 
     127      zvn(:,:,jpk) = 0._wp 
     128      zwn(:,:,jpk) = 0._wp 
     129      ! 
     130      ! 
     131      SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==! 
     132      ! 
     133      CASE ( np_CEN )                                    ! Centered : 2nd / 4th order 
     134         CALL tra_adv_cen    ( kt, nittrc000,'TRC',       zun, zvn, zwn     , trn, tra, jptra, nn_cen_h, nn_cen_v ) 
     135      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 ) 
     137      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 ) 
     139      CASE ( np_MUS )                                    ! MUSCL 
     140         CALL tra_adv_mus    ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra        , ln_mus_ups )  
     141      CASE ( np_UBS )                                    ! UBS 
     142         CALL tra_adv_ubs    ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra        , nn_ubs_v   ) 
     143      CASE ( np_QCK )                                    ! QUICKEST 
     144         CALL tra_adv_qck    ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra                     ) 
     145      ! 
    141146      END SELECT 
    142  
    143       !                                              ! print mean trends (used for debugging) 
    144       IF( ln_ctl )   THEN 
     147      !                   
     148      IF( ln_ctl )   THEN                             !== print mean trends (used for debugging) 
    145149         WRITE(charout, FMT="('adv ')")  ;  CALL prt_ctl_trc_info(charout) 
    146150                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    147151      END IF 
    148152      ! 
    149       CALL wrk_dealloc( jpi, jpj, jpk, zun, zvn, zwn ) 
     153      CALL wrk_dealloc( jpi,jpj,jpk,  zun, zvn, zwn ) 
    150154      ! 
    151155      IF( nn_timing == 1 )  CALL timing_stop('trc_adv') 
    … …  
    154158 
    155159 
    156    SUBROUTINE trc_adv_ctl 
     160   SUBROUTINE trc_adv_ini 
    157161      !!--------------------------------------------------------------------- 
    158       !!                  ***  ROUTINE trc_adv_ctl  *** 
     162      !!                  ***  ROUTINE trc_adv_ini  *** 
    159163      !!                 
    160164      !! ** Purpose : Control the consistency between namelist options for  
    … …  
    162166      !!---------------------------------------------------------------------- 
    163167      INTEGER ::   ioptio 
    164       !!---------------------------------------------------------------------- 
    165  
    166       ioptio = 0                      ! Parameter control 
    167       IF( ln_trcadv_cen2   )   ioptio = ioptio + 1 
    168       IF( ln_trcadv_tvd    )   ioptio = ioptio + 1 
    169       IF( ln_trcadv_muscl  )   ioptio = ioptio + 1 
    170       IF( ln_trcadv_muscl2 )   ioptio = ioptio + 1 
    171       IF( ln_trcadv_ubs    )   ioptio = ioptio + 1 
    172       IF( ln_trcadv_qck    )   ioptio = ioptio + 1 
    173       IF( lk_esopa         )   ioptio =          1 
    174  
     168      INTEGER ::  ios                 ! Local integer output status for namelist read 
     169      !! 
     170      NAMELIST/namtrc_adv/ ln_trcadv_cen, nn_cen_h, nn_cen_v,               &   ! CEN 
     171         &                 ln_trcadv_fct, nn_fct_h, nn_fct_v, nn_fct_zts,   &   ! FCT 
     172         &                 ln_trcadv_mus,                     ln_mus_ups,   &   ! MUSCL 
     173         &                 ln_trcadv_ubs,           nn_ubs_v,               &   ! UBS 
     174         &                 ln_trcadv_qck                                        ! QCK 
     175      !!---------------------------------------------------------------------- 
     176      ! 
     177      REWIND( numnat_ref )              !  namtrc_adv in reference namelist  
     178      READ  ( numnat_ref, namtrc_adv, IOSTAT = ios, ERR = 901) 
     179901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in reference namelist', lwp ) 
     180 
     181      REWIND( numnat_cfg )              ! namtrc_adv in configuration namelist 
     182      READ  ( numnat_cfg, namtrc_adv, IOSTAT = ios, ERR = 902 ) 
     183902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist', lwp ) 
     184      IF(lwm) WRITE ( numont, namtrc_adv ) 
     185 
     186      IF(lwp) THEN                    ! Namelist print 
     187         WRITE(numout,*) 
     188         WRITE(numout,*) 'trc_adv_ini : choice/control of the tracer advection scheme' 
     189         WRITE(numout,*) '~~~~~~~~~~~' 
     190         WRITE(numout,*) '   Namelist namtrc_adv : chose a advection scheme for tracers' 
     191         WRITE(numout,*) '      centered scheme                           ln_trcadv_cen = ', ln_trcadv_cen 
     192         WRITE(numout,*) '            horizontal 2nd/4th order               nn_cen_h   = ', nn_fct_h 
     193         WRITE(numout,*) '            vertical   2nd/4th order               nn_cen_v   = ', nn_fct_v 
     194         WRITE(numout,*) '      Flux Corrected Transport scheme           ln_trcadv_fct = ', ln_trcadv_fct 
     195         WRITE(numout,*) '            horizontal 2nd/4th order               nn_fct_h   = ', nn_fct_h 
     196         WRITE(numout,*) '            vertical   2nd/4th order               nn_fct_v   = ', nn_fct_v 
     197         WRITE(numout,*) '            2nd order + vertical sub-timestepping  nn_fct_zts = ', nn_fct_zts 
     198         WRITE(numout,*) '      MUSCL scheme                              ln_trcadv_mus = ', ln_trcadv_mus 
     199         WRITE(numout,*) '            + upstream scheme near river mouths    ln_mus_ups = ', ln_mus_ups 
     200         WRITE(numout,*) '      UBS scheme                                ln_trcadv_ubs = ', ln_trcadv_ubs 
     201         WRITE(numout,*) '            vertical   2nd/4th order               nn_ubs_v   = ', nn_ubs_v 
     202         WRITE(numout,*) '      QUICKEST scheme                           ln_trcadv_qck = ', ln_trcadv_qck 
     203      ENDIF 
     204      ! 
     205 
     206      ioptio = 0                       !==  Parameter control  ==! 
     207      IF( ln_trcadv_cen )   ioptio = ioptio + 1 
     208      IF( ln_trcadv_fct )   ioptio = ioptio + 1 
     209      IF( ln_trcadv_mus )   ioptio = ioptio + 1 
     210      IF( ln_trcadv_ubs )   ioptio = ioptio + 1 
     211      IF( ln_trcadv_qck )   ioptio = ioptio + 1 
     212 
     213      ! 
     214      IF( ioptio == 0 ) THEN 
     215         nadv = np_NO_adv 
     216         CALL ctl_warn( 'trc_adv_init: You are running without tracer advection.' ) 
     217      ENDIF 
    175218      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namtrc_adv' ) 
    176  
    177       !                              ! Set nadv 
    178       IF( ln_trcadv_cen2   )   nadv =  1 
    179       IF( ln_trcadv_tvd    )   nadv =  2 
    180       IF( ln_trcadv_muscl  )   nadv =  3 
    181       IF( ln_trcadv_muscl2 )   nadv =  4 
    182       IF( ln_trcadv_ubs    )   nadv =  5 
    183       IF( ln_trcadv_qck    )   nadv =  6 
    184       IF( lk_esopa         )   nadv = -1 
    185  
     219      ! 
     220      IF( ln_trcadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 )   & 
     221                        .AND. ( nn_cen_v /= 2 .AND. nn_cen_v /= 4 )   ) THEN 
     222        CALL ctl_stop( 'trc_adv_init: CEN scheme, choose 2nd or 4th order' ) 
     223      ENDIF 
     224      IF( ln_trcadv_fct .AND. ( nn_fct_h /= 2 .AND. nn_fct_h /= 4 )   & 
     225                        .AND. ( nn_fct_v /= 2 .AND. nn_fct_v /= 4 )   ) THEN 
     226        CALL ctl_stop( 'trc_adv_init: FCT scheme, choose 2nd or 4th order' ) 
     227      ENDIF 
     228      IF( ln_trcadv_fct .AND. nn_fct_zts > 0 ) THEN 
     229         IF( nn_fct_h == 4 ) THEN 
     230            nn_fct_h = 2 
     231            CALL ctl_stop( 'trc_adv_init: force 2nd order FCT scheme, 4th order does not exist with sub-timestepping' ) 
     232         ENDIF 
     233         IF( lk_vvl ) THEN 
     234            CALL ctl_stop( 'trc_adv_init: vertical sub-timestepping not allow in non-linear free surface' ) 
     235         ENDIF 
     236         IF( nn_fct_zts == 1 )   CALL ctl_warn( 'trc_adv_init: FCT with ONE sub-timestep = FCT without sub-timestep' ) 
     237      ENDIF 
     238      IF( ln_trcadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 )   ) THEN 
     239        CALL ctl_stop( 'trc_adv_init: UBS scheme, choose 2nd or 4th order' ) 
     240      ENDIF 
     241      IF( ln_trcadv_ubs .AND. nn_ubs_v == 4 ) THEN 
     242         CALL ctl_warn( 'trc_adv_init: UBS scheme, only 2nd FCT scheme available on the vertical. It will be used' ) 
     243      ENDIF 
     244      IF( ln_isfcav ) THEN                                                       ! ice-shelf cavities 
     245         IF(  ln_trcadv_cen .AND. nn_cen_v /= 4    .OR.   &                            ! NO 4th order with ISF 
     246            & ln_trcadv_fct .AND. nn_fct_v /= 4   )   CALL ctl_stop( 'tra_adv_init: 4th order COMPACT scheme not allowed with ISF' ) 
     247      ENDIF 
     248      ! 
     249      !                                !==  used advection scheme  ==! 
     250      !                                      ! set nadv 
     251      IF( ln_trcadv_cen                      )   nadv = np_CEN 
     252      IF( ln_trcadv_fct                      )   nadv = np_FCT 
     253      IF( ln_trcadv_fct .AND. nn_fct_zts > 0 )   nadv = np_FCT_zts 
     254      IF( ln_trcadv_mus                      )   nadv = np_MUS 
     255      IF( ln_trcadv_ubs                      )   nadv = np_UBS 
     256      IF( ln_trcadv_qck                      )   nadv = np_QCK 
     257      ! 
    186258      IF(lwp) THEN                   ! Print the choice 
    187259         WRITE(numout,*) 
    188          IF( nadv ==  1 )   WRITE(numout,*) '         2nd order scheme is used' 
    189          IF( nadv ==  2 )   WRITE(numout,*) '         TVD       scheme is used' 
    190          IF( nadv ==  3 )   WRITE(numout,*) '         MUSCL     scheme is used' 
    191          IF( nadv ==  4 )   WRITE(numout,*) '         MUSCL2    scheme is used' 
    192          IF( nadv ==  5 )   WRITE(numout,*) '         UBS       scheme is used' 
    193          IF( nadv ==  6 )   WRITE(numout,*) '         QUICKEST  scheme is used' 
    194          IF( nadv == -1 )   WRITE(numout,*) '         esopa test: use all advection scheme' 
    195       ENDIF 
    196       ! 
    197    END SUBROUTINE trc_adv_ctl 
     260         IF( nadv == np_NO_adv  )   WRITE(numout,*) '         NO passive tracer advection' 
     261         IF( nadv == np_CEN     )   WRITE(numout,*) '         CEN      scheme is used. Horizontal order: ', nn_cen_h,   & 
     262            &                                                                        ' Vertical   order: ', nn_cen_v 
     263         IF( nadv == np_FCT     )   WRITE(numout,*) '         FCT      scheme is used. Horizontal order: ', nn_fct_h,   & 
     264            &                                                                       ' Vertical   order: ', nn_fct_v 
     265         IF( nadv == np_FCT_zts )   WRITE(numout,*) '         use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping' 
     266         IF( nadv == np_MUS     )   WRITE(numout,*) '         MUSCL    scheme is used' 
     267         IF( nadv == np_UBS     )   WRITE(numout,*) '         UBS      scheme is used' 
     268         IF( nadv == np_QCK     )   WRITE(numout,*) '         QUICKEST scheme is used' 
     269      ENDIF 
     270      ! 
     271   END SUBROUTINE trc_adv_ini 
    198272    
    199273#else 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90

    r4990 r5870  
    2222   USE oce_trc             ! ocean dynamics and active tracers variables 
    2323   USE trc                 ! ocean passive tracers variables 
    24    USE trcnam_trp      ! passive tracers transport namelist variables 
    2524   USE trabbl              !  
    2625   USE prtctl_trc          ! Print control for debbuging 
    … …  
    3029   PUBLIC   trc_bbl       !  routine called by step.F90 
    3130 
    32  
    33    !! * Substitutions 
    34 #  include "top_substitute.h90" 
    3531   !!---------------------------------------------------------------------- 
    3632   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    r5506 r5870  
    1818   USE oce_trc         ! ocean dynamics and tracers variables 
    1919   USE trc             ! ocean passive tracers variables 
    20    USE trcnam_trp      ! passive tracers transport namelist variables 
    2120   USE trcdta 
    2221   USE tradmp 
    … …  
    2928   PRIVATE 
    3029 
    31    PUBLIC trc_dmp            ! routine called by step.F90 
    32    PUBLIC trc_dmp_clo        ! routine called by step.F90 
    33    PUBLIC trc_dmp_alloc      ! routine called by nemogcm.F90 
     30   PUBLIC trc_dmp       
     31   PUBLIC trc_dmp_clo    
     32   PUBLIC trc_dmp_alloc   
     33   PUBLIC trc_dmp_ini     
     34 
     35   INTEGER , PUBLIC ::   nn_zdmp_tr    ! = 0/1/2 flag for damping in the mixed layer 
     36   CHARACTER(LEN=200) , PUBLIC :: cn_resto_tr    !File containing restoration coefficient 
    3437 
    3538   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   restotr   ! restoring coeff. on tracers (s-1) 
    … …  
    4043 
    4144   !! * Substitutions 
    42 #  include "top_substitute.h90" 
     45#  include "domzgr_substitute.h90" 
     46#  include "vectopt_loop_substitute.h90" 
    4347   !!---------------------------------------------------------------------- 
    4448   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    9094      IF( nn_timing == 1 )  CALL timing_start('trc_dmp') 
    9195      ! 
    92       ! 0. Initialization (first time-step only) 
    93       !    -------------- 
    94       IF( kt == nittrc000 ) CALL trc_dmp_init 
    95  
    9696      IF( l_trdtrc )   CALL wrk_alloc( jpi, jpj, jpk, ztrtrd )   ! temporary save of trends 
    9797      ! 
    … …  
    171171   END SUBROUTINE trc_dmp 
    172172 
     173   SUBROUTINE trc_dmp_ini 
     174      !!---------------------------------------------------------------------- 
     175      !!                  ***  ROUTINE trc_dmp_ini  *** 
     176      !!  
     177      !! ** Purpose :   Initialization for the newtonian damping  
     178      !! 
     179      !! ** Method  :   read the nammbf namelist and check the parameters 
     180      !!              called by trc_dmp at the first timestep (nittrc000) 
     181      !!---------------------------------------------------------------------- 
     182      ! 
     183      INTEGER ::  ios                 ! Local integer output status for namelist read 
     184      INTEGER :: imask  !local file handle 
     185      ! 
     186      NAMELIST/namtrc_dmp/ nn_zdmp_tr , cn_resto_tr 
     187      !!---------------------------------------------------------------------- 
     188 
     189      IF( nn_timing == 1 )  CALL timing_start('trc_dmp_init') 
     190      ! 
     191 
     192      REWIND( numnat_ref )              ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping 
     193      READ  ( numnat_ref, namtrc_dmp, IOSTAT = ios, ERR = 909) 
     194909   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in reference namelist', lwp ) 
     195 
     196      REWIND( numnat_cfg )              ! Namelist namtrc_dmp in configuration namelist : Passive tracers newtonian damping 
     197      READ  ( numnat_cfg, namtrc_dmp, IOSTAT = ios, ERR = 910) 
     198910   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in configuration namelist', lwp ) 
     199      IF(lwm) WRITE ( numont, namtrc_dmp ) 
     200 
     201      IF(lwp) THEN                       ! Namelist print 
     202         WRITE(numout,*) 
     203         WRITE(numout,*) 'trc_dmp : Passive tracers newtonian damping' 
     204         WRITE(numout,*) '~~~~~~~' 
     205         WRITE(numout,*) '   Namelist namtrc_dmp : set damping parameter' 
     206         WRITE(numout,*) '      mixed layer damping option     nn_zdmp_tr = ', nn_zdmp_tr, '(zoom: forced to 0)' 
     207         WRITE(numout,*) '      Restoration coeff file    cn_resto_tr = ', cn_resto_tr 
     208      ENDIF 
     209      ! 
     210      IF( lzoom .AND. .NOT.lk_c1d )   nn_zdmp_tr = 0           ! restoring to climatology at closed north or south boundaries 
     211      SELECT CASE ( nn_zdmp_tr ) 
     212      CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column' 
     213      CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline (avt > 5 cm2/s)' 
     214      CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer' 
     215      CASE DEFAULT 
     216         WRITE(ctmp1,*) 'bad flag value for nn_zdmp_tr = ', nn_zdmp_tr 
     217         CALL ctl_stop(ctmp1) 
     218      END SELECT 
     219 
     220      IF( .NOT.lk_c1d ) THEN 
     221         IF( .NOT. ln_tradmp )   & 
     222            &   CALL ctl_stop( 'passive trace damping need ln_tradmp to compute damping coef.' ) 
     223         ! 
     224         !                          ! Read damping coefficients from file 
     225         !Read in mask from file 
     226         CALL iom_open ( cn_resto_tr, imask) 
     227         CALL iom_get  ( imask, jpdom_autoglo, 'resto', restotr) 
     228         CALL iom_close( imask ) 
     229         ! 
     230      ENDIF 
     231      IF( nn_timing == 1 )  CALL timing_stop('trc_dmp_init') 
     232      ! 
     233   END SUBROUTINE trc_dmp_ini 
     234 
    173235   SUBROUTINE trc_dmp_clo( kt ) 
    174236      !!--------------------------------------------------------------------- 
    … …  
    303365 
    304366 
    305    SUBROUTINE trc_dmp_init 
    306       !!---------------------------------------------------------------------- 
    307       !!                  ***  ROUTINE trc_dmp_init  *** 
    308       !!  
    309       !! ** Purpose :   Initialization for the newtonian damping  
    310       !! 
    311       !! ** Method  :   read the nammbf namelist and check the parameters 
    312       !!              called by trc_dmp at the first timestep (nittrc000) 
    313       !!---------------------------------------------------------------------- 
    314       ! 
    315       INTEGER :: imask  !local file handle 
    316  
    317       IF( nn_timing == 1 )  CALL timing_start('trc_dmp_init') 
    318       ! 
    319  
    320       IF( lzoom )   nn_zdmp_tr = 0           ! restoring to climatology at closed north or south boundaries 
    321       SELECT CASE ( nn_zdmp_tr ) 
    322       CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column' 
    323       CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline (avt > 5 cm2/s)' 
    324       CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer' 
    325       CASE DEFAULT 
    326          WRITE(ctmp1,*) 'bad flag value for nn_zdmp_tr = ', nn_zdmp_tr 
    327          CALL ctl_stop(ctmp1) 
    328       END SELECT 
    329  
    330       IF( .NOT. ln_tradmp )   & 
    331          &   CALL ctl_stop( 'passive trace damping need key_tradmp to compute damping coef.' ) 
    332       ! 
    333       !                          ! Read damping coefficients from file 
    334       !Read in mask from file 
    335       CALL iom_open ( cn_resto_tr, imask) 
    336       CALL iom_get  ( imask, jpdom_autoglo, 'resto', restotr) 
    337       CALL iom_close( imask ) 
    338       ! 
    339       IF( nn_timing == 1 )  CALL timing_stop('trc_dmp_init') 
    340       ! 
    341    END SUBROUTINE trc_dmp_init 
    342  
    343367#else 
    344368   !!---------------------------------------------------------------------- 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90

    r5385 r5870  
    44   !! Ocean Passive tracers : lateral diffusive trends 
    55   !!===================================================================== 
    6    !! History :  9.0  ! 2005-11 (G. Madec)  Original code 
    7    !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA 
     6   !! History :  1.0  ! 2005-11  (G. Madec)  Original code 
     7   !!            3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA 
     8   !!            3.7  ! 2014-03  (G. Madec)  LDF simplification 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_top 
    … …  
    1112   !!   'key_top'                                                TOP models 
    1213   !!---------------------------------------------------------------------- 
    13    !!---------------------------------------------------------------------- 
    14    !!   trc_ldf     : update the tracer trend with the lateral diffusion 
    15    !!       ldf_ctl : initialization, namelist read, and parameters control 
    16    !!---------------------------------------------------------------------- 
    17    USE oce_trc         ! ocean dynamics and active tracers 
    18    USE trc             ! ocean passive tracers variables 
    19    USE trcnam_trp      ! passive tracers transport namelist variables 
    20    USE ldftra_oce      ! lateral diffusion coefficient on tracers 
    21    USE ldfslp          ! ??? 
    22    USE traldf_bilapg   ! lateral mixing            (tra_ldf_bilapg routine) 
    23    USE traldf_bilap    ! lateral mixing            (tra_ldf_bilap routine) 
    24    USE traldf_iso      ! lateral mixing            (tra_ldf_iso routine) 
    25    USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine) 
    26    USE traldf_lap      ! lateral mixing            (tra_ldf_lap routine) 
    27    USE trd_oce 
    28    USE trdtra 
     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  
     26   ! 
    2927   USE prtctl_trc      ! Print control 
    3028 
    … …  
    3230   PRIVATE 
    3331 
    34    PUBLIC   trc_ldf    ! called by step.F90 
    35    !                                                 !!: ** lateral mixing namelist (nam_trcldf) ** 
    36    REAL(wp) ::  rldf_rat    ! ratio between active and passive tracers diffusive coefficient 
     32   PUBLIC   trc_ldf     
     33   PUBLIC   trc_ldf_ini    
     34   ! 
     35   LOGICAL , PUBLIC ::   ln_trcldf_lap       !:   laplacian operator 
     36   LOGICAL , PUBLIC ::   ln_trcldf_blp       !: bilaplacian operator 
     37   LOGICAL , PUBLIC ::   ln_trcldf_lev       !: iso-level   direction 
     38   LOGICAL , PUBLIC ::   ln_trcldf_hor       !: horizontal  direction (rotation to geopotential) 
     39   LOGICAL , PUBLIC ::   ln_trcldf_iso       !: iso-neutral direction (standard) 
     40   LOGICAL , PUBLIC ::   ln_trcldf_triad     !: iso-neutral direction (triad) 
     41   REAL(wp), PUBLIC ::   rn_ahtrc_0          !:   laplacian diffusivity coefficient for passive tracer [m2/s] 
     42   REAL(wp), PUBLIC ::   rn_bhtrc_0          !: bilaplacian      -          --     -       -   [m4/s] 
     43   ! 
     44                                                 !!: ** lateral mixing namelist (nam_trcldf) ** 
     45   REAL(wp) ::  rldf    ! ratio between active and passive tracers diffusive coefficient 
    3746   INTEGER  ::  nldf = 0   ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals) 
     47    
    3848   !! * Substitutions 
    3949#  include "domzgr_substitute.h90" 
    4050#  include "vectopt_loop_substitute.h90" 
    4151   !!---------------------------------------------------------------------- 
    42    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     52   !! NEMO/TOP 3.7 , NEMO Consortium (2014) 
    4353   !! $Id$ 
    4454   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4555   !!---------------------------------------------------------------------- 
    46  
    4756CONTAINS 
    4857 
    … …  
    5867      INTEGER            :: jn 
    5968      CHARACTER (len=22) :: charout 
     69      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zahu, zahv 
    6070      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd 
    6171      !!---------------------------------------------------------------------- 
    … …  
    6373      IF( nn_timing == 1 )   CALL timing_start('trc_ldf') 
    6474      ! 
    65       IF( kt == nittrc000 )   CALL ldf_ctl          ! initialisation & control of options 
    66  
    67       rldf = rldf_rat 
    68  
    6975      IF( l_trdtrc )  THEN 
    70          CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) 
     76         CALL wrk_alloc( jpi,jpj,jpk,jptra,  ztrtrd ) 
    7177         ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
    7278      ENDIF 
    73  
    74       SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend 
    75       CASE ( 0 )   ;   CALL tra_ldf_lap   ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra        )  ! iso-level laplacian 
    76       CASE ( 1 )                                                                                            ! rotated laplacian 
    77                        IF( ln_traldf_grif ) THEN 
    78                           CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 
    79                        ELSE 
    80                           CALL tra_ldf_iso     ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, rn_ahtb_0 ) 
    81                        ENDIF 
    82       CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra            )  ! iso-level bilaplacian 
    83       CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt, nittrc000, 'TRC',             trb, tra, jptra            )  ! s-coord. horizontal bilaplacian 
    84          ! 
    85       CASE ( -1 )                                     ! esopa: test all possibility with control print 
    86          CALL tra_ldf_lap   ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra            ) 
    87          WRITE(charout, FMT="('ldf0 ')") ;  CALL prt_ctl_trc_info(charout) 
    88                                             CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    89          IF( ln_traldf_grif ) THEN 
    90             CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 
    91          ELSE 
    92             CALL tra_ldf_iso     ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, rn_ahtb_0 ) 
    93          ENDIF 
    94          WRITE(charout, FMT="('ldf1 ')") ;  CALL prt_ctl_trc_info(charout) 
    95                                             CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    96          CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra            ) 
    97          WRITE(charout, FMT="('ldf2 ')") ;  CALL prt_ctl_trc_info(charout) 
    98                                             CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    99          CALL tra_ldf_bilapg( kt, nittrc000, 'TRC',             trb, tra, jptra            ) 
    100          WRITE(charout, FMT="('ldf3 ')") ;  CALL prt_ctl_trc_info(charout) 
    101                                             CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     79      ! 
     80      !                                        !* set the lateral diffusivity coef. for passive tracer       
     81      CALL wrk_alloc( jpi,jpj,jpk,   zahu, zahv ) 
     82      zahu(:,:,:) = rldf * ahtu(:,:,:) 
     83      zahv(:,:,:) = rldf * ahtv(:,:,:) 
     84 
     85      SELECT CASE ( nldf )                     !* compute lateral mixing trend and add it to the general trend 
     86      ! 
     87      CASE ( np_lap   )                               ! iso-level laplacian 
     88         CALL tra_ldf_lap  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb,      tra, jptra,  1   ) 
     89         ! 
     90      CASE ( np_lap_i )                               ! laplacian : standard iso-neutral operator (Madec) 
     91         CALL tra_ldf_iso  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra,  1   ) 
     92         ! 
     93      CASE ( np_lap_it )                              ! laplacian : triad iso-neutral operator (griffies) 
     94         CALL tra_ldf_triad( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra,  1   ) 
     95         ! 
     96      CASE ( np_blp , np_blp_i , np_blp_it )          ! bilaplacian: all operator (iso-level, -neutral) 
     97         CALL tra_ldf_blp  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb     , tra, jptra, nldf ) 
     98         ! 
    10299      END SELECT 
    103100      ! 
    104       IF( l_trdtrc )   THEN                      ! save the horizontal diffusive trends for further diagnostics 
     101      IF( l_trdtrc )   THEN                    ! save the horizontal diffusive trends for further diagnostics 
    105102        DO jn = 1, jptra 
    106103           ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 
    … …  
    109106        CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) 
    110107      ENDIF 
    111       !                                          ! print mean trends (used for debugging) 
    112       IF( ln_ctl )   THEN 
    113          WRITE(charout, FMT="('ldf ')") ;  CALL prt_ctl_trc_info(charout) 
    114                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    115       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' ) 
     112      ENDIF 
     113      ! 
     114      CALL wrk_dealloc( jpi,jpj,jpk,   zahu, zahv ) 
    116115      ! 
    117116      IF( nn_timing == 1 )   CALL timing_stop('trc_ldf') 
    … …  
    120119 
    121120 
    122    SUBROUTINE ldf_ctl 
     121   SUBROUTINE trc_ldf_ini 
    123122      !!---------------------------------------------------------------------- 
    124123      !!                  ***  ROUTINE ldf_ctl  *** 
    125124      !! 
    126       !! ** Purpose :   Choice of the operator for the lateral tracer diffusion 
     125      !! ** Purpose :   Define the operator for the lateral diffusion 
    127126      !! 
    128127      !! ** Method  :   set nldf from the namtra_ldf logicals 
    129       !!      nldf == -2   No lateral diffusion 
    130       !!      nldf == -1   ESOPA test: ALL operators are used 
    131128      !!      nldf ==  0   laplacian operator 
    132129      !!      nldf ==  1   Rotated laplacian operator 
    … …  
    134131      !!      nldf ==  3   Rotated bilaplacian 
    135132      !!---------------------------------------------------------------------- 
    136       INTEGER ::   ioptio, ierr         ! temporary integers 
    137       !!---------------------------------------------------------------------- 
    138  
    139       IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN 
    140          IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN 
    141             rldf_rat = 1.0_wp 
    142          ELSE 
    143             CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
    144          END IF 
    145       ELSE 
    146          rldf_rat = rn_ahtrc_0 / rn_aht_0 
    147       END IF 
    148       !  Define the lateral mixing oparator for tracers 
    149       ! =============================================== 
    150  
    151       !                               ! control the input 
     133      INTEGER ::   ioptio, ierr   ! temporary integers 
     134      INTEGER ::   ios            ! Local integer output status for namelist read 
     135      ! 
     136      NAMELIST/namtrc_ldf/ ln_trcldf_lap, ln_trcldf_blp,                                  & 
     137         &                 ln_trcldf_lev, ln_trcldf_hor, ln_trcldf_iso, ln_trcldf_triad,  & 
     138         &                 rn_ahtrc_0   , rn_bhtrc_0 
     139      !!---------------------------------------------------------------------- 
     140      REWIND( numnat_ref )              !  namtrc_ldf in reference namelist  
     141      READ  ( numnat_ref, namtrc_ldf, IOSTAT = ios, ERR = 903) 
     142903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in reference namelist', lwp ) 
     143 
     144      REWIND( numnat_cfg )              !  namtrc_ldf in configuration namelist  
     145      READ  ( numnat_cfg, namtrc_ldf, IOSTAT = ios, ERR = 904 ) 
     146904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist', lwp ) 
     147      IF(lwm) WRITE ( numont, namtrc_ldf ) 
     148 
     149      IF(lwp) THEN                    ! Namelist print 
     150         WRITE(numout,*) 
     151         WRITE(numout,*) 'trc_ldf_ini : lateral tracer diffusive operator' 
     152         WRITE(numout,*) '~~~~~~~~~~~' 
     153         WRITE(numout,*) '   Namelist namtrc_ldf : set lateral mixing parameters (type, direction, coefficients)' 
     154         WRITE(numout,*) '      operator' 
     155         WRITE(numout,*) '           laplacian                 ln_trcldf_lap   = ', ln_trcldf_lap 
     156         WRITE(numout,*) '         bilaplacian                 ln_trcldf_blp   = ', ln_trcldf_blp 
     157         WRITE(numout,*) '      direction of action' 
     158         WRITE(numout,*) '         iso-level                   ln_trcldf_lev   = ', ln_trcldf_lev 
     159         WRITE(numout,*) '         horizontal (geopotential)   ln_trcldf_hor   = ', ln_trcldf_hor 
     160         WRITE(numout,*) '         iso-neutral (standard)      ln_trcldf_iso   = ', ln_trcldf_iso 
     161         WRITE(numout,*) '         iso-neutral (triad)         ln_trcldf_triad = ', ln_trcldf_triad 
     162         WRITE(numout,*) '      diffusivity coefficient' 
     163         WRITE(numout,*) '           laplacian                 rn_ahtrc_0      = ', rn_ahtrc_0 
     164         WRITE(numout,*) '         bilaplacian                 rn_bhtrc_0      = ', rn_bhtrc_0 
     165      ENDIF 
     166      !       
     167      !                                ! control the namelist parameters 
    152168      ioptio = 0 
    153       IF( ln_trcldf_lap   )   ioptio = ioptio + 1 
    154       IF( ln_trcldf_bilap )   ioptio = ioptio + 1 
    155       IF( ioptio >  1 )   CALL ctl_stop( '          use ONE or NONE of the 2 lap/bilap operator type on tracer' ) 
    156       IF( ioptio == 0 )   nldf = -2   ! No lateral diffusion 
     169      IF( ln_trcldf_lap )   ioptio = ioptio + 1 
     170      IF( ln_trcldf_blp )   ioptio = ioptio + 1 
     171      IF( ioptio >  1   )   CALL ctl_stop( 'trc_ldf_ctl: use ONE or NONE of the 2 lap/bilap operator type on tracer' ) 
     172      IF( ioptio == 0   )   nldf = np_no_ldf   ! No lateral diffusion 
     173       
     174      IF( ln_trcldf_lap .AND. ln_trcldf_blp )   CALL ctl_stop( 'trc_ldf_ctl: bilaplacian should be used on both TRC and TRA' ) 
     175      IF( ln_trcldf_blp .AND. ln_trcldf_lap )   CALL ctl_stop( 'trc_ldf_ctl:   laplacian should be used on both TRC and TRA' ) 
     176       
    157177      ioptio = 0 
    158       IF( ln_trcldf_level )   ioptio = ioptio + 1 
    159       IF( ln_trcldf_hor   )   ioptio = ioptio + 1 
    160       IF( ln_trcldf_iso   )   ioptio = ioptio + 1 
    161       IF( ioptio /= 1 )   CALL ctl_stop( '          use only ONE direction (level/hor/iso)' ) 
     178      IF( ln_trcldf_lev )   ioptio = ioptio + 1 
     179      IF( ln_trcldf_hor )   ioptio = ioptio + 1 
     180      IF( ln_trcldf_iso )   ioptio = ioptio + 1 
     181      IF( ioptio /= 1   )   CALL ctl_stop( 'trc_ldf_ctl: use only ONE direction (level/hor/iso)' ) 
    162182 
    163183      ! defined the type of lateral diffusion from ln_trcldf_... logicals 
    164184      ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully 
    165185      ierr = 0 
    166       IF( ln_trcldf_lap ) THEN       ! laplacian operator 
     186      IF( ln_trcldf_lap ) THEN      !==  laplacian operator  ==! 
    167187         IF ( ln_zco ) THEN                ! z-coordinate 
    168             IF ( ln_trcldf_level )   nldf = 0      ! iso-level  (no rotation) 
    169             IF ( ln_trcldf_hor   )   nldf = 0      ! horizontal (no rotation) 
    170             IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation) 
    171          ENDIF 
    172          IF ( ln_zps ) THEN             ! z-coordinate 
    173             IF ( ln_trcldf_level )   ierr = 1      ! iso-level not allowed 
    174             IF ( ln_trcldf_hor   )   nldf = 0      ! horizontal (no rotation) 
    175             IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation) 
    176          ENDIF 
    177          IF ( ln_sco ) THEN             ! z-coordinate 
    178             IF ( ln_trcldf_level )   nldf = 0      ! iso-level  (no rotation) 
    179             IF ( ln_trcldf_hor   )   nldf = 1      ! horizontal (   rotation) 
    180             IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation) 
    181          ENDIF 
    182       ENDIF 
    183  
    184       IF( ln_trcldf_bilap ) THEN      ! bilaplacian operator 
     188            IF ( ln_trcldf_lev   )   nldf = np_lap     ! iso-level = horizontal (no rotation) 
     189            IF ( ln_trcldf_hor   )   nldf = np_lap     ! iso-level = horizontal (no rotation) 
     190            IF ( ln_trcldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard  (   rotation) 
     191            IF ( ln_trcldf_triad )   nldf = np_lap_it  ! iso-neutral: triad     (   rotation) 
     192         ENDIF 
     193         IF ( ln_zps ) THEN             ! z-coordinate with partial step 
     194            IF ( ln_trcldf_lev   )   ierr = 1         ! iso-level not allowed  
     195            IF ( ln_trcldf_hor   )   nldf = np_lap     ! horizontal (no rotation) 
     196            IF ( ln_trcldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard (rotation) 
     197            IF ( ln_trcldf_triad )   nldf = np_lap_it  ! iso-neutral: triad    (rotation) 
     198         ENDIF 
     199         IF ( ln_sco ) THEN             ! s-coordinate 
     200            IF ( ln_trcldf_lev   )   nldf = np_lap     ! iso-level  (no rotation) 
     201            IF ( ln_trcldf_hor   )   nldf = np_lap_it  ! horizontal (   rotation)       !!gm   a checker.... 
     202            IF ( ln_trcldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard (rotation) 
     203            IF ( ln_trcldf_triad )   nldf = np_lap_it  ! iso-neutral: triad    (rotation) 
     204         ENDIF 
     205         !                                ! 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 
     208               rldf = 1.0_wp 
     209            ELSE 
     210               CALL ctl_stop( 'STOP', 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
     211            ENDIF 
     212         ELSE 
     213            rldf = rn_ahtrc_0 / rn_aht_0 
     214         ENDIF 
     215      ENDIF 
     216      ! 
     217      IF( ln_trcldf_blp ) THEN      !==  bilaplacian operator  ==! 
    185218         IF ( ln_zco ) THEN                ! z-coordinate 
    186             IF ( ln_trcldf_level )   nldf = 2      ! iso-level  (no rotation) 
    187             IF ( ln_trcldf_hor   )   nldf = 2      ! horizontal (no rotation) 
    188             IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
    189          ENDIF 
    190          IF ( ln_zps ) THEN             ! z-coordinate 
    191             IF ( ln_trcldf_level )   ierr = 1      ! iso-level not allowed 
    192             IF ( ln_trcldf_hor   )   nldf = 2      ! horizontal (no rotation) 
    193             IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
    194          ENDIF 
    195          IF ( ln_sco ) THEN             ! z-coordinate 
    196             IF ( ln_trcldf_level )   nldf = 2      ! iso-level  (no rotation) 
    197             IF ( ln_trcldf_hor   )   nldf = 3      ! horizontal (   rotation) 
    198             IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
    199          ENDIF 
    200       ENDIF 
    201  
     219            IF ( ln_trcldf_lev   )   nldf = np_blp     ! iso-level = horizontal (no rotation) 
     220            IF ( ln_trcldf_hor   )   nldf = np_blp     ! iso-level = horizontal (no rotation) 
     221            IF ( ln_trcldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard (rotation) 
     222            IF ( ln_trcldf_triad )   nldf = np_blp_it  ! iso-neutral: triad    (rotation) 
     223         ENDIF 
     224         IF ( ln_zps ) THEN             ! z-coordinate with partial step 
     225            IF ( ln_trcldf_lev   )   ierr = 1         ! iso-level not allowed  
     226            IF ( ln_trcldf_hor   )   nldf = np_blp     ! horizontal (no rotation) 
     227            IF ( ln_trcldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard (rotation) 
     228            IF ( ln_trcldf_triad )   nldf = np_blp_it  ! iso-neutral: triad    (rotation) 
     229         ENDIF 
     230         IF ( ln_sco ) THEN             ! s-coordinate 
     231            IF ( ln_trcldf_lev   )   nldf = np_blp     ! iso-level  (no rotation) 
     232            IF ( ln_trcldf_hor   )   nldf = np_blp_it  ! horizontal (   rotation)       !!gm   a checker.... 
     233            IF ( ln_trcldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard (rotation) 
     234            IF ( ln_trcldf_triad )   nldf = np_blp_it  ! iso-neutral: triad    (rotation) 
     235         ENDIF 
     236         !                                ! 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 
     239               rldf = 1.0_wp 
     240            ELSE 
     241               CALL ctl_stop( 'STOP', 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
     242            ENDIF 
     243         ELSE 
     244            rldf = SQRT(  ABS( rn_bhtrc_0 / rn_bht_0 )  ) 
     245         ENDIF 
     246      ENDIF 
     247      ! 
    202248      IF( ierr == 1 )   CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' ) 
    203       IF( ierr == 2 )   CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' ) 
    204       IF( lk_traldf_eiv .AND. .NOT.ln_trcldf_iso )   & 
     249      IF( ln_ldfeiv .AND. .NOT.ln_trcldf_iso )   & 
    205250           CALL ctl_stop( '          eddy induced velocity on tracers',   & 
    206251           &              ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' ) 
    207252      IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation 
    208          IF( .NOT.lk_ldfslp )   CALL ctl_stop( '          the rotation of the diffusive tensor require key_ldfslp' ) 
    209 #if defined key_offline 
    210          l_traldf_rot = .TRUE.                 ! needed for trazdf_imp 
    211 #endif 
    212       ENDIF 
    213  
    214       IF( lk_esopa ) THEN 
    215          IF(lwp) WRITE(numout,*) '          esopa control: use all lateral physics options' 
    216          nldf = -1 
    217       ENDIF 
    218  
     253         IF( .NOT.l_ldfslp )   CALL ctl_stop( '          the rotation of the diffusive tensor require l_ldfslp' ) 
     254      ENDIF 
     255      ! 
    219256      IF(lwp) THEN 
    220257         WRITE(numout,*) 
    221          IF( nldf == -2 )   WRITE(numout,*) '          NO lateral diffusion' 
    222          IF( nldf == -1 )   WRITE(numout,*) '          ESOPA test All scheme used' 
    223          IF( nldf ==  0 )   WRITE(numout,*) '          laplacian operator' 
    224          IF( nldf ==  1 )   WRITE(numout,*) '          Rotated laplacian operator' 
    225          IF( nldf ==  2 )   WRITE(numout,*) '          bilaplacian operator' 
    226          IF( nldf ==  3 )   WRITE(numout,*) '          Rotated bilaplacian' 
    227       ENDIF 
    228  
    229       IF( ln_trcldf_bilap ) THEN 
    230          IF(lwp) WRITE(numout,*) '          biharmonic tracer diffusion' 
    231          IF( rn_ahtrc_0 > 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal diffusivity coef. rn_ahtrc_0 must be negative' ) 
    232       ELSE 
    233          IF(lwp) WRITE(numout,*) '          harmonic tracer diffusion (default)' 
    234          IF( rn_ahtrc_0 < 0 .AND. .NOT. lk_esopa )   CALL ctl_stop('The horizontal diffusivity coef. rn_ahtrc_0 must be positive' ) 
    235       ENDIF 
    236  
    237       ! ratio between active and passive tracers diffusive coef. 
    238       IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN 
    239          IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN 
    240             rldf_rat = 1.0_wp 
    241          ELSE 
    242             CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
    243          END IF 
    244       ELSE 
    245          rldf_rat = rn_ahtrc_0 / rn_aht_0 
    246       END IF 
    247       IF( rldf_rat < 0 ) THEN 
    248          IF( .NOT.lk_offline ) THEN  
    249             CALL ctl_stop( 'Choose the same type of diffusive scheme both for active & passive tracers' ) 
    250          ELSE 
    251             CALL ctl_stop( 'Change the sign of rn_aht_0 in namelist to -/+1' ) 
    252          ENDIF  
    253       ENDIF 
    254       ! 
    255    END SUBROUTINE ldf_ctl 
     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)' 
     265      ENDIF 
     266      ! 
     267   END SUBROUTINE trc_ldf_ini 
    256268#else 
    257269   !!---------------------------------------------------------------------- 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90

    r4990 r5870  
    2222   PRIVATE 
    2323 
    24    PUBLIC trc_rad         ! routine called by trcstp.F90 
    25  
    26    !! * Substitutions 
    27 #  include "top_substitute.h90" 
     24   PUBLIC trc_rad      
     25   PUBLIC trc_rad_ini   
     26 
     27   LOGICAL , PUBLIC ::   ln_trcrad           !: flag to artificially correct negative concentrations 
     28 
    2829   !!---------------------------------------------------------------------- 
    2930   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    7677      ! 
    7778   END SUBROUTINE trc_rad 
     79 
     80   SUBROUTINE trc_rad_ini 
     81      !!--------------------------------------------------------------------- 
     82      !!                  ***  ROUTINE trc _rad_ini *** 
     83      !! 
     84      !! ** Purpose : read  namelist options  
     85      !!---------------------------------------------------------------------- 
     86      INTEGER ::  ios                 ! Local integer output status for namelist read 
     87      NAMELIST/namtrc_rad/ ln_trcrad 
     88      !!---------------------------------------------------------------------- 
     89 
     90      ! 
     91      REWIND( numnat_ref )              ! namtrc_rad in reference namelist  
     92      READ  ( numnat_ref, namtrc_rad, IOSTAT = ios, ERR = 907) 
     93907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in reference namelist', lwp ) 
     94 
     95      REWIND( numnat_cfg )              ! namtrc_rad in configuration namelist  
     96      READ  ( numnat_cfg, namtrc_rad, IOSTAT = ios, ERR = 908 ) 
     97908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in configuration namelist', lwp ) 
     98      IF(lwm) WRITE ( numont, namtrc_rad ) 
     99 
     100      IF(lwp) THEN                     !   ! Control print 
     101         WRITE(numout,*) 
     102         WRITE(numout,*) '   Namelist namtrc_rad : treatment of negative concentrations' 
     103         WRITE(numout,*) '      correct artificially negative concen. or not ln_trcrad = ', ln_trcrad 
     104      ENDIF 
     105      ! 
     106   END SUBROUTINE trc_rad_ini 
    78107 
    79108   SUBROUTINE trc_rad_sms( kt, ptrb, ptrn, jp_sms0, jp_sms1, cpreserv ) 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r5385 r5870  
    3131 
    3232   !! * Substitutions 
    33 #  include "top_substitute.h90" 
     33#  include "domzgr_substitute.h90" 
     34#  include "vectopt_loop_substitute.h90" 
    3435   !!---------------------------------------------------------------------- 
    3536   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    8384         CASE( 0    )   ;   zswitch = 1  ! (0) standard levitating sea-ice : salt exchange only 
    8485         CASE( 1, 2 )   ;   zswitch = 0  ! (1) levitating sea-ice: salt and volume exchange but no pressure effect                                 
    85                                          ! (2) embedded sea-ice : salt and volume fluxes and pressure 
     86      !                                  ! (2) embedded sea-ice : salt and volume fluxes and pressure 
    8687      END SELECT 
    8788 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    r5120 r5870  
    1515   USE oce_trc         ! ocean dynamics and active tracers variables 
    1616   USE trc             ! ocean passive tracers variables  
    17    USE trcnam_trp      ! passive tracers transport namelist variables 
    1817   USE trabbl          ! bottom boundary layer               (trc_bbl routine) 
    1918   USE trcbbl          ! bottom boundary layer               (trc_bbl routine) 
    20    USE zdfkpp          ! KPP non-local tracer fluxes         (trc_kpp routine) 
    2119   USE trcdmp          ! internal damping                    (trc_dmp routine) 
    2220   USE trcldf          ! lateral mixing                      (trc_ldf routine) 
    … …  
    3836   PUBLIC   trc_trp    ! called by trc_stp 
    3937 
    40    !! * Substitutions 
    41 #  include "top_substitute.h90" 
    4238   !!---------------------------------------------------------------------- 
    4339   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    4844CONTAINS 
    4945 
    50    SUBROUTINE trc_trp( kstp ) 
     46   SUBROUTINE trc_trp( kt ) 
    5147      !!---------------------------------------------------------------------- 
    5248      !!                     ***  ROUTINE trc_trp  *** 
    … …  
    5753      !!              - Update the passive tracers 
    5854      !!---------------------------------------------------------------------- 
    59       INTEGER, INTENT( in ) ::  kstp  ! ocean time-step index 
     55      INTEGER, INTENT( in ) ::  kt  ! ocean time-step index 
    6056      !! --------------------------------------------------------------------- 
    6157      ! 
    … …  
    6460      IF( .NOT. lk_c1d ) THEN 
    6561         ! 
    66                                 CALL trc_sbc( kstp )            ! surface boundary condition 
    67          IF( lk_trabbl )        CALL trc_bbl( kstp )            ! advective (and/or diffusive) bottom boundary layer scheme 
    68          IF( ln_trcdmp )        CALL trc_dmp( kstp )            ! internal damping trends 
    69          IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kstp )        ! internal damping trends on closed seas only 
    70                                 CALL trc_adv( kstp )            ! horizontal & vertical advection  
    71                                 CALL trc_ldf( kstp )            ! lateral mixing 
    72          IF( .NOT. lk_offline .AND. lk_zdfkpp )    & 
    73             &                   CALL trc_kpp( kstp )            ! KPP non-local tracer fluxes 
     62                                CALL trc_sbc    ( kt )      ! surface boundary condition 
     63         IF( lk_trabbl )        CALL trc_bbl    ( kt )      ! advective (and/or diffusive) bottom boundary layer scheme 
     64         IF( ln_trcdmp )        CALL trc_dmp    ( kt )      ! internal damping trends 
     65         IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kt )      ! internal damping trends on closed seas only 
     66                                CALL trc_adv    ( kt )      ! horizontal & vertical advection  
     67         !                                                         ! Partial top/bottom cell: GRADh( trb )   
     68         IF( ln_zps ) THEN 
     69           IF( ln_isfcav ) THEN ; CALL zps_hde_isf( kt, jptra, trb, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )  ! both top & bottom 
     70           ELSE                 ; CALL zps_hde    ( kt, jptra, trb, gtru, gtrv )                                      !  only bottom 
     71           ENDIF 
     72         ENDIF 
     73         !                                                       
     74                                CALL trc_ldf    ( kt )      ! lateral mixing 
    7475#if defined key_agrif 
    75          IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc           ! tracers sponge 
     76         IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc       ! tracers sponge 
    7677#endif 
    77                                 CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields 
    78                                 CALL trc_nxt( kstp )            ! tracer fields at next time step      
    79          IF( ln_trcrad )        CALL trc_rad( kstp )            ! Correct artificial negative concentrations 
     78                                CALL trc_zdf    ( kt )      ! vertical mixing and after tracer fields 
     79                                CALL trc_nxt    ( kt )      ! tracer fields at next time step      
     80         IF( ln_trcrad )        CALL trc_rad    ( kt )      ! Correct artificial negative concentrations 
    8081 
    8182#if defined key_agrif 
    82       IF( .NOT. Agrif_Root())   CALL Agrif_Update_Trc( kstp )  ! Update tracer at AGRIF zoom boundaries : children only 
     83         IF( .NOT.Agrif_Root()) CALL Agrif_Update_Trc( kt ) ! Update tracer at AGRIF zoom boundaries : children only 
    8384#endif 
    84  
    85          IF( ln_zps  .AND. .NOT. ln_isfcav)        & 
    86             &            CALL zps_hde    ( kstp, jptra, trn, gtru, gtrv )   ! Partial steps: now horizontal gradient of passive 
    87          IF( ln_zps .AND.        ln_isfcav)        & 
    88             &            CALL zps_hde_isf( kstp, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )  ! Partial steps: now horizontal gradient of passive 
    89                                                                 ! tracers at the bottom ocean level 
    9085         ! 
    9186      ELSE                                               ! 1D vertical configuration 
    92                                 CALL trc_sbc( kstp )            ! surface boundary condition 
    93          IF( .NOT. lk_offline .AND. lk_zdfkpp )    & 
    94             &                   CALL trc_kpp( kstp )            ! KPP non-local tracer fluxes 
    95                                 CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields 
    96                                 CALL trc_nxt( kstp )            ! tracer fields at next time step      
    97           IF( ln_trcrad )       CALL trc_rad( kstp )            ! Correct artificial negative concentrations 
     87                                CALL trc_sbc( kt )            ! surface boundary condition 
     88         IF( ln_trcdmp )        CALL trc_dmp( kt )            ! internal damping trends 
     89                                CALL trc_zdf( kt )            ! vertical mixing and after tracer fields 
     90                                CALL trc_nxt( kt )            ! tracer fields at next time step      
     91          IF( ln_trcrad )       CALL trc_rad( kt )            ! Correct artificial negative concentrations 
    9892         ! 
    9993      END IF 
    … …  
    108102   !!---------------------------------------------------------------------- 
    109103CONTAINS 
    110    SUBROUTINE trc_trp( kstp )              ! Empty routine 
    111       INTEGER, INTENT(in) ::   kstp 
    112       WRITE(*,*) 'trc_trp: You should not have seen this print! error?', kstp 
     104   SUBROUTINE trc_trp( kt )              ! Empty routine 
     105      INTEGER, INTENT(in) ::   kt 
     106      WRITE(*,*) 'trc_trp: You should not have seen this print! error?', kt 
    113107   END SUBROUTINE trc_trp 
    114108#endif 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90

    r5385 r5870  
    1111   !!   'key_top'                                                TOP models 
    1212   !!---------------------------------------------------------------------- 
    13    !!   trc_ldf     : update the tracer trend with the lateral diffusion 
    14    !!       ldf_ctl : initialization, namelist read, and parameters control 
     13   !!   trc_zdf      : update the tracer trend with the lateral diffusion 
     14   !!   trc_zdf_ini : initialization, namelist read, and parameters control 
    1515   !!---------------------------------------------------------------------- 
    16    USE oce_trc         ! ocean dynamics and active tracers 
    17    USE trc             ! ocean passive tracers variables 
    18    USE trcnam_trp      ! passive tracers transport namelist variables 
    19    USE trazdf_exp      ! vertical diffusion: explicit (tra_zdf_exp     routine) 
    20    USE trazdf_imp      ! vertical diffusion: implicit (tra_zdf_imp     routine) 
    21    USE trd_oce 
    22    USE trdtra 
    23    USE prtctl_trc      ! Print control 
     16   USE trc           ! ocean passive tracers variables 
     17   USE oce_trc       ! ocean dynamics and active tracers 
     18   USE trd_oce       ! trends: ocean variables 
     19   USE trazdf_exp    ! vertical diffusion: explicit (tra_zdf_exp     routine) 
     20   USE trazdf_imp    ! vertical diffusion: implicit (tra_zdf_imp     routine) 
     21   USE trcldf        ! passive tracers: lateral diffusion 
     22   USE trdtra        ! trends manager: tracers  
     23   USE prtctl_trc    ! Print control 
    2424 
    2525   IMPLICIT NONE 
    2626   PRIVATE 
    2727 
    28    PUBLIC   trc_zdf          ! called by step.F90  
    29    PUBLIC   trc_zdf_alloc    ! called by nemogcm.F90  
     28   PUBLIC   trc_zdf         ! called by step.F90  
     29   PUBLIC   trc_zdf_ini     ! called by nemogcm.F90  
     30   PUBLIC   trc_zdf_alloc   ! called by nemogcm.F90  
     31    
     32   !                                        !!** Vertical diffusion (nam_trczdf) ** 
     33   LOGICAL , PUBLIC ::   ln_trczdf_exp       !: explicit vertical diffusion scheme flag 
     34   INTEGER , PUBLIC ::   nn_trczdf_exp       !: number of sub-time step (explicit time stepping) 
    3035 
    3136   INTEGER ::   nzdf = 0               ! type vertical diffusion algorithm used 
    … …  
    3944#  include "vectopt_loop_substitute.h90" 
    4045   !!---------------------------------------------------------------------- 
    41    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     46   !! NEMO/TOP 3.7 , NEMO Consortium (2015) 
    4247   !! $Id$  
    4348   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    7176      IF( nn_timing == 1 )  CALL timing_start('trc_zdf') 
    7277      ! 
    73       IF( kt == nittrc000 )   CALL zdf_ctl          ! initialisation & control of options 
    74  
    7578      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000 
    7679         r2dt(:) =  rdttrc(:)           ! = rdttrc (use or restarting with Euler time stepping) 
    … …  
    8588 
    8689      SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend 
    87       CASE ( -1 )                                       ! esopa: test all possibility with control print 
    88          CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )  
    89          WRITE(charout, FMT="('zdf1 ')") ;  CALL prt_ctl_trc_info(charout) 
    90                                             CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    91          CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dt,                trb, tra, jptra )  
    92          WRITE(charout, FMT="('zdf2 ')") ;  CALL prt_ctl_trc_info(charout) 
    93                                             CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    9490      CASE ( 0 ) ;  CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )    !   explicit scheme  
    9591      CASE ( 1 ) ;  CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dt,                trb, tra, jptra )    !   implicit scheme           
    96  
    9792      END SELECT 
    9893 
    … …  
    117112 
    118113 
    119    SUBROUTINE zdf_ctl 
     114   SUBROUTINE trc_zdf_ini 
    120115      !!---------------------------------------------------------------------- 
    121       !!                 ***  ROUTINE zdf_ctl  *** 
     116      !!                 ***  ROUTINE trc_zdf_ini  *** 
    122117      !! 
    123118      !! ** Purpose :   Choose the vertical mixing scheme 
    … …  
    128123      !!      NB: The implicit scheme is required when using :  
    129124      !!             - rotated lateral mixing operator 
    130       !!             - TKE, GLS or KPP vertical mixing scheme 
     125      !!             - TKE, GLS vertical mixing scheme 
    131126      !!---------------------------------------------------------------------- 
    132  
    133       !  Define the vertical tracer physics scheme 
    134       ! ========================================== 
    135  
    136       ! Choice from ln_zdfexp already read in namelist in zdfini module 
    137       IF( ln_trczdf_exp ) THEN           ! use explicit scheme 
    138          nzdf = 0 
    139       ELSE                               ! use implicit scheme 
    140          nzdf = 1 
     127      INTEGER ::  ios                 ! Local integer output status for namelist read 
     128      !! 
     129      NAMELIST/namtrc_zdf/ ln_trczdf_exp  , nn_trczdf_exp 
     130      !!---------------------------------------------------------------------- 
     131      ! 
     132      REWIND( numnat_ref )             ! namtrc_zdf in reference namelist  
     133      READ  ( numnat_ref, namtrc_zdf, IOSTAT = ios, ERR = 905) 
     134905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_zdf in reference namelist', lwp ) 
     135      ! 
     136      REWIND( numnat_cfg )             ! namtrc_zdf in configuration namelist  
     137      READ  ( numnat_cfg, namtrc_zdf, IOSTAT = ios, ERR = 906 ) 
     138906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_zdf in configuration namelist', lwp ) 
     139      IF(lwm) WRITE ( numont, namtrc_zdf ) 
     140      ! 
     141      IF(lwp) THEN                     ! Control print 
     142         WRITE(numout,*) 
     143         WRITE(numout,*) '   Namelist namtrc_zdf : set vertical diffusion  parameters' 
     144         WRITE(numout,*) '      time splitting / backward scheme ln_trczdf_exp = ', ln_trczdf_exp 
     145         WRITE(numout,*) '      number of time step              nn_trczdf_exp = ', nn_trczdf_exp 
    141146      ENDIF 
    142147 
    143       ! Force implicit schemes 
    144       IF( ln_trcldf_iso                               )   nzdf = 1      ! iso-neutral lateral physics 
    145       IF( ln_trcldf_hor .AND. ln_sco                  )   nzdf = 1      ! horizontal lateral physics in s-coordinate 
    146 #if defined key_zdftke || defined key_zdfgls || defined key_zdfkpp 
    147                                                           nzdf = 1      ! TKE, GLS or KPP physics        
    148 #endif 
    149       IF( ln_trczdf_exp .AND. nzdf == 1 )   THEN 
    150          CALL ctl_stop( 'trc_zdf : If using the rotated lateral mixing operator or TKE, GLS or KPP vertical scheme ', & 
    151             &           '          the implicit scheme is required, set ln_trczdf_exp = .false.' ) 
     148      !                                ! Define the vertical tracer physics scheme 
     149      IF( ln_trczdf_exp ) THEN   ;   nzdf = 0     ! explicit scheme 
     150      ELSE                       ;   nzdf = 1     ! implicit scheme 
    152151      ENDIF 
    153152 
    154       ! Test: esopa 
    155       IF( lk_esopa )    nzdf = -1                      ! All schemes used 
     153      !                                ! Force implicit schemes 
     154      IF( ln_trcldf_iso              )   nzdf = 1      ! iso-neutral lateral physics 
     155      IF( ln_trcldf_hor .AND. ln_sco )   nzdf = 1      ! horizontal lateral physics in s-coordinate 
     156#if defined key_zdftke || defined key_zdfgls  
     157                                         nzdf = 1      ! TKE or GLS physics        
     158#endif 
     159      IF( ln_trczdf_exp .AND. nzdf == 1 )  &  
     160         CALL ctl_stop( 'trc_zdf : If using the rotated lateral mixing operator or TKE, GLS vertical scheme ', & 
     161            &           '          the implicit scheme is required, set ln_trczdf_exp = .false.' ) 
    156162 
    157163      IF(lwp) THEN 
    … …  
    159165         WRITE(numout,*) 'trc:zdf_ctl : vertical passive tracer physics scheme' 
    160166         WRITE(numout,*) '~~~~~~~~~~~' 
    161          IF( nzdf == -1 )   WRITE(numout,*) '              ESOPA test All scheme used' 
    162167         IF( nzdf ==  0 )   WRITE(numout,*) '              Explicit time-splitting scheme' 
    163168         IF( nzdf ==  1 )   WRITE(numout,*) '              Implicit (euler backward) scheme' 
    164169      ENDIF 
    165  
    166    END SUBROUTINE zdf_ctl 
     170      ! 
     171   END SUBROUTINE trc_zdf_ini 
     172    
    167173#else 
    168174   !!---------------------------------------------------------------------- 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90

    r5215 r5870  
    88   !!                 !  07-06  (C. Deltel)  key_gyre : do not call lbc_lnk 
    99   !!---------------------------------------------------------------------- 
    10 #if   defined key_top && ( defined key_trdmxl_trc   ||   defined key_esopa ) 
     10#if   defined key_top   &&   defined key_trdmxl_trc 
    1111   !!---------------------------------------------------------------------- 
    1212   !!   'key_trdmxl_trc'                      mixed layer trend diagnostics 
    … …  
    2424   USE zdfddm  , ONLY : avs  ! salinity vertical diffusivity coeff. at w-point 
    2525# endif 
    26    USE trcnam_trp        ! passive tracers transport namelist variables 
    2726   USE trdtrc_oce    ! definition of main arrays used for trends computations 
    2827   USE in_out_manager    ! I/O manager 
    … …  
    6766 
    6867   !! * Substitutions 
    69 #  include "top_substitute.h90" 
     68#  include "domzgr_substitute.h90" 
    7069#  include "zdfddm_substitute.h90" 
    7170   !!---------------------------------------------------------------------- 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90

    r5215 r5870  
    1414   !!---------------------------------------------------------------------- 
    1515   USE trc               ! tracer definitions (trn, trb, tra, etc.) 
    16    USE trcnam_trp 
    1716   USE trd_oce 
    1817   USE trdtrc_oce       ! definition of main arrays used for trends computations 
    … …  
    2928   PUBLIC trd_trc 
    3029 
    31    !! * Substitutions 
    32 #  include "top_substitute.h90" 
    3330   !!---------------------------------------------------------------------- 
    3431   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90

    r5215 r5870  
    44   !! Ocean trends :   set tracer and momentum trend variables 
    55   !!====================================================================== 
    6 #if defined key_top   ||   defined key_esopa 
     6#if defined key_top 
    77   !!---------------------------------------------------------------------- 
    88   !!   'key_top'                                                TOP models 
    … …  
    3030# endif 
    3131 
    32 # if defined key_trdmxl_trc   ||   defined key_esopa 
     32# if defined key_trdmxl_trc 
    3333   !!---------------------------------------------------------------------- 
    3434   !!   'key_trdmxl_trc'                     mixed layer trends diagnostics 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90

    r5385 r5870  
    1111   !!   'key_top'                                                TOP models 
    1212   !!---------------------------------------------------------------------- 
    13  
    14    !* Domain size * 
     13   ! 
     14   !                                            !* Domain size * 
    1515   USE par_oce , ONLY :   jpi      =>   jpi        !: first  dimension of grid --> i  
    1616   USE par_oce , ONLY :   jpj      =>   jpj        !: second dimension of grid --> j   
    … …  
    2020   USE par_oce , ONLY :   jpkm1    =>   jpkm1      !: jpk - 1   
    2121   USE par_oce , ONLY :   jpij     =>   jpij       !: jpi x jpj 
    22    USE par_oce , ONLY :   lk_esopa =>   lk_esopa   !: flag to activate the all option 
    2322   USE par_oce , ONLY :   jp_tem   =>   jp_tem     !: indice for temperature 
    2423   USE par_oce , ONLY :   jp_sal   =>   jp_sal     !: indice for salinity 
    2524 
    26    !* IO manager * 
    27    USE in_out_manager     
    28   
    29    !* Memory Allocation * 
    30    USE wrk_nemo       
    31   
    32    !* Timing * 
    33    USE timing     
    34   
    35    !* MPP library                          
    36    USE lib_mpp  
    37  
    38    !* Fortran utilities                          
    39    USE lib_fortran 
    40  
    41    !* Lateral boundary conditions                          
    42    USE lbclnk 
    43  
    44    !* physical constants * 
    45    USE phycst             
    46  
    47    !* 1D configuration 
    48    USE c1d                                          
    49  
    50    !* model domain * 
    51    USE dom_oce  
     25   USE in_out_manager                           !* IO manager * 
     26   USE wrk_nemo                                 !* Memory Allocation * 
     27   USE timing                                   !* Timing *  
     28   USE lib_mpp                                  !* MPP library                          
     29   USE lib_fortran                              !* Fortran utilities                          
     30   USE lbclnk                                   !* Lateral boundary conditions                          
     31   USE phycst                                   !* physical constants * 
     32   USE c1d                                      !* 1D configuration 
     33   USE dom_oce                                  !* model domain * 
    5234 
    5335   USE domvvl, ONLY : un_td, vn_td          !: thickness diffusion transport 
    … …  
    5638 
    5739   !* ocean fields: here now and after fields * 
    58    USE oce , ONLY :   ua      =>    ua      !: i-horizontal velocity (m s-1)  
    59    USE oce , ONLY :   va      =>    va      !: j-horizontal velocity (m s-1) 
    6040   USE oce , ONLY :   un      =>    un      !: i-horizontal velocity (m s-1)  
    6141   USE oce , ONLY :   vn      =>    vn      !: j-horizontal velocity (m s-1) 
    … …  
    6646   USE oce , ONLY :   rhop    =>    rhop    !: potential volumic mass (kg m-3)  
    6747   USE oce , ONLY :   rhd     =>    rhd     !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 
     48   USE oce , ONLY :   hdivn   =>    hdivn   !: horizontal divergence (1/s) 
     49   USE oce , ONLY :   sshn    =>    sshn    !: sea surface height at t-point [m]    
     50   USE oce , ONLY :   sshb    =>    sshb    !: sea surface height at t-point [m]    
     51   USE oce , ONLY :   ssha    =>    ssha    !: sea surface height at t-point [m]    
    6852#if defined key_offline 
    6953   USE oce , ONLY :   rab_n   =>    rab_n   !: local thermal/haline expension ratio at T-points 
    7054#endif 
    71    USE oce , ONLY :   hdivn   =>    hdivn   !: horizontal divergence (1/s) 
    72    USE oce , ONLY :   rotn    =>    rotn    !: relative vorticity    [s-1] 
    73    USE oce , ONLY :   hdivb   =>    hdivb   !: horizontal divergence (1/s) 
    74    USE oce , ONLY :   rotb    =>    rotb    !: relative vorticity    [s-1] 
    75    USE oce , ONLY :   sshn    =>    sshn    !: sea surface height at t-point [m]    
    76    USE oce , ONLY :   sshb    =>    sshb    !: sea surface height at t-point [m]    
    77    USE oce , ONLY :   ssha    =>    ssha    !: sea surface height at t-point [m]    
    78    USE oce , ONLY :   l_traldf_rot => l_traldf_rot  !: rotated laplacian operator for lateral diffusion 
    7955 
    8056   !* surface fluxes * 
    … …  
    10278   USE trc_oce 
    10379 
     80!!gm : I don't understand this as ldftra (where everything is defined) is used by TRC in all cases (ON/OFF-line) 
     81!!gm   so the following lines should be removed....   logical should be the one of TRC namelist 
     82!!gm   In case off coarsening....  the ( ahtu, ahtv, aeiu, aeiv) arrays are needed that's all. 
    10483   !* lateral diffusivity (tracers) * 
    105    USE ldftra_oce , ONLY :  rldf     =>   rldf        !: multiplicative coef. for lateral diffusivity 
    106    USE ldftra_oce , ONLY :  rn_aht_0 =>   rn_aht_0    !: horizontal eddy diffusivity for tracers (m2/s) 
    107    USE ldftra_oce , ONLY :  aht0     =>   aht0        !: horizontal eddy diffusivity for tracers (m2/s) 
    108    USE ldftra_oce , ONLY :  ahtb0    =>   ahtb0       !: background eddy diffusivity for isopycnal diff. (m2/s) 
    109    USE ldftra_oce , ONLY :  ahtu     =>   ahtu        !: lateral diffusivity coef. at u-points  
    110    USE ldftra_oce , ONLY :  ahtv     =>   ahtv        !: lateral diffusivity coef. at v-points  
    111    USE ldftra_oce , ONLY :  ahtw     =>   ahtw        !: lateral diffusivity coef. at w-points  
    112    USE ldftra_oce , ONLY :  ahtt     =>   ahtt        !: lateral diffusivity coef. at t-points 
    113    USE ldftra_oce , ONLY :  aeiv0    =>   aeiv0       !: eddy induced velocity coefficient (m2/s)  
    114    USE ldftra_oce , ONLY :  aeiu     =>   aeiu        !: eddy induced velocity coef. at u-points (m2/s)    
    115    USE ldftra_oce , ONLY :  aeiv     =>   aeiv        !: eddy induced velocity coef. at v-points (m2/s)  
    116    USE ldftra_oce , ONLY :  aeiw     =>   aeiw        !: eddy induced velocity coef. at w-points (m2/s)  
    117    USE ldftra_oce , ONLY :  lk_traldf_eiv  =>  lk_traldf_eiv     !: eddy induced velocity flag 
     84   USE ldftra , ONLY :  rn_aht_0     =>   rn_aht_0     !:   laplacian lateral eddy diffusivity [m2/s] 
     85   USE ldftra , ONLY :  rn_bht_0     =>   rn_bht_0     !: bilaplacian lateral eddy diffusivity [m4/s] 
     86   USE ldftra , ONLY :  ahtu         =>   ahtu         !: lateral diffusivity coef. at u-points  
     87   USE ldftra , ONLY :  ahtv         =>   ahtv         !: lateral diffusivity coef. at v-points  
     88   USE ldftra , ONLY :  rn_aeiv_0    =>   rn_aeiv_0    !: eddy induced velocity coefficient (m2/s)  
     89   USE ldftra , ONLY :  aeiu         =>   aeiu         !: eddy induced velocity coef. at u-points (m2/s)    
     90   USE ldftra , ONLY :  aeiv         =>   aeiv         !: eddy induced velocity coef. at v-points (m2/s)  
     91   USE ldftra , ONLY :  ln_ldfeiv    =>   ln_ldfeiv    !: eddy induced velocity flag 
     92      
     93!!gm this should be : ln_trcldf_triad (TRC namelist) 
     94   USE ldfslp , ONLY :  ln_traldf_triad => ln_traldf_triad   !: triad scheme (Griffies et al.) 
     95 
     96   !* direction of lateral diffusion * 
     97   USE ldfslp , ONLY :   l_ldfslp  =>  l_ldfslp       !: slopes flag 
     98   USE ldfslp , ONLY :   uslp       =>   uslp         !: i-slope at u-point 
     99   USE ldfslp , ONLY :   vslp       =>   vslp         !: j-slope at v-point 
     100   USE ldfslp , ONLY :   wslpi      =>   wslpi        !: i-slope at w-point 
     101   USE ldfslp , ONLY :   wslpj      =>   wslpj        !: j-slope at w-point 
     102!!gm end  
    118103 
    119104   !* vertical diffusion * 
    … …  
    128113   USE zdfmxl , ONLY :   hmlp        =>   hmlp        !: mixed layer depth  (rho=rho0+zdcrit) (m) 
    129114   USE zdfmxl , ONLY :   hmlpt       =>   hmlpt       !: mixed layer depth at t-points (m) 
    130  
    131    !* direction of lateral diffusion * 
    132    USE ldfslp , ONLY :   lk_ldfslp  =>  lk_ldfslp     !: slopes flag 
    133 # if   defined key_ldfslp 
    134    USE ldfslp , ONLY :   uslp       =>   uslp         !: i-direction slope at u-, w-points 
    135    USE ldfslp , ONLY :   vslp       =>   vslp         !: j-direction slope at v-, w-points 
    136    USE ldfslp , ONLY :   wslpi      =>   wslpi        !: i-direction slope at u-, w-points 
    137    USE ldfslp , ONLY :   wslpj      =>   wslpj        !: j-direction slope at v-, w-points 
    138 # endif 
    139115 
    140116   USE diaar5 , ONLY :   lk_diaar5  =>   lk_diaar5 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r5385 r5870  
    143143   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_tm      !: vertical double diffusivity coeff. at w-point   [m/s] 
    144144# endif 
    145 #if defined key_ldfslp 
    146    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpi_tm    !: i-direction slope at u-, w-points 
    147    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpj_tm    !: j-direction slope at u-, w-points 
    148    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_tm     !: j-direction slope at u-, w-points 
    149    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  vslp_tm     !: j-direction slope at u-, w-points 
    150 #endif 
    151145#if defined key_trabbl 
    152146   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahu_bbl_tm  !: u-, w-points 
    … …  
    183177#endif 
    184178   ! 
    185 #if defined key_ldfslp 
    186    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpi_temp, wslpj_temp, uslp_temp, vslp_temp    !: hold current values  
    187 #endif 
    188    !  
    189179# if defined key_zdfddm 
    190180   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_temp      !: salinity vertical diffusivity coeff. at w-point   [m/s] 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/trcdia.F90

    r4292 r5870  
    5151   INTEGER  ::   nhoritb   !:  id for horizontal mesh 
    5252 
    53    !! * Substitutions 
    54 #  include "top_substitute.h90" 
    5553   !!---------------------------------------------------------------------- 
    5654   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r5407 r5870  
    1818   USE oce_trc         ! shared variables between ocean and passive tracers 
    1919   USE trc             ! passive tracers common variables 
    20    USE trcrst          ! passive tracers restart 
    2120   USE trcnam          ! Namelist read 
    22    USE trcini_cfc      ! CFC      initialisation 
    23    USE trcini_pisces   ! PISCES   initialisation 
    24    USE trcini_c14b     ! C14 bomb initialisation 
    25    USE trcini_my_trc   ! MY_TRC   initialisation 
    26    USE trcdta          ! initialisation from files 
    2721   USE daymod          ! calendar manager 
    28    USE zpshde          ! partial step: hor. derivative   (zps_hde routine) 
    2922   USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine) 
    3023   USE trcsub          ! variables to substep passive tracers 
     24   USE trcrst 
    3125   USE lib_mpp         ! distribued memory computing library 
    3226   USE sbc_oce 
    … …  
    5953      !!                or read data or analytical formulation 
    6054      !!--------------------------------------------------------------------- 
    61       INTEGER ::   jk, jn, jl    ! dummy loop indices 
    62       CHARACTER (len=25) :: charout 
    63       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta   ! 4D  workspace 
    64       !!--------------------------------------------------------------------- 
    6555      ! 
    6656      IF( nn_timing == 1 )   CALL timing_start('trc_init') 
    … …  
    7060      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    7161 
    72       CALL top_alloc()              ! allocate TOP arrays 
    73  
     62      ! 
     63      CALL top_alloc()   ! allocate TOP arrays 
     64      ! 
     65      CALL trc_ini_ctl   ! control  
     66      ! 
     67      CALL trc_nam       ! read passive tracers namelists 
     68      ! 
     69      IF(lwp) WRITE(numout,*) 
     70      ! 
     71      IF( ln_rsttr .AND. .NOT. lk_offline ) CALL trc_rst_cal( nit000, 'READ' )   ! calendar 
     72      ! 
     73      IF(lwp) WRITE(numout,*) 
     74      ! 
     75      CALL trc_ini_sms   ! SMS 
     76      ! 
     77      CALL trc_ini_trp   ! passive tracers transport 
     78      ! 
     79      CALL trc_ice_ini   ! Tracers in sea ice 
     80      ! 
     81      IF( lwp )  & 
     82         &  CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea ) 
     83      ! 
     84      CALL trc_ini_state  !  passive tracers initialisation : from a restart or from clim 
     85      ! 
     86      IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers 
     87      ! 
     88      CALL trc_ini_inv   ! Inventories 
     89      ! 
     90      IF( nn_timing == 1 )   CALL timing_stop('trc_init') 
     91      ! 
     92   END SUBROUTINE trc_init 
     93 
     94 
     95   SUBROUTINE trc_ini_ctl 
     96      !!---------------------------------------------------------------------- 
     97      !!                     ***  ROUTINE trc_ini_ctl  *** 
     98      !! ** Purpose :        Control  + ocean volume 
     99      !!---------------------------------------------------------------------- 
     100      INTEGER ::   jk    ! dummy loop indices 
     101      ! 
     102      ! Define logical parameter ton control dirunal cycle in TOP 
    74103      l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 ) 
    75104      l_trcdm2dc = l_trcdm2dc  .AND. .NOT. lk_offline 
    76       IF( l_trcdm2dc .AND. lwp ) & 
    77          &   CALL ctl_warn(' Coupling with passive tracers and used of diurnal cycle. & 
    78          & Computation of a daily mean shortwave for some biogeochemical models) ') 
    79  
    80       IF( nn_cla == 1 )   & 
    81          &  CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' ) 
    82  
    83       CALL trc_nam      ! read passive tracers namelists 
    84       ! 
    85       IF(lwp) WRITE(numout,*) 
    86       ! 
    87       IF( ln_rsttr .AND. .NOT. lk_offline ) CALL trc_rst_cal( nit000, 'READ' )   ! calendar 
    88       ! 
    89       IF(lwp) WRITE(numout,*) 
    90                                                               ! masked grid volume 
     105      IF( l_trcdm2dc .AND. lwp )   CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.',   & 
     106         &                           'Computation of a daily mean shortwave for some biogeochemical models ' ) 
     107      ! 
     108   END SUBROUTINE trc_ini_ctl 
     109 
     110 
     111   SUBROUTINE trc_ini_inv 
     112      !!---------------------------------------------------------------------- 
     113      !!                     ***  ROUTINE trc_ini_stat  *** 
     114      !! ** Purpose :      passive tracers inventories at initialsation phase 
     115      !!---------------------------------------------------------------------- 
     116      INTEGER ::  jk, jn    ! dummy loop indices 
     117      CHARACTER (len=25) :: charout 
     118      !!---------------------------------------------------------------------- 
    91119      !                                                              ! masked grid volume 
    92120      DO jk = 1, jpk 
    … …  
    96124      !                                                              ! total volume of the ocean  
    97125      areatot = glob_sum( cvol(:,:,:) ) 
    98  
     126      ! 
     127      trai(:) = 0._wp                                                   ! initial content of all tracers 
     128      DO jn = 1, jptra 
     129         trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   ) 
     130      END DO 
     131 
     132      IF(lwp) THEN               ! control print 
     133         WRITE(numout,*) 
     134         WRITE(numout,*) 
     135         WRITE(numout,*) '          *** Total number of passive tracer jptra = ', jptra 
     136         WRITE(numout,*) '          *** Total volume of ocean                = ', areatot 
     137         WRITE(numout,*) '          *** Total inital content of all tracers ' 
     138         WRITE(numout,*) 
     139         DO jn = 1, jptra 
     140            WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn) 
     141         ENDDO 
     142         WRITE(numout,*) 
     143      ENDIF 
     144      IF(lwp) WRITE(numout,*) 
     145      IF(ln_ctl) THEN            ! print mean trends (used for debugging) 
     146         CALL prt_ctl_trc_init 
     147         WRITE(charout, FMT="('ini ')") 
     148         CALL prt_ctl_trc_info( charout ) 
     149         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
     150      ENDIF 
     1519000  FORMAT(' tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10) 
     152      ! 
     153   END SUBROUTINE trc_ini_inv 
     154 
     155 
     156   SUBROUTINE trc_ini_sms 
     157      !!---------------------------------------------------------------------- 
     158      !!                     ***  ROUTINE trc_ini_sms  *** 
     159      !! ** Purpose :   SMS initialisation 
     160      !!---------------------------------------------------------------------- 
     161      USE trcini_cfc      ! CFC      initialisation 
     162      USE trcini_pisces   ! PISCES   initialisation 
     163      USE trcini_c14b     ! C14 bomb initialisation 
     164      USE trcini_my_trc   ! MY_TRC   initialisation 
     165      !!---------------------------------------------------------------------- 
    99166      IF( lk_pisces  )       CALL trc_ini_pisces       ! PISCES  bio-model 
    100167      IF( lk_cfc     )       CALL trc_ini_cfc          ! CFC     tracers 
    101168      IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer 
    102169      IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers 
    103  
    104       CALL trc_ice_ini                                 ! Tracers in sea ice 
    105  
    106       IF( lwp ) THEN 
    107          ! 
    108          CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea ) 
    109          ! 
    110       ENDIF 
    111  
     170      ! 
     171   END SUBROUTINE trc_ini_sms 
     172 
     173   SUBROUTINE trc_ini_trp 
     174      !!---------------------------------------------------------------------- 
     175      !!                     ***  ROUTINE trc_ini_trp  *** 
     176      !! 
     177      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules 
     178      !!---------------------------------------------------------------------- 
     179      USE trcdmp , ONLY:  trc_dmp_ini 
     180      USE trcadv , ONLY:  trc_adv_ini 
     181      USE trcldf , ONLY:  trc_ldf_ini 
     182      USE trczdf , ONLY:  trc_zdf_ini 
     183      USE trcrad , ONLY:  trc_rad_ini 
     184      ! 
     185      INTEGER :: ierr 
     186      !!---------------------------------------------------------------------- 
     187      ! 
     188      IF( ln_trcdmp )  CALL  trc_dmp_ini          ! damping 
     189                       CALL  trc_adv_ini          ! advection 
     190                       CALL  trc_ldf_ini          ! lateral diffusion 
     191                       CALL  trc_zdf_ini          ! vertical diffusion 
     192                       CALL  trc_rad_ini          ! positivity of passive tracers  
     193      ! 
     194   END SUBROUTINE trc_ini_trp 
     195 
     196 
     197   SUBROUTINE trc_ini_state 
     198      !!---------------------------------------------------------------------- 
     199      !!                     ***  ROUTINE trc_ini_state *** 
     200      !! ** Purpose :          Initialisation of passive tracer concentration  
     201      !!---------------------------------------------------------------------- 
     202      USE zpshde          ! partial step: hor. derivative   (zps_hde routine) 
     203      USE trcrst          ! passive tracers restart 
     204      USE trcdta          ! initialisation from files 
     205      ! 
     206      INTEGER ::   jk, jn, jl    ! dummy loop indices 
     207      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta   ! 4D  workspace 
     208      !!---------------------------------------------------------------------- 
     209      ! 
    112210      IF( ln_trcdta )      CALL trc_dta_init(jptra) 
    113  
    114211 
    115212      IF( ln_rsttr ) THEN 
    … …  
    146243  
    147244      tra(:,:,:,:) = 0._wp 
    148       IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav )   &              ! Partial steps: before horizontal gradient of passive 
    149         &    CALL zps_hde    ( nit000, jptra, trn, gtru, gtrv  )  ! Partial steps: before horizontal gradient 
    150       IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav )   & 
    151         &    CALL zps_hde_isf( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )       ! tracers at the bottom ocean level 
    152  
    153  
    154       ! 
    155       IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers 
    156       ! 
    157  
    158       trai(:) = 0._wp                                                   ! initial content of all tracers 
    159       DO jn = 1, jptra 
    160          trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   ) 
    161       END DO 
    162  
    163       IF(lwp) THEN               ! control print 
    164          WRITE(numout,*) 
    165          WRITE(numout,*) 
    166          WRITE(numout,*) '          *** Total number of passive tracer jptra = ', jptra 
    167          WRITE(numout,*) '          *** Total volume of ocean                = ', areatot 
    168          WRITE(numout,*) '          *** Total inital content of all tracers ' 
    169          WRITE(numout,*) 
    170          DO jn = 1, jptra 
    171             WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn) 
    172          ENDDO 
    173          WRITE(numout,*) 
    174       ENDIF 
    175       IF(lwp) WRITE(numout,*) 
    176       IF(ln_ctl) THEN            ! print mean trends (used for debugging) 
    177          CALL prt_ctl_trc_init 
    178          WRITE(charout, FMT="('ini ')") 
    179          CALL prt_ctl_trc_info( charout ) 
    180          CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
    181       ENDIF 
    182 9000  FORMAT(' tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10) 
    183       ! 
    184       IF( nn_timing == 1 )   CALL timing_stop('trc_init') 
    185       ! 
    186    END SUBROUTINE trc_init 
     245      !                                                         ! Partial top/bottom cell: GRADh(trn) 
     246   END SUBROUTINE trc_ini_state 
    187247 
    188248 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r5656 r5870  
    2020   USE oce_trc           ! shared variables between ocean and passive tracers 
    2121   USE trc               ! passive tracers common variables 
    22    USE trcnam_trp        ! Transport namelist 
    2322   USE trcnam_pisces     ! PISCES namelist 
    2423   USE trcnam_cfc        ! CFC SMS namelist 
    … …  
    3534   PUBLIC trc_nam      ! called in trcini 
    3635 
    37    !! * Substitutions 
    38 #  include "top_substitute.h90" 
    3936   !!---------------------------------------------------------------------- 
    4037   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    4239   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4340   !!---------------------------------------------------------------------- 
    44  
    4541CONTAINS 
    46  
    4742 
    4843   SUBROUTINE trc_nam 
    … …  
    5752      !!--------------------------------------------------------------------- 
    5853      INTEGER  ::   jn                  ! dummy loop indice 
    59       !                                        !   Parameters of the run  
    60       IF( .NOT. lk_offline ) CALL trc_nam_run 
    61        
    62       !                                        !  passive tracer informations 
    63       CALL trc_nam_trc 
    64        
    65       !                                        !   Parameters of additional diagnostics 
    66       CALL trc_nam_dia 
    67  
    68       !                                        !   namelist of transport 
    69       CALL trc_nam_trp 
    70  
    71  
    72       IF( ln_rsttr )                      ln_trcdta = .FALSE.   ! restart : no need of clim data 
    73       ! 
    74       IF( ln_trcdmp .OR. ln_trcdmp_clo )  ln_trcdta = .TRUE.   ! damping : need to have clim data 
    75       ! 
    76       IF( .NOT.ln_trcdta ) THEN 
    77          ln_trc_ini(:) = .FALSE. 
    78       ENDIF 
    79  
    80      IF(lwp) THEN                   ! control print 
     54      !                                   
     55      IF( .NOT.lk_offline )   CALL trc_nam_run     ! Parameters of the run  
     56      !                
     57                              CALL trc_nam_trc     ! passive tracer informations 
     58      !                                         
     59                              CALL trc_nam_dia     ! Parameters of additional diagnostics 
     60      !                                       
     61      ! 
     62      IF( ln_rsttr                     )   ln_trcdta     = .FALSE.   ! restart : no need of clim data 
     63      ! 
     64      IF( ln_trcdmp .OR. ln_trcdmp_clo )   ln_trcdta     = .TRUE.   ! damping : need to have clim data 
     65      ! 
     66      IF( .NOT.ln_trcdta               )   ln_trc_ini(:) = .FALSE. 
     67 
     68      IF(lwp) THEN                   ! control print 
    8169         WRITE(numout,*) 
    8270         WRITE(numout,*) ' Namelist : namtrc' 
    … …  
    149137      ! Call the ice module for tracers 
    150138      ! ------------------------------- 
    151       CALL trc_nam_ice 
     139                                  CALL trc_nam_ice 
    152140 
    153141      ! namelist of SMS 
    … …  
    171159   END SUBROUTINE trc_nam 
    172160 
     161 
    173162   SUBROUTINE trc_nam_run 
    174163      !!--------------------------------------------------------------------- 
    … …  
    180169      NAMELIST/namtrc_run/ nn_dttrc, nn_writetrc, ln_rsttr, nn_rsttr, ln_top_euler, & 
    181170        &                  cn_trcrst_indir, cn_trcrst_outdir, cn_trcrst_in, cn_trcrst_out 
    182  
    183  
     171      ! 
    184172      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    185  
    186       !!--------------------------------------------------------------------- 
    187  
    188  
     173      !!--------------------------------------------------------------------- 
     174      ! 
    189175      IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists' 
    190176      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    … …  
    220206    END SUBROUTINE trc_nam_run 
    221207 
     208 
    222209   SUBROUTINE trc_nam_ice 
    223210      !!--------------------------------------------------------------------- 
    … …  
    229216      !! 
    230217      !!--------------------------------------------------------------------- 
    231       ! --- Variable declarations --- ! 
    232218      INTEGER :: jn      ! dummy loop indices 
    233219      INTEGER :: ios     ! Local integer output status for namelist read 
    234  
    235       ! --- Namelist declarations --- ! 
     220      ! 
    236221      TYPE(TRC_I_NML), DIMENSION(jptra) :: sn_tri_tracer 
     222      !! 
    237223      NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer 
    238  
     224      !!--------------------------------------------------------------------- 
     225      ! 
    239226      IF(lwp) THEN 
    240227         WRITE(numout,*) 
    … …  
    271258   END SUBROUTINE trc_nam_ice 
    272259 
     260 
    273261   SUBROUTINE trc_nam_trc 
    274262      !!--------------------------------------------------------------------- 
    … …  
    278266      !! 
    279267      !!--------------------------------------------------------------------- 
    280       TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer  ! type of tracer for saving if not key_iomput 
    281       !! 
    282       NAMELIST/namtrc/ sn_tracer, ln_trcdta,ln_trcdmp, ln_trcdmp_clo 
    283    
    284268      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    285269      INTEGER  ::   jn                  ! dummy loop indice 
     270      ! 
     271      TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer  ! type of tracer for saving if not key_iomput 
     272      !! 
     273      NAMELIST/namtrc/ sn_tracer, ln_trcdta,ln_trcdmp, ln_trcdmp_clo 
    286274      !!--------------------------------------------------------------------- 
    287275      IF(lwp) WRITE(numout,*) 
    288276      IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists' 
    289277      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    290  
    291278 
    292279      REWIND( numnat_ref )              ! Namelist namtrc in reference namelist : Passive tracer variables 
    … …  
    306293         ln_trc_wri(jn) =       sn_tracer(jn)%llsave 
    307294      END DO 
    308        
    309     END SUBROUTINE trc_nam_trc 
     295      ! 
     296   END SUBROUTINE trc_nam_trc 
    310297 
    311298 
    … …  
    320307      !!                ( (PISCES, CFC, MY_TRC ) 
    321308      !!--------------------------------------------------------------------- 
     309      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    322310      INTEGER ::  ierr 
     311      !! 
    323312#if defined key_trdmxl_trc  || defined key_trdtrc 
    324313      NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & 
    … …  
    327316#endif 
    328317      NAMELIST/namtrc_dia/ ln_diatrc, ln_diabio, nn_writedia, nn_writebio 
    329  
    330       INTEGER  ::   ios                 ! Local integer output status for namelist read 
    331318      !!--------------------------------------------------------------------- 
    332319 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r5513 r5870  
    2525   USE oce_trc 
    2626   USE trc 
    27    USE trcnam_trp 
    2827   USE iom 
    2928   USE daymod 
    … …  
    3736 
    3837   !! * Substitutions 
    39 #  include "top_substitute.h90" 
     38#  include "domzgr_substitute.h90" 
    4039    
    4140CONTAINS 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/trcsub.F90

    r5215 r5870  
    2525   USE zdf_oce 
    2626   USE domvvl 
    27    USE divcur          ! hor. divergence and curl      (div & cur routines) 
     27   USE divhor          ! horizontal divergence            (div_hor routine) 
    2828   USE sbcrnf, ONLY: h_rnf, nk_rnf   ! River runoff  
    2929   USE bdy_oce 
    … …  
    4444   REAL(wp)  :: r1_ndttrcp1   !    1 / (nn_dttrc+1)  
    4545 
    46    !!* Substitution 
    47 #  include "top_substitute.h90" 
     46   !                                                       !* iso-neutral slopes (if l_ldfslp=T) 
     47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_temp, vslp_temp, wslpi_temp, wslpj_temp   !: hold current values  
     48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_tm  , vslp_tm  , wslpi_tm  , wslpj_tm     !: time mean  
     49 
     50   !! * Substitutions 
     51#  include "domzgr_substitute.h90" 
    4852   !!---------------------------------------------------------------------- 
    4953   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    9397          avs_tm  (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * fse3w(:,:,:)   
    9498# endif 
    95 #if defined key_ldfslp 
    96           wslpi_tm(:,:,:)        = wslpi_tm(:,:,:)        + wslpi(:,:,:) 
    97           wslpj_tm(:,:,:)        = wslpj_tm(:,:,:)        + wslpj(:,:,:) 
    98           uslp_tm (:,:,:)        = uslp_tm (:,:,:)        + uslp (:,:,:) 
    99           vslp_tm (:,:,:)        = vslp_tm (:,:,:)        + vslp (:,:,:) 
    100 #endif 
     99         IF( l_ldfslp ) THEN 
     100            uslp_tm (:,:,:)      = uslp_tm (:,:,:)        + uslp (:,:,:) 
     101            vslp_tm (:,:,:)      = vslp_tm (:,:,:)        + vslp (:,:,:) 
     102            wslpi_tm(:,:,:)      = wslpi_tm(:,:,:)        + wslpi(:,:,:) 
     103            wslpj_tm(:,:,:)      = wslpj_tm(:,:,:)        + wslpj(:,:,:) 
     104         ENDIF 
    101105# if defined key_trabbl 
    102106          IF( nn_bbl_ldf == 1 ) THEN 
    … …  
    131135         avs_temp   (:,:,:)      = avs   (:,:,:) 
    132136# endif 
    133 #if defined key_ldfslp 
    134          wslpi_temp (:,:,:)      = wslpi (:,:,:) 
    135          wslpj_temp (:,:,:)      = wslpj (:,:,:) 
    136          uslp_temp  (:,:,:)      = uslp  (:,:,:) 
    137          vslp_temp  (:,:,:)      = vslp  (:,:,:) 
    138 #endif 
     137         IF( l_ldfslp ) THEN 
     138            uslp_temp  (:,:,:)   = uslp  (:,:,:)   ;   wslpi_temp (:,:,:)   = wslpi (:,:,:) 
     139            vslp_temp  (:,:,:)   = vslp  (:,:,:)   ;   wslpj_temp (:,:,:)   = wslpj (:,:,:) 
     140         ENDIF 
    139141# if defined key_trabbl 
    140142          IF( nn_bbl_ldf == 1 ) THEN 
    … …  
    160162         wndm_temp  (:,:)        = wndm  (:,:) 
    161163         !                                    !  Variables reset in trc_sub_ssh 
    162          rotn_temp  (:,:,:)      = rotn  (:,:,:) 
    163164         hdivn_temp (:,:,:)      = hdivn (:,:,:) 
    164          rotb_temp  (:,:,:)      = rotb  (:,:,:) 
    165          hdivb_temp (:,:,:)      = hdivb (:,:,:) 
    166165         ! 
    167166         ! 2. Create averages and reassign variables 
    … …  
    175174         avs_tm   (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * fse3w(:,:,:)   
    176175# endif 
    177 #if defined key_ldfslp 
    178          wslpi_tm (:,:,:)        = wslpi_tm(:,:,:)        + wslpi(:,:,:)  
    179          wslpj_tm (:,:,:)        = wslpj_tm(:,:,:)        + wslpj(:,:,:)  
    180          uslp_tm  (:,:,:)        = uslp_tm (:,:,:)        + uslp (:,:,:)  
    181          vslp_tm  (:,:,:)        = vslp_tm (:,:,:)        + vslp (:,:,:) 
    182 #endif 
     176         IF( l_ldfslp ) THEN 
     177            uslp_tm  (:,:,:)     = uslp_tm (:,:,:)        + uslp (:,:,:)  
     178            vslp_tm  (:,:,:)     = vslp_tm (:,:,:)        + vslp (:,:,:) 
     179            wslpi_tm (:,:,:)     = wslpi_tm(:,:,:)        + wslpi(:,:,:)  
     180            wslpj_tm (:,:,:)     = wslpj_tm(:,:,:)        + wslpj(:,:,:)  
     181         ENDIF 
    183182# if defined key_trabbl 
    184183          IF( nn_bbl_ldf == 1 ) THEN 
    … …  
    255254                  tsn  (ji,jj,jk,jp_sal) = tsn_tm  (ji,jj,jk,jp_sal) * z1_ne3t 
    256255                  rhop (ji,jj,jk)        = rhop_tm (ji,jj,jk)        * z1_ne3t 
     256!!gm : BUG? ==>> for avt & avs I don't understand the division by e3w 
    257257                  avt  (ji,jj,jk)        = avt_tm  (ji,jj,jk)        * z1_ne3w 
    258258# if defined key_zdfddm 
    259259                  avs  (ji,jj,jk)        = avs_tm  (ji,jj,jk)        * z1_ne3w 
    260260# endif 
    261 #if defined key_ldfslp 
    262                   wslpi(ji,jj,jk)        = wslpi_tm(ji,jj,jk)  
    263                   wslpj(ji,jj,jk)        = wslpj_tm(ji,jj,jk) 
    264                   uslp (ji,jj,jk)        = uslp_tm (ji,jj,jk) 
    265                   vslp (ji,jj,jk)        = vslp_tm (ji,jj,jk) 
    266 #endif 
    267                ENDDO 
    268             ENDDO 
    269          ENDDO 
     261               END DO 
     262            END DO 
     263         END DO 
     264         IF( l_ldfslp ) THEN 
     265            wslpi(:,:,:)        = wslpi_tm(:,:,:)  
     266            wslpj(:,:,:)        = wslpj_tm(:,:,:) 
     267            uslp (:,:,:)        = uslp_tm (:,:,:) 
     268            vslp (:,:,:)        = vslp_tm (:,:,:) 
     269         ENDIF 
    270270         ! 
    271271         CALL trc_sub_ssh( kt )         ! after ssh & vertical velocity 
    … …  
    276276      ! 
    277277   END SUBROUTINE trc_sub_stp 
     278 
    278279 
    279280   SUBROUTINE trc_sub_ini 
    … …  
    304305      tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * fse3t(:,:,:)   
    305306      rhop_tm (:,:,:)        = rhop (:,:,:)        * fse3t(:,:,:)   
     307!!gm : BUG? ==>> for avt & avs I don't understand the division by e3w 
    306308      avt_tm  (:,:,:)        = avt  (:,:,:)        * fse3w(:,:,:)   
    307309# if defined key_zdfddm 
    308310      avs_tm  (:,:,:)        = avs  (:,:,:)        * fse3w(:,:,:)   
    309311# endif 
    310 #if defined key_ldfslp 
    311       wslpi_tm(:,:,:)        = wslpi(:,:,:) 
    312       wslpj_tm(:,:,:)        = wslpj(:,:,:) 
    313       uslp_tm (:,:,:)        = uslp (:,:,:) 
    314       vslp_tm (:,:,:)        = vslp (:,:,:) 
    315 #endif 
     312      IF( l_ldfslp ) THEN 
     313         wslpi_tm(:,:,:)     = wslpi(:,:,:) 
     314         wslpj_tm(:,:,:)     = wslpj(:,:,:) 
     315         uslp_tm (:,:,:)     = uslp (:,:,:) 
     316         vslp_tm (:,:,:)     = vslp (:,:,:) 
     317      ENDIF 
    316318      sshn_tm  (:,:) = sshn  (:,:)  
    317319      rnf_tm   (:,:) = rnf   (:,:)  
    … …  
    365367      avs   (:,:,:)   =  avs_temp   (:,:,:) 
    366368# endif 
    367 #if defined key_ldfslp 
    368       wslpi (:,:,:)   =  wslpi_temp (:,:,:) 
    369       wslpj (:,:,:)   =  wslpj_temp (:,:,:) 
    370       uslp  (:,:,:)   =  uslp_temp  (:,:,:) 
    371       vslp  (:,:,:)   =  vslp_temp  (:,:,:) 
    372 #endif 
     369      IF( l_ldfslp ) THEN 
     370         wslpi (:,:,:)=  wslpi_temp (:,:,:) 
     371         wslpj (:,:,:)=  wslpj_temp (:,:,:) 
     372         uslp  (:,:,:)=  uslp_temp  (:,:,:) 
     373         vslp  (:,:,:)=  vslp_temp  (:,:,:) 
     374      ENDIF 
    373375      sshn  (:,:)     =  sshn_temp  (:,:) 
    374376      sshb  (:,:)     =  sshb_temp  (:,:) 
    … …  
    396398      ! 
    397399      hdivn (:,:,:)   =  hdivn_temp (:,:,:) 
    398       rotn  (:,:,:)   =  rotn_temp  (:,:,:) 
    399       hdivb (:,:,:)   =  hdivb_temp (:,:,:) 
    400       rotb  (:,:,:)   =  rotb_temp  (:,:,:) 
    401400      !                                       
    402  
    403401      ! Start new averages 
    404402         un_tm   (:,:,:)        = un   (:,:,:)        * fse3u(:,:,:)  
    … …  
    411409         avs_tm  (:,:,:)        = avs  (:,:,:)        * fse3w(:,:,:)   
    412410# endif 
    413 #if defined key_ldfslp 
     411      IF( l_ldfslp ) THEN 
     412         uslp_tm (:,:,:)        = uslp (:,:,:) 
     413         vslp_tm (:,:,:)        = vslp (:,:,:) 
    414414         wslpi_tm(:,:,:)        = wslpi(:,:,:)  
    415415         wslpj_tm(:,:,:)        = wslpj(:,:,:) 
    416          uslp_tm (:,:,:)        = uslp (:,:,:) 
    417          vslp_tm (:,:,:)        = vslp (:,:,:) 
    418 #endif 
     416      ENDIF 
    419417      ! 
    420418      sshb_hold  (:,:) = sshn  (:,:) 
    … …  
    487485      ENDIF 
    488486      ! 
    489       CALL div_cur( kt )                              ! Horizontal divergence & Relative vorticity 
     487      CALL div_hor( kt )                              ! Horizontal divergence & Relative vorticity 
    490488      ! 
    491489      z2dt = 2._wp * rdt                              ! set time step size (Euler/Leapfrog) 
    … …  
    551549         &      sshn_temp(jpi,jpj)          ,  sshb_temp(jpi,jpj) ,      & 
    552550         &      ssha_temp(jpi,jpj)          ,                           & 
    553 #if defined key_ldfslp 
    554          &      wslpi_temp(jpi,jpj,jpk)     ,  wslpj_temp(jpi,jpj,jpk),  & 
    555          &      uslp_temp(jpi,jpj,jpk)      ,  vslp_temp(jpi,jpj,jpk),   & 
    556 #endif 
    557551#if defined key_trabbl 
    558552         &      ahu_bbl_temp(jpi,jpj)       ,  ahv_bbl_temp(jpi,jpj),    & 
    … …  
    569563# endif 
    570564         &      hdivn_temp(jpi,jpj,jpk)     ,  hdivb_temp(jpi,jpj,jpk),  & 
    571          &      rotn_temp(jpi,jpj,jpk)      ,  rotb_temp(jpi,jpj,jpk),   & 
    572565         &      un_tm(jpi,jpj,jpk)          ,  vn_tm(jpi,jpj,jpk)  ,     & 
    573566         &      avt_tm(jpi,jpj,jpk)                                ,     & 
    … …  
    577570         &      emp_b_hold(jpi,jpj)         ,                            & 
    578571         &      hmld_tm(jpi,jpj)            ,  qsr_tm(jpi,jpj) ,         & 
    579 #if defined key_ldfslp 
    580          &      wslpi_tm(jpi,jpj,jpk)       ,  wslpj_tm(jpi,jpj,jpk),    & 
    581          &      uslp_tm(jpi,jpj,jpk)        ,  vslp_tm(jpi,jpj,jpk),     & 
    582 #endif 
    583572#if defined key_trabbl 
    584573         &      ahu_bbl_tm(jpi,jpj)         ,  ahv_bbl_tm(jpi,jpj),      & 
    585574         &      utr_bbl_tm(jpi,jpj)         ,  vtr_bbl_tm(jpi,jpj),      & 
    586575#endif 
    587          &      rnf_tm(jpi,jpj)             ,  h_rnf_tm(jpi,jpj) ,       & 
    588          &                                    STAT=trc_sub_alloc )   
     576         &      rnf_tm(jpi,jpj)             ,  h_rnf_tm(jpi,jpj) , STAT=trc_sub_alloc )   
     577      ! 
    589578      IF( trc_sub_alloc /= 0 )   CALL ctl_warn('trc_sub_alloc: failed to allocate arrays') 
    590  
     579      ! 
     580      IF( l_ldfslp ) THEN 
     581         ALLOCATE( uslp_temp(jpi,jpj,jpk)   ,  wslpi_temp(jpi,jpj,jpk),      & 
     582            &      vslp_temp(jpi,jpj,jpk)   ,  wslpj_temp(jpi,jpj,jpk),      & 
     583            &      uslp_tm  (jpi,jpj,jpk)   ,  wslpi_tm  (jpi,jpj,jpk),      & 
     584            &      vslp_tm  (jpi,jpj,jpk)   ,  wslpj_tm  (jpi,jpj,jpk),  STAT=trc_sub_alloc ) 
     585      ENDIF 
     586      ! 
     587      IF( trc_sub_alloc /= 0 )   CALL ctl_warn('trc_sub_alloc: failed to allocate ldf_slp arrays') 
    591588      ! 
    592589   END FUNCTION trc_sub_alloc 

  • branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/trcwri.F90

    r3750 r5870  
    2626 
    2727   PUBLIC trc_wri       
    28  
    29    !! * Substitutions 
    30 #  include "top_substitute.h90" 
    3128 
    3229CONTAINS 
Note: See TracChangeset for help on using the changeset viewer.