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 7953 – NEMO

Changeset 7953


Ignore:
Timestamp:
2017-04-23T09:30:41+02:00 (7 years ago)
Author:
gm
Message:

#1880 (HPC-09): add zdfphy (the ZDF manager) + remove all key_...

Location:
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM
Files:
1 deleted
46 edited
1 moved

Legend:

Unmodified
Added
Removed

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg

    r7646 r7953  
    2929!----------------------------------------------------------------------- 
    3030   rn_rdt      =   600.    !  time step for the dynamics (and tracer if nn_acc=0) 
    31 / 
    32 !----------------------------------------------------------------------- 
    33 &namcrs        !   Grid coarsening for dynamics output and/or 
    34 !              !   passive tracer coarsened online simulations 
    35 !----------------------------------------------------------------------- 
    3631/ 
    3732!----------------------------------------------------------------------- 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg

    r7931 r7953  
    1212!!                   ***  Run management namelists  *** 
    1313!!====================================================================== 
    14 !!   namrun        parameters of the run 
    15 !!====================================================================== 
    16 ! 
    1714!----------------------------------------------------------------------- 
    1815&namrun        !   parameters of the run 
    … …  
    2522   nn_write    =      60   !  frequency of write in the output file   (modulo referenced to nn_it000) 
    2623/ 
     24!!====================================================================== 
     25!!                      ***  Domain namelists  *** 
     26!!====================================================================== 
    2727!----------------------------------------------------------------------- 
    2828&namcfg     !   parameters of the configuration    
    … …  
    3737!----------------------------------------------------------------------- 
    3838   ln_linssh   = .true.    !  =T  linear free surface  ==>>  model level are fixed in time 
    39    ! 
    4039   nn_msh      =    0      !  create (>0) a mesh file or not (=0) 
    41    ! 
    4240   rn_rdt      = 7200.     !  time step for the dynamics (and tracer if nn_acc=0) 
    43 / 
    44 !----------------------------------------------------------------------- 
    45 &namcrs        !   Grid coarsening for dynamics output and/or 
    46 !              !   passive tracer coarsened online simulations 
    47 !----------------------------------------------------------------------- 
    4841/ 
    4942!----------------------------------------------------------------------- 
    … …  
    5649   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F) 
    5750/ 
     51 
     52!!====================================================================== 
     53!!            ***  Surface Boundary Condition namelists  *** 
     54!!====================================================================== 
    5855!----------------------------------------------------------------------- 
    5956&namsbc        !   Surface Boundary Condition (surface module) 
    … …  
    7673/ 
    7774!----------------------------------------------------------------------- 
    78 &namsbc_rnf    !   runoffs namelist surface boundary condition 
    79 !----------------------------------------------------------------------- 
    80    ln_rnf_mouth = .false.   !  specific treatment at rivers mouths 
    81 / 
    82 !----------------------------------------------------------------------- 
    83 &namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk 
    84 !----------------------------------------------------------------------- 
    85 / 
    86 !----------------------------------------------------------------------- 
    87 &namsbc_ssr    !   surface boundary condition : sea surface restoring 
    88 !----------------------------------------------------------------------- 
    89 / 
    90 !----------------------------------------------------------------------- 
    91 &namsbc_alb    !   albedo parameters 
    92 !----------------------------------------------------------------------- 
    93 / 
    94 !----------------------------------------------------------------------- 
    95 &namberg       !   iceberg parameters 
    96 !----------------------------------------------------------------------- 
    97 / 
    98 !----------------------------------------------------------------------- 
    9975&namlbc        !   lateral momentum boundary condition 
    10076!----------------------------------------------------------------------- 
    … …  
    10278/ 
    10379!----------------------------------------------------------------------- 
    104 &namagrif      !  AGRIF zoom                                            ("key_agrif") 
    105 !----------------------------------------------------------------------- 
    106 / 
    107 !----------------------------------------------------------------------- 
    108 &nam_tide      !    tide parameters 
    109 !----------------------------------------------------------------------- 
    110 / 
    111 !----------------------------------------------------------------------- 
    112 &nambdy        !  unstructured open boundaries                           
    113 !----------------------------------------------------------------------- 
    114 / 
    115 !----------------------------------------------------------------------- 
    116 &nambdy_dta      !  open boundaries - external data            
    117 !----------------------------------------------------------------------- 
    118 / 
    119 !----------------------------------------------------------------------- 
    120 &nambdy_tide     ! tidal forcing at open boundaries 
    121 !----------------------------------------------------------------------- 
    122 / 
    123 !----------------------------------------------------------------------- 
    12480&nambfr        !   bottom friction 
    12581!----------------------------------------------------------------------- 
    12682   nn_bfr      =    2      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction 
    127 / 
    128 !----------------------------------------------------------------------- 
    129 &nambbc        !   bottom temperature boundary condition                (default: NO) 
    130 !----------------------------------------------------------------------- 
    13183/ 
    13284!----------------------------------------------------------------------- 
    … …  
    282234/ 
    283235!----------------------------------------------------------------------- 
    284 &namzdf_ric    !   richardson number dependent vertical diffusion       ("key_zdfric" ) 
    285 !----------------------------------------------------------------------- 
    286 / 
    287 !----------------------------------------------------------------------- 
    288 &namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke") 
     236&namzdf_ric    !   richardson number dependent vertical diffusion       (ln_zdfric=T) 
     237!----------------------------------------------------------------------- 
     238/ 
     239!----------------------------------------------------------------------- 
     240&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  (ln_zdftke=T) 
    289241!----------------------------------------------------------------------- 
    290242   nn_etau     =   0       !  penetration of tke below the mixed layer (ML) due to internal & intertial waves 
    291243/ 
    292244!----------------------------------------------------------------------- 
    293 &namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls") 
    294 !----------------------------------------------------------------------- 
    295 / 
    296 !----------------------------------------------------------------------- 
    297 &namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm") 
    298 !----------------------------------------------------------------------- 
    299 / 
    300 !----------------------------------------------------------------------- 
    301 &namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx") 
     245&namzdf_gls                !   GLS vertical diffusion                   (ln_zdfgls=T) 
     246!----------------------------------------------------------------------- 
     247/ 
     248!----------------------------------------------------------------------- 
     249&namzdf_ddm    !   double diffusive mixing parameterization             (ln_zdfddm=T) 
     250!----------------------------------------------------------------------- 
     251/ 
     252!----------------------------------------------------------------------- 
     253&namzdf_tmx    !   tidal mixing parameterization                        (ln_zdftmx=T) 
    302254!----------------------------------------------------------------------- 
    303255   ln_tmx_itf  = .false.   !  ITF specific parameterisation 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_top_cfg

    r7715 r7953  
    4343/ 
    4444!----------------------------------------------------------------------- 
    45 &namtrc_zdf        !   vertical physics 
    46 !----------------------------------------------------------------------- 
    47 / 
    48 !----------------------------------------------------------------------- 
    4945&namtrc_rad        !  treatment of negative concentrations 
    5046!----------------------------------------------------------------------- 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/GYRE_PISCES/cpp_GYRE_PISCES.fcm

    r7646 r7953  
    1 bld::tool::fppkeys key_zdftke key_top key_mpp_mpi 
     1bld::tool::fppkeys key_zdftke key_top key_mpp_mpi key_nosignedzero 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_cfg

    r7828 r7953  
    235235/ 
    236236!----------------------------------------------------------------------- 
    237 &namzdf        !   vertical physics 
    238 !----------------------------------------------------------------------- 
    239 / 
    240 !----------------------------------------------------------------------- 
    241 &namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke") 
    242 !----------------------------------------------------------------------- 
    243 / 
    244 !----------------------------------------------------------------------- 
    245 &namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm") 
     237&namzdf        !   vertical physics                                     (default: NO selection) 
     238!----------------------------------------------------------------------- 
     239   !                       ! type of vertical closure 
     240   ln_zdfcst   = .false.      !  constant mixing 
     241   ln_zdfric   = .false.      !  local Richardson dependent formulation (T =>   fill namzdf_ric) 
     242   ln_zdftke   = .true.       !  Turbulent Kinetic Energy closure       (T =>   fill namzdf_tke) 
     243   ln_zdfgls   = .false.      !  Generic Length Scale closure           (T =>   fill namzdf_gls) 
     244   ! 
     245   !                       ! convection 
     246   ln_zdfevd   = .true.       !  Enhanced Vertical Diffusion scheme 
     247      nn_evdm  =    0            !  evd apply on tracer (=0) or on tracer and momentum (=1) 
     248      rn_evd   =  100.           !  evd mixing coefficient [m2/s] 
     249   ! 
     250   ln_zdfddm   = .true.    ! double diffusive mixing 
     251      rn_avts  =    1.e-4     !  maximum avs (vertical mixing on salinity) 
     252      rn_hsbfr =    1.6       !  heat/salt buoyancy flux ratio 
     253   ! 
     254   ln_zdftmx   = .true.    ! tidal mixing parameterization              (T =>   fill namzdf_tmx) 
     255   ! 
     256   ln_zdfqiao  = .false.   ! enhanced wave vertical mixing Qiao (2010) (T => ln_wave=T & ln_sdw=T & fill namsbc_wave) 
     257   ! 
     258   !                       ! time-stepping 
     259   ln_zdfexp   = .false.   ! split-explicit (T) or implicit (F) time stepping scheme 
     260      nn_zdfexp=    3         !  number of sub-timestep for ln_zdfexp=T 
     261   ! 
     262   !                       !  Coefficients 
     263   rn_avm0     =   1.2e-4     !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F) 
     264   rn_avt0     =   1.2e-5     !  vertical eddy diffusivity [m2/s]       (background Kz if ln_zdfcst=F) 
     265   nn_avb      =    0         !  profile for background avt & avm (=1) or not (=0) 
     266   nn_havtb    =    1         !  horizontal shape for avtb (=1) or not (=0) 
     267/ 
     268!----------------------------------------------------------------------- 
     269&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  
    246270!----------------------------------------------------------------------- 
    247271/ 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_top_cfg

    r7445 r7953  
    8181/ 
    8282!----------------------------------------------------------------------- 
    83 &namtrc_zdf        !   vertical physics 
    84 !----------------------------------------------------------------------- 
    85 / 
    86 !----------------------------------------------------------------------- 
    8783&namtrc_rad        !  treatment of negative concentrations  
    8884!----------------------------------------------------------------------- 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/cpp_ORCA2_LIM3_PISCES.fcm

    r7828 r7953  
    1 bld::tool::fppkeys key_trabbl key_lim3 key_zdftke key_zdfddm key_zdftmx_new key_iomput key_mpp_mpi key_top key_nosignedzero 
     1bld::tool::fppkeys key_trabbl key_lim3 key_zdftke key_zdftmx_new key_iomput key_mpp_mpi key_top key_nosignedzero 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/SHARED/field_def_nemo-opa.xml

    r7828 r7953  
    390390         <field id="avm"          long_name="vertical eddy viscosity"     standard_name="ocean_vertical_momentum_diffusivity"   unit="m2/s" /> 
    391391 
    392          <!-- avs: available with key_zdfddm --> 
     392         <!-- avs: if ln_zdfddm=F avs=avt --> 
    393393         <field id="avs"          long_name="salt vertical eddy diffusivity"   standard_name="ocean_vertical_salt_diffusivity"   unit="m2/s" /> 
    394394         <field id="logavs"       long_name="logarithm of salt vertical eddy diffusivity"   standard_name="ocean_vertical_heat_diffusivity"       unit="m2/s" /> 
    … …  
    398398         <field id="avm_evd"      long_name="convective enhancement of vertical viscosity"     standard_name="ocean_vertical_momentum_diffusivity_due_to_convection"   unit="m2/s" /> 
    399399 
    400          <!-- avt_tide: available with key_zdftmx --> 
    401          <field id="av_tide"      long_name="tidal vertical diffusivity"   standard_name="ocean_vertical_tracer_diffusivity_due_to_tides"   unit="m2/s" /> 
    402  
    403          <!-- variables available with key_zdftmx_new --> 
     400         <!-- variables available with ln_zdftmx =T --> 
    404401         <field id="av_ratio"     long_name="S over T diffusivity ratio"            standard_name="salinity_over_temperature_diffusivity_ratio"                     unit="1"    /> 
    405402         <field id="av_wave"      long_name="wave-induced vertical diffusivity"     standard_name="ocean_vertical_tracer_diffusivity_due_to_internal_waves"         unit="m2/s" /> 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/SHARED/namelist_ref

    r7931 r7953  
    236236/ 
    237237!----------------------------------------------------------------------- 
    238 &namsbc_blk   !   namsbc_blk  generic Bulk formula                      (ln_blk = T) 
     238&namsbc_blk   !   namsbc_blk  generic Bulk formula                      (ln_blk =T) 
    239239!----------------------------------------------------------------------- 
    240240!              !  file name                   ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights                              ! rotation ! land/sea mask ! 
    … …  
    326326/ 
    327327!----------------------------------------------------------------------- 
    328 &namtra_qsr    !   penetrative solar radiation                          (ln_traqsr=T) 
     328&namtra_qsr    !   penetrative solar radiation                          (ln_traqsr =T) 
    329329!----------------------------------------------------------------------- 
    330330!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    … …  
    343343/ 
    344344!----------------------------------------------------------------------- 
    345 &namsbc_rnf    !   runoffs namelist surface boundary condition          (ln_rnf=T) 
     345&namsbc_rnf    !   runoffs namelist surface boundary condition          (ln_rnf =T) 
    346346!----------------------------------------------------------------------- 
    347347!              !  file name           ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    … …  
    419419/ 
    420420!----------------------------------------------------------------------- 
    421 &namsbc_ssr    !   surface boundary condition : sea surface restoring   (ln_ssr=T) 
     421&namsbc_ssr    !   surface boundary condition : sea surface restoring   (ln_ssr =T) 
    422422!----------------------------------------------------------------------- 
    423423!              ! file name ! frequency (hours) ! variable ! time interp.!  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    … …  
    448448/ 
    449449!----------------------------------------------------------------------- 
    450 &namsbc_wave   ! External fields from wave model                        (ln_wave=T) 
     450&namsbc_wave   ! External fields from wave model                        (ln_wave =T) 
    451451!----------------------------------------------------------------------- 
    452452!              !  file name  ! frequency (hours) ! variable     ! time interp. !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    … …  
    667667! 
    668668!----------------------------------------------------------------------- 
    669 &nameos        !   ocean Equation Of State                              (default: NO) 
     669&nameos        !   ocean Equation Of Seawater                           (default: NO) 
    670670!----------------------------------------------------------------------- 
    671671   ln_teos10   = .false.         !  = Use TEOS-10 equation of state 
    … …  
    894894      nn_npc      =    1         ! frequency of application of npc 
    895895      nn_npcp     =  365         ! npc control print frequency 
    896 !!gm new 
    897896   ! 
    898897   ln_zdfddm   = .false.   ! double diffusive mixing 
    … …  
    902901   ln_zdftmx   = .false.   ! tidal mixing parameterization              (T =>   fill namzdf_tmx) 
    903902   ! 
    904 !!gm 
    905    ! 
    906903   ln_zdfqiao  = .false.   ! surface wave-induced mixing (Qiao et al. 2010) (T =>   ln_wave=ln_sdw=T. & fill namsbc_wave) 
    907904   ! 
    … …  
    909906   ln_zdfexp   = .false.   ! split-explicit (T) or implicit (F) scheme 
    910907      nn_zdfexp=    3         !  number of sub-timestep for ln_zdfexp=T 
     908   ! 
    911909   !                       ! coefficients 
    912910   rn_avm0     =   1.2e-4     !  vertical eddy viscosity   [m2/s]       (background Kz if ln_zdfcst=F) 
    … …  
    977975/ 
    978976!----------------------------------------------------------------------- 
    979 &namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx") 
    980 !----------------------------------------------------------------------- 
    981    rn_htmx     = 500.      !  vertical decay scale for turbulence (meters) 
    982    rn_n2min    = 1.e-8     !  threshold of the Brunt-Vaisala frequency (s-1) 
    983    rn_tfe      = 0.333     !  tidal dissipation efficiency 
    984    rn_me       = 0.2       !  mixing efficiency 
    985    ln_tmx_itf  = .true.    !  ITF specific parameterisation 
    986    rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency 
    987 / 
    988 !----------------------------------------------------------------------- 
    989 &namzdf_tmx_new !   internal wave-driven mixing parameterization        ("key_zdftmx_new" & "key_zdfddm") 
     977&namzdf_tmx    !    internal wave-driven mixing parameterization        (ln_zdftmx =T) 
    990978!----------------------------------------------------------------------- 
    991979   nn_zpyc     = 1         !  pycnocline-intensified dissipation scales as N (=1) or N^2 (=2) 
    … …  
    996984!!                  ***  Miscellaneous namelists  *** 
    997985!!====================================================================== 
    998 !!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi) 
     986!!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi") 
    999987!!   namctl            Control prints  
    1000988!!   namsto            Stochastic parametrization of EOS 
    … …  
    1002990! 
    1003991!----------------------------------------------------------------------- 
    1004 &nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi) 
     992&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi") 
    1005993!----------------------------------------------------------------------- 
    1006994   cn_mpi_send =  'I'      !  mpi send/recieve type   ='S', 'B', or 'I' for standard send, 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/SHARED/namelist_top_ref

    r7646 r7953  
    9595/ 
    9696!----------------------------------------------------------------------- 
    97 &namtrc_zdf      !   vertical physics 
    98 !----------------------------------------------------------------------- 
    99    ln_trczdf_exp =  .false.  !  split explicit (T) or implicit (F) time stepping 
    100    nn_trczdf_exp =   3       !  number of sub-timestep for ln_trczdfexp=T 
    101 / 
    102 !----------------------------------------------------------------------- 
    10397&namtrc_rad      !  treatment of negative concentrations  
    10498!----------------------------------------------------------------------- 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/cfg.txt

    r7715 r7953  
    11AMM12 OPA_SRC 
    22C1D_PAPA OPA_SRC 
    3 GYRE_PISCES OPA_SRC TOP_SRC 
    43GYRE_BFM OPA_SRC TOP_SRC 
    54ORCA2_SAS_LIM3 OPA_SRC SAS_SRC LIM_SRC_3 NST_SRC 
    65ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC 
    76ORCA2_OFF_TRC OPA_SRC OFF_SRC TOP_SRC 
     7GYRE_PISCES OPA_SRC TOP_SRC 
    88ORCA2_LIM3_PISCES OPA_SRC LIM_SRC_3 TOP_SRC NST_SRC 
     9GYRE_PISCES_XIOS OPA_SRC TOP_SRC 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/NST_SRC/agrif_ice.F90

    r7646 r7953  
    1818   PUBLIC agrif_ice_alloc ! routine called by nemo_init in nemogcm.F90 
    1919 
    20    INTEGER, PUBLIC :: u_ice_id, v_ice_id, adv_ice_id 
    21    REAL(wp), PUBLIC :: lim_nbstep = 0.    ! child time position in sea-ice model 
     20   INTEGER , PUBLIC ::  u_ice_id, v_ice_id, adv_ice_id 
     21   REAL(wp), PUBLIC ::   lim_nbstep = 0.    ! child time position in sea-ice model 
    2222#if defined key_lim2_vp 
    2323   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)     :: u_ice_nst, v_ice_nst    
    2424#else 
    2525   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)   :: u_ice_oe, u_ice_sn     !: boundaries arrays 
    26    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)   :: v_ice_oe, v_ice_sn     !:  "          "  
     26   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)   :: v_ice_oe, v_ice_sn     !:     -        -  
    2727#endif 
    28    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:,:) :: adv_ice_oe, adv_ice_sn !:  "          " 
     28   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:,:) :: adv_ice_oe, adv_ice_sn !:     -        - 
    2929 
    3030   !!---------------------------------------------------------------------- 
    31    !! NEMO/NST 3.3.4 , NEMO Consortium (2012) 
     31   !! NEMO/NST 4.0 , NEMO Consortium (2017) 
    3232   !! $Id$ 
    3333   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3434   !!---------------------------------------------------------------------- 
    35  
    3635CONTAINS  
    3736 
    … …  
    5049 
    5150#if ! defined key_lim2_vp 
    52       u_ice_oe(:,:,:) =  0.e0 
    53       v_ice_oe(:,:,:) =  0.e0 
    54       u_ice_sn(:,:,:) =  0.e0 
    55       v_ice_sn(:,:,:) =  0.e0 
     51      u_ice_oe(:,:,:) =  0._wp 
     52      v_ice_oe(:,:,:) =  0._wp 
     53      u_ice_sn(:,:,:) =  0._wp 
     54      v_ice_sn(:,:,:) =  0._wp 
    5655#endif 
    57       adv_ice_oe (:,:,:,:) = 0.e0  
    58       adv_ice_sn (:,:,:,:) = 0.e0  
     56      adv_ice_oe (:,:,:,:) = 0._wp  
     57      adv_ice_sn (:,:,:,:) = 0._wp 
    5958      ! 
    6059   END FUNCTION agrif_ice_alloc 
    … …  
    7170 
    7271   !!---------------------------------------------------------------------- 
    73    !! NEMO/NST 3.6 , NEMO Consortium (2016) 
     72   !! NEMO/NST 4.0 , NEMO Consortium (2017) 
    7473   !! $Id$ 
    7574   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/NST_SRC/agrif_lim3_interp.F90

    r7761 r7953  
    2828   PRIVATE 
    2929 
    30    PUBLIC agrif_interp_lim3 
     30   PUBLIC   agrif_interp_lim3   ! called by ??? 
    3131 
    3232   !!---------------------------------------------------------------------- 
    … …  
    4646      !!  computing factor for time interpolation 
    4747      !!----------------------------------------------------------------------- 
    48       CHARACTER(len=1), INTENT( in )           :: cd_type 
    49       INTEGER         , INTENT( in ), OPTIONAL :: kiter, kitermax 
    50       !! 
    51       REAL(wp) :: zbeta 
     48      CHARACTER(len=1), INTENT(in   )           ::  cd_type 
     49      INTEGER         , INTENT(in   ), OPTIONAL ::  kiter, kitermax 
     50      !! 
     51      REAL(wp) ::   zbeta   ! local scalar 
    5252      !!----------------------------------------------------------------------- 
    5353      ! 
    5454      IF( Agrif_Root() )  RETURN 
    5555      ! 
    56       SELECT CASE(cd_type) 
     56      SELECT CASE( cd_type ) 
    5757      CASE('U','V') 
    5858         IF( PRESENT( kiter ) ) THEN  ! interpolation at the child sub-time step (only for ice rheology) 
    … …  
    6666      END SELECT 
    6767      ! 
    68       Agrif_SpecialValue=-9999. 
     68      Agrif_SpecialValue    = -9999. 
    6969      Agrif_UseSpecialValue = .TRUE. 
    70       SELECT CASE(cd_type) 
    71       CASE('U') 
    72          CALL Agrif_Bc_variable( u_ice_id  , procname=interp_u_ice  , calledweight=zbeta ) 
    73       CASE('V') 
    74          CALL Agrif_Bc_variable( v_ice_id  , procname=interp_v_ice  , calledweight=zbeta ) 
    75       CASE('T') 
    76          CALL Agrif_Bc_variable( tra_ice_id, procname=interp_tra_ice, calledweight=zbeta ) 
     70      SELECT CASE( cd_type ) 
     71      CASE('U')   ;   CALL Agrif_Bc_variable( u_ice_id  , procname=interp_u_ice  , calledweight=zbeta ) 
     72      CASE('V')   ;   CALL Agrif_Bc_variable( v_ice_id  , procname=interp_v_ice  , calledweight=zbeta ) 
     73      CASE('T')   ;   CALL Agrif_Bc_variable( tra_ice_id, procname=interp_tra_ice, calledweight=zbeta ) 
    7774      END SELECT 
    78       Agrif_SpecialValue=0. 
     75      Agrif_SpecialValue    = 0._wp 
    7976      Agrif_UseSpecialValue = .FALSE. 
    8077      ! 
    8178   END SUBROUTINE agrif_interp_lim3 
    8279 
    83    !!------------------ 
    84    !! Local subroutines 
    85    !!------------------ 
     80 
    8681   SUBROUTINE interp_u_ice( ptab, i1, i2, j1, j2, before ) 
    8782      !!----------------------------------------------------------------------- 
    … …  
    9287      !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 
    9388      !!----------------------------------------------------------------------- 
    94       INTEGER , INTENT(in) :: i1, i2, j1, j2 
    95       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
    96       LOGICAL , INTENT(in) :: before 
    97       !! 
    98       REAL(wp) :: zrhoy 
     89      INTEGER                         , INTENT(in   ) ::  i1, i2, j1, j2 
     90      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
     91      LOGICAL                         , INTENT(in   ) ::  before 
     92      !! 
     93      REAL(wp) ::   zrhoy   ! local scalar 
    9994      !!----------------------------------------------------------------------- 
    10095      ! 
    … …  
    118113      !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 
    119114      !!-----------------------------------------------------------------------       
    120       INTEGER , INTENT(in) :: i1, i2, j1, j2 
    121       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
    122       LOGICAL , INTENT(in) :: before 
    123       !! 
    124       REAL(wp) :: zrhox 
     115      INTEGER                         , INTENT(in   ) ::  i1, i2, j1, j2 
     116      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
     117      LOGICAL                         , INTENT(in   ) ::  before 
     118      !! 
     119      REAL(wp) ::   zrhox   ! local scalar 
    125120      !!----------------------------------------------------------------------- 
    126121      ! 
    … …  
    144139      !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 
    145140      !!----------------------------------------------------------------------- 
    146       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    147       INTEGER , INTENT(in) :: i1, i2, j1, j2, k1, k2 
    148       LOGICAL , INTENT(in) :: before 
    149       INTEGER , INTENT(in) :: nb, ndir 
    150       !! 
    151       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztab 
     141      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
     142      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
     143      LOGICAL                               , INTENT(in   ) ::   before 
     144      INTEGER                               , INTENT(in   ) ::   nb, ndir 
     145      !! 
    152146      INTEGER  ::   ji, jj, jk, jl, jm 
    153147      INTEGER  ::   imin, imax, jmin, jmax 
     148      LOGICAL  ::   western_side, eastern_side, northern_side, southern_side 
    154149      REAL(wp) ::   zrhox, z1, z2, z3, z4, z5, z6, z7 
    155       LOGICAL  ::   western_side, eastern_side, northern_side, southern_side 
    156  
    157       !!----------------------------------------------------------------------- 
    158       ! tracers are not multiplied by grid cell here => before: * e12t ; after: * r1_e12t / rhox / rhoy 
     150      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztab 
     151      !!----------------------------------------------------------------------- 
     152      ! tracers are not multiplied by grid cell here => before: * e1e2t ; after: * r1_e1e2t / rhox / rhoy 
    159153      ! and it is ok since we conserve tracers (same as in the ocean). 
    160154      ALLOCATE( ztab(SIZE(a_i_b,1),SIZE(a_i_b,2),SIZE(ptab,3)) ) 
    … …  
    163157         jm = 1 
    164158         DO jl = 1, jpl 
    165             ptab(i1:i2,j1:j2,jm) = a_i_b  (i1:i2,j1:j2,jl) ; jm = jm + 1 
    166             ptab(i1:i2,j1:j2,jm) = v_i_b  (i1:i2,j1:j2,jl) ; jm = jm + 1 
    167             ptab(i1:i2,j1:j2,jm) = v_s_b  (i1:i2,j1:j2,jl) ; jm = jm + 1 
    168             ptab(i1:i2,j1:j2,jm) = smv_i_b(i1:i2,j1:j2,jl) ; jm = jm + 1 
    169             ptab(i1:i2,j1:j2,jm) = oa_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1 
     159            ptab(i1:i2,j1:j2,jm) = a_i_b  (i1:i2,j1:j2,jl)   ;  jm = jm + 1 
     160            ptab(i1:i2,j1:j2,jm) = v_i_b  (i1:i2,j1:j2,jl)   ;  jm = jm + 1 
     161            ptab(i1:i2,j1:j2,jm) = v_s_b  (i1:i2,j1:j2,jl)   ;  jm = jm + 1 
     162            ptab(i1:i2,j1:j2,jm) = smv_i_b(i1:i2,j1:j2,jl)   ;  jm = jm + 1 
     163            ptab(i1:i2,j1:j2,jm) = oa_i_b (i1:i2,j1:j2,jl)   ;  jm = jm + 1 
    170164            DO jk = 1, nlay_s 
    171                ptab(i1:i2,j1:j2,jm) = e_s_b(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 
    172             ENDDO 
     165               ptab(i1:i2,j1:j2,jm) = e_s_b(i1:i2,j1:j2,jk,jl)   ;  jm = jm + 1 
     166            END DO 
    173167            DO jk = 1, nlay_i 
    174                ptab(i1:i2,j1:j2,jm) = e_i_b(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 
    175             ENDDO 
    176          ENDDO 
     168               ptab(i1:i2,j1:j2,jm) = e_i_b(i1:i2,j1:j2,jk,jl)   ;  jm = jm + 1 
     169            END DO 
     170         END DO 
    177171          
    178172         DO jk = k1, k2 
    179             WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(i1:i2,j1:j2,jk) = -9999. 
    180          ENDDO 
     173            WHERE( tmask(i1:i2,j1:j2,1) == 0._wp )   ptab(i1:i2,j1:j2,jk) = -9999. 
     174         END DO 
    181175          
    182176      ELSE               ! child grid 
    … …  
    184178         jm = 1 
    185179         DO jl = 1, jpl 
    186             a_i  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    187             v_i  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    188             v_s  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    189             smv_i(i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    190             oa_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
     180            a_i  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)   ;  jm = jm + 1 
     181            v_i  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)   ;  jm = jm + 1 
     182            v_s  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)   ;  jm = jm + 1 
     183            smv_i(i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)   ;  jm = jm + 1 
     184            oa_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)   ;  jm = jm + 1 
    191185            DO jk = 1, nlay_s 
    192                e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    193             ENDDO 
     186               e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)   ;  jm = jm + 1 
     187            END DO 
    194188            DO jk = 1, nlay_i 
    195                e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    196             ENDDO 
    197          ENDDO 
     189               e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)   ;  jm = jm + 1 
     190            END DO 
     191         END DO 
    198192 
    199193!! ==> this is a more complex interpolation since we mix solutions over a couple of grid points 
    … …  
    319313         et_s(i1:i2,j1:j2)  = SUM( SUM( e_s(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 
    320314         et_i(i1:i2,j1:j2)  = SUM( SUM( e_i(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 
    321  
     315         ! 
    322316      ENDIF 
    323317       
    … …  
    327321 
    328322#else 
     323   !!---------------------------------------------------------------------- 
     324   !!   Empty module                                             no sea-ice 
     325   !!---------------------------------------------------------------------- 
    329326CONTAINS 
    330327   SUBROUTINE agrif_lim3_interp_empty 
    331       !!--------------------------------------------- 
    332       !!   *** ROUTINE agrif_lim3_interp_empty *** 
    333       !!--------------------------------------------- 
    334328      WRITE(*,*)  'agrif_lim3_interp : You should not have seen this print! error?' 
    335329   END SUBROUTINE agrif_lim3_interp_empty 
    336330#endif 
     331 
     332   !!====================================================================== 
    337333END MODULE agrif_lim3_interp 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90

    r7761 r7953  
    3131   PRIVATE 
    3232 
    33    PUBLIC agrif_update_lim3 
     33   PUBLIC   agrif_update_lim3   ! called by ???? 
    3434 
    3535   !!---------------------------------------------------------------------- 
    36    !! NEMO/NST 3.6 , LOCEAN-IPSL (2016) 
     36   !! NEMO/NST 4.0 , LOCEAN-IPSL (2017) 
    3737   !! $Id: agrif_lim3_update.F90 6204 2016-01-04 13:47:06Z cetlod $ 
    3838   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3939   !!---------------------------------------------------------------------- 
    40  
    4140CONTAINS 
    4241 
    … …  
    4948      !!---------------------------------------------------------------------- 
    5049      INTEGER, INTENT(in) :: kt 
    51       !! 
    5250      !!---------------------------------------------------------------------- 
    5351      ! 
    … …  
    5755                                                                                                                           ! i.e. update only at the parent time step 
    5856      Agrif_UseSpecialValueInUpdate = .TRUE. 
    59       Agrif_SpecialValueFineGrid = -9999. 
     57      Agrif_SpecialValueFineGrid    = -9999. 
    6058# if defined TWO_WAY 
    6159      IF( MOD(nbcline,nbclineupdate) == 0) THEN ! update the whole basin at each nbclineupdate (=nn_cln_update) baroclinic parent time steps 
    … …  
    7573 
    7674 
    77    !!------------------ 
    78    !! Local subroutines 
    79    !!------------------ 
    8075   SUBROUTINE update_tra_ice( ptab, i1, i2, j1, j2, k1, k2, before ) 
    8176      !!----------------------------------------------------------------------- 
    … …  
    8479      !!              the properties per mass on the coarse grid 
    8580      !!----------------------------------------------------------------------- 
    86       INTEGER , INTENT(in) :: i1, i2, j1, j2, k1, k2 
    87       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    88       LOGICAL , INTENT(in) :: before 
     81      INTEGER                               , INTENT(in   ) ::  i1, i2, j1, j2, k1, k2 
     82      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
     83      LOGICAL                               , INTENT(in   ) ::  before 
    8984      !! 
    9085      INTEGER  :: jk, jl, jm 
    … …  
    9489         jm = 1 
    9590         DO jl = 1, jpl 
    96             ptab(:,:,jm) = a_i  (i1:i2,j1:j2,jl) ; jm = jm + 1 
    97             ptab(:,:,jm) = v_i  (i1:i2,j1:j2,jl) ; jm = jm + 1 
    98             ptab(:,:,jm) = v_s  (i1:i2,j1:j2,jl) ; jm = jm + 1 
    99             ptab(:,:,jm) = smv_i(i1:i2,j1:j2,jl) ; jm = jm + 1 
    100             ptab(:,:,jm) = oa_i (i1:i2,j1:j2,jl) ; jm = jm + 1 
     91            ptab(:,:,jm) = a_i  (i1:i2,j1:j2,jl)   ;  jm = jm + 1 
     92            ptab(:,:,jm) = v_i  (i1:i2,j1:j2,jl)   ;  jm = jm + 1 
     93            ptab(:,:,jm) = v_s  (i1:i2,j1:j2,jl)   ;  jm = jm + 1 
     94            ptab(:,:,jm) = smv_i(i1:i2,j1:j2,jl)   ;  jm = jm + 1 
     95            ptab(:,:,jm) = oa_i (i1:i2,j1:j2,jl)   ;  jm = jm + 1 
    10196            DO jk = 1, nlay_s 
    102                ptab(:,:,jm) = e_s(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 
    103             ENDDO 
     97               ptab(:,:,jm) = e_s(i1:i2,j1:j2,jk,jl)   ;  jm = jm + 1 
     98            END DO 
    10499            DO jk = 1, nlay_i 
    105                ptab(:,:,jm) = e_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 
    106             ENDDO 
    107          ENDDO 
     100               ptab(:,:,jm) = e_i(i1:i2,j1:j2,jk,jl)   ;  jm = jm + 1 
     101            END DO 
     102         END DO 
    108103 
    109104         DO jk = k1, k2 
    110105            WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:,jk) = -9999. 
    111          ENDDO 
    112                    
     106         END DO 
     107         !        
    113108      ELSE 
    114109         jm = 1 
    115110         DO jl = 1, jpl 
    116             a_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    117             v_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    118             v_s  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    119             smv_i(i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    120             oa_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
     111            a_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;  jm = jm + 1 
     112            v_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;  jm = jm + 1 
     113            v_s  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;  jm = jm + 1 
     114            smv_i(i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;  jm = jm + 1 
     115            oa_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;  jm = jm + 1 
    121116            DO jk = 1, nlay_s 
    122                e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
     117               e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;  jm = jm + 1 
    123118            ENDDO 
    124119            DO jk = 1, nlay_i 
    125                e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    126             ENDDO 
    127          ENDDO 
     120               e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;  jm = jm + 1 
     121            END DO 
     122         END DO 
    128123 
    129124         ! integrated values 
    … …  
    144139      !! ** Method  : Update the fluxes and recover the properties (C-grid) 
    145140      !!----------------------------------------------------------------------- 
    146       INTEGER , INTENT(in) :: i1, i2, j1, j2 
    147       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
    148       LOGICAL , INTENT(in) :: before 
     141      INTEGER                         , INTENT(in   ) ::  i1, i2, j1, j2 
     142      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
     143      LOGICAL                         , INTENT(in   ) ::  before 
    149144      !! 
    150       REAL(wp) :: zrhoy 
     145      REAL(wp) ::   zrhoy   ! local scalar 
    151146      !!----------------------------------------------------------------------- 
    152147      ! 
    … …  
    154149         zrhoy = Agrif_Rhoy() 
    155150         ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice(i1:i2,j1:j2) * zrhoy 
    156          WHERE( umask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999. 
     151         WHERE( umask(i1:i2,j1:j2,1) == 0. )   ptab(:,:) = -9999. 
    157152      ELSE 
    158153         u_ice(i1:i2,j1:j2) = ptab(:,:) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1) 
    … …  
    167162      !! ** Method  : Update the fluxes and recover the properties (C-grid) 
    168163      !!----------------------------------------------------------------------- 
    169       INTEGER , INTENT(in) :: i1,i2,j1,j2 
    170       REAL(wp), DIMENSION(i1:i2,j1:j2),  INTENT(inout) :: ptab 
    171       LOGICAL , INTENT(in) :: before 
     164      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
     165      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::  ptab 
     166      LOGICAL                         , INTENT(in   ) ::  before 
    172167      !! 
    173       REAL(wp) :: zrhox 
     168      REAL(wp) ::   zrhox   ! local scalar 
    174169      !!----------------------------------------------------------------------- 
    175170      ! 
    … …  
    177172         zrhox = Agrif_Rhox() 
    178173         ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice(i1:i2,j1:j2) * zrhox 
    179          WHERE( vmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999. 
     174         WHERE( vmask(i1:i2,j1:j2,1) == 0. )   ptab(:,:) = -9999. 
    180175      ELSE 
    181176         v_ice(i1:i2,j1:j2) = ptab(:,:) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1) 
    … …  
    185180 
    186181#else 
     182   !!---------------------------------------------------------------------- 
     183   !!   Empty module                                             no sea-ice 
     184   !!---------------------------------------------------------------------- 
    187185CONTAINS 
    188186   SUBROUTINE agrif_lim3_update_empty 
    189       !!--------------------------------------------- 
    190       !!   *** ROUTINE agrif_lim3_update_empty *** 
    191       !!--------------------------------------------- 
    192187      WRITE(*,*)  'agrif_lim3_update : You should not have seen this print! error?' 
    193188   END SUBROUTINE agrif_lim3_update_empty 
    194189#endif 
     190 
     191   !!====================================================================== 
    195192END MODULE agrif_lim3_update 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90

    r5656 r7953  
    4747   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) :: fsahm_spt, fsahm_spf !: sponge viscosities 
    4848 
    49    ! Barotropic arrays used to store open boundary data during 
    50    ! time-splitting loop: 
     49   ! Barotropic arrays used to store open boundary data during time-splitting loop: 
    5150   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_w, vbdy_w, hbdy_w 
    5251   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_e, vbdy_e, hbdy_e 
    … …  
    5453   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_s, vbdy_s, hbdy_s 
    5554 
    56    INTEGER :: tsn_id                                                  ! AGRIF profile for tracers interpolation and update 
    57    INTEGER :: un_interp_id, vn_interp_id                              ! AGRIF profiles for interpolations 
    58    INTEGER :: un_update_id, vn_update_id                              ! AGRIF profiles for udpates 
    59    INTEGER :: tsn_sponge_id, un_sponge_id, vn_sponge_id               ! AGRIF profiles for sponge layers 
     55!!gm   add PUBLIC in all variable below: 
     56 
     57   INTEGER, PUBLIC :: tsn_id                                                  ! AGRIF profile for tracers interpolation and update 
     58   INTEGER, PUBLIC :: un_interp_id, vn_interp_id                              ! AGRIF profiles for interpolations 
     59   INTEGER, PUBLIC :: un_update_id, vn_update_id                              ! AGRIF profiles for udpates 
     60   INTEGER, PUBLIC :: tsn_sponge_id, un_sponge_id, vn_sponge_id               ! AGRIF profiles for sponge layers 
    6061# if defined key_top 
    61    INTEGER :: trn_id, trn_sponge_id 
     62   INTEGER, PUBLIC :: trn_id, trn_sponge_id 
    6263# endif   
    63    INTEGER :: unb_id, vnb_id, ub2b_interp_id, vb2b_interp_id 
    64    INTEGER :: ub2b_update_id, vb2b_update_id 
    65    INTEGER :: e3t_id, e1u_id, e2v_id, sshn_id 
    66    INTEGER :: scales_t_id 
    67 # if defined key_zdftke 
    68    INTEGER :: avt_id, avm_id, en_id 
    69 # endif   
    70    INTEGER :: umsk_id, vmsk_id 
    71    INTEGER :: kindic_agr 
     64   INTEGER, PUBLIC :: unb_id, vnb_id, ub2b_interp_id, vb2b_interp_id 
     65   INTEGER, PUBLIC :: ub2b_update_id, vb2b_update_id 
     66   INTEGER, PUBLIC :: e3t_id, e1u_id, e2v_id, sshn_id 
     67   INTEGER, PUBLIC :: scales_t_id 
     68   INTEGER, PUBLIC :: avt_id, avm_id, en_id                ! TKE related identificators 
     69   INTEGER, PUBLIC :: umsk_id, vmsk_id 
     70   INTEGER, PUBLIC :: kindic_agr 
     71    
     72!!gm end public addition 
    7273 
    7374   !!---------------------------------------------------------------------- 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90

    r7646 r7953  
    2121   USE oce 
    2222   USE dom_oce       
    23    USE zdf_oce 
     23   USE zdf_oce          ! vertical physics 
    2424   USE agrif_oce 
    2525   USE phycst 
    … …  
    3434 
    3535   PUBLIC   Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts 
    36    PUBLIC   interpun, interpvn 
    37    PUBLIC   interptsn,  interpsshn 
    38    PUBLIC   interpunb, interpvnb, interpub2b, interpvb2b 
     36   PUBLIC   interpun , interpvn 
     37   PUBLIC   interptsn, interpsshn 
     38   PUBLIC   interpunb, interpvnb , interpub2b, interpvb2b 
    3939   PUBLIC   interpe3t, interpumsk, interpvmsk 
    40 # if defined key_zdftke 
    4140   PUBLIC   Agrif_tke, interpavm 
    42 # endif 
    4341 
    4442   INTEGER ::   bdy_tinterp = 0 
    … …  
    4644#  include "vectopt_loop_substitute.h90" 
    4745   !!---------------------------------------------------------------------- 
    48    !! NEMO/NST 3.7 , NEMO Consortium (2015) 
     46   !! NEMO/NST 4.0 , NEMO Consortium (2017) 
    4947   !! $Id$ 
    5048   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    385383      !!                  ***  ROUTINE Agrif_dyn_ts  *** 
    386384      !!----------------------------------------------------------------------   
    387       !!  
    388385      INTEGER, INTENT(in) ::   jn 
    389386      !! 
    … …  
    444441      !!                  ***  ROUTINE Agrif_dta_ts  *** 
    445442      !!----------------------------------------------------------------------   
    446       !!  
    447443      INTEGER, INTENT(in) ::   kt 
    448444      !! 
    … …  
    504500      !!----------------------------------------------------------------------   
    505501      INTEGER, INTENT(in) ::   kt 
    506       !! 
    507502      !!----------------------------------------------------------------------   
    508503      ! 
    … …  
    541536      !!----------------------------------------------------------------------   
    542537      ! 
    543       IF((nbondi == -1).OR.(nbondi == 2)) THEN 
     538      IF( nbondi == -1 .OR. nbondi == 2 ) THEN 
    544539         DO jj = 1, jpj 
    545540            ssha_e(2,jj) = hbdy_w(jj) 
    … …  
    547542      ENDIF 
    548543      ! 
    549       IF((nbondi == 1).OR.(nbondi == 2)) THEN 
     544      IF( nbondi == 1 .OR. nbondi == 2 ) THEN 
    550545         DO jj = 1, jpj 
    551546            ssha_e(nlci-1,jj) = hbdy_e(jj) 
    … …  
    553548      ENDIF 
    554549      ! 
    555       IF((nbondj == -1).OR.(nbondj == 2)) THEN 
     550      IF( nbondj == -1 .OR.(nbondj == 2 ) THEN 
    556551         DO ji = 1, jpi 
    557552            ssha_e(ji,2) = hbdy_s(ji) 
    … …  
    559554      ENDIF 
    560555      ! 
    561       IF((nbondj == 1).OR.(nbondj == 2)) THEN 
     556      IF( nbondj == 1 .OR. nbondj == 2 ) THEN 
    562557         DO ji = 1, jpi 
    563558            ssha_e(ji,nlcj-1) = hbdy_n(ji) 
    … …  
    567562   END SUBROUTINE Agrif_ssh_ts 
    568563 
    569 # if defined key_zdftke 
    570564 
    571565   SUBROUTINE Agrif_tke 
    … …  
    579573      IF( zalpha > 1. )   zalpha = 1. 
    580574      ! 
    581       Agrif_SpecialValue    = 0.e0 
     575      Agrif_SpecialValue    = 0._wp 
    582576      Agrif_UseSpecialValue = .TRUE. 
    583577      ! 
    584       CALL Agrif_Bc_variable(avm_id ,calledweight=zalpha, procname=interpavm)        
     578      CALL Agrif_Bc_variable( avm_id , calledweight=zalpha, procname=interpavm )        
    585579      ! 
    586580      Agrif_UseSpecialValue = .FALSE. 
    587581      ! 
    588582   END SUBROUTINE Agrif_tke 
    589     
    590 # endif 
     583 
    591584 
    592585   SUBROUTINE interptsn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir ) 
    593586      !!---------------------------------------------------------------------- 
    594       !!   *** ROUTINE interptsn *** 
     587      !!                  *** ROUTINE interptsn *** 
    595588      !!---------------------------------------------------------------------- 
    596589      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   ptab 
    … …  
    599592      INTEGER                                     , INTENT(in   ) ::   nb , ndir 
    600593      ! 
    601       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    602       INTEGER  ::   imin, imax, jmin, jmax 
    603       REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3 
    604       REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7 
    605       LOGICAL  ::   western_side, eastern_side,northern_side,southern_side 
     594      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
     595      INTEGER ::   imin, imax, jmin, jmax 
     596      REAL(wp)::   zrhox , zalpha1, zalpha2, zalpha3 
     597      REAL(wp)::   zalpha4, zalpha5, zalpha6, zalpha7 
     598      LOGICAL ::   western_side, eastern_side,northern_side,southern_side 
    606599      !!---------------------------------------------------------------------- 
    607600      ! 
    … …  
    770763   SUBROUTINE interpun( ptab, i1, i2, j1, j2, k1, k2, before ) 
    771764      !!---------------------------------------------------------------------- 
    772       !!   *** ROUTINE interpun *** 
     765      !!                         *** ROUTINE interpun *** 
    773766      !!---------------------------------------------------------------------- 
    774767      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
    … …  
    776769      LOGICAL                               , INTENT(in   ) ::   before 
    777770      ! 
    778       INTEGER  ::   ji, jj, jk 
    779       REAL(wp) ::   zrhoy   
     771      INTEGER ::   ji, jj, jk 
     772      REAL(wp)::   zrhoy    
    780773      !!---------------------------------------------------------------------- 
    781774      ! 
    … …  
    798791   SUBROUTINE interpvn( ptab, i1, i2, j1, j2, k1, k2, before ) 
    799792      !!---------------------------------------------------------------------- 
    800       !!   *** ROUTINE interpvn *** 
     793      !!                      *** ROUTINE interpvn *** 
    801794      !!---------------------------------------------------------------------- 
    802795      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
    … …  
    804797      LOGICAL                               , INTENT(in   ) ::   before 
    805798      ! 
    806       INTEGER  ::   ji, jj, jk 
    807       REAL(wp) ::   zrhox   
     799      INTEGER ::   ji, jj, jk 
     800      REAL(wp)::   zrhox    
    808801      !!---------------------------------------------------------------------- 
    809802      !       
    … …  
    831824      INTEGER                         , INTENT(in   ) ::   nb , ndir 
    832825      ! 
    833       INTEGER  ::   ji, jj 
    834       REAL(wp) ::   zrhoy, zrhot, zt0, zt1, ztcoeff 
    835       LOGICAL  ::   western_side, eastern_side,northern_side,southern_side 
     826      INTEGER ::   ji, jj 
     827      REAL(wp)::   zrhoy, zrhot, zt0, zt1, ztcoeff 
     828      LOGICAL ::   western_side, eastern_side,northern_side,southern_side 
    836829      !!----------------------------------------------------------------------   
    837830      ! 
    … …  
    901894      INTEGER                         , INTENT(in   ) ::   nb , ndir 
    902895      ! 
    903       INTEGER  ::   ji,jj 
    904       REAL(wp) ::   zrhox, zrhot, zt0, zt1, ztcoeff    
    905       LOGICAL  ::   western_side, eastern_side,northern_side,southern_side 
     896      INTEGER ::   ji,jj 
     897      REAL(wp)::   zrhox, zrhot, zt0, zt1, ztcoeff    
     898      LOGICAL ::   western_side, eastern_side,northern_side,southern_side 
    906899      !!----------------------------------------------------------------------   
    907900      !  
    … …  
    919912         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot       
    920913         IF( bdy_tinterp == 1 ) THEN 
    921             ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        & 
    922                &               - zt0**2._wp * (       zt0 - 1._wp)        ) 
     914            ztcoeff = zrhot * (  zt1**2._wp * ( zt1 - 1._wp)        & 
     915               &               - zt0**2._wp * ( zt0 - 1._wp)        ) 
    923916         ELSEIF( bdy_tinterp == 2 ) THEN 
    924             ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp & 
    925                &               - zt0        * (       zt0 - 1._wp)**2._wp )  
     917            ztcoeff = zrhot * (  zt1        * ( zt1 - 1._wp)**2._wp & 
     918               &               - zt0        * ( zt0 - 1._wp)**2._wp )  
    926919         ELSE 
    927920            ztcoeff = 1 
    … …  
    942935         !             
    943936         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 
    944             IF(western_side) THEN 
    945                vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2))   & 
    946                      &                                  * vmask(i1,j1:j2,1) 
    947             ENDIF 
    948             IF(eastern_side) THEN 
    949                vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2))   & 
    950                      &                                  * vmask(i1,j1:j2,1) 
    951             ENDIF 
    952             IF(southern_side) THEN 
    953                vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j1))   & 
    954                      &                                  * vmask(i1:i2,j1,1) 
    955             ENDIF 
    956             IF(northern_side) THEN 
    957                vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1))   & 
    958                      &                                  * vmask(i1:i2,j1,1) 
     937            IF( western_side  )   vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2)) * vmask(i1,j1:j2,1) 
     938            IF( eastern_side  )   vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2)) * vmask(i1,j1:j2,1) 
     939            IF( southern_side )   vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j1)) * vmask(i1:i2,j1,1) 
     940            IF( northern_side )   vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1)) * vmask(i1:i2,j1,1) 
    959941            ENDIF 
    960942         ENDIF 
    … …  
    973955      INTEGER                         , INTENT(in   ) ::   nb , ndir 
    974956      ! 
    975       INTEGER  ::   ji,jj 
    976       REAL(wp) ::   zrhot, zt0, zt1,zat 
    977       LOGICAL  ::   western_side, eastern_side,northern_side,southern_side 
     957      INTEGER ::   ji,jj 
     958      REAL(wp)::   zrhot, zt0, zt1,zat 
     959      LOGICAL ::   western_side, eastern_side,northern_side,southern_side 
    978960      !!----------------------------------------------------------------------   
    979961      IF( before ) THEN 
    … …  
    10301012            &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    )  
    10311013         ! 
    1032          IF(western_side )   vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)   
    1033          IF(eastern_side )   vbdy_e(j1:j2) = zat * ptab(i1,j1:j2)   
    1034          IF(southern_side)   vbdy_s(i1:i2) = zat * ptab(i1:i2,j1)  
    1035          IF(northern_side)   vbdy_n(i1:i2) = zat * ptab(i1:i2,j1)  
     1014         IF( western_side )   vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)   
     1015         IF( eastern_side )   vbdy_e(j1:j2) = zat * ptab(i1,j1:j2)   
     1016         IF( southern_side )   vbdy_s(i1:i2) = zat * ptab(i1:i2,j1)  
     1017         IF( northern_side )   vbdy_n(i1:i2) = zat * ptab(i1:i2,j1)  
    10361018      ENDIF 
    10371019      !       
    … …  
    10481030      INTEGER                              , INTENT(in   ) :: nb , ndir 
    10491031      ! 
    1050       INTEGER :: ji, jj, jk 
    1051       LOGICAL :: western_side, eastern_side, northern_side, southern_side 
    1052       REAL(wp) :: ztmpmsk       
     1032      INTEGER ::   ji, jj, jk 
     1033      LOGICAL ::   western_side, eastern_side, northern_side, southern_side 
     1034      REAL(wp)::  ztmpmsk       
    10531035      !!----------------------------------------------------------------------   
    10541036      !     
    … …  
    10651047               DO ji = i1, i2 
    10661048                  ! Get velocity mask at boundary edge points: 
    1067                   IF( western_side )   ztmpmsk = umask(ji    ,jj    ,1) 
    1068                   IF( eastern_side )   ztmpmsk = umask(nlci-2,jj    ,1) 
    1069                   IF( northern_side)   ztmpmsk = vmask(ji    ,nlcj-2,1) 
    1070                   IF( southern_side)   ztmpmsk = vmask(ji    ,2     ,1) 
     1049                  IF( western_side  )   ztmpmsk = umask(ji    ,jj    ,1) 
     1050                  IF( eastern_side  )   ztmpmsk = umask(nlci-2,jj    ,1) 
     1051                  IF( northern_side )   ztmpmsk = vmask(ji    ,nlcj-2,1) 
     1052                  IF( southern_side )   ztmpmsk = vmask(ji    ,2     ,1) 
    10711053                  ! 
    10721054                  IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) )*ztmpmsk > 1.D-2) THEN 
    … …  
    11411123      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
    11421124      LOGICAL                              , INTENT(in   ) ::   before 
    1143       INTEGER                              , INTENT(in   ) :: nb , ndir 
     1125      INTEGER                              , INTENT(in   ) ::   nb , ndir 
    11441126      ! 
    11451127      INTEGER ::   ji, jj, jk 
    … …  
    11751157   END SUBROUTINE interpvmsk 
    11761158 
    1177 # if defined key_zdftke 
    11781159 
    11791160   SUBROUTINE interpavm( ptab, i1, i2, j1, j2, k1, k2, before ) 
    … …  
    11861167      !!----------------------------------------------------------------------   
    11871168      !       
    1188       IF( before ) THEN 
    1189          ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 
    1190       ELSE 
    1191          avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
     1169      IF( before ) THEN   ;   ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 
     1170      ELSE                ;   avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
    11921171      ENDIF 
    11931172      ! 
    11941173   END SUBROUTINE interpavm 
    1195  
    1196 # endif /* key_zdftke */ 
    11971174 
    11981175#else 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90

    r7646 r7953  
    33MODULE agrif_opa_sponge 
    44   !!====================================================================== 
    5    !!                ***  MODULE agrif_opa_update  *** 
    6    !! AGRIF :    
     5   !!                   ***  MODULE  agrif_opa_interp  *** 
     6   !! AGRIF: interpolation package 
    77   !!====================================================================== 
    8    !! History :   
     8   !! History :  2.0  !  2002-06  (XXX)  Original cade 
     9   !!             -   !  2005-11  (XXX)  
     10   !!            3.2  !  2009-04  (R. Benshila)  
     11   !!            3.6  !  2014-09  (R. Benshila)  
    912   !!---------------------------------------------------------------------- 
    1013#if defined key_agrif 
     14   !!---------------------------------------------------------------------- 
     15   !!   'key_agrif'                                              AGRIF zoom 
     16   !!---------------------------------------------------------------------- 
    1117   USE par_oce 
    1218   USE oce 
    1319   USE dom_oce 
     20   ! 
    1421   USE in_out_manager 
    1522   USE agrif_oce 
    … …  
    2431 
    2532   !!---------------------------------------------------------------------- 
    26    !! NEMO/NST 3.7 , NEMO Consortium (2015) 
     33   !! NEMO/NST 4.0 , NEMO Consortium (2017) 
    2734   !! $Id$ 
    2835   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    3138 
    3239   SUBROUTINE Agrif_Sponge_Tra 
    33       !!--------------------------------------------- 
    34       !!   *** ROUTINE Agrif_Sponge_Tra *** 
    35       !!--------------------------------------------- 
    36       REAL(wp) :: timecoeff 
    37       !!--------------------------------------------- 
     40      !!---------------------------------------------------------------------- 
     41      !!                 *** ROUTINE Agrif_Sponge_Tra *** 
     42      !!---------------------------------------------------------------------- 
     43      REAL(wp) ::   timecoeff   ! local scalar 
     44      !!---------------------------------------------------------------------- 
    3845      ! 
    3946#if defined SPONGE 
    4047      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
    41  
     48      ! 
    4249      CALL Agrif_Sponge 
    43       Agrif_SpecialValue=0. 
     50      Agrif_SpecialValue    = 0._wp 
    4451      Agrif_UseSpecialValue = .TRUE. 
    45       tabspongedone_tsn = .FALSE. 
    46  
     52      tabspongedone_tsn     = .FALSE. 
     53      ! 
    4754      CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=timecoeff,procname=interptsn_sponge) 
    48  
     55      ! 
    4956      Agrif_UseSpecialValue = .FALSE. 
    5057#endif 
    … …  
    5461 
    5562   SUBROUTINE Agrif_Sponge_dyn 
    56       !!--------------------------------------------- 
    57       !!   *** ROUTINE Agrif_Sponge_dyn *** 
    58       !!--------------------------------------------- 
    59       REAL(wp) :: timecoeff 
    60       !!--------------------------------------------- 
    61  
     63      !!---------------------------------------------------------------------- 
     64      !!                 *** ROUTINE Agrif_Sponge_dyn *** 
     65      !!---------------------------------------------------------------------- 
     66      REAL(wp) ::   timecoeff   ! local scalar 
     67      !!---------------------------------------------------------------------- 
     68      ! 
    6269#if defined SPONGE 
    6370      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
    64  
    65       Agrif_SpecialValue=0. 
     71      ! 
     72      Agrif_SpecialValue    = 0._wp 
    6673      Agrif_UseSpecialValue = ln_spc_dyn 
    67  
     74      ! 
    6875      tabspongedone_u = .FALSE. 
    6976      tabspongedone_v = .FALSE.          
    7077      CALL Agrif_Bc_Variable(un_sponge_id,calledweight=timecoeff,procname=interpun_sponge) 
    71  
     78      ! 
    7279      tabspongedone_u = .FALSE. 
    7380      tabspongedone_v = .FALSE. 
    7481      CALL Agrif_Bc_Variable(vn_sponge_id,calledweight=timecoeff,procname=interpvn_sponge) 
    75  
     82      ! 
    7683      Agrif_UseSpecialValue = .FALSE. 
    7784#endif 
    … …  
    8188 
    8289   SUBROUTINE Agrif_Sponge 
    83       !!--------------------------------------------- 
    84       !!   *** ROUTINE  Agrif_Sponge *** 
    85       !!--------------------------------------------- 
     90      !!---------------------------------------------------------------------- 
     91      !!                 *** ROUTINE  Agrif_Sponge *** 
     92      !!---------------------------------------------------------------------- 
    8693      INTEGER  :: ji,jj,jk 
    8794      INTEGER  :: ispongearea, ilci, ilcj 
    … …  
    8996      REAL(wp) :: z1spongearea, zramp 
    9097      REAL(wp), POINTER, DIMENSION(:,:) :: ztabramp 
    91  
     98      !!---------------------------------------------------------------------- 
     99      ! 
    92100#if defined SPONGE || defined SPONGE_TOP 
    93101      ll_spdone=.TRUE. 
    … …  
    176184               fsahm_spt(ji,jj) = visc_dyn * ztabramp(ji,jj) 
    177185               fsahm_spf(ji,jj) = 0.25_wp * visc_dyn * ( ztabramp(ji,jj) + ztabramp(ji  ,jj+1) & 
    178                                                      &  +ztabramp(ji,jj) + ztabramp(ji+1,jj  ) ) 
    179             END DO 
    180          END DO 
    181  
     186                  &                                     +ztabramp(ji,jj) + ztabramp(ji+1,jj  ) ) 
     187            END DO 
     188         END DO 
     189         ! 
    182190         CALL lbc_lnk( fsahm_spt, 'T', 1. )   ! Lateral boundary conditions 
    183191         CALL lbc_lnk( fsahm_spf, 'F', 1. ) 
    … …  
    192200 
    193201 
    194    SUBROUTINE interptsn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before) 
    195       !!--------------------------------------------- 
    196       !!   *** ROUTINE interptsn_sponge *** 
    197       !!--------------------------------------------- 
    198       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    199       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    200       LOGICAL, INTENT(in) :: before 
     202   SUBROUTINE interptsn_sponge( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
     203      !!---------------------------------------------------------------------- 
     204      !!                 *** ROUTINE interptsn_sponge *** 
     205      !!---------------------------------------------------------------------- 
     206      INTEGER                                     , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2 
     207      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   tabres 
     208      LOGICAL                                     , INTENT(in   ) ::  before 
    201209      ! 
    202210      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    … …  
    205213      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ztu, ztv 
    206214      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff 
     215      !!---------------------------------------------------------------------- 
    207216      ! 
    208217      IF( before ) THEN 
    … …  
    258267 
    259268 
    260    SUBROUTINE interpun_sponge(tabres,i1,i2,j1,j2,k1,k2, before) 
    261       !!--------------------------------------------- 
    262       !!   *** ROUTINE interpun_sponge *** 
    263       !!---------------------------------------------     
    264       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    265       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    266       LOGICAL, INTENT(in) :: before 
    267  
     269   SUBROUTINE interpun_sponge( tabres, i1, i2, j1, j2, k1, k2, before ) 
     270      !!---------------------------------------------------------------------- 
     271      !!                 *** ROUTINE interpun_sponge *** 
     272      !!---------------------------------------------------------------------- 
     273      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
     274      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   tabres 
     275      LOGICAL                               , INTENT(in   ) ::  before 
     276      !! 
    268277      INTEGER :: ji,jj,jk 
    269  
    270       ! sponge parameters  
     278      INTEGER :: jmax 
    271279      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr 
    272280      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ubdiff 
    273281      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff 
    274       INTEGER :: jmax 
    275       !!---------------------------------------------     
     282      !!---------------------------------------------------------------------- 
    276283      ! 
    277284      IF( before ) THEN 
    … …  
    356363 
    357364 
    358    SUBROUTINE interpvn_sponge(tabres,i1,i2,j1,j2,k1,k2, before,nb,ndir) 
    359       !!--------------------------------------------- 
    360       !!   *** ROUTINE interpvn_sponge *** 
    361       !!---------------------------------------------  
    362       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    363       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    364       LOGICAL, INTENT(in) :: before 
    365       INTEGER, INTENT(in) :: nb , ndir 
    366       ! 
    367       INTEGER  ::   ji, jj, jk 
    368       REAL(wp) ::   ze2u, ze1v, zua, zva, zbtr 
    369       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: vbdiff 
    370       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff 
    371       INTEGER :: imax 
    372       !!---------------------------------------------  
     365   SUBROUTINE interpvn_sponge( tabres, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 
     366      !!---------------------------------------------------------------------- 
     367      !!                 *** ROUTINE interpvn_sponge *** 
     368      !!---------------------------------------------------------------------- 
     369      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
     370      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   tabres 
     371      LOGICAL                               , INTENT(in   ) ::   before 
     372      INTEGER                               , INTENT(in   ) ::   nb , ndir 
     373      ! 
     374      INTEGER ::   ji, jj, jk 
     375      INTEGER ::   imax 
     376      REAL(wp)::   ze2u, ze1v, zua, zva, zbtr 
     377      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) ::   vbdiff, rotdiff, hdivdiff 
     378      !!---------------------------------------------------------------------- 
    373379 
    374380      IF( before ) THEN  
    … …  
    403409         !                                                 
    404410 
    405          imax = i2-1 
     411         imax = i2 - 1 
    406412         IF ((nbondi == 1).OR.(nbondi == 2))   imax = MIN(imax,nlci-3) 
    407413 
    … …  
    437443 
    438444#else 
     445   !!---------------------------------------------------------------------- 
     446   !!   Empty module                                          no AGRIF zoom 
     447   !!---------------------------------------------------------------------- 
    439448CONTAINS 
    440449   SUBROUTINE agrif_opa_sponge_empty 
    441       !!--------------------------------------------- 
    442       !!   *** ROUTINE agrif_OPA_sponge_empty *** 
    443       !!--------------------------------------------- 
     450      !!---------------------------------------------------------------------- 
     451      !!                 *** ROUTINE agrif_OPA_sponge_empty *** 
     452      !!---------------------------------------------------------------------- 
    444453      WRITE(*,*)  'agrif_opa_sponge : You should not have seen this print! error?' 
    445454   END SUBROUTINE agrif_opa_sponge_empty 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

    r7646 r7953  
    33  
    44MODULE agrif_opa_update 
     5   !!====================================================================== 
     6   !!                   ***  MODULE  agrif_opa_interp  *** 
     7   !! AGRIF: interpolation package 
     8   !!====================================================================== 
     9   !! History :  2.0  !  2002-06  (XXX)  Original cade 
     10   !!             -   !  2005-11  (XXX)  
     11   !!            3.2  !  2009-04  (R. Benshila)  
     12   !!            3.6  !  2014-09  (R. Benshila)  
     13   !!---------------------------------------------------------------------- 
    514#if defined key_agrif  
     15   !!---------------------------------------------------------------------- 
     16   !!   'key_agrif'                                              AGRIF zoom 
     17   !!---------------------------------------------------------------------- 
    618   USE par_oce 
    719   USE oce 
    820   USE dom_oce 
     21   USE zdf_oce        ! vertical physics: ocean variables  
    922   USE agrif_oce 
    10    USE in_out_manager  ! I/O manager 
     23   ! 
     24   USE in_out_manager ! I/O manager 
    1125   USE lib_mpp 
    1226   USE wrk_nemo   
    13    USE zdf_oce        ! vertical physics: ocean variables  
    1427 
    1528   IMPLICIT NONE 
    1629   PRIVATE 
    1730 
    18    PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn,Update_Scales 
    19 # if defined key_zdftke 
    20    PUBLIC Agrif_Update_Tke 
    21 # endif 
     31   PUBLIC   Agrif_Update_Tra, Agrif_Update_Dyn, Update_Scales 
     32   PUBLIC   Agrif_Update_Tke 
     33 
    2234   !!---------------------------------------------------------------------- 
    23    !! NEMO/NST 3.6 , NEMO Consortium (2010) 
     35   !! NEMO/NST 4.0 , NEMO Consortium (2017) 
    2436   !! $Id$ 
    2537   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    2840 
    2941   RECURSIVE SUBROUTINE Agrif_Update_Tra( ) 
    30       !!--------------------------------------------- 
    31       !!   *** ROUTINE Agrif_Update_Tra *** 
    32       !!--------------------------------------------- 
     42      !!---------------------------------------------------------------------- 
     43      !!                   *** ROUTINE Agrif_Update_Tra *** 
     44      !!---------------------------------------------------------------------- 
    3345      !  
    3446      IF (Agrif_Root()) RETURN 
    … …  
    3850 
    3951      Agrif_UseSpecialValueInUpdate = .TRUE. 
    40       Agrif_SpecialValueFineGrid = 0. 
     52      Agrif_SpecialValueFineGrid    = 0._wp 
    4153      !  
    4254      IF (MOD(nbcline,nbclineupdate) == 0) THEN 
    … …  
    6880 
    6981   RECURSIVE SUBROUTINE Agrif_Update_Dyn( ) 
    70       !!--------------------------------------------- 
    71       !!   *** ROUTINE Agrif_Update_Dyn *** 
    72       !!--------------------------------------------- 
     82      !!---------------------------------------------------------------------- 
     83      !!                   *** ROUTINE Agrif_Update_Dyn *** 
     84      !!---------------------------------------------------------------------- 
    7385      !  
    7486      IF (Agrif_Root()) RETURN 
    … …  
    106118# endif 
    107119 
    108       IF ( ln_dynspg_ts.AND.ln_bt_fw ) THEN 
     120      IF ( ln_dynspg_ts .AND. ln_bt_fw ) THEN 
    109121         ! Update time integrated transports 
    110122         IF (mod(nbcline,nbclineupdate) == 0) THEN 
    … …  
    149161   END SUBROUTINE Agrif_Update_Dyn 
    150162 
    151 # if defined key_zdftke 
     163!!gm Missing GLS case !!!!! 
    152164 
    153165   SUBROUTINE Agrif_Update_Tke( kt ) 
    154       !!--------------------------------------------- 
    155       !!   *** ROUTINE Agrif_Update_Tke *** 
    156       !!--------------------------------------------- 
    157       !! 
     166      !!---------------------------------------------------------------------- 
     167      !!                   *** ROUTINE Agrif_Update_Tke *** 
     168      !!---------------------------------------------------------------------- 
    158169      INTEGER, INTENT(in) :: kt 
    159       !        
    160       IF( ( Agrif_NbStepint() .NE. 0 ) .AND. (kt /= 0) ) RETURN 
     170      !!---------------------------------------------------------------------- 
     171      ! 
     172!!gm test on kt/=0  ????  why not nit000-1  ?  doesn't seem logic 
     173      IF( ( Agrif_NbStepint() /= 0 ) .AND. kt /= 0 )   RETURN 
    161174#  if defined TWO_WAY 
    162  
     175      ! 
    163176      Agrif_UseSpecialValueInUpdate = .TRUE. 
    164       Agrif_SpecialValueFineGrid = 0. 
    165  
    166       CALL Agrif_Update_Variable( en_id, locupdate=(/0,0/), procname=updateEN  ) 
    167       CALL Agrif_Update_Variable(avt_id, locupdate=(/0,0/), procname=updateAVT ) 
    168       CALL Agrif_Update_Variable(avm_id, locupdate=(/0,0/), procname=updateAVM ) 
    169  
     177      Agrif_SpecialValueFineGrid    = 0._wp 
     178      ! 
     179      CALL Agrif_Update_Variable(  en_id, locupdate=(/0,0/), procname=updateEN  ) 
     180      CALL Agrif_Update_Variable( avt_id, locupdate=(/0,0/), procname=updateAVT ) 
     181      CALL Agrif_Update_Variable( avm_id, locupdate=(/0,0/), procname=updateAVM ) 
     182      ! 
    170183      Agrif_UseSpecialValueInUpdate = .FALSE. 
    171  
     184      ! 
    172185#  endif 
    173        
     186      ! 
    174187   END SUBROUTINE Agrif_Update_Tke 
    175188    
    176 # endif /* key_zdftke */ 
    177189 
    178190   SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    179       !!--------------------------------------------- 
     191      !!---------------------------------------------------------------------- 
    180192      !!           *** ROUTINE updateT *** 
    181       !!--------------------------------------------- 
    182       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    183       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    184       LOGICAL, INTENT(in) :: before 
    185       !! 
    186       INTEGER :: ji,jj,jk,jn 
    187       !!--------------------------------------------- 
    188       ! 
    189       IF (before) THEN 
    190          DO jn = n1,n2 
    191             DO jk=k1,k2 
    192                DO jj=j1,j2 
    193                   DO ji=i1,i2 
     193      !!---------------------------------------------------------------------- 
     194      INTEGER                                    , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2 
     195      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   tabres 
     196      LOGICAL                                    , INTENT(in   ) ::  before 
     197      ! 
     198      INTEGER :: ji, jj, jk, jn 
     199      !!---------------------------------------------------------------------- 
     200      ! 
     201      IF( before ) THEN 
     202         DO jn = n1, n2 
     203            DO jk = k1, k2 
     204               DO jj = j1, j2 
     205                  DO ji = i1, i2 
    194206                     tabres(ji,jj,jk,jn) = tsn(ji,jj,jk,jn) 
    195207                  END DO 
    … …  
    209221                                 &             - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
    210222                        ENDIF 
    211                      ENDDO 
    212                   ENDDO 
    213                ENDDO 
    214             ENDDO 
     223                     END DO 
     224                  END DO 
     225               END DO 
     226            END DO 
    215227         ENDIF 
    216228         DO jn = n1,n2 
    … …  
    238250      LOGICAL                               , INTENT(in   ) :: before 
    239251      ! 
    240       INTEGER  ::   ji, jj, jk 
    241       REAL(wp) ::   zrhoy 
     252      INTEGER ::   ji, jj, jk 
     253      REAL(wp)::   zrhoy 
    242254      !!--------------------------------------------- 
    243255      !  
    … …  
    268280 
    269281   SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, before ) 
    270       !!--------------------------------------------- 
    271       !!           *** ROUTINE updatev *** 
    272       !!--------------------------------------------- 
    273       INTEGER :: i1,i2,j1,j2,k1,k2 
    274       INTEGER :: ji,jj,jk 
    275       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: tabres 
    276       LOGICAL :: before 
     282      !!---------------------------------------------------------------------- 
     283      !!                      *** ROUTINE updatev *** 
     284      !!---------------------------------------------------------------------- 
     285      INTEGER                               , INTENT(in   ) :: i1, i2, j1, j2, k1, k2 
     286      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
     287      LOGICAL                               , INTENT(in   ) :: before 
    277288      !! 
    278       REAL(wp) :: zrhox 
    279       !!---------------------------------------------       
    280       ! 
    281       IF (before) THEN 
     289      INTEGER  ::   ji, jj, jk 
     290      REAL(wp) ::   zrhox 
     291      !!---------------------------------------------------------------------- 
     292      ! 
     293      IF( before ) THEN 
    282294         zrhox = Agrif_Rhox() 
    283295         DO jk=k1,k2 
    … …  
    309321 
    310322   SUBROUTINE updateu2d( tabres, i1, i2, j1, j2, before ) 
     323      !!---------------------------------------------------------------------- 
     324      !!                      *** ROUTINE updateu2d *** 
     325      !!---------------------------------------------------------------------- 
     326      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
     327      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   tabres 
     328      LOGICAL                         , INTENT(in   ) ::   before 
     329      !!  
     330      INTEGER ::   ji, jj, jk 
     331      REAL(wp)::   zrhoy, zcorr 
    311332      !!--------------------------------------------- 
    312       !!          *** ROUTINE updateu2d *** 
    313       !!--------------------------------------------- 
    314       INTEGER, INTENT(in) :: i1, i2, j1, j2 
    315       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    316       LOGICAL, INTENT(in) :: before 
    317       !!  
    318       INTEGER :: ji, jj, jk 
    319       REAL(wp) :: zrhoy 
    320       REAL(wp) :: zcorr 
    321       !!--------------------------------------------- 
    322       ! 
    323       IF (before) THEN 
     333      ! 
     334      IF( before ) THEN 
    324335         zrhoy = Agrif_Rhoy() 
    325336         DO jj=j1,j2 
    … …  
    374385 
    375386   SUBROUTINE updatev2d( tabres, i1, i2, j1, j2, before ) 
    376       !!--------------------------------------------- 
    377       !!          *** ROUTINE updatev2d *** 
    378       !!--------------------------------------------- 
    379       INTEGER, INTENT(in) :: i1, i2, j1, j2 
    380       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    381       LOGICAL, INTENT(in) :: before 
    382       !!  
     387      !!---------------------------------------------------------------------- 
     388      !!                   *** ROUTINE updatev2d *** 
     389      !!---------------------------------------------------------------------- 
     390      INTEGER                         , INTENT(in   ) ::  i1, i2, j1, j2 
     391      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   tabres 
     392      LOGICAL                         , INTENT(in   ) ::  before 
     393      !  
    383394      INTEGER :: ji, jj, jk 
    384       REAL(wp) :: zrhox 
    385       REAL(wp) :: zcorr 
    386       !!--------------------------------------------- 
    387       ! 
    388       IF (before) THEN 
     395      REAL(wp) :: zrhox, zcorr 
     396      !!---------------------------------------------------------------------- 
     397      ! 
     398      IF( before ) THEN 
    389399         zrhox = Agrif_Rhox() 
    390400         DO jj=j1,j2 
    … …  
    439449 
    440450   SUBROUTINE updateSSH( tabres, i1, i2, j1, j2, before ) 
    441       !!--------------------------------------------- 
    442       !!          *** ROUTINE updateSSH *** 
    443       !!--------------------------------------------- 
    444       INTEGER, INTENT(in) :: i1, i2, j1, j2 
    445       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    446       LOGICAL, INTENT(in) :: before 
     451      !!---------------------------------------------------------------------- 
     452      !!                   *** ROUTINE updateSSH *** 
     453      !!---------------------------------------------------------------------- 
     454      INTEGER                         , INTENT(in   ) ::  i1, i2, j1, j2 
     455      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   tabres 
     456      LOGICAL                         , INTENT(in   ) ::  before 
    447457      !! 
    448458      INTEGER :: ji, jj 
    449       !!--------------------------------------------- 
    450       !  
    451       IF (before) THEN 
     459      !!---------------------------------------------------------------------- 
     460      !  
     461      IF( before ) THEN 
    452462         DO jj=j1,j2 
    453463            DO ji=i1,i2 
    … …  
    478488 
    479489   SUBROUTINE updateub2b( tabres, i1, i2, j1, j2, before ) 
    480       !!--------------------------------------------- 
    481       !!          *** ROUTINE updateub2b *** 
    482       !!--------------------------------------------- 
    483       INTEGER, INTENT(in) :: i1, i2, j1, j2 
    484       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    485       LOGICAL, INTENT(in) :: before 
     490      !!---------------------------------------------------------------------- 
     491      !!                      *** ROUTINE updateub2b *** 
     492      !!---------------------------------------------------------------------- 
     493      INTEGER                            , INTENT(in) ::  i1, i2, j1, j2 
     494      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   tabres 
     495      LOGICAL                            , INTENT(in) ::  before 
    486496      !! 
    487       INTEGER :: ji, jj 
    488       REAL(wp) :: zrhoy 
    489       !!--------------------------------------------- 
     497      INTEGER ::   ji, jj 
     498      REAL(wp)::  zrhoy 
     499      !!---------------------------------------------------------------------- 
    490500      ! 
    491501      IF (before) THEN 
    … …  
    509519 
    510520   SUBROUTINE updatevb2b( tabres, i1, i2, j1, j2, before ) 
    511       !!--------------------------------------------- 
    512       !!          *** ROUTINE updatevb2b *** 
    513       !!--------------------------------------------- 
    514       INTEGER, INTENT(in) :: i1, i2, j1, j2 
    515       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    516       LOGICAL, INTENT(in) :: before 
     521      !!---------------------------------------------------------------------- 
     522      !!                      *** ROUTINE updatevb2b *** 
     523      !!---------------------------------------------------------------------- 
     524      INTEGER                         , INTENT(in   ) ::  i1, i2, j1, j2 
     525      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   tabres 
     526      LOGICAL                         , INTENT(in   ) ::  before 
    517527      !! 
    518       INTEGER :: ji, jj 
    519       REAL(wp) :: zrhox 
    520       !!--------------------------------------------- 
    521       ! 
    522       IF (before) THEN 
     528      INTEGER ::   ji, jj 
     529      REAL(wp)::  zrhox 
     530      !!---------------------------------------------------------------------- 
     531      ! 
     532      IF( before ) THEN 
    523533         zrhox = Agrif_Rhox() 
    524534         DO jj=j1,j2 
    … …  
    540550 
    541551   SUBROUTINE update_scales( tabres, i1, i2, j1, j2, k1, k2, n1,n2, before ) 
    542       ! currently not used 
    543       !!--------------------------------------------- 
    544       !!           *** ROUTINE updateT *** 
    545       !!--------------------------------------------- 
    546       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    547       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    548       LOGICAL, iNTENT(in) :: before 
    549       ! 
     552      ! 
     553      ! ====>>>>>>>>>>    currently not used 
     554      ! 
     555      !!---------------------------------------------------------------------- 
     556      !!                      *** ROUTINE updateT *** 
     557      !!---------------------------------------------------------------------- 
     558      INTEGER                                    , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2 
     559      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   tabres 
     560      LOGICAL                                    , INTENT(in   ) ::   before 
     561      !! 
    550562      INTEGER :: ji,jj,jk 
    551563      REAL(wp) :: ztemp 
    552       !!--------------------------------------------- 
     564      !!---------------------------------------------------------------------- 
    553565 
    554566      IF (before) THEN 
    … …  
    587599   END SUBROUTINE update_scales 
    588600 
    589 # if defined key_zdftke 
    590601 
    591602   SUBROUTINE updateEN( ptab, i1, i2, j1, j2, k1, k2, before ) 
    592       !!--------------------------------------------- 
    593       !!           *** ROUTINE updateen *** 
    594       !!--------------------------------------------- 
    595       INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 
    596       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    597       LOGICAL, INTENT(in) :: before 
    598       !!--------------------------------------------- 
    599       ! 
    600       IF (before) THEN 
     603      !!---------------------------------------------------------------------- 
     604      !!                      *** ROUTINE updateen *** 
     605      !!---------------------------------------------------------------------- 
     606      INTEGER                               , INTENT(in   ) ::  i1, i2, j1, j2, k1, k2 
     607      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
     608      LOGICAL                               , INTENT(in   ) ::  before 
     609      !!---------------------------------------------------------------------- 
     610      ! 
     611      IF( before ) THEN 
    601612         ptab (i1:i2,j1:j2,k1:k2) = en(i1:i2,j1:j2,k1:k2) 
    602613      ELSE 
    … …  
    608619 
    609620   SUBROUTINE updateAVT( ptab, i1, i2, j1, j2, k1, k2, before ) 
    610       !!--------------------------------------------- 
    611       !!           *** ROUTINE updateavt *** 
    612       !!--------------------------------------------- 
    613       INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 
    614       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    615       LOGICAL, INTENT(in) :: before 
    616       !!--------------------------------------------- 
    617       ! 
    618       IF (before) THEN 
    619          ptab (i1:i2,j1:j2,k1:k2) = avt_k(i1:i2,j1:j2,k1:k2) 
    620       ELSE 
    621          avt_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)  
     621      !!---------------------------------------------------------------------- 
     622      !!                      *** ROUTINE updateavt *** 
     623      !!---------------------------------------------------------------------- 
     624      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
     625      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
     626      LOGICAL                               , INTENT(in   ) ::   before 
     627      !!---------------------------------------------------------------------- 
     628      ! 
     629      IF( before ) THEN   ;   ptab (i1:i2,j1:j2,k1:k2) = avt_k(i1:i2,j1:j2,k1:k2) 
     630      ELSE                ;   avt_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)  
    622631      ENDIF 
    623632      ! 
    … …  
    628637      !!--------------------------------------------- 
    629638      !!           *** ROUTINE updateavm *** 
    630       !!--------------------------------------------- 
    631       INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 
    632       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    633       LOGICAL, INTENT(in) :: before 
    634       !!--------------------------------------------- 
    635       ! 
    636       IF (before) THEN 
    637          ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 
    638       ELSE 
    639          avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)  
     639      !!---------------------------------------------------------------------- 
     640      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
     641      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
     642      LOGICAL                               , INTENT(in   ) ::   before 
     643      !!---------------------------------------------------------------------- 
     644      ! 
     645      IF( before ) THEN   ;   ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 
     646      ELSE                ;   avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)  
    640647      ENDIF 
    641648      ! 
    642649   END SUBROUTINE updateAVM 
    643650 
    644 # endif /* key_zdftke */  
    645  
    646651#else 
     652   !!---------------------------------------------------------------------- 
     653   !!   Empty module                                          no AGRIF zoom 
     654   !!---------------------------------------------------------------------- 
    647655CONTAINS 
    648656   SUBROUTINE agrif_opa_update_empty 
    649       !!--------------------------------------------- 
    650       !!   *** ROUTINE agrif_opa_update_empty *** 
    651       !!--------------------------------------------- 
    652657      WRITE(*,*)  'agrif_opa_update : You should not have seen this print! error?' 
    653658   END SUBROUTINE agrif_opa_update_empty 
    654659#endif 
     660 
     661   !!====================================================================== 
    655662END MODULE agrif_opa_update 
    656663 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90

    r6140 r7953  
    11MODULE agrif_top_interp 
     2   !!====================================================================== 
     3   !!                   ***  MODULE  agrif_top_interp  *** 
     4   !! AGRIF: interpolation package 
     5   !!====================================================================== 
     6   !! History :  2.0  !  ???  
     7   !!---------------------------------------------------------------------- 
    28#if defined key_agrif && defined key_top 
     9   !!---------------------------------------------------------------------- 
     10   !!   'key_agrif'                                              AGRIF zoom 
     11   !!   'key_top'                                           on-line tracers 
     12   !!---------------------------------------------------------------------- 
    313   USE par_oce 
    414   USE oce 
    … …  
    818   USE par_trc 
    919   USE trc 
     20   ! 
    1021   USE lib_mpp 
    1122   USE wrk_nemo   
    … …  
    1627   PUBLIC Agrif_trc, interptrn 
    1728 
    18 #  include "vectopt_loop_substitute.h90" 
    1929  !!---------------------------------------------------------------------- 
    20    !! NEMO/NST 3.6 , NEMO Consortium (2010) 
     30   !! NEMO/NST 4.0 , NEMO Consortium (2017) 
    2131   !! $Id$ 
    2232   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    2636   SUBROUTINE Agrif_trc 
    2737      !!---------------------------------------------------------------------- 
    28       !!                  ***  ROUTINE Agrif_trc  *** 
     38      !!                   ***  ROUTINE Agrif_trc  *** 
    2939      !!---------------------------------------------------------------------- 
    3040      ! 
    3141      IF( Agrif_Root() )   RETURN 
    32  
    33       Agrif_SpecialValue    = 0.e0 
     42      ! 
     43      Agrif_SpecialValue    = 0._wp 
    3444      Agrif_UseSpecialValue = .TRUE. 
    35  
     45      ! 
    3646      CALL Agrif_Bc_variable( trn_id, procname=interptrn ) 
    3747      Agrif_UseSpecialValue = .FALSE. 
    … …  
    4050 
    4151 
    42    SUBROUTINE interptrn(ptab,i1,i2,j1,j2,k1,k2,n1,n2,before,nb,ndir) 
    43       !!--------------------------------------------- 
    44       !!   *** ROUTINE interptrn *** 
    45       !!--------------------------------------------- 
    46       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab 
    47       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    48       LOGICAL, INTENT(in) :: before 
    49       INTEGER, INTENT(in) :: nb , ndir 
    50       ! 
    51       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    52       INTEGER :: imin, imax, jmin, jmax 
    53       REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3 
    54       REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7 
    55       LOGICAL :: western_side, eastern_side,northern_side,southern_side 
    56  
    57       IF (before) THEN          
     52   SUBROUTINE interptrn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir ) 
     53      !!---------------------------------------------------------------------- 
     54      !!                   *** ROUTINE interptrn *** 
     55      !!---------------------------------------------------------------------- 
     56      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   ptab 
     57      INTEGER                                     , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2 
     58      LOGICAL                                     , INTENT(in   ) ::   before 
     59      INTEGER                                     , INTENT(in   ) ::   nb , ndir 
     60      !! 
     61      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
     62      INTEGER ::   imin, imax, jmin, jmax 
     63      LOGICAL ::   western_side, eastern_side,northern_side,southern_side 
     64      REAL(wp)::   zrhox , zalpha1, zalpha2, zalpha3 
     65      REAL(wp)::   zalpha4, zalpha5, zalpha6, zalpha7 
     66      !!---------------------------------------------------------------------- 
     67      ! 
     68      IF( before ) THEN          
    5869         ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 
    5970      ELSE 
    … …  
    185196 
    186197#else 
     198   !!---------------------------------------------------------------------- 
     199   !!   Empty module                                           no TOP AGRIF 
     200   !!---------------------------------------------------------------------- 
    187201CONTAINS 
    188202   SUBROUTINE Agrif_TOP_Interp_empty 
    … …  
    193207   END SUBROUTINE Agrif_TOP_Interp_empty 
    194208#endif 
     209 
     210   !!====================================================================== 
    195211END MODULE agrif_top_interp 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90

    r6140 r7953  
    44   !!====================================================================== 
    55   !!                ***  MODULE agrif_top_sponge  *** 
    6    !! AGRIF :   define in memory AGRIF variables for sea-ice 
     6   !! AGRIF :   TOP sponge layer 
    77   !!====================================================================== 
    88   !! History :  2.0  ! 2006-08  (R. Benshila, L. Debreu)  Original code 
    99   !!---------------------------------------------------------------------- 
    10  
     10#if defined key_agrif && defined key_top 
    1111   !!---------------------------------------------------------------------- 
    1212   !!   Agrif_Sponge_trc :  
    1313   !!   interptrn_sponge :   
    1414   !!---------------------------------------------------------------------- 
    15 #if defined key_agrif && defined key_top 
    1615   USE par_oce 
    1716   USE par_trc 
    … …  
    3231 
    3332   !!---------------------------------------------------------------------- 
    34    !! NEMO/NST 3.7 , NEMO Consortium (2015) 
     33   !! NEMO/NST 4.0 , NEMO Consortium (2017) 
    3534   !! $Id$ 
    3635   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    4241      !!                   *** ROUTINE Agrif_Sponge_Trc *** 
    4342      !!---------------------------------------------------------------------- 
    44       REAL(wp) ::   timecoeff 
     43      REAL(wp) ::   timecoeff   ! local scalar 
    4544      !!---------------------------------------------------------------------- 
    4645      ! 
    … …  
    107106 
    108107#else 
    109  
     108   !!---------------------------------------------------------------------- 
     109   !!   Empty module                                           no TOP AGRIF 
     110   !!---------------------------------------------------------------------- 
    110111CONTAINS 
    111112   SUBROUTINE agrif_top_sponge_empty 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90

    r6140 r7953  
    66   !!                ***  MODULE agrif_top_update  *** 
    77   !! AGRIF :    
    8    !!---------------------------------------------------------------------- 
     8   !!====================================================================== 
    99   !! History :   
    1010   !!---------------------------------------------------------------------- 
    11  
    1211#if defined key_agrif && defined key_top 
     12   !!---------------------------------------------------------------------- 
     13   !!   'key_agrif'                                              AGRIF zoom 
     14   !!   'key_TOP'                                           on-line tracers 
     15   !!---------------------------------------------------------------------- 
    1316   USE par_oce 
    1417   USE oce 
     18   USE dom_oce 
     19   USE agrif_oce 
    1520   USE par_trc 
    1621   USE trc 
    17    USE dom_oce 
    18    USE agrif_oce 
     22   ! 
    1923   USE wrk_nemo   
    2024 
    … …  
    2731 
    2832   !!---------------------------------------------------------------------- 
    29    !! NEMO/NST 3.7 , NEMO Consortium (2015) 
     33   !! NEMO/NST 4.0 , NEMO Consortium (2017) 
    3034   !! $Id$ 
    3135   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    112116 
    113117#else 
     118   !!---------------------------------------------------------------------- 
     119   !!   Empty module                                           no TOP AGRIF 
     120   !!---------------------------------------------------------------------- 
    114121CONTAINS 
    115122   SUBROUTINE agrif_top_update_empty 
    116       !!--------------------------------------------- 
    117       !!   *** ROUTINE agrif_Top_update_empty *** 
    118       !!--------------------------------------------- 
    119123      WRITE(*,*)  'agrif_top_update : You should not have seen this print! error?' 
    120124   END SUBROUTINE agrif_top_update_empty 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r7761 r7953  
    11#if defined key_agrif 
    22!!---------------------------------------------------------------------- 
    3 !! NEMO/NST 3.7 , NEMO Consortium (2016) 
     3!! NEMO/NST 4.0 , NEMO Consortium (2017) 
    44!! $Id$ 
    55!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    107107   !! 
    108108   IMPLICIT NONE 
     109   ! 
    109110   !!---------------------------------------------------------------------- 
    110111   ! 
    … …  
    125126   USE par_oce        
    126127   USE oce 
    127    !! 
     128   ! 
    128129   IMPLICIT NONE 
    129130   !!---------------------------------------------------------------------- 
    … …  
    136137   ! 2. Type of interpolation 
    137138   !------------------------- 
    138    CALL Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    139    CALL Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     139   CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm    ) 
     140   CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm   , interp2=Agrif_linear ) 
    140141 
    141142   ! 3. Location of interpolation 
    142143   !----------------------------- 
    143    CALL Agrif_Set_bc(e1u_id,(/0,0/)) 
    144    CALL Agrif_Set_bc(e2v_id,(/0,0/)) 
     144   CALL Agrif_Set_bc( e1u_id, (/0,0/) ) 
     145   CALL Agrif_Set_bc( e2v_id, (/0,0/) ) 
    145146 
    146147   ! 5. Update type 
    147148   !---------------  
    148    CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 
    149    CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
     149   CALL Agrif_Set_Updatetype( e1u_id, update1=Agrif_Update_Copy   , update2=Agrif_Update_Average ) 
     150   CALL Agrif_Set_Updatetype( e2v_id, update1=Agrif_Update_Average, update2=Agrif_Update_Copy    ) 
    150151 
    151152! High order updates 
    152 !   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average,            update2=Agrif_Update_Full_Weighting) 
    153 !   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting,     update2=Agrif_Update_Average) 
     153!   CALL Agrif_Set_Updatetype( e1u_id, update1=Agrif_Update_Average       , update2=Agrif_Update_Full_Weighting ) 
     154!   CALL Agrif_Set_Updatetype( e2v_id, update1=Agrif_Update_Full_Weighting, update2=Agrif_Update_Average        ) 
    154155    ! 
    155156END SUBROUTINE agrif_declare_var_dom 
    … …  
    165166   USE oce  
    166167   USE dom_oce 
     168   USE zdf_oce 
    167169   USE nemogcm 
     170   ! 
    168171   USE lib_mpp 
    169172   USE in_out_manager 
    … …  
    171174   USE agrif_opa_interp 
    172175   USE agrif_opa_sponge 
    173    !! 
     176   ! 
    174177   IMPLICIT NONE 
    175178   ! 
    … …  
    184187   ! 2. First interpolations of potentially non zero fields 
    185188   !------------------------------------------------------- 
    186    Agrif_SpecialValue=0. 
     189   Agrif_SpecialValue    = 0._wp 
    187190   Agrif_UseSpecialValue = .TRUE. 
    188191   CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn) 
    … …  
    319322   ENDIF 
    320323   ! 
    321 # if defined key_zdftke 
    322    CALL Agrif_Update_tke(0) 
    323 # endif 
     324   IF( ln_zdftke )   CALL Agrif_Update_tke( 0 ) 
    324325   ! 
    325326   Agrif_UseSpecialValueInUpdate = .FALSE. 
    … …  
    337338   !!---------------------------------------------------------------------- 
    338339   USE agrif_util 
    339    USE par_oce       !   ONLY : jpts 
     340   USE agrif_oce 
     341   USE par_oce       ! ocean parameters 
     342   USE zdf_oce       ! vertical physics 
    340343   USE oce 
    341    USE agrif_oce 
    342344   !! 
    343345   IMPLICIT NONE 
    … …  
    371373   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 
    372374 
    373 # if defined key_zdftke 
    374    CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 
    375    CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 
    376    CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id) 
    377 # endif 
     375   IF( ln_zdftke ) THEN 
     376      CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 
     377      CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 
     378      CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id) 
     379   ENDIF 
    378380 
    379381   ! 2. Type of interpolation 
    … …  
    400402   CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant) 
    401403 
    402 # if defined key_zdftke 
    403    CALL Agrif_Set_bcinterp(avm_id ,interp=AGRIF_linear) 
    404 # endif 
    405  
     404   IF( ln_zdftke )   CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear ) 
    406405 
    407406   ! 3. Location of interpolation 
    … …  
    418417   CALL Agrif_Set_bc(vn_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
    419418 
    420    CALL Agrif_Set_bc(sshn_id,(/0,0/)) 
    421    CALL Agrif_Set_bc(unb_id ,(/0,0/)) 
    422    CALL Agrif_Set_bc(vnb_id ,(/0,0/)) 
    423    CALL Agrif_Set_bc(ub2b_interp_id,(/0,0/)) 
    424    CALL Agrif_Set_bc(vb2b_interp_id,(/0,0/)) 
     419   CALL Agrif_Set_bc( sshn_id       , (/0,0/) ) 
     420   CALL Agrif_Set_bc( unb_id        , (/0,0/) ) 
     421   CALL Agrif_Set_bc( vnb_id        , (/0,0/) ) 
     422   CALL Agrif_Set_bc( ub2b_interp_id, (/0,0/) ) 
     423   CALL Agrif_Set_bc( vb2b_interp_id, (/0,0/) ) 
    425424 
    426425   CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,0/))   ! if west and rhox=3: column 2 to 9 
    … …  
    428427   CALL Agrif_Set_bc(vmsk_id,(/0,0/)) 
    429428 
    430 # if defined key_zdftke 
    431    CALL Agrif_Set_bc(avm_id ,(/0,1/)) 
    432 # endif 
     429   IF( ln_zdftke )   CALL Agrif_Set_bc( avm_id, (/0,1/) ) 
    433430 
    434431   ! 5. Update type 
    … …  
    446443   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    447444 
    448 # if defined key_zdftke 
    449    CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average) 
    450    CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average) 
    451    CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average) 
    452 # endif 
     445   IF( ln_zdftke) THEN 
     446      CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average) 
     447      CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average) 
     448      CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average) 
     449   ENDIF 
    453450 
    454451! High order updates 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

    r7761 r7953  
    2828   USE trabbl          ! bottom boundary layer          (tra_bbl_init routine) 
    2929   USE traldf          ! lateral physics                (tra_ldf_init routine) 
    30    USE zdfini          ! vertical physics: initialization 
    31    USE sbcmod          ! surface boundary condition       (sbc_init     routine) 
    32    USE phycst          ! physical constant                  (par_cst routine) 
     30   USE sbcmod          ! surface boundary condition     (sbc_init     routine) 
     31   USE phycst          ! physical constant                   (par_cst routine) 
    3332   USE dtadyn          ! Lecture and Interpolation of the dynamical fields 
    3433   USE trcini          ! Initilization of the passive tracers 
    35    USE daymod          ! calendar                         (day     routine) 
    36    USE trcstp          ! passive tracer time-stepping      (trc_stp routine) 
     34   USE daymod          ! calendar                            (day     routine) 
     35   USE trcstp          ! passive tracer time-stepping        (trc_stp routine) 
    3736   USE dtadyn          ! Lecture and interpolation of the dynamical fields 
    3837   !              ! Passive tracers needs 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90

    r6140 r7953  
    2828   USE ldfslp             ! Lateral diffusion: slopes of neutral surfaces 
    2929   USE tradmp             ! Tracer damping 
    30 #if defined key_zdftke 
    3130   USE zdftke             ! TKE vertical physics 
    32 #endif 
    3331   USE eosbn2             ! Equation of state (eos_bn2 routine) 
    3432   USE zdfmxl             ! Mixed layer depth 
    … …  
    9492            IF( nitbkg_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0 
    9593               zdate = REAL( ndastp ) 
    96 #if defined key_zdftke 
    97                ! lk_zdftke=T :   Read turbulent kinetic energy ( en ) 
    98                IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...' 
    99                CALL tke_rst( nit000, 'READ' )               ! lk_zdftke=T :   Read turbulent kinetic energy ( en ) 
    100  
    101 #endif 
     94               IF( ln_zdftke ) THEN                   ! read turbulent kinetic energy ( en ) 
     95                  IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...' 
     96                  CALL tke_rst( nit000, 'READ' ) 
     97               ENDIF 
    10298            ELSE 
    10399               zdate = REAL( ndastp ) 
    … …  
    111107            CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , tsn(:,:,:,jp_sal) ) 
    112108            CALL iom_rstput( kt, nitbkg_r, inum, 'sshn'   , sshn              ) 
    113 #if defined key_zdftke 
    114             CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en                ) 
    115 #endif 
     109            IF( ln_zdftke )   CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en                ) 
    116110            ! 
    117111            CALL iom_close( inum ) 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90

    r7931 r7953  
    7474                         CALL bn2( tsb, rab_b, rn2b ) ! before Brunt-Vaisala frequency 
    7575                         CALL bn2( tsn, rab_n, rn2  ) ! now    Brunt-Vaisala frequency 
    76       !  VERTICAL PHYSICS    
    77                          CALL zdf_bfr( kstp )         ! bottom friction 
    78       !                                               ! Vertical eddy viscosity and diffusivity coefficients 
    79       IF( lk_zdfric  )   CALL zdf_ric( kstp )            ! Richardson number dependent Kz 
    80       IF( lk_zdftke  )   CALL zdf_tke( kstp )            ! TKE closure scheme for Kz 
    81       IF( lk_zdfgls  )   CALL zdf_gls( kstp )            ! GLS closure scheme for Kz 
    82       IF( lk_zdfcst  )   THEN                            ! Constant Kz (reset avt, avm[uv] to the background value) 
    83          avt (:,:,:) = rn_avt0 * tmask(:,:,:) 
    84          avmu(:,:,:) = rn_avm0 * umask(:,:,:) 
    85          avmv(:,:,:) = rn_avm0 * vmask(:,:,:) 
    86       ENDIF 
    87  
    88       IF( ln_rnf_mouth ) THEN                         ! increase diffusivity at rivers mouths 
    89          DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + 2.e0 * rn_avt_rnf * rnfmsk(:,:)   ;   END DO 
    90       ENDIF 
    91       IF( ln_zdfevd  )   CALL zdf_evd( kstp )         ! enhanced vertical eddy diffusivity 
    92       IF( lk_zdftmx  )   CALL zdf_tmx( kstp )         ! tidal vertical mixing 
    93       IF( ln_zdfddm  )   CALL zdf_ddm( kstp )         ! double diffusive mixing 
    94                          CALL zdf_mxl( kstp )         ! mixed layer depth 
    95  
    96                                                       ! write tke information in the restart file 
    97       IF( lrst_oce .AND. lk_zdftke )   CALL tke_rst( kstp, 'WRITE' ) 
    98                                                       ! write gls information in the restart file 
    99       IF( lrst_oce .AND. lk_zdfgls )   CALL gls_rst( kstp, 'WRITE' ) 
     76       
     77      !  VERTICAL PHYSICS 
     78                         CALL zdf_phy( kstp )         ! vertical physics update (bfr, avt, avs, avm + MLD) 
    10079 
    10180      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90

    r6140 r7953  
    151151 
    152152      ! Vertical diffusion 
    153       REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avt_crs           !: vert. diffusivity coef. [m2/s] at w-point for temp   
    154 # if defined key_zdfddm 
    155153      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avs_crs           !: salinity vertical diffusivity coeff. [m2/s] at w-point 
    156 # endif 
    157154 
    158155      ! Mixing and Mixed Layer Depth 
    … …  
    239236         &     fr_i_crs(jpi_crs,jpj_crs), sfx_crs(jpi_crs ,jpj_crs),  STAT=ierr(12)  ) 
    240237 
    241      ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), avt_crs(jpi_crs,jpj_crs,jpk),    & 
    242 # if defined key_zdfddm 
    243          &      avs_crs(jpi_crs,jpj_crs,jpk),    & 
    244 # endif 
    245          &      STAT=ierr(13) ) 
     238     ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), avs_crs(jpi_crs,jpj_crs,jpk), STAT=ierr(13) ) 
    246239 
    247240      ALLOCATE( nmln_crs(jpi_crs,jpj_crs) , hmld_crs(jpi_crs,jpj_crs) , & 
    248241         &      hmlp_crs(jpi_crs,jpj_crs) , hmlpt_crs(jpi_crs,jpj_crs) , STAT=ierr(14) ) 
    249242          
    250       ALLOCATE( nimppt_crs(jpnij) , nlcit_crs(jpnij) , nldit_crs(jpnij) , nleit_crs(jpnij), & 
    251        &  nimppt_full(jpnij) , nlcit_full(jpnij) , nldit_full(jpnij) , nleit_full(jpnij),   & 
    252                 njmppt_crs(jpnij) , nlcjt_crs(jpnij) , nldjt_crs(jpnij) , nlejt_crs(jpnij), & 
    253        &  njmppt_full(jpnij) , nlcjt_full(jpnij) , nldjt_full(jpnij) , nlejt_full(jpnij)  , STAT=ierr(15) ) 
    254  
    255           
     243      ALLOCATE( nimppt_crs (jpnij) , nlcit_crs (jpnij) , nldit_crs (jpnij) , nleit_crs (jpnij),   & 
     244         &      nimppt_full(jpnij) , nlcit_full(jpnij) , nldit_full(jpnij) , nleit_full(jpnij),   & 
     245                njmppt_crs (jpnij) , nlcjt_crs (jpnij) , nldjt_crs (jpnij) , nlejt_crs (jpnij),   & 
     246         &      njmppt_full(jpnij) , nlcjt_full(jpnij) , nldjt_full(jpnij) , nlejt_full(jpnij)  , STAT=ierr(15) ) 
     247    
    256248      crs_dom_alloc = MAXVAL(ierr) 
    257  
     249      ! 
    258250   END FUNCTION crs_dom_alloc 
    259251 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90

    r6140 r7953  
    8484         vn_crs   (:,:,:  ) = 0._wp    ! v-velocity 
    8585         wn_crs   (:,:,:  ) = 0._wp    ! w 
    86          avt_crs  (:,:,:  ) = 0._wp    ! avt 
     86         avs_crs  (:,:,:  ) = 0._wp    ! avt 
    8787         hdivn_crs(:,:,:  ) = 0._wp    ! hdiv 
    8888         rke_crs  (:,:,:  ) = 0._wp    ! rke 
    … …  
    200200      SELECT CASE ( nn_crs_kz ) 
    201201         CASE ( 0 ) 
    202             CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 
     202            CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 
    203203         CASE ( 1 ) 
    204             CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 
     204            CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 
    205205         CASE ( 2 ) 
    206             CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 
     206            CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 
    207207      END SELECT 
    208208      ! 
    209       CALL iom_put( "avt", avt_crs )   !  Kz 
     209      CALL iom_put( "avt", avs_crs )   !  Kz 
    210210       
    211211      !  sbc fields   

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90

    r7753 r7953  
    88   USE oce             ! ocean dynamics and tracers variables 
    99   USE dom_oce         ! ocean space and time domain 
     10   USE zdf_oce         ! ocean vertical physics     
     11   USE zdfgls, ONLY: mxln 
    1012   USE in_out_manager  ! I/O units 
    1113   USE iom             ! I/0 library 
    12    USE wrk_nemo        ! working arrays 
    13 #if defined key_zdftke  
    14    USE zdf_oce, ONLY: en 
    15 #endif 
    16    USE zdf_oce, ONLY: avt, avm 
    17 #if defined key_zdfgls 
    18    USE zdf_oce, ONLY: en 
    19    USE zdfgls, ONLY: mxln 
    20 #endif 
     14   USE wrk_nemo        ! work arrays 
    2115 
    2216   IMPLICIT NONE 
    2317   PRIVATE 
    2418 
    25    LOGICAL , PUBLIC ::   ln_dia25h     !:  25h mean output 
    2619   PUBLIC   dia_25h_init               ! routine called by nemogcm.F90 
    2720   PUBLIC   dia_25h                    ! routine called by diawri.F90 
    2821 
    29   !! * variables for calculating 25-hourly means 
    30    REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   tn_25h  , sn_25h 
    31    REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:)   ::   sshn_25h  
    32    REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   un_25h  , vn_25h  , wn_25h 
    33    REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   avt_25h , avm_25h 
    34 #if defined key_zdfgls || key_zdftke 
    35    REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   en_25h 
    36 #endif 
    37 #if defined key_zdfgls  
    38    REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   rmxln_25h 
    39 #endif 
    40    INTEGER, SAVE :: cnt_25h     ! Counter for 25 hour means 
    41  
    42  
     22   LOGICAL, PUBLIC ::   ln_dia25h      !:  25h mean output 
     23 
     24   ! variables for calculating 25-hourly means 
     25   INTEGER , SAVE ::   cnt_25h     ! Counter for 25 hour means 
     26   REAL(wp), SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   tn_25h  , sn_25h 
     27   REAL(wp), SAVE, ALLOCATABLE,   DIMENSION(:,:)   ::   sshn_25h  
     28   REAL(wp), SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   un_25h  , vn_25h  , wn_25h 
     29   REAL(wp), SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   avt_25h , avm_25h 
     30   REAL(wp), SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   en_25h  , rmxln_25h 
    4331 
    4432   !!---------------------------------------------------------------------- 
    … …  
    5644      !!         
    5745      !! ** Method : Read namelist 
    58       !!   History 
    59       !!   3.6  !  08-14  (E. O'Dea) Routine to initialize dia_25h 
    6046      !!--------------------------------------------------------------------------- 
    61       !! 
    6247      INTEGER ::   ios                 ! Local integer output status for namelist read 
    6348      INTEGER ::   ierror              ! Local integer for memory allocation 
    … …  
    7964         WRITE(numout,*) 'dia_25h_init : Output 25 hour mean diagnostics' 
    8065         WRITE(numout,*) '~~~~~~~~~~~~' 
    81          WRITE(numout,*) 'Namelist nam_dia25h : set 25h outputs ' 
    82          WRITE(numout,*) 'Switch for 25h diagnostics (T) or not (F)  ln_dia25h  = ', ln_dia25h 
     66         WRITE(numout,*) '   Namelist nam_dia25h : set 25h outputs ' 
     67         WRITE(numout,*) '      Switch for 25h diagnostics (T) or not (F)  ln_dia25h  = ', ln_dia25h 
    8368      ENDIF 
    8469      IF( .NOT. ln_dia25h )   RETURN 
    … …  
    8671      ! 1 - Allocate memory ! 
    8772      ! ------------------- ! 
    88       ALLOCATE( tn_25h(jpi,jpj,jpk), STAT=ierror ) 
     73      !                                ! ocean arrays 
     74      ALLOCATE( tn_25h (jpi,jpj,jpk), sn_25h (jpi,jpj,jpk), sshn_25h(jpi,jpj)  ,     & 
     75         &      un_25h (jpi,jpj,jpk), vn_25h (jpi,jpj,jpk), wn_25h(jpi,jpj,jpk),     & 
     76         &      avt_25h(jpi,jpj,jpk), avm_25h(jpi,jpj,jpk),                      STAT=ierror ) 
    8977      IF( ierror > 0 ) THEN 
    90          CALL ctl_stop( 'dia_25h: unable to allocate tn_25h' )   ;   RETURN 
    91       ENDIF 
    92       ALLOCATE( sn_25h(jpi,jpj,jpk), STAT=ierror ) 
    93       IF( ierror > 0 ) THEN 
    94          CALL ctl_stop( 'dia_25h: unable to allocate sn_25h' )   ;   RETURN 
    95       ENDIF 
    96       ALLOCATE( un_25h(jpi,jpj,jpk), STAT=ierror ) 
    97       IF( ierror > 0 ) THEN 
    98          CALL ctl_stop( 'dia_25h: unable to allocate un_25h' )   ;   RETURN 
    99       ENDIF 
    100       ALLOCATE( vn_25h(jpi,jpj,jpk), STAT=ierror ) 
    101       IF( ierror > 0 ) THEN 
    102          CALL ctl_stop( 'dia_25h: unable to allocate vn_25h' )   ;   RETURN 
    103       ENDIF 
    104       ALLOCATE( wn_25h(jpi,jpj,jpk), STAT=ierror ) 
    105       IF( ierror > 0 ) THEN 
    106          CALL ctl_stop( 'dia_25h: unable to allocate wn_25h' )   ;   RETURN 
    107       ENDIF 
    108       ALLOCATE( avt_25h(jpi,jpj,jpk), STAT=ierror ) 
    109       IF( ierror > 0 ) THEN 
    110          CALL ctl_stop( 'dia_25h: unable to allocate avt_25h' )   ;   RETURN 
    111       ENDIF 
    112       ALLOCATE( avm_25h(jpi,jpj,jpk), STAT=ierror ) 
    113       IF( ierror > 0 ) THEN 
    114          CALL ctl_stop( 'dia_25h: unable to allocate avm_25h' )   ;   RETURN 
    115       ENDIF 
    116 # if defined key_zdfgls || defined key_zdftke 
    117       ALLOCATE( en_25h(jpi,jpj,jpk), STAT=ierror ) 
    118       IF( ierror > 0 ) THEN 
    119          CALL ctl_stop( 'dia_25h: unable to allocate en_25h' )   ;   RETURN 
    120       ENDIF 
    121 #endif 
    122 # if defined key_zdfgls  
    123       ALLOCATE( rmxln_25h(jpi,jpj,jpk), STAT=ierror ) 
    124       IF( ierror > 0 ) THEN 
    125          CALL ctl_stop( 'dia_25h: unable to allocate rmxln_25h' )   ;   RETURN 
    126       ENDIF 
    127 #endif 
    128       ALLOCATE( sshn_25h(jpi,jpj), STAT=ierror ) 
    129       IF( ierror > 0 ) THEN 
    130          CALL ctl_stop( 'dia_25h: unable to allocate sshn_25h' )   ;   RETURN 
     78         CALL ctl_stop( 'dia_25h: unable to allocate ocean arrays' )   ;   RETURN 
     79      ENDIF 
     80      IF( ln_zdftke ) THEN             ! TKE physics 
     81         ALLOCATE( en_25h(jpi,jpj,jpk), STAT=ierror ) 
     82         IF( ierror > 0 ) THEN 
     83            CALL ctl_stop( 'dia_25h: unable to allocate en_25h' )   ;   RETURN 
     84         ENDIF 
     85      ENDIF 
     86      IF( ln_zdfgls ) THEN             ! GLS physics 
     87         ALLOCATE( en_25h(jpi,jpj,jpk), rmxln_25h(jpi,jpj,jpk), STAT=ierror ) 
     88         IF( ierror > 0 ) THEN 
     89            CALL ctl_stop( 'dia_25h: unable to allocate en_25h and rmxln_25h' )   ;   RETURN 
     90         ENDIF 
    13191      ENDIF 
    13292      ! ------------------------- ! 
    … …  
    142102      avt_25h(:,:,:) = avt(:,:,:) 
    143103      avm_25h(:,:,:) = avm(:,:,:) 
    144 # if defined key_zdfgls || defined key_zdftke 
     104      IF( ln_zdftke ) THEN 
    145105         en_25h(:,:,:) = en(:,:,:) 
    146 #endif 
    147 # if defined key_zdfgls 
     106      ENDIF 
     107      IF( ln_zdfgls ) THEN 
     108         en_25h(:,:,:) = en(:,:,:) 
    148109         rmxln_25h(:,:,:) = mxln(:,:,:) 
    149 #endif 
     110      ENDIF 
    150111#if defined key_lim3 || defined key_lim2 
    151112         CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice') 
    152113#endif  
    153  
    154       ! -------------------------- ! 
    155       ! 3 - Return to dia_wri      ! 
    156       ! -------------------------- ! 
    157  
    158  
     114      ! 
    159115   END SUBROUTINE dia_25h_init 
    160116 
    … …  
    164120      !!                 ***  ROUTINE dia_25h  *** 
    165121      !!          
    166       !! 
    167       !!-------------------------------------------------------------------- 
    168       !!                    
    169122      !! ** Purpose :   Write diagnostics with M2/S2 tide removed 
    170123      !! 
    171       !! ** Method  :    
    172       !!      25hr mean outputs for shelf seas 
     124      !! ** Method  :   25hr mean outputs for shelf seas 
     125      !!---------------------------------------------------------------------- 
     126      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    173127      !! 
    174       !! History : 
    175       !!   ?.0  !  07-04  (A. Hines) New routine, developed from dia_wri_foam 
    176       !!   3.4  !  02-13  (J. Siddorn) Routine taken from old dia_wri_foam 
    177       !!   3.6  !  08-14  (E. O'Dea) adapted for VN3.6 
    178       !!---------------------------------------------------------------------- 
    179       !! * Modules used 
    180  
    181       IMPLICIT NONE 
    182  
    183       !! * Arguments 
    184       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    185  
    186  
    187       !! * Local declarations 
    188128      INTEGER ::   ji, jj, jk 
    189  
     129      INTEGER                          ::   iyear0, nimonth0,iday0            ! start year,imonth,day 
    190130      LOGICAL ::   ll_print = .FALSE.    ! =T print and flush numout 
    191       REAL(wp)                         ::   zsto, zout, zmax, zjulian, zmdi       ! temporary reals 
    192       INTEGER                          ::   i_steps                               ! no of timesteps per hour 
    193       REAL(wp), DIMENSION(jpi,jpj    ) ::   zw2d, un_dm, vn_dm                    ! temporary workspace 
    194       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d                                  ! temporary workspace 
    195       REAL(wp), DIMENSION(jpi,jpj,3)   ::   zwtmb                                 ! temporary workspace 
    196       INTEGER                          ::   iyear0, nimonth0,iday0                ! start year,imonth,day 
    197  
     131      REAL(wp)                         ::   zsto, zout, zmax, zjulian, zmdi   ! local scalars 
     132      INTEGER                          ::   i_steps                           ! no of timesteps per hour 
     133      REAL(wp), DIMENSION(jpi,jpj    ) ::   zw2d, un_dm, vn_dm                ! workspace 
     134      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d                              ! workspace 
     135      REAL(wp), DIMENSION(jpi,jpj,3)   ::   zwtmb                             ! workspace 
    198136      !!---------------------------------------------------------------------- 
    199137 
    … …  
    207145      ENDIF 
    208146 
    209 #if defined key_lim3 || defined key_lim2 
    210       CALL ctl_stop('STOP', 'dia_wri_tide not setup yet to do tidemean ice') 
    211 #endif 
    212  
    213147      ! local variable for debugging 
    214148      ll_print = ll_print .AND. lwp 
    215149 
    216       ! Sum of 25 hourly instantaneous values to give a 25h mean from 24hours 
    217       ! every day 
    218       IF( MOD( kt, i_steps ) == 0  .and. kt .ne. nn_it000 ) THEN 
     150      ! Sum of 25 hourly instantaneous values to give a 25h mean from 24hours every day 
     151      IF( MOD( kt, i_steps ) == 0  .AND. kt /= nn_it000 ) THEN 
    219152 
    220153         IF (lwp) THEN 
    … …  
    231164         avt_25h(:,:,:)       = avt_25h(:,:,:) + avt(:,:,:) 
    232165         avm_25h(:,:,:)       = avm_25h(:,:,:) + avm(:,:,:) 
    233 # if defined key_zdfgls || defined key_zdftke 
    234          en_25h(:,:,:)        = en_25h(:,:,:) + en(:,:,:) 
    235 #endif 
    236 # if defined key_zdfgls 
    237          rmxln_25h(:,:,:)      = rmxln_25h(:,:,:) + mxln(:,:,:) 
    238 #endif 
     166         IF( ln_zdftke ) THEN 
     167            en_25h(:,:,:)        = en_25h(:,:,:) + en(:,:,:) 
     168         ENDIF 
     169         IF( ln_zdfgls ) THEN 
     170            en_25h(:,:,:)        = en_25h(:,:,:) + en(:,:,:) 
     171            rmxln_25h(:,:,:)      = rmxln_25h(:,:,:) + mxln(:,:,:) 
     172         ENDIF 
    239173         cnt_25h = cnt_25h + 1 
    240  
     174         ! 
    241175         IF (lwp) THEN 
    242176            WRITE(numout,*) 'dia_tide : Summed the following number of hourly values so far',cnt_25h 
    243177         ENDIF 
    244  
     178         ! 
    245179      ENDIF ! MOD( kt, i_steps ) == 0 
    246180 
    247          ! Write data for 25 hour mean output streams 
    248       IF( cnt_25h .EQ. 25 .AND.  MOD( kt, i_steps*24) == 0 .AND. kt .NE. nn_it000 ) THEN 
    249  
    250             IF(lwp) THEN 
    251                WRITE(numout,*) 'dia_wri_tide : Writing 25 hour mean tide diagnostics at timestep', kt 
    252                WRITE(numout,*) '~~~~~~~~~~~~ ' 
    253             ENDIF 
    254  
    255             tn_25h(:,:,:)        = tn_25h(:,:,:) / 25.0_wp 
    256             sn_25h(:,:,:)        = sn_25h(:,:,:) / 25.0_wp 
    257             sshn_25h(:,:)        = sshn_25h(:,:) / 25.0_wp 
    258             un_25h(:,:,:)        = un_25h(:,:,:) / 25.0_wp 
    259             vn_25h(:,:,:)        = vn_25h(:,:,:) / 25.0_wp 
    260             wn_25h(:,:,:)        = wn_25h(:,:,:) / 25.0_wp 
    261             avt_25h(:,:,:)       = avt_25h(:,:,:) / 25.0_wp 
    262             avm_25h(:,:,:)       = avm_25h(:,:,:) / 25.0_wp 
    263 # if defined key_zdfgls || defined key_zdftke 
     181      ! Write data for 25 hour mean output streams 
     182      IF( cnt_25h == 25 .AND.  MOD( kt, i_steps*24) == 0 .AND. kt /= nn_it000 ) THEN 
     183         ! 
     184         IF(lwp) THEN 
     185            WRITE(numout,*) 'dia_wri_tide : Writing 25 hour mean tide diagnostics at timestep', kt 
     186            WRITE(numout,*) '~~~~~~~~~~~~ ' 
     187         ENDIF 
     188         ! 
     189         tn_25h(:,:,:)        = tn_25h(:,:,:) / 25.0_wp 
     190         sn_25h(:,:,:)        = sn_25h(:,:,:) / 25.0_wp 
     191         sshn_25h(:,:)        = sshn_25h(:,:) / 25.0_wp 
     192         un_25h(:,:,:)        = un_25h(:,:,:) / 25.0_wp 
     193         vn_25h(:,:,:)        = vn_25h(:,:,:) / 25.0_wp 
     194         wn_25h(:,:,:)        = wn_25h(:,:,:) / 25.0_wp 
     195         avt_25h(:,:,:)       = avt_25h(:,:,:) / 25.0_wp 
     196         avm_25h(:,:,:)       = avm_25h(:,:,:) / 25.0_wp 
     197         IF( ln_zdftke ) THEN 
    264198            en_25h(:,:,:)        = en_25h(:,:,:) / 25.0_wp 
    265 #endif 
    266 # if defined key_zdfgls 
     199         ENDIF 
     200         IF( ln_zdfgls ) THEN 
     201            en_25h(:,:,:)        = en_25h(:,:,:) / 25.0_wp 
    267202            rmxln_25h(:,:,:)       = rmxln_25h(:,:,:) / 25.0_wp 
    268 #endif 
    269  
    270             IF (lwp)  WRITE(numout,*) 'dia_wri_tide : Mean calculated by dividing 25 hour sums and writing output' 
    271             zmdi=1.e+20 !missing data indicator for masking 
    272             ! write tracers (instantaneous) 
    273             zw3d(:,:,:) = tn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
    274             CALL iom_put("temper25h", zw3d)   ! potential temperature 
    275             zw3d(:,:,:) = sn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
    276             CALL iom_put( "salin25h", zw3d  )   ! salinity 
    277             zw2d(:,:) = sshn_25h(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 
    278             CALL iom_put( "ssh25h", zw2d )   ! sea surface  
    279  
    280  
    281             ! Write velocities (instantaneous) 
    282             zw3d(:,:,:) = un_25h(:,:,:)*umask(:,:,:) + zmdi*(1.0-umask(:,:,:)) 
    283             CALL iom_put("vozocrtx25h", zw3d)    ! i-current 
    284             zw3d(:,:,:) = vn_25h(:,:,:)*vmask(:,:,:) + zmdi*(1.0-vmask(:,:,:)) 
    285             CALL iom_put("vomecrty25h", zw3d  )   ! j-current 
    286  
    287             zw3d(:,:,:) = wn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
    288             CALL iom_put("vomecrtz25h", zw3d )   ! k-current 
    289             zw3d(:,:,:) = avt_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
    290             CALL iom_put("avt25h", zw3d )   ! diffusivity 
    291             zw3d(:,:,:) = avm_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
    292             CALL iom_put("avm25h", zw3d)   ! viscosity 
    293 #if defined key_zdftke || defined key_zdfgls  
     203         ENDIF 
     204         ! 
     205         IF(lwp)  WRITE(numout,*) 'dia_wri_tide : Mean calculated by dividing 25 hour sums and writing output' 
     206         zmdi=1.e+20 !missing data indicator for masking 
     207         ! write tracers (instantaneous) 
     208         zw3d(:,:,:) = tn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     209         CALL iom_put("temper25h", zw3d)   ! potential temperature 
     210         zw3d(:,:,:) = sn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     211         CALL iom_put( "salin25h", zw3d  )   ! salinity 
     212         zw2d(:,:) = sshn_25h(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 
     213         CALL iom_put( "ssh25h", zw2d )   ! sea surface  
     214         ! Write velocities (instantaneous) 
     215         zw3d(:,:,:) = un_25h(:,:,:)*umask(:,:,:) + zmdi*(1.0-umask(:,:,:)) 
     216         CALL iom_put("vozocrtx25h", zw3d)    ! i-current 
     217         zw3d(:,:,:) = vn_25h(:,:,:)*vmask(:,:,:) + zmdi*(1.0-vmask(:,:,:)) 
     218         CALL iom_put("vomecrty25h", zw3d  )   ! j-current 
     219         zw3d(:,:,:) = wn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     220         CALL iom_put("vomecrtz25h", zw3d )   ! k-current 
     221         ! Write vertical physics 
     222         zw3d(:,:,:) = avt_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     223         CALL iom_put("avt25h", zw3d )   ! diffusivity 
     224         zw3d(:,:,:) = avm_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     225         CALL iom_put("avm25h", zw3d)   ! viscosity 
     226         IF( ln_zdftke ) THEN 
    294227            zw3d(:,:,:) = en_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
    295228            CALL iom_put("tke25h", zw3d)   ! tke 
    296 #endif 
    297 #if defined key_zdfgls  
     229         ENDIF 
     230         IF( ln_zdfgls ) THEN 
     231            zw3d(:,:,:) = en_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     232            CALL iom_put("tke25h", zw3d)   ! tke 
    298233            zw3d(:,:,:) = rmxln_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
    299234            CALL iom_put( "mxln25h",zw3d) 
    300 #endif 
    301  
    302             ! After the write reset the values to cnt=1 and sum values equal current value  
    303             tn_25h(:,:,:) = tsn(:,:,:,jp_tem) 
    304             sn_25h(:,:,:) = tsn(:,:,:,jp_sal) 
    305             sshn_25h(:,:) = sshn (:,:) 
    306             un_25h(:,:,:) = un(:,:,:) 
    307             vn_25h(:,:,:) = vn(:,:,:) 
    308             wn_25h(:,:,:) = wn(:,:,:) 
    309             avt_25h(:,:,:) = avt(:,:,:) 
    310             avm_25h(:,:,:) = avm(:,:,:) 
    311 # if defined key_zdfgls || defined key_zdftke 
     235         ENDIF 
     236         ! 
     237         ! After the write reset the values to cnt=1 and sum values equal current value  
     238         tn_25h(:,:,:) = tsn(:,:,:,jp_tem) 
     239         sn_25h(:,:,:) = tsn(:,:,:,jp_sal) 
     240         sshn_25h(:,:) = sshn (:,:) 
     241         un_25h(:,:,:) = un(:,:,:) 
     242         vn_25h(:,:,:) = vn(:,:,:) 
     243         wn_25h(:,:,:) = wn(:,:,:) 
     244         avt_25h(:,:,:) = avt(:,:,:) 
     245         avm_25h(:,:,:) = avm(:,:,:) 
     246         IF( ln_zdftke ) THEN 
    312247            en_25h(:,:,:) = en(:,:,:) 
    313 #endif 
    314 # if defined key_zdfgls 
     248         ENDIF 
     249         IF( ln_zdfgls ) THEN 
     250            en_25h(:,:,:) = en(:,:,:) 
    315251            rmxln_25h(:,:,:) = mxln(:,:,:) 
    316 #endif 
    317             cnt_25h = 1 
    318             IF (lwp)  WRITE(numout,*) 'dia_wri_tide : After 25hr mean write, reset sum to current value and cnt_25h to one for overlapping average',cnt_25h 
    319  
     252         ENDIF 
     253         cnt_25h = 1 
     254         IF (lwp)  WRITE(numout,*) 'dia_wri_tide : After 25hr mean write, reset sum to current value and cnt_25h to one for overlapping average',cnt_25h 
     255         ! 
    320256      ENDIF !  cnt_25h .EQ. 25 .AND.  MOD( kt, i_steps * 24) == 0 .AND. kt .NE. nn_it000 
    321  
    322  
     257      ! 
    323258   END SUBROUTINE dia_25h  
    324259 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r7931 r7953  
    3939   USE zdfmxl          ! mixed layer 
    4040   USE dianam          ! build name of file (routine) 
    41    USE zdfddm          ! vertical  physics: double diffusion 
     41!   USE zdfddm          ! vertical  physics: double diffusion 
    4242   USE diahth          ! thermocline diagnostics 
    4343   USE wet_dry         ! wetting and drying 
    … …  
    233233 
    234234      CALL iom_put( "avt" , avt                        )    ! T vert. eddy diff. coef. 
    235       CALL iom_put( "avs" , avs                        )    ! S vert. eddy diff. coef. (useful only with key_zdfddm) 
     235      CALL iom_put( "avs" , avs                        )    ! S vert. eddy diff. coef. 
    236236      CALL iom_put( "avm" , avmu                       )    ! T vert. eddy visc. coef. 
    237237 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90

    r7753 r7953  
    9696      !!                 ***  ROUTINE dyn_zdf_init  *** 
    9797      !! 
    98       !! ** Purpose :   initializations of the vertical diffusion scheme 
     98      !! ** Purpose :   initialization of the vertical diffusion scheme 
    9999      !! 
    100100      !! ** Method  :   implicit (euler backward) scheme (default) 
    … …  
    105105      !!---------------------------------------------------------------------- 
    106106      ! 
    107       ! Choice from ln_zdfexp read in namelist in zdfini 
     107      ! Choice from ln_zdfexp (namzdf namelist variable read in zdfphy module) 
    108108      IF( ln_zdfexp ) THEN   ;   nzdf = 0           ! use explicit scheme 
    109109      ELSE                   ;   nzdf = 1           ! use implicit scheme 
    … …  
    111111      ! 
    112112      ! Force implicit schemes 
    113       IF( lk_zdftke .OR. lk_zdfgls   )   nzdf = 1   ! TKE or GLS physics 
     113      IF( ln_zdftke .OR. ln_zdfgls   )   nzdf = 1   ! TKE or GLS physics 
    114114      IF( ln_dynldf_iso              )   nzdf = 1   ! iso-neutral lateral physics 
    115115      IF( ln_dynldf_hor .AND. ln_sco )   nzdf = 1   ! horizontal lateral physics in s-coordinate 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90

    r7931 r7953  
    124124      !!---------------------------------------------------------------------- 
    125125      ! 
    126       ! Choice from ln_zdfexp already read in namelist in zdfini module 
     126      ! Choice from ln_zdfexp (namzdf namelist variable read in zdfphy module) 
    127127      IF( ln_zdfexp ) THEN   ;   nzdf = 0           ! use explicit scheme 
    128128      ELSE                   ;   nzdf = 1           ! use implicit scheme 
    … …  
    130130      ! 
    131131      ! Force implicit schemes 
    132       IF( lk_zdftke .OR. lk_zdfgls   )   nzdf = 1   ! TKE, or GLS physics 
     132      IF( ln_zdftke .OR. ln_zdfgls   )   nzdf = 1   ! TKE, or GLS physics 
    133133      IF( ln_traldf_iso              )   nzdf = 1   ! iso-neutral lateral physics 
    134134      IF( ln_traldf_hor .AND. ln_sco )   nzdf = 1   ! horizontal lateral physics in s-coordinate 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90

    r7931 r7953  
    1515 
    1616   PUBLIC  zdf_oce_alloc    ! Called in nemogcm.F90 
    17  
    18 #if defined key_zdfcst 
    19    LOGICAL, PARAMETER, PUBLIC ::   lk_zdfcst        = .TRUE.         !: constant vertical mixing flag 
    20 #else 
    21    LOGICAL, PARAMETER, PUBLIC ::   lk_zdfcst        = .FALSE.        !: constant vertical mixing flag 
    22 #endif 
    2317 
    2418   !                                 !!* namelist namzdf: vertical diffusion * 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90

    r7646 r7953  
    88   !!             3.3  !  2010-10  (C. Bricaud)  Add in the reference 
    99   !!---------------------------------------------------------------------- 
    10 #if defined key_zdfgls 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_zdfgls'                 Generic Length Scale vertical physics 
     10 
    1311   !!---------------------------------------------------------------------- 
    1412   !!   zdf_gls       : update momentum and tracer Kz from a gls scheme 
    … …  
    3937 
    4038   PUBLIC   zdf_gls        ! routine called in step module 
    41    PUBLIC   zdf_gls_init   ! routine called in opa module 
    42    PUBLIC   gls_rst        ! routine called in step module 
    43  
    44    LOGICAL , PUBLIC, PARAMETER ::   lk_zdfgls = .TRUE.   !: TKE vertical mixing flag 
     39   PUBLIC   zdf_gls_init   ! routine called in zdfphy module 
     40   PUBLIC   gls_rst        ! routine called in zdfphy module 
     41 
    4542   ! 
    4643   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mxln    !: now mixing length 
    … …  
    12111208   END SUBROUTINE gls_rst 
    12121209 
    1213 #else 
    1214    !!---------------------------------------------------------------------- 
    1215    !!   Dummy module :                                        NO TKE scheme 
    1216    !!---------------------------------------------------------------------- 
    1217    LOGICAL, PUBLIC, PARAMETER ::   lk_zdfgls = .FALSE.   !: TKE flag 
    1218 CONTAINS 
    1219    SUBROUTINE zdf_gls_init           ! Empty routine 
    1220       WRITE(*,*) 'zdf_gls_init: You should not have seen this print! error?' 
    1221    END SUBROUTINE zdf_gls_init 
    1222    SUBROUTINE zdf_gls( kt )          ! Empty routine 
    1223       WRITE(*,*) 'zdf_gls: You should not have seen this print! error?', kt 
    1224    END SUBROUTINE zdf_gls 
    1225    SUBROUTINE gls_rst( kt, cdrw )          ! Empty routine 
    1226       INTEGER         , INTENT(in) ::   kt         ! ocean time-step 
    1227       CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
    1228       WRITE(*,*) 'gls_rst: You should not have seen this print! error?', kt, cdrw 
    1229    END SUBROUTINE gls_rst 
    1230 #endif 
    1231  
    12321210   !!====================================================================== 
    12331211END MODULE zdfgls 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfphy.F90

    r7931 r7953  
    1 MODULE zdfini 
     1MODULE zdfphy 
    22   !!====================================================================== 
    3    !!                      ***  MODULE  zdfini  *** 
    4    !! Ocean physics :   read vertical mixing namelist and check consistancy 
     3   !!                      ***  MODULE  zdfphy  *** 
     4   !! Ocean physics :   manager of vertical mixing parametrizations 
    55   !!====================================================================== 
    6    !! History :  8.0  ! 1997-06  (G. Madec)  Original code from inimix 
    7    !!            1.0  ! 2002-08  (G. Madec)  F90 : free form 
    8    !!             -   ! 2005-06  (C. Ethe) KPP scheme 
    9    !!             -   ! 2009-07  (G. Madec) add avmb, avtb in restart for cen2 advection 
    10    !!            3.7  ! 2014-12  (G. Madec) remove KPP scheme 
    11    !!---------------------------------------------------------------------- 
    12  
    13    !!---------------------------------------------------------------------- 
    14    !!   zdf_init    : initialization, namelist read, and parameters control 
    15    !!---------------------------------------------------------------------- 
    16    USE par_oce         ! mesh and scale factors 
    17    USE zdf_oce         ! TKE vertical mixing           
    18    USE sbc_oce         ! surface module (only for nn_isf in the option compatibility test) 
    19    USE zdftke          ! TKE vertical mixing 
    20    USE zdfgls          ! GLS vertical mixing 
    21    USE zdfric          ! Richardson vertical mixing    
    22    USE zdfddm          ! double diffusion mixing       
    23    USE zdfevd          ! enhanced vertical diffusion   
    24    USE tranpc          ! convection: non penetrative adjustment 
    25    USE ldfslp          ! iso-neutral slopes 
     6   !! History :  4.0  !  2017-04  (G. Madec)  original code 
     7   !!---------------------------------------------------------------------- 
     8 
     9   !!---------------------------------------------------------------------- 
     10   !!   zdf_phy_init  : initialization of all vertical physics pakages 
     11   !!   zdf_phy       : upadate at each time-step the vertical mixing coeff.  
     12   !!---------------------------------------------------------------------- 
     13   USE par_oce        ! mesh and scale factors 
     14   USE zdf_oce        ! TKE vertical mixing           
     15   USE sbc_oce        ! surface module (only for nn_isf in the option compatibility test) 
     16   USE zdfbfr         ! bottom friction 
     17   USE zdftke         ! TKE vertical mixing 
     18   USE zdfgls         ! GLS vertical mixing 
     19   USE zdfric         ! Richardson vertical mixing    
     20   USE zdfddm         ! double diffusion mixing       
     21   USE zdfevd         ! enhanced vertical diffusion 
     22   USE zdftmx         ! internal tide-induced mixing 
     23   USE zdfqiao          !Qiao module wave induced mixing   (zdf_qiao routine) 
     24   USE zdfmxl           ! Mixed-layer depth                (zdf_mxl routine) 
     25   USE tranpc         ! convection: non penetrative adjustment 
     26   USE sbcrnf         ! surface boundary condition: runoff variables 
    2627   ! 
    27    USE in_out_manager  ! I/O manager 
    28    USE iom             ! IOM library 
    29    USE lib_mpp         ! distribued memory computing 
     28   USE in_out_manager ! I/O manager 
     29   USE iom            ! IOM library 
     30   USE lib_mpp        ! distribued memory computing 
    3031 
    3132   IMPLICIT NONE 
    3233   PRIVATE 
    3334 
    34    PUBLIC   zdf_init   ! routine called by opa.F90 
     35   PUBLIC   zdf_phy_init   ! routine called by nemogcm.F90 
     36   PUBLIC   zdf_phy        ! routine called by step.F90 
     37    
    3538    
    3639   !!---------------------------------------------------------------------- 
    … …  
    4144CONTAINS 
    4245 
    43    SUBROUTINE zdf_init 
    44       !!---------------------------------------------------------------------- 
    45       !!                  ***  ROUTINE zdf_init  *** 
     46   SUBROUTINE zdf_phy_init 
     47      !!---------------------------------------------------------------------- 
     48      !!                  ***  ROUTINE zdf_phy_init  *** 
    4649      !!  
    4750      !! ** Purpose :   initializations of the vertical ocean physics 
    … …  
    4952      !! ** Method  :   Read namelist namzdf, control logicals  
    5053      !!---------------------------------------------------------------------- 
    51       INTEGER ::   ioptio, ios       ! local integers 
     54      INTEGER ::   ioptio, ios   ! local integers 
    5255      !! 
    5356      NAMELIST/namzdf/ ln_zdfcst, ln_zdfric, ln_zdftke, ln_zdfgls,   &     ! type of closure scheme 
    … …  
    7780      IF(lwp) THEN               !* Parameter print 
    7881         WRITE(numout,*) 
    79          WRITE(numout,*) 'zdf_init : vertical physics' 
     82         WRITE(numout,*) 'zdf_phy_init : vertical physics' 
    8083         WRITE(numout,*) '~~~~~~~~' 
    8184         WRITE(numout,*) '   Namelist namzdf : set vertical mixing mixing parameters' 
    … …  
    106109      ENDIF 
    107110 
    108       IF(ln_zdfddm) THEN                    ! double diffusive mixing' 
    109          ALLOCATE( avs(jpi,jpj,jpk) ) 
    110          avs(:,:,:) = rn_avt0 * wmask(:,:,:)  
    111       ENDIF 
    112  
     111!!gm      IF(ln_zdfddm) THEN                    ! double diffusive mixing' 
     112!         avs(:,:,:) = rn_avt0 * wmask(:,:,:)  
     113!!gm      ENDIF 
    113114 
    114115      !                          !* Parameter & logical controls 
    … …  
    122123      IF(lwp) WRITE(numout,*) '   vertical mixing option :' 
    123124      ioptio = 0 
    124       IF( lk_zdfcst ) THEN 
     125      IF( ln_zdfcst ) THEN 
    125126         IF(lwp) WRITE(numout,*) '      constant eddy diffusion coefficients' 
    126127         ioptio = ioptio+1 
    127128      ENDIF 
    128       IF( lk_zdfric ) THEN 
     129      IF( ln_zdfric ) THEN 
    129130         IF(lwp) WRITE(numout,*) '      Richardson dependent eddy coefficients' 
    130131         ioptio = ioptio+1 
    131132      ENDIF 
    132       IF( lk_zdftke ) THEN 
     133      IF( ln_zdftke ) THEN 
    133134         IF(lwp) WRITE(numout,*) '      TKE dependent eddy coefficients' 
    134135         ioptio = ioptio+1 
    135136      ENDIF 
    136       IF( lk_zdfgls ) THEN 
     137      IF( ln_zdfgls ) THEN 
    137138         IF(lwp) WRITE(numout,*) '      GLS dependent eddy coefficients' 
    138139         ioptio = ioptio+1 
    … …  
    140141      IF( ioptio == 0 .OR. ioptio > 1 )   & 
    141142         &   CALL ctl_stop( ' one and only one vertical diffusion option has to be defined ' ) 
    142       IF( ( lk_zdfric .OR. lk_zdfgls ) .AND. ln_isfcav )   & 
     143      IF( ( ln_zdfric .OR. ln_zdfgls ) .AND. ln_isfcav )   & 
    143144         &   CALL ctl_stop( ' only zdfcst and zdftke were tested with ice shelves cavities ' ) 
    144145      ! 
    … …  
    148149      ! 
    149150#if defined key_top 
    150       IF( ln_zdfnpc )   CALL ctl_stop( ' zdf_init: npc scheme is not working with key_top' ) 
     151      IF( ln_zdfnpc )   CALL ctl_stop( ' zdf_phy_init: npc scheme is not working with key_top' ) 
    151152#endif 
    152153      ! 
    … …  
    160161         ioptio = ioptio+1 
    161162      ENDIF 
    162       IF( lk_zdftke ) THEN 
     163      IF( ln_zdftke ) THEN 
    163164         IF(lwp) WRITE(numout,*) '      use the 1.5 turbulent closure' 
    164165      ENDIF 
    165       IF( lk_zdfgls ) THEN 
     166      IF( ln_zdfgls ) THEN 
    166167         IF(lwp) WRITE(numout,*) '      use the GLS closure scheme' 
    167168      ENDIF 
    168169      IF ( ioptio > 1 )   CALL ctl_stop( ' chose between ln_zdfnpc and ln_zdfevd' ) 
    169       IF( ioptio == 0 .AND. .NOT.( lk_zdftke .OR. lk_zdfgls ) )           & 
     170      IF( ioptio == 0 .AND. .NOT.( ln_zdftke .OR. ln_zdfgls ) )           & 
    170171         CALL ctl_stop( ' except for TKE or GLS physics, a convection scheme is',   & 
    171172         &              ' required: ln_zdfevd or ln_zdfnpc logicals' ) 
    … …  
    202203      ENDIF 
    203204      ! 
    204    END SUBROUTINE zdf_init 
     205 
     206!!gm moved into zdf_phy_init 
     207! 
     208                            CALL zdf_bfr_init      ! bottom friction 
     209 
     210      ioptio = 0                 !==  type of vertical turbulent closure  ==!    (set nzdfphy) 
     211      ! 
     212!      IF( ln_zdfcst ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_CST   ;   ENDIF 
     213!      IF( ln_zdfric ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_RIC   ;   CALL zdf_ric_init   ;   ENDIF 
     214!      IF( ln_zdftke ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_TKE   ;   CALL zdf_tke_init   ;   ENDIF 
     215!      IF( ln_zdfgls ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_GLS   ;   CALL zdf_gls_init   ;   ENDIF 
     216 
     217 
     218      ! 
     219      IF( ln_zdfric     )   CALL zdf_ric_init      ! Richardson number dependent Kz 
     220      IF( ln_zdftke     )   CALL zdf_tke_init      ! TKE closure scheme 
     221      IF( ln_zdfgls     )   CALL zdf_gls_init      ! GLS closure scheme 
     222      IF( ln_zdftmx     )   CALL zdf_tmx_init      ! tidal vertical mixing 
     223!!gm 
     224      ! 
     225   END SUBROUTINE zdf_phy_init 
     226 
     227 
     228   SUBROUTINE zdf_phy( kstp ) 
     229      !!---------------------------------------------------------------------- 
     230      !!                     ***  ROUTINE zdf_phy  *** 
     231      !! 
     232      !! ** Purpose :  Update ocean physics at each time-step 
     233      !! 
     234      !! ** Method  :  
     235      !! 
     236      !! ** Action  :   avm, avt vertical eddy viscosity and diffusivity at w-points 
     237      !!                nmld ??? mixed layer depth in level and meters   <<<<====verifier ! 
     238      !!                bottom stress.....                               <<<<====verifier ! 
     239      !!---------------------------------------------------------------------- 
     240      INTEGER, INTENT(in) ::   kstp   ! ocean time-step index 
     241      ! 
     242      INTEGER ::   ji, jj, jk    ! dummy loop indice 
     243      !!---------------------------------------------------------------------- 
     244      ! 
     245                         CALL zdf_bfr( kstp )         ! bottom friction (if quadratic) 
     246      !                                               ! Vertical eddy viscosity and diffusivity coefficients 
     247      IF( ln_zdfric  )   CALL zdf_ric ( kstp )             ! Richardson number dependent Kz 
     248      IF( ln_zdftke  )   CALL zdf_tke ( kstp )             ! TKE closure scheme for Kz 
     249      IF( ln_zdfgls  )   CALL zdf_gls ( kstp )             ! GLS closure scheme for Kz 
     250      IF( ln_zdfqiao )   CALL zdf_qiao( kstp )             ! Qiao vertical mixing  
     251      ! 
     252      IF( ln_zdfcst  ) THEN                                ! Constant Kz (reset avt, avm[uv] to the background value) 
     253         avt (:,:,:) = rn_avt0 * wmask (:,:,:) 
     254         avm (:,:,:) = rn_avm0 * wmask (:,:,:) 
     255         avmu(:,:,:) = rn_avm0 * wumask(:,:,:) 
     256         avmv(:,:,:) = rn_avm0 * wvmask(:,:,:) 
     257      ENDIF 
     258      ! 
     259      IF( ln_rnf_mouth ) THEN                         ! increase diffusivity at rivers mouths 
     260         DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + 2._wp * rn_avt_rnf * rnfmsk(:,:) * tmask(:,:,jk)   ;   END DO 
     261      ENDIF 
     262      ! 
     263      IF( ln_zdfevd  )   CALL zdf_evd( kstp )         ! enhanced vertical eddy diffusivity 
     264      ! 
     265      IF( ln_zdfddm  ) THEN                           ! double diffusive mixing 
     266                         CALL zdf_ddm( kstp ) 
     267      ELSE                                            ! avs=avt 
     268         DO jk = 2, jpkm1   ;   avs(:,:,jk) = avt(:,:,jk)   ;   END DO 
     269      ENDIF 
     270      ! 
     271      IF( ln_zdftmx  )   CALL zdf_tmx( kstp )         ! tidal vertical mixing 
     272 
     273                         CALL zdf_mxl( kstp )         ! mixed layer depth 
     274 
     275                                                      ! write TKE or GLS information in the restart file 
     276      IF( lrst_oce .AND. ln_zdftke )   CALL tke_rst( kstp, 'WRITE' ) 
     277      IF( lrst_oce .AND. ln_zdfgls )   CALL gls_rst( kstp, 'WRITE' ) 
     278      ! 
     279   END SUBROUTINE zdf_phy 
    205280 
    206281   !!====================================================================== 
    207 END MODULE zdfini 
     282END MODULE zdfphy 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfqiao.F90

    r7646 r7953  
    6767      !--------------------------------------------------------------------------------- 
    6868      ! 
     69!!gm Comment: I don't understand the use of min of 4 gdepw_n to define a quantity at w-point 
     70!!gm                       ==>> this is an error.... 
    6971      DO jk = 1, jpk 
    7072         DO jj = 1, jpjm1 
    … …  
    101103      !------------------------------- 
    102104      ! 
     105!!gm  with double diffusion activated, avs is not updated... 
     106!!gm                    =====>>> BUG 
    103107      DO jk = 1, jpkm1 
    104108         DO jj = 1, jpj 
    … …  
    112116      ! 
    113117   END SUBROUTINE zdf_qiao 
     118 
    114119 
    115120   INTEGER FUNCTION zdf_qiao_alloc() 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90

    r7646 r7953  
    1313   !!            3.3.1! 2011-09  (P. Oddo) Mixed layer depth parameterization 
    1414   !!---------------------------------------------------------------------- 
    15 #if defined key_zdfric 
    16    !!---------------------------------------------------------------------- 
    17    !!   'key_zdfric'                                             Kz = f(Ri) 
    18    !!---------------------------------------------------------------------- 
    19    !!   zdf_ric       : update momentum and tracer Kz from the Richardson 
    20    !!                  number computation 
     15 
     16   !!---------------------------------------------------------------------- 
     17   !!   zdf_ric       : update momentum and tracer Kz from the Richardson number 
    2118   !!   zdf_ric_init  : initialization, namelist read, & parameters control 
    2219   !!---------------------------------------------------------------------- 
    … …  
    3835   PUBLIC   zdf_ric         ! called by step.F90 
    3936   PUBLIC   zdf_ric_init    ! called by opa.F90 
    40  
    41    LOGICAL, PUBLIC, PARAMETER ::   lk_zdfric = .TRUE.   !: Richardson vertical mixing flag 
    4237 
    4338   !                           !!* Namelist namzdf_ric : Richardson number dependent Kz * 
    … …  
    108103      !!      namelist 
    109104      !!        N.B. the mask are required for implicit scheme, and surface 
    110       !!      and bottom value already set in zdfini.F90 
     105      !!      and bottom value already set in zdfphy.F90 
    111106      !! 
    112107      !! References : Pacanowski & Philander 1981, JPO, 1441-1451. 
    … …  
    183178            zrhos          = rhop(ji,jj,1) + zflageos * ( 1. - tmask(ji,jj,1) ) 
    184179            zustar         = SQRT( taum(ji,jj) / ( zrhos +  rsmall ) ) 
    185             ekm_dep(ji,jj) = rn_ekmfc * zustar / ( ABS( ff(ji,jj) ) + rsmall ) 
     180            ekm_dep(ji,jj) = rn_ekmfc * zustar / ( ABS( ff_t(ji,jj) ) + rsmall ) 
    186181            ekm_dep(ji,jj) = MAX(ekm_dep(ji,jj),rn_mldmin) ! Minimun allowed 
    187182            ekm_dep(ji,jj) = MIN(ekm_dep(ji,jj),rn_mldmax) ! Maximum allowed 
    … …  
    303298   END SUBROUTINE zdf_ric_init 
    304299 
    305 #else 
    306    !!---------------------------------------------------------------------- 
    307    !!   Dummy module :              NO Richardson dependent vertical mixing 
    308    !!---------------------------------------------------------------------- 
    309    LOGICAL, PUBLIC, PARAMETER ::   lk_zdfric = .FALSE.   !: Richardson mixing flag 
    310 CONTAINS 
    311    SUBROUTINE zdf_ric_init         ! Dummy routine 
    312    END SUBROUTINE zdf_ric_init 
    313    SUBROUTINE zdf_ric( kt )        ! Dummy routine 
    314       WRITE(*,*) 'zdf_ric: You should not have seen this print! error?', kt 
    315    END SUBROUTINE zdf_ric 
    316 #endif 
    317  
    318300   !!====================================================================== 
    319301END MODULE zdfric 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r7813 r7953  
    2727   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    2828   !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability 
     29   !!            4.0  !  2017-04  (G. Madec)  Remove CPP keys 
    2930   !!---------------------------------------------------------------------- 
    30 #if defined key_zdftke 
    31    !!---------------------------------------------------------------------- 
    32    !!   'key_zdftke'                                   TKE vertical physics 
     31 
    3332   !!---------------------------------------------------------------------- 
    3433   !!   zdf_tke       : update momentum and tracer Kz from a tke scheme 
    … …  
    6564   PUBLIC   tke_rst        ! routine called in step module 
    6665 
    67    LOGICAL , PUBLIC, PARAMETER ::   lk_zdftke = .TRUE.  !: TKE vertical mixing flag 
    68  
    6966   !                      !!** Namelist  namzdf_tke  ** 
    7067   LOGICAL  ::   ln_mxl0   ! mixing length scale surface value as function of wind stress or not 
    … …  
    376373            DO ji = fs_2, fs_jpim1   ! vector opt. 
    377374               zcof   = zfact1 * tmask(ji,jj,jk) 
    378 # if defined key_zdftmx_new 
    379                ! key_zdftmx_new: New internal wave-driven param: set a minimum value for Kz on TKE (ensure numerical stability) 
    380                zzd_up = zcof * MAX( avm(ji,jj,jk+1) + avm(ji,jj,jk), 2.e-5_wp )   &  ! upper diagonal 
    381                   &          / (  e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk  )  ) 
    382                zzd_lw = zcof * MAX( avm(ji,jj,jk) + avm(ji,jj,jk-1), 2.e-5_wp )   &  ! lower diagonal 
    383                   &          / (  e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk  )  ) 
    384 # else 
    385                zzd_up = zcof * ( avm  (ji,jj,jk+1) + avm  (ji,jj,jk  ) )   &  ! upper diagonal 
    386                   &          / ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk  ) ) 
    387                zzd_lw = zcof * ( avm  (ji,jj,jk  ) + avm  (ji,jj,jk-1) )   &  ! lower diagonal 
    388                   &          / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk  ) ) 
    389 # endif 
     375               !                                   ! A minimum of 2.e-5 m2/s is imposed on TKE vertical 
     376               !                                   ! eddy coefficient (ensure numerical stability) 
     377               zzd_up = zcof * MAX(   avm(ji,jj,jk+1) +   avm(ji,jj,jk  ) , 2.e-5_wp  )   &  ! upper diagonal 
     378                  &          /    ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk  )  ) 
     379               zzd_lw = zcof * MAX(   avm(ji,jj,jk  ) +   avm(ji,jj,jk-1) , 2.e-5_wp  )   &  ! lower diagonal 
     380                  &          /    ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk  )  ) 
     381               ! 
    390382               !                                   ! shear prod. at w-point weightened by mask 
    391383               zesh2  =  ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   & 
    … …  
    741733      ! 
    742734      ri_cri   = 2._wp    / ( 2._wp + rn_ediss / rn_ediff )   ! resulting critical Richardson number 
    743 # if defined key_zdftmx_new 
    744       ! key_zdftmx_new: New internal wave-driven param: specified value of rn_emin & rmxl_min are used 
    745       rn_emin  = 1.e-10_wp 
    746       rmxl_min = 1.e-03_wp 
    747       IF(lwp) THEN                  ! Control print 
    748          WRITE(numout,*) 
    749          WRITE(numout,*) 'zdf_tke_init :  New tidal mixing case: force rn_emin = 1.e-10 and rmxl_min = 1.e-3 ' 
    750          WRITE(numout,*) '~~~~~~~~~~~~' 
    751       ENDIF 
    752 # else 
    753       rmxl_min = 1.e-6_wp / ( rn_ediff * SQRT( rn_emin ) )    ! resulting minimum length to recover molecular viscosity 
    754 # endif 
    755735      ! 
    756736      IF(lwp) THEN                    !* Control print 
    … …  
    776756         WRITE(numout,*) 
    777757         WRITE(numout,*) '      critical Richardson nb with your parameters  ri_cri = ', ri_cri 
     758         WRITE(numout,*) 
     759      ENDIF 
     760      ! 
     761      IF( ln_zdftmx ) THEN          ! Internal wave driven mixing 
     762         !                          ! specific values of rn_emin & rmxl_min are used 
     763         rn_emin  = 1.e-10_wp 
     764         rmxl_min = 1.e-03_wp 
     765         IF(lwp) WRITE(numout,*) '      Internal wave-driven mixing case:   force   rn_emin = 1.e-10 and rmxl_min = 1.e-3 ' 
     766      ELSE 
     767         rmxl_min = 1.e-6_wp / ( rn_ediff * SQRT( rn_emin ) )    ! resulting minimum length to recover molecular viscosity 
     768         IF(lwp) WRITE(numout,*) '      minimum mixing length with your parameters rmxl_min = ', rmxl_min 
    778769      ENDIF 
    779770      ! 
    … …  
    891882   END SUBROUTINE tke_rst 
    892883 
    893 #else 
    894    !!---------------------------------------------------------------------- 
    895    !!   Dummy module :                                        NO TKE scheme 
    896    !!---------------------------------------------------------------------- 
    897    LOGICAL, PUBLIC, PARAMETER ::   lk_zdftke = .FALSE.   !: TKE flag 
    898 CONTAINS 
    899    SUBROUTINE zdf_tke_init           ! Dummy routine 
    900    END SUBROUTINE zdf_tke_init 
    901    SUBROUTINE zdf_tke( kt )          ! Dummy routine 
    902       WRITE(*,*) 'zdf_tke: You should not have seen this print! error?', kt 
    903    END SUBROUTINE zdf_tke 
    904    SUBROUTINE tke_rst( kt, cdrw ) 
    905      CHARACTER(len=*) ::   cdrw 
    906      WRITE(*,*) 'tke_rst: You should not have seen this print! error?', kt, cdwr 
    907    END SUBROUTINE tke_rst 
    908 #endif 
    909  
    910884   !!====================================================================== 
    911885END MODULE zdftke 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90

    r7931 r7953  
    22   !!======================================================================== 
    33   !!                       ***  MODULE  zdftmx  *** 
    4    !! Ocean physics: vertical tidal mixing coefficient 
     4   !! Ocean physics: Internal gravity wave-driven vertical mixing 
    55   !!======================================================================== 
    66   !! History :  1.0  !  2004-04  (L. Bessieres, G. Madec)  Original code 
    7    !!             -   !  2006-08  (A. Koch-Larrouy) Indonesian strait 
    8    !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
     7   !!             -   !  2006-08  (A. Koch-Larrouy)  Indonesian strait 
     8   !!            3.3  !  2010-10  (C. Ethe, G. Madec)  reorganisation of initialisation phase 
     9   !!            3.6  !  2016-03  (C. de Lavergne)  New param: internal wave-driven mixing  
     10   !!            4.0  !  2017-04  (G. Madec)  Remove the old tidal mixing param. and key zdftmx(_new) 
    911   !!---------------------------------------------------------------------- 
    10 #if defined key_zdftmx 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_zdftmx'                                  Tidal vertical mixing 
    13    !!---------------------------------------------------------------------- 
    14    !!   zdf_tmx       : global     momentum & tracer Kz with tidal induced Kz 
    15    !!   tmx_itf       : Indonesian momentum & tracer Kz with tidal induced Kz  
    16    !!---------------------------------------------------------------------- 
    17    USE oce            ! ocean dynamics and tracers variables 
    18    USE dom_oce        ! ocean space and time domain variables 
    19    USE zdf_oce        ! ocean vertical physics variables 
    20    USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    21    USE eosbn2         ! ocean equation of state 
    22    USE phycst         ! physical constants 
    23    USE prtctl         ! Print control 
    24    USE in_out_manager ! I/O manager 
    25    USE iom            ! I/O Manager 
    26    USE lib_mpp        ! MPP library 
    27    USE wrk_nemo       ! work arrays 
    28    USE timing         ! Timing 
    29    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    30  
    31    IMPLICIT NONE 
    32    PRIVATE 
    33  
    34    PUBLIC   zdf_tmx         ! called in step module  
    35    PUBLIC   zdf_tmx_init    ! called in opa module  
    36    PUBLIC   zdf_tmx_alloc   ! called in nemogcm module 
    37  
    38    LOGICAL, PUBLIC, PARAMETER ::   lk_zdftmx = .TRUE.    !: tidal mixing flag 
    39  
    40    !                       !!* Namelist  namzdf_tmx : tidal mixing * 
    41    REAL(wp) ::  rn_htmx     ! vertical decay scale for turbulence (meters) 
    42    REAL(wp) ::  rn_n2min    ! threshold of the Brunt-Vaisala frequency (s-1) 
    43    REAL(wp) ::  rn_tfe      ! tidal dissipation efficiency (St Laurent et al. 2002) 
    44    REAL(wp) ::  rn_me       ! mixing efficiency (Osborn 1980) 
    45    LOGICAL  ::  ln_tmx_itf  ! Indonesian Through Flow (ITF): Koch-Larrouy et al. (2007) parameterization 
    46    REAL(wp) ::  rn_tfe_itf  ! ITF tidal dissipation efficiency (St Laurent et al. 2002) 
    47  
    48    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   en_tmx     ! energy available for tidal mixing (W/m2) 
    49    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   mask_itf   ! mask to use over Indonesian area 
    50    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   az_tmx     ! coefficient used to evaluate the tidal induced Kz 
    51  
    52    !! * Substitutions 
    53 #  include "vectopt_loop_substitute.h90" 
    54    !!---------------------------------------------------------------------- 
    55    !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    56    !! $Id$ 
    57    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    58    !!---------------------------------------------------------------------- 
    59 CONTAINS 
    60  
    61    INTEGER FUNCTION zdf_tmx_alloc() 
    62       !!---------------------------------------------------------------------- 
    63       !!                ***  FUNCTION zdf_tmx_alloc  *** 
    64       !!---------------------------------------------------------------------- 
    65       ALLOCATE(en_tmx(jpi,jpj), mask_itf(jpi,jpj), az_tmx(jpi,jpj,jpk), STAT=zdf_tmx_alloc ) 
    66       ! 
    67       IF( lk_mpp             )   CALL mpp_sum ( zdf_tmx_alloc ) 
    68       IF( zdf_tmx_alloc /= 0 )   CALL ctl_warn('zdf_tmx_alloc: failed to allocate arrays') 
    69    END FUNCTION zdf_tmx_alloc 
    70  
    71  
    72    SUBROUTINE zdf_tmx( kt ) 
    73       !!---------------------------------------------------------------------- 
    74       !!                  ***  ROUTINE zdf_tmx  *** 
    75       !!                    
    76       !! ** Purpose :   add to the vertical mixing coefficients the effect of 
    77       !!              tidal mixing (Simmons et al 2004). 
    78       !! 
    79       !! ** Method  : - tidal-induced vertical mixing is given by: 
    80       !!                  Kz_tides = az_tmx / max( rn_n2min, N^2 ) 
    81       !!              where az_tmx is a coefficient that specified the 3D space  
    82       !!              distribution of the faction of tidal energy taht is used 
    83       !!              for mixing. Its expression is set in zdf_tmx_init routine, 
    84       !!              following Simmons et al. 2004. 
    85       !!                NB: a specific bounding procedure is performed on av_tide 
    86       !!              so that the input tidal energy is actually almost used. The 
    87       !!              basic maximum value is 60 cm2/s, but values of 300 cm2/s  
    88       !!              can be reached in area where bottom stratification is too  
    89       !!              weak. 
    90       !! 
    91       !!              - update av_tide in the Indonesian Through Flow area 
    92       !!              following Koch-Larrouy et al. (2007) parameterisation 
    93       !!              (see tmx_itf routine). 
    94       !! 
    95       !!              - update the model vertical eddy viscosity and diffusivity:  
    96       !!                     avt  = avt  +    av_tides 
    97       !!                     avm  = avm  +    av_tides 
    98       !!                     avmu = avmu + mi(av_tides) 
    99       !!                     avmv = avmv + mj(av_tides) 
    100       !! 
    101       !! ** Action  :   avt, avm, avmu, avmv   increased by tidal mixing 
    102       !! 
    103       !! References : Simmons et al. 2004, Ocean Modelling, 6, 3-4, 245-263. 
    104       !!              Koch-Larrouy et al. 2007, GRL. 
    105       !!---------------------------------------------------------------------- 
    106       INTEGER, INTENT(in) ::   kt   ! ocean time-step  
    107       ! 
    108       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    109       REAL(wp) ::   ztpc         ! scalar workspace 
    110       REAL(wp), POINTER, DIMENSION(:,:)   ::   zkz 
    111       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zav_tide 
    112       !!---------------------------------------------------------------------- 
    113       ! 
    114       IF( nn_timing == 1 )  CALL timing_start('zdf_tmx') 
    115       ! 
    116       CALL wrk_alloc( jpi,jpj,       zkz ) 
    117       CALL wrk_alloc( jpi,jpj,jpk,   zav_tide ) 
    118       ! 
    119       !                          ! ----------------------- ! 
    120       !                          !  Standard tidal mixing  !  (compute zav_tide) 
    121       !                          ! ----------------------- ! 
    122       !                             !* First estimation (with n2 bound by rn_n2min) bounded by 60 cm2/s 
    123       zav_tide(:,:,:) = MIN(  60.e-4, az_tmx(:,:,:) / MAX( rn_n2min, rn2(:,:,:) )  ) 
    124  
    125       zkz(:,:) = 0.e0               !* Associated potential energy consummed over the whole water column 
    126       DO jk = 2, jpkm1 
    127          zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk) 
    128       END DO 
    129  
    130       DO jj = 1, jpj                !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx 
    131          DO ji = 1, jpi 
    132             IF( zkz(ji,jj) /= 0.e0 )   zkz(ji,jj) = en_tmx(ji,jj) / zkz(ji,jj) 
    133          END DO 
    134       END DO 
    135  
    136       DO jk = 2, jpkm1     !* Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zav_tide bound by 300 cm2/s 
    137          zav_tide(:,:,jk) = zav_tide(:,:,jk) * MIN( zkz(:,:), 30./6. ) * wmask(:,:,jk)  !kz max = 300 cm2/s 
    138       END DO 
    139  
    140       IF( kt == nit000 ) THEN       !* check at first time-step: diagnose the energy consumed by zav_tide 
    141          ztpc = 0._wp 
    142          DO jk= 1, jpk 
    143             DO jj= 1, jpj 
    144                DO ji= 1, jpi 
    145                   ztpc = ztpc + e3w_n(ji,jj,jk) * e1e2t(ji,jj)                  & 
    146                      &        * MAX( 0.e0, rn2(ji,jj,jk) ) * zav_tide(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    147                END DO 
    148             END DO 
    149          END DO 
    150          ztpc= rau0 / ( rn_tfe * rn_me ) * ztpc 
    151          IF( lk_mpp )   CALL mpp_sum( ztpc ) 
    152          IF(lwp) WRITE(numout,*)  
    153          IF(lwp) WRITE(numout,*) '          N Total power consumption by av_tide    : ztpc = ', ztpc * 1.e-12 ,'TW' 
    154       ENDIF 
    155         
    156       !                          ! ----------------------- ! 
    157       !                          !    ITF  tidal mixing    !  (update zav_tide) 
    158       !                          ! ----------------------- ! 
    159       IF( ln_tmx_itf )   CALL tmx_itf( kt, zav_tide ) 
    160  
    161       !                          ! ----------------------- ! 
    162       !                          !   Update  mixing coefs  !                           
    163       !                          ! ----------------------- ! 
    164       DO jk = 2, jpkm1              !* update momentum & tracer diffusivity with tidal mixing 
    165          avt(:,:,jk) = avs(:,:,jk) + zav_tide(:,:,jk) * wmask(:,:,jk) 
    166          avm(:,:,jk) = avm(:,:,jk) + zav_tide(:,:,jk) * wmask(:,:,jk) 
    167          DO jj = 2, jpjm1 
    168             DO ji = fs_2, fs_jpim1  ! vector opt. 
    169                avmu(ji,jj,jk) = avmu(ji,jj,jk) + 0.5 * ( zav_tide(ji,jj,jk) + zav_tide(ji+1,jj  ,jk) ) * wumask(ji,jj,jk) 
    170                avmv(ji,jj,jk) = avmv(ji,jj,jk) + 0.5 * ( zav_tide(ji,jj,jk) + zav_tide(ji  ,jj+1,jk) ) * wvmask(ji,jj,jk) 
    171             END DO 
    172          END DO 
    173       END DO 
    174       CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )      ! lateral boundary condition 
    175  
    176       !                             !* output tidal mixing coefficient 
    177       CALL iom_put( "av_tide", zav_tide ) 
    178  
    179       IF(ln_ctl)   CALL prt_ctl(tab3d_1=zav_tide , clinfo1=' tmx - av_tide: ', tab3d_2=avt, clinfo2=' avt: ', ovlap=1, kdim=jpk) 
    180       ! 
    181       CALL wrk_dealloc( jpi,jpj,       zkz ) 
    182       CALL wrk_dealloc( jpi,jpj,jpk,   zav_tide ) 
    183       ! 
    184       IF( nn_timing == 1 )  CALL timing_stop('zdf_tmx') 
    185       ! 
    186    END SUBROUTINE zdf_tmx 
    187  
    188  
    189    SUBROUTINE tmx_itf( kt, pav ) 
    190       !!---------------------------------------------------------------------- 
    191       !!                  ***  ROUTINE tmx_itf  *** 
    192       !!                    
    193       !! ** Purpose :   modify the vertical eddy diffusivity coefficients  
    194       !!              (pav) in the Indonesian Through Flow area (ITF). 
    195       !! 
    196       !! ** Method  : - Following Koch-Larrouy et al. (2007), in the ITF defined 
    197       !!                by msk_itf (read in a file, see tmx_init), the tidal 
    198       !!                mixing coefficient is computed with : 
    199       !!                  * q=1 (i.e. all the tidal energy remains trapped in 
    200       !!                         the area and thus is used for mixing) 
    201       !!                  * the vertical distribution of the tifal energy is a 
    202       !!                    proportional to N above the thermocline (d(N^2)/dz > 0) 
    203       !!                    and to N^2 below the thermocline (d(N^2)/dz < 0) 
    204       !! 
    205       !! ** Action  :   av_tide   updated in the ITF area (msk_itf) 
    206       !! 
    207       !! References :  Koch-Larrouy et al. 2007, GRL  
    208       !!---------------------------------------------------------------------- 
    209       INTEGER , INTENT(in   )                         ::   kt   ! ocean time-step 
    210       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pav  ! Tidal mixing coef. 
    211       !!  
    212       INTEGER  ::   ji, jj, jk    ! dummy loop indices 
    213       REAL(wp) ::   zcoef, ztpc   ! temporary scalar 
    214       REAL(wp), DIMENSION(:,:)  , POINTER ::   zkz                        ! 2D workspace 
    215       REAL(wp), DIMENSION(:,:)  , POINTER ::   zsum1 , zsum2 , zsum       !  -      - 
    216       REAL(wp), DIMENSION(:,:,:), POINTER ::   zempba_3d_1, zempba_3d_2   ! 3D workspace 
    217       REAL(wp), DIMENSION(:,:,:), POINTER ::   zempba_3d  , zdn2dz        !  -      - 
    218       REAL(wp), DIMENSION(:,:,:), POINTER ::   zavt_itf                   !  -      - 
    219       !!---------------------------------------------------------------------- 
    220       ! 
    221       IF( nn_timing == 1 )  CALL timing_start('tmx_itf') 
    222       ! 
    223       CALL wrk_alloc( jpi,jpj, zkz, zsum1 , zsum2 , zsum ) 
    224       CALL wrk_alloc( jpi,jpj,jpk, zempba_3d_1, zempba_3d_2, zempba_3d, zdn2dz, zavt_itf ) 
    225  
    226       !                             ! compute the form function using N2 at each time step 
    227       zempba_3d_1(:,:,jpk) = 0.e0 
    228       zempba_3d_2(:,:,jpk) = 0.e0 
    229       DO jk = 1, jpkm1              
    230          zdn2dz     (:,:,jk) = rn2(:,:,jk) - rn2(:,:,jk+1)           ! Vertical profile of dN2/dz 
    231          zempba_3d_1(:,:,jk) = SQRT(  MAX( 0.e0, rn2(:,:,jk) )  )    !    -        -    of N 
    232          zempba_3d_2(:,:,jk) =        MAX( 0.e0, rn2(:,:,jk) )       !    -        -    of N^2 
    233       END DO 
    234       ! 
    235       zsum (:,:) = 0.e0 
    236       zsum1(:,:) = 0.e0 
    237       zsum2(:,:) = 0.e0 
    238       DO jk= 2, jpk 
    239          zsum1(:,:) = zsum1(:,:) + zempba_3d_1(:,:,jk) * e3w_n(:,:,jk) * wmask(:,:,jk) 
    240          zsum2(:,:) = zsum2(:,:) + zempba_3d_2(:,:,jk) * e3w_n(:,:,jk) * wmask(:,:,jk)                
    241       END DO 
    242       DO jj = 1, jpj 
    243          DO ji = 1, jpi 
    244             IF( zsum1(ji,jj) /= 0.e0 )   zsum1(ji,jj) = 1.e0 / zsum1(ji,jj) 
    245             IF( zsum2(ji,jj) /= 0.e0 )   zsum2(ji,jj) = 1.e0 / zsum2(ji,jj)                 
    246          END DO 
    247       END DO 
    248  
    249       DO jk= 1, jpk 
    250          DO jj = 1, jpj 
    251             DO ji = 1, jpi 
    252                zcoef = 0.5 - SIGN( 0.5, zdn2dz(ji,jj,jk) )       ! =0 if dN2/dz > 0, =1 otherwise  
    253                ztpc  = zempba_3d_1(ji,jj,jk) * zsum1(ji,jj) *        zcoef     & 
    254                   &  + zempba_3d_2(ji,jj,jk) * zsum2(ji,jj) * ( 1. - zcoef ) 
    255                ! 
    256                zempba_3d(ji,jj,jk) =               ztpc  
    257                zsum     (ji,jj)    = zsum(ji,jj) + ztpc * e3w_n(ji,jj,jk) 
    258             END DO 
    259          END DO 
    260        END DO 
    261        DO jj = 1, jpj 
    262           DO ji = 1, jpi 
    263              IF( zsum(ji,jj) > 0.e0 )   zsum(ji,jj) = 1.e0 / zsum(ji,jj)                 
    264           END DO 
    265        END DO 
    266  
    267       !                             ! first estimation bounded by 10 cm2/s (with n2 bounded by rn_n2min)  
    268       zcoef = rn_tfe_itf / ( rn_tfe * rau0 ) 
    269       DO jk = 1, jpk 
    270          zavt_itf(:,:,jk) = MIN(  10.e-4, zcoef * en_tmx(:,:) * zsum(:,:) * zempba_3d(:,:,jk)   & 
    271             &                                      / MAX( rn_n2min, rn2(:,:,jk) ) * tmask(:,:,jk)  ) 
    272       END DO            
    273  
    274       zkz(:,:) = 0.e0               ! Associated potential energy consummed over the whole water column 
    275       DO jk = 2, jpkm1 
    276          zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zavt_itf(:,:,jk) * wmask(:,:,jk) 
    277       END DO 
    278  
    279       DO jj = 1, jpj                ! Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx 
    280          DO ji = 1, jpi 
    281             IF( zkz(ji,jj) /= 0.e0 )   zkz(ji,jj) = en_tmx(ji,jj) * rn_tfe_itf / rn_tfe / zkz(ji,jj) 
    282          END DO 
    283       END DO 
    284  
    285       DO jk = 2, jpkm1              ! Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zavt_itf bound by 300 cm2/s 
    286          zavt_itf(:,:,jk) = zavt_itf(:,:,jk) * MIN( zkz(:,:), 120./10. ) * wmask(:,:,jk)   ! kz max = 120 cm2/s 
    287       END DO 
    288  
    289       IF( kt == nit000 ) THEN       ! diagnose the nergy consumed by zavt_itf 
    290          ztpc = 0.e0 
    291          DO jk= 1, jpk 
    292             DO jj= 1, jpj 
    293                DO ji= 1, jpi 
    294                   ztpc = ztpc + e1e2t(ji,jj) * e3w_n(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) )   & 
    295                      &                       * zavt_itf(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    296                END DO 
    297             END DO 
    298          END DO 
    299          IF( lk_mpp )   CALL mpp_sum( ztpc ) 
    300          ztpc= rau0 * ztpc / ( rn_me * rn_tfe_itf ) 
    301          IF(lwp) WRITE(numout,*) '          N Total power consumption by zavt_itf: ztpc = ', ztpc * 1.e-12 ,'TW' 
    302       ENDIF 
    303  
    304       !                             ! Update pav with the ITF mixing coefficient 
    305       DO jk = 2, jpkm1 
    306          pav(:,:,jk) = pav     (:,:,jk) * ( 1.e0 - mask_itf(:,:) )   & 
    307             &        + zavt_itf(:,:,jk) *          mask_itf(:,:)  
    308       END DO 
    309       ! 
    310       CALL wrk_dealloc( jpi,jpj, zkz, zsum1 , zsum2 , zsum ) 
    311       CALL wrk_dealloc( jpi,jpj,jpk, zempba_3d_1, zempba_3d_2, zempba_3d, zdn2dz, zavt_itf ) 
    312       ! 
    313       IF( nn_timing == 1 )  CALL timing_stop('tmx_itf') 
    314       ! 
    315    END SUBROUTINE tmx_itf 
    316  
    317  
    318    SUBROUTINE zdf_tmx_init 
    319       !!---------------------------------------------------------------------- 
    320       !!                  ***  ROUTINE zdf_tmx_init  *** 
    321       !!                      
    322       !! ** Purpose :   Initialization of the vertical tidal mixing, Reading 
    323       !!              of M2 and K1 tidal energy in nc files 
    324       !! 
    325       !! ** Method  : - Read the namtmx namelist and check the parameters 
    326       !! 
    327       !!              - Read the input data in NetCDF files : 
    328       !!              M2 and K1 tidal energy. The total tidal energy, en_tmx,  
    329       !!              is the sum of M2, K1 and S2 energy where S2 is assumed  
    330       !!              to be: S2=(1/2)^2 * M2 
    331       !!              mask_itf, a mask array that determine where substituing  
    332       !!              the standard Simmons et al. (2005) formulation with the 
    333       !!              one of Koch_Larrouy et al. (2007). 
    334       !! 
    335       !!              - Compute az_tmx, a 3D coefficient that allows to compute 
    336       !!             the standard tidal-induced vertical mixing as follows: 
    337       !!                  Kz_tides = az_tmx / max( rn_n2min, N^2 ) 
    338       !!             with az_tmx a bottom intensified coefficient is given by: 
    339       !!                 az_tmx(z) = en_tmx / ( rau0 * rn_htmx ) * EXP( -(H-z)/rn_htmx ) 
    340       !!                                                  / ( 1. - EXP( - H   /rn_htmx ) )  
    341       !!             where rn_htmx the characteristic length scale of the bottom  
    342       !!             intensification, en_tmx the tidal energy, and H the ocean depth 
    343       !! 
    344       !! ** input   :   - Namlist namtmx 
    345       !!                - NetCDF file : M2_ORCA2.nc, K1_ORCA2.nc, and mask_itf.nc 
    346       !! 
    347       !! ** Action  : - Increase by 1 the nstop flag is setting problem encounter 
    348       !!              - defined az_tmx used to compute tidal-induced mixing 
    349       !! 
    350       !! References : Simmons et al. 2004, Ocean Modelling, 6, 3-4, 245-263. 
    351       !!              Koch-Larrouy et al. 2007, GRL. 
    352       !!---------------------------------------------------------------------- 
    353       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    354       INTEGER  ::   inum         ! local integer 
    355       INTEGER  ::   ios 
    356       REAL(wp) ::   ztpc, ze_z   ! local scalars 
    357       REAL(wp), DIMENSION(:,:)  , POINTER ::  zem2, zek1     ! read M2 and K1 tidal energy 
    358       REAL(wp), DIMENSION(:,:)  , POINTER ::  zkz            ! total M2, K1 and S2 tidal energy 
    359       REAL(wp), DIMENSION(:,:)  , POINTER ::  zfact          ! used for vertical structure function 
    360       REAL(wp), DIMENSION(:,:)  , POINTER ::  zhdep          ! Ocean depth  
    361       REAL(wp), DIMENSION(:,:,:), POINTER ::  zpc, zav_tide  ! power consumption 
    362       !! 
    363       NAMELIST/namzdf_tmx/ rn_htmx, rn_n2min, rn_tfe, rn_me, ln_tmx_itf, rn_tfe_itf 
    364       !!---------------------------------------------------------------------- 
    365       ! 
    366       IF( nn_timing == 1 )  CALL timing_start('zdf_tmx_init') 
    367       ! 
    368       CALL wrk_alloc( jpi,jpj,       zem2, zek1, zkz, zfact, zhdep ) 
    369       CALL wrk_alloc( jpi,jpj,jpk,   zpc, zav_tide ) 
    370       ! 
    371       REWIND( numnam_ref )             ! Namelist namzdf_tmx in reference namelist : Tidal Mixing 
    372       READ  ( numnam_ref, namzdf_tmx, IOSTAT = ios, ERR = 901) 
    373 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_tmx in reference namelist', lwp ) 
    374       ! 
    375       REWIND( numnam_cfg )             ! Namelist namzdf_tmx in configuration namelist : Tidal Mixing 
    376       READ  ( numnam_cfg, namzdf_tmx, IOSTAT = ios, ERR = 902 ) 
    377 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_tmx in configuration namelist', lwp ) 
    378       IF(lwm) WRITE ( numond, namzdf_tmx ) 
    379       ! 
    380       IF(lwp) THEN                     ! Control print 
    381          WRITE(numout,*) 
    382          WRITE(numout,*) 'zdf_tmx_init : tidal mixing' 
    383          WRITE(numout,*) '~~~~~~~~~~~~' 
    384          WRITE(numout,*) '   Namelist namzdf_tmx : set tidal mixing parameters' 
    385          WRITE(numout,*) '      Vertical decay scale for turbulence   = ', rn_htmx  
    386          WRITE(numout,*) '      Brunt-Vaisala frequency threshold     = ', rn_n2min 
    387          WRITE(numout,*) '      Tidal dissipation efficiency          = ', rn_tfe 
    388          WRITE(numout,*) '      Mixing efficiency                     = ', rn_me 
    389          WRITE(numout,*) '      ITF specific parameterisation         = ', ln_tmx_itf 
    390          WRITE(numout,*) '      ITF tidal dissipation efficiency      = ', rn_tfe_itf 
    391       ENDIF 
    392       !                                ! allocate tmx arrays 
    393       IF( zdf_tmx_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_tmx_init : unable to allocate tmx arrays' ) 
    394  
    395       IF( ln_tmx_itf ) THEN            ! read the Indonesian Through Flow mask 
    396          CALL iom_open('mask_itf',inum) 
    397          CALL iom_get (inum, jpdom_data, 'tmaskitf',mask_itf,1) !  
    398          CALL iom_close(inum) 
    399       ENDIF 
    400       !                                ! read M2 tidal energy flux : W/m2  ( zem2 < 0 ) 
    401       CALL iom_open('M2rowdrg',inum) 
    402       CALL iom_get (inum, jpdom_data, 'field',zem2,1) !  
    403       CALL iom_close(inum) 
    404       !                                ! read K1 tidal energy flux : W/m2  ( zek1 < 0 ) 
    405       CALL iom_open('K1rowdrg',inum) 
    406       CALL iom_get (inum, jpdom_data, 'field',zek1,1) !  
    407       CALL iom_close(inum) 
    408       !                                ! Total tidal energy ( M2, S2 and K1  with S2=(1/2)^2 * M2 ) 
    409       !                                ! only the energy available for mixing is taken into account, 
    410       !                                ! (mixing efficiency tidal dissipation efficiency) 
    411       en_tmx(:,:) = - rn_tfe * rn_me * ( zem2(:,:) * 1.25 + zek1(:,:) ) * ssmask(:,:) 
    412  
    413 !============ 
    414 !TG: Bug for VVL? Should this section be moved out of _init and be updated at every timestep? 
    415 !!gm : you are right, but tidal mixing acts in deep ocean (H>500m) where e3 is O(100m) 
    416 !!     the error is thus ~1% which I feel comfortable with, compared to uncertainties in tidal energy dissipation. 
    417       !                                ! Vertical structure (az_tmx) 
    418       DO jj = 1, jpj                         ! part independent of the level 
    419          DO ji = 1, jpi 
    420             zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1)       ! depth of the ocean 
    421             zfact(ji,jj) = rau0 * rn_htmx * ( 1. - EXP( -zhdep(ji,jj) / rn_htmx ) ) 
    422             IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = en_tmx(ji,jj) / zfact(ji,jj) 
    423          END DO 
    424       END DO 
    425       DO jk= 1, jpk                          ! complete with the level-dependent part 
    426          DO jj = 1, jpj 
    427             DO ji = 1, jpi 
    428                az_tmx(ji,jj,jk) = zfact(ji,jj) * EXP( -( zhdep(ji,jj)-gdepw_0(ji,jj,jk) ) / rn_htmx ) * tmask(ji,jj,jk) 
    429             END DO 
    430          END DO 
    431       END DO 
    432 !=========== 
    433       ! 
    434       IF( nprint == 1 .AND. lwp ) THEN 
    435          ! Control print 
    436          ! Total power consumption due to vertical mixing 
    437          ! zpc = rau0 * 1/rn_me * rn2 * zav_tide 
    438          zav_tide(:,:,:) = 0.e0 
    439          DO jk = 2, jpkm1 
    440             zav_tide(:,:,jk) = az_tmx(:,:,jk) / MAX( rn_n2min, rn2(:,:,jk) ) 
    441          END DO 
    442          ! 
    443          ztpc = 0._wp 
    444          zpc(:,:,:) = MAX(rn_n2min,rn2(:,:,:)) * zav_tide(:,:,:) 
    445          DO jk= 2, jpkm1 
    446             DO jj = 1, jpj 
    447                DO ji = 1, jpi 
    448                   ztpc = ztpc + e3w_n(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 
    449                END DO 
    450             END DO 
    451          END DO 
    452          IF( lk_mpp )   CALL mpp_sum( ztpc ) 
    453          ztpc= rau0 * 1/(rn_tfe * rn_me) * ztpc 
    454          ! 
    455          WRITE(numout,*)  
    456          WRITE(numout,*) '          Total power consumption of the tidally driven part of Kz : ztpc = ', ztpc * 1.e-12 ,'TW' 
    457          ! 
    458          ! control print 2 
    459          zav_tide(:,:,:) = MIN( zav_tide(:,:,:), 60.e-4 )    
    460          zkz(:,:) = 0._wp 
    461          DO jk = 2, jpkm1 
    462                zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX(0.e0, rn2(:,:,jk)) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk) 
    463          END DO 
    464          ! Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz 
    465          DO jj = 1, jpj 
    466             DO ji = 1, jpi 
    467                IF( zkz(ji,jj) /= 0.e0 )   THEN 
    468                    zkz(ji,jj) = en_tmx(ji,jj) / zkz(ji,jj) 
    469                ENDIF 
    470             END DO 
    471          END DO 
    472          ztpc = 1.e50 
    473          DO jj = 1, jpj 
    474             DO ji = 1, jpi 
    475                IF( zkz(ji,jj) /= 0.e0 )   THEN 
    476                    ztpc = Min( zkz(ji,jj), ztpc) 
    477                ENDIF 
    478             END DO 
    479          END DO 
    480          WRITE(numout,*) '          Min de zkz ', ztpc, ' Max = ', maxval(zkz(:,:) ) 
    481          ! 
    482          DO jk = 2, jpkm1 
    483             zav_tide(:,:,jk) = zav_tide(:,:,jk) * MIN( zkz(:,:), 30./6. ) * wmask(:,:,jk)  !kz max = 300 cm2/s 
    484          END DO 
    485          ztpc = 0._wp 
    486          zpc(:,:,:) = Max(0.e0,rn2(:,:,:)) * zav_tide(:,:,:) 
    487          DO jk= 1, jpk 
    488             DO jj = 1, jpj 
    489                DO ji = 1, jpi 
    490                   ztpc = ztpc + e3w_n(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 
    491                END DO 
    492             END DO 
    493          END DO 
    494          IF( lk_mpp )   CALL mpp_sum( ztpc ) 
    495          ztpc= rau0 * 1/(rn_tfe * rn_me) * ztpc 
    496          WRITE(numout,*) '          2 Total power consumption of the tidally driven part of Kz : ztpc = ', ztpc * 1.e-12 ,'TW' 
    497 !!gm bug mpp  in these diagnostics 
    498          DO jk = 1, jpk 
    499             ze_z =                  SUM( e1e2t(:,:) * zav_tide(:,:,jk) * tmask_i(:,:) )   & 
    500                &     / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask   (:,:,jk) * tmask_i(:,:) ) ) 
    501             ztpc = 1.e50 
    502             DO jj = 1, jpj 
    503                DO ji = 1, jpi 
    504                   IF( zav_tide(ji,jj,jk) /= 0.e0 )   ztpc = MIN( ztpc, zav_tide(ji,jj,jk) ) 
    505                END DO 
    506             END DO 
    507             WRITE(numout,*) '            N2 min - jk= ', jk,'   ', ze_z * 1.e4,' cm2/s min= ',ztpc*1.e4,   & 
    508                &       'max= ', MAXVAL(zav_tide(:,:,jk) )*1.e4, ' cm2/s' 
    509          END DO 
    510  
    511          WRITE(numout,*) '          e_tide : ', SUM( e1e2t*en_tmx ) / ( rn_tfe * rn_me ) * 1.e-12, 'TW' 
    512          WRITE(numout,*)  
    513          WRITE(numout,*) '          Initial profile of tidal vertical mixing' 
    514          DO jk = 1, jpk 
    515             DO jj = 1,jpj 
    516                DO ji = 1,jpi 
    517                   zkz(ji,jj) = az_tmx(ji,jj,jk) /MAX( rn_n2min, rn2(ji,jj,jk) ) 
    518                END DO 
    519             END DO 
    520             ze_z =                  SUM( e1e2t(:,:) * zkz  (:,:)    * tmask_i(:,:) )   & 
    521                &     / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask(:,:,jk) * tmask_i(:,:) ) ) 
    522             WRITE(numout,*) '                jk= ', jk,'   ', ze_z * 1.e4,' cm2/s' 
    523          END DO 
    524          DO jk = 1, jpk 
    525             zkz(:,:) = az_tmx(:,:,jk) /rn_n2min 
    526             ze_z =                  SUM( e1e2t(:,:) * zkz  (:,:)    * tmask_i(:,:) )   & 
    527                &     / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask(:,:,jk) * tmask_i(:,:) ) ) 
    528             WRITE(numout,*)  
    529             WRITE(numout,*) '          N2 min - jk= ', jk,'   ', ze_z * 1.e4,' cm2/s min= ',MINVAL(zkz)*1.e4,   & 
    530                &       'max= ', MAXVAL(zkz)*1.e4, ' cm2/s' 
    531          END DO 
    532 !!gm  end bug mpp 
    533          ! 
    534       ENDIF 
    535       ! 
    536       CALL wrk_dealloc( jpi,jpj, zem2, zek1, zkz, zfact, zhdep ) 
    537       CALL wrk_dealloc( jpi,jpj,jpk, zpc, zav_tide ) 
    538       ! 
    539       IF( nn_timing == 1 )  CALL timing_stop('zdf_tmx_init') 
    540       ! 
    541    END SUBROUTINE zdf_tmx_init 
    542  
    543 #elif defined key_zdftmx_new 
    544    !!---------------------------------------------------------------------- 
    545    !!   'key_zdftmx_new'               Internal wave-driven vertical mixing 
     12 
    54613   !!---------------------------------------------------------------------- 
    54714   !!   zdf_tmx       : global     momentum & tracer Kz with wave induced Kz 
    … …  
    56936   PUBLIC   zdf_tmx_init    ! called in nemogcm module  
    57037   PUBLIC   zdf_tmx_alloc   ! called in nemogcm module 
    571  
    572    LOGICAL, PUBLIC, PARAMETER ::   lk_zdftmx = .TRUE.    !: wave-driven mixing flag 
    57338 
    57439   !                       !!* Namelist  namzdf_tmx : internal wave-driven mixing * 
    … …  
    1027492   END SUBROUTINE zdf_tmx_init 
    1028493 
    1029 #else 
    1030    !!---------------------------------------------------------------------- 
    1031    !!   Default option          Dummy module                NO Tidal MiXing 
    1032    !!---------------------------------------------------------------------- 
    1033    LOGICAL, PUBLIC, PARAMETER ::   lk_zdftmx = .FALSE.   !: tidal mixing flag 
    1034 CONTAINS 
    1035    SUBROUTINE zdf_tmx_init           ! Dummy routine 
    1036       WRITE(*,*) 'zdf_tmx: You should not have seen this print! error?' 
    1037    END SUBROUTINE zdf_tmx_init 
    1038    SUBROUTINE zdf_tmx( kt )          ! Dummy routine 
    1039       WRITE(*,*) 'zdf_tmx: You should not have seen this print! error?', kt 
    1040    END SUBROUTINE zdf_tmx 
    1041 #endif 
    1042  
    1043494   !!====================================================================== 
    1044495END MODULE zdftmx 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r7931 r7953  
    5555   USE ldfdyn         ! lateral viscosity setting      (ldfdyn_init routine) 
    5656   USE ldftra         ! lateral diffusivity setting    (ldftra_init routine) 
    57    USE zdfini         ! vertical physics setting          (zdf_init routine) 
     57!!gm   USE zdfphy         ! vertical physics manager      (zdf_phy_init routine) 
    5858   USE trdini         ! dyn/tra trends initialization     (trd_init routine) 
    5959   USE asminc         ! assimilation increments      
    … …  
    429429      IF( ln_ctl        )   CALL prt_ctl_init   ! Print control 
    430430       
    431       CALL diurnal_sst_bulk_init            ! diurnal sst 
     431      CALL diurnal_sst_bulk_init             ! diurnal sst 
    432432      IF ( ln_diurnal ) CALL diurnal_sst_coolskin_init   ! cool skin    
    433433       
    … …  
    455455                            CALL     sbc_init   ! surface boundary conditions (including sea-ice) 
    456456                            CALL     bdy_init   ! Open boundaries initialisation 
     457 
    457458      !                                      ! Ocean physics 
    458       !                                         ! Vertical physics 
    459                             CALL     zdf_init      ! namelist read 
    460                             CALL zdf_bfr_init      ! bottom friction 
    461       IF( lk_zdfric     )   CALL zdf_ric_init      ! Richardson number dependent Kz 
    462       IF( lk_zdftke     )   CALL zdf_tke_init      ! TKE closure scheme 
    463       IF( lk_zdfgls     )   CALL zdf_gls_init      ! GLS closure scheme 
    464       IF( lk_zdftmx     )   CALL zdf_tmx_init      ! tidal vertical mixing 
    465 !!gm      IF( ln_zdfddm     )   CALL zdf_ddm_init      ! double diffusive mixing 
    466           
     459                            CALL zdf_phy_init   ! Vertical physics 
     460                                      
    467461      !                                         ! Lateral physics 
    468462                            CALL ldf_tra_init      ! Lateral ocean tracer physics 
    … …  
    470464                            CALL ldf_dyn_init      ! Lateral ocean momentum physics 
    471465 
    472       !                                         ! Active tracers 
     466      !                                      ! Active tracers 
    473467                            CALL tra_qsr_init      ! penetrative solar radiation qsr 
    474468                            CALL tra_bbc_init      ! bottom heat flux 
    … …  
    479473                            CALL tra_zdf_init      ! vertical mixing and after tracer fields 
    480474 
    481       !                                         ! Dynamics 
     475      !                                      ! Dynamics 
    482476      IF( lk_c1d        )   CALL dyn_dmp_init      ! internal momentum damping 
    483477                            CALL dyn_adv_init      ! advection (vector or flux form) 
    … …  
    511505      IF( ln_diaobs     )   CALL dia_obs( nit000 - 1 )   ! Observation operator for restart 
    512506 
    513       !                                         ! Assimilation increments 
     507      !                                      ! Assimilation increments 
    514508      IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments 
    515509      IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/step.F90

    r7931 r7953  
    7474      !!              -8- Outputs and diagnostics 
    7575      !!---------------------------------------------------------------------- 
    76       INTEGER ::   ji,jj,jk ! dummy loop indice 
    77       INTEGER ::   indic    ! error indicator if < 0 
    78       INTEGER ::   kcall    ! optional integer argument (dom_vvl_sf_nxt) 
     76      INTEGER ::   ji, jj, jk  ! dummy loop indice 
     77      INTEGER ::   indic        ! error indicator if < 0 
     78      INTEGER ::   kcall        ! optional integer argument (dom_vvl_sf_nxt) 
    7979      !! --------------------------------------------------------------------- 
    8080#if defined key_agrif 
    … …  
    125125                         CALL bn2    ( tsn, rab_n, rn2  ) ! now    Brunt-Vaisala frequency 
    126126 
    127       ! 
    128127      !  VERTICAL PHYSICS 
    129                          CALL zdf_bfr( kstp )         ! bottom friction (if quadratic) 
    130       !                                               ! Vertical eddy viscosity and diffusivity coefficients 
    131       IF( lk_zdfric  )   CALL zdf_ric ( kstp )             ! Richardson number dependent Kz 
    132       IF( lk_zdftke  )   CALL zdf_tke ( kstp )             ! TKE closure scheme for Kz 
    133       IF( lk_zdfgls  )   CALL zdf_gls ( kstp )             ! GLS closure scheme for Kz 
    134       IF( ln_zdfqiao )   CALL zdf_qiao( kstp )             ! Qiao vertical mixing  
    135       ! 
    136       IF( lk_zdfcst  ) THEN                                ! Constant Kz (reset avt, avm[uv] to the background value) 
    137          avt (:,:,:) = rn_avt0 * wmask (:,:,:) 
    138          avm (:,:,:) = rn_avm0 * wmask (:,:,:) 
    139          avmu(:,:,:) = rn_avm0 * wumask(:,:,:) 
    140          avmv(:,:,:) = rn_avm0 * wvmask(:,:,:) 
    141       ENDIF 
    142       ! 
    143       IF( ln_rnf_mouth ) THEN                         ! increase diffusivity at rivers mouths 
    144          DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + 2._wp * rn_avt_rnf * rnfmsk(:,:) * tmask(:,:,jk)   ;   END DO 
    145       ENDIF 
    146       ! 
    147       IF( ln_zdfevd  )   CALL zdf_evd( kstp )         ! enhanced vertical eddy diffusivity 
    148       ! 
    149       IF( ln_zdfddm  ) THEN                           ! double diffusive mixing 
    150                          CALL zdf_ddm( kstp ) 
    151       ELSE                                            ! avs=avt 
    152          DO jk = 2, jpkm1   ;   avs(:,:,jk) = avt(:,:,jk)   ;   END DO 
    153       ENDIF 
    154       ! 
    155       IF( lk_zdftmx  )   CALL zdf_tmx( kstp )         ! tidal vertical mixing 
    156  
    157                          CALL zdf_mxl( kstp )         ! mixed layer depth 
    158  
    159                                                       ! write TKE or GLS information in the restart file 
    160       IF( lrst_oce .AND. lk_zdftke )   CALL tke_rst( kstp, 'WRITE' ) 
    161       IF( lrst_oce .AND. lk_zdfgls )   CALL gls_rst( kstp, 'WRITE' ) 
    162       ! 
     128                         CALL zdf_phy( kstp )         ! vertical physics update (bfr, avt, avs, avm + MLD) 
     129 
    163130      !  LATERAL  PHYSICS 
    164131      ! 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r7646 r7953  
    6363   USE ldftra           ! lateral eddy diffusive coef.     (ldf_tra routine) 
    6464 
     65   USE zdfphy         ! vertical physics manager      (zdf_phy_init routine) 
     66!!gm to be suppressed 
    6567   USE zdftmx           ! tide-induced vertical mixing     (zdf_tmx routine) 
    6668   USE zdfbfr           ! bottom friction                  (zdf_bfr routine) 
    … …  
    7274   USE zdfmxl           ! Mixed-layer depth                (zdf_mxl routine) 
    7375   USE zdfqiao          !Qiao module wave induced mixing   (zdf_qiao routine) 
     76!!gm end 
    7477 
    7578   USE step_diu        ! Time stepping for diurnal sst 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    r7646 r7953  
    121121                     DO jj = 2, jpjm1 
    122122                        DO ji = fs_2, fs_jpim1   ! vector opt. 
    123                            IF( avt(ji,jj,jk) <= 5.e-4_wp )  THEN  
     123                           IF( avs(ji,jj,jk) <= 5.e-4_wp )  THEN  
    124124                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    125125                           ENDIF 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90

    r7931 r7953  
    44   !! Ocean Passive tracers : vertical diffusive trends  
    55   !!===================================================================== 
    6    !! History :  9.0  ! 2005-11 (G. Madec)  Original code 
     6   !! History :  9.0  ! 2005-11  (G. Madec)  Original code 
    77   !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA  
     8   !!            4.0  ! 2017-04  (G. Madec)  remove the explicit case 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_top 
    … …  
    1112   !!   'key_top'                                                TOP models 
    1213   !!---------------------------------------------------------------------- 
    13    !!   trc_zdf      : update the tracer trend with the lateral diffusion 
    14    !!   trc_zdf_ini  : initialization, namelist read, and parameters control 
     14   !!   trc_zdf      : update the tracer trend with the vertical diffusion 
    1515   !!---------------------------------------------------------------------- 
    1616   USE trc           ! ocean passive tracers variables 
    … …  
    2727 
    2828   PUBLIC   trc_zdf         ! called by step.F90  
    29    PUBLIC   trc_zdf_ini     ! called by nemogcm.F90  
    3029    
    31    !                                        !!** Vertical diffusion (nam_trczdf) ** 
    32    LOGICAL , PUBLIC ::   ln_trczdf_exp       !: explicit vertical diffusion scheme flag 
    33    INTEGER , PUBLIC ::   nn_trczdf_exp       !: number of sub-time step (explicit time stepping) 
    34  
    35    INTEGER ::   nzdf = 0               ! type vertical diffusion algorithm used 
    36       !                                ! defined from ln_zdf...  namlist logicals) 
    37    !! * Substitutions 
    38 #  include "vectopt_loop_substitute.h90" 
    3930   !!---------------------------------------------------------------------- 
    4031   !! NEMO/TOP 3.7 , NEMO Consortium (2015) 
    … …  
    4839      !!                  ***  ROUTINE trc_zdf  *** 
    4940      !! 
    50       !! ** Purpose :   compute the vertical ocean tracer physics. 
     41      !! ** Purpose :   compute the vertical ocean tracer physics using 
     42      !!              an implicit time-stepping scheme. 
    5143      !!--------------------------------------------------------------------- 
    5244      INTEGER, INTENT( in ) ::  kt      ! ocean time-step index 
    … …  
    5446      INTEGER               ::  jk, jn 
    5547      CHARACTER (len=22)    :: charout 
    56       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd   ! 4D workspace 
     48      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) ::   ztrtrd   ! 4D workspace 
    5749      !!--------------------------------------------------------------------- 
    5850      ! 
    5951      IF( nn_timing == 1 )  CALL timing_start('trc_zdf') 
    6052      ! 
    61       IF( l_trdtrc )  THEN 
    62          CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) 
    63          ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
    64       ENDIF 
    65  
    66       SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend 
    67       CASE ( 0 ) ;  CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dttrc, nn_trczdf_exp, trb, tra, jptra )    !   explicit scheme  
    68       CASE ( 1 ) ;  CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dttrc,                trb, tra, jptra )    !   implicit scheme           
    69       END SELECT 
    70  
     53      IF( l_trdtrc )   ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
     54      ! 
     55      CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dttrc, trb, tra, jptra )    !   implicit scheme           
     56      ! 
    7157      IF( l_trdtrc )   THEN                      ! save the vertical diffusive trends for further diagnostics 
    7258         DO jn = 1, jptra 
    … …  
    7662            CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) ) 
    7763         END DO 
    78          CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) 
    7964      ENDIF 
    8065      !                                          ! print mean trends (used for debugging) 
    8166      IF( ln_ctl )   THEN 
    82          WRITE(charout, FMT="('zdf ')") ;  CALL prt_ctl_trc_info(charout) 
    83                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     67         WRITE(charout, FMT="('zdf ')") 
     68         CALL prt_ctl_trc_info(charout) 
     69         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    8470      END IF 
    8571      ! 
    … …  
    8773      ! 
    8874   END SUBROUTINE trc_zdf 
    89  
    90  
    91    SUBROUTINE trc_zdf_ini 
    92       !!---------------------------------------------------------------------- 
    93       !!                 ***  ROUTINE trc_zdf_ini  *** 
    94       !! 
    95       !! ** Purpose :   Choose the vertical mixing scheme 
    96       !! 
    97       !! ** Method  :   Set nzdf from ln_zdfexp 
    98       !!      nzdf = 0   explicit (time-splitting) scheme (ln_trczdf_exp=T) 
    99       !!           = 1   implicit (euler backward) scheme (ln_trczdf_exp=F) 
    100       !!      NB: The implicit scheme is required when using :  
    101       !!             - rotated lateral mixing operator 
    102       !!             - TKE, GLS vertical mixing scheme 
    103       !!---------------------------------------------------------------------- 
    104       INTEGER ::  ios                 ! Local integer output status for namelist read 
    105       !! 
    106       NAMELIST/namtrc_zdf/ ln_trczdf_exp  , nn_trczdf_exp 
    107       !!---------------------------------------------------------------------- 
    108       ! 
    109       REWIND( numnat_ref )             ! namtrc_zdf in reference namelist  
    110       READ  ( numnat_ref, namtrc_zdf, IOSTAT = ios, ERR = 905) 
    111 905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_zdf in reference namelist', lwp ) 
    112       ! 
    113       REWIND( numnat_cfg )             ! namtrc_zdf in configuration namelist  
    114       READ  ( numnat_cfg, namtrc_zdf, IOSTAT = ios, ERR = 906 ) 
    115 906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_zdf in configuration namelist', lwp ) 
    116       IF(lwm) WRITE ( numont, namtrc_zdf ) 
    117       ! 
    118       IF(lwp) THEN                     ! Control print 
    119          WRITE(numout,*) 
    120          WRITE(numout,*) '   Namelist namtrc_zdf : set vertical diffusion  parameters' 
    121          WRITE(numout,*) '      time splitting / backward scheme ln_trczdf_exp = ', ln_trczdf_exp 
    122          WRITE(numout,*) '      number of time step              nn_trczdf_exp = ', nn_trczdf_exp 
    123       ENDIF 
    124  
    125       !                                ! Define the vertical tracer physics scheme 
    126       IF( ln_trczdf_exp ) THEN   ;   nzdf = 0     ! explicit scheme 
    127       ELSE                       ;   nzdf = 1     ! implicit scheme 
    128       ENDIF 
    129  
    130       !                                ! Force implicit schemes 
    131       IF( ln_trcldf_iso              )   nzdf = 1      ! iso-neutral lateral physics 
    132       IF( ln_trcldf_hor .AND. ln_sco )   nzdf = 1      ! horizontal lateral physics in s-coordinate 
    133 #if defined key_zdftke || defined key_zdfgls  
    134                                          nzdf = 1      ! TKE or GLS physics        
    135 #endif 
    136       IF( ln_trczdf_exp .AND. nzdf == 1 )  &  
    137          CALL ctl_stop( 'trc_zdf : If using the rotated lateral mixing operator or TKE, GLS vertical scheme ', & 
    138             &           '          the implicit scheme is required, set ln_trczdf_exp = .false.' ) 
    139  
    140       IF(lwp) THEN 
    141          WRITE(numout,*) 
    142          WRITE(numout,*) 'trc:zdf_ctl : vertical passive tracer physics scheme' 
    143          WRITE(numout,*) '~~~~~~~~~~~' 
    144          IF( nzdf ==  0 )   WRITE(numout,*) '              Explicit time-splitting scheme' 
    145          IF( nzdf ==  1 )   WRITE(numout,*) '              Implicit (euler backward) scheme' 
    146       ENDIF 
    147       ! 
    148    END SUBROUTINE trc_zdf_ini 
    14975    
    15076#else 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90

    r7881 r7953  
    101101 
    102102   !* vertical diffusion * 
    103    USE zdf_oce , ONLY :   avt        =>   avt         !: vert. diffusivity coef. at w-point for temp   
    104 # if defined key_zdfddm 
    105    USE zdfddm  , ONLY :   avs        =>   avs         !: salinity vertical diffusivity coeff. at w-point 
    106 # endif 
     103   USE zdf_oce , ONLY :   avs        =>   avs         !: vert. diffusivity coef. for salinity (w-point) 
    107104 
    108105   !* mixing & mixed layer depth * 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r7881 r7953  
    126126   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  vn_tm       !: j-horizontal velocity average     [m/s] 
    127127   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  tsn_tm      !: t/s average     [m/s] 
    128    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avt_tm      !: vertical diffusivity coeff. at  w-point   [m2/s] 
     128   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_tm      !: vertical diffusivity coeff. at  w-point   [m2/s] 
    129129   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  rhop_tm     !:  
    130 # if defined key_zdfddm 
    131    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_tm      !: vertical double diffusivity coeff. at w-point   [m/s] 
    132 # endif 
    133130#if defined key_trabbl 
    134131   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahu_bbl_tm  !: u-, w-points 
    … …  
    154151   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  tsn_temp 
    155152   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  un_temp,vn_temp,wn_temp     !: hold current values of avt, un, vn, wn 
    156    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avt_temp, rhop_temp     !: hold current values of avt, un, vn, wn 
     153   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_temp, rhop_temp     !: hold current values of avt, un, vn, wn 
    157154   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshn_temp, sshb_temp, ssha_temp, rnf_temp,h_rnf_temp 
    158155   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  hdivn_temp, rotn_temp 
    … …  
    165162#endif 
    166163   ! 
    167 # if defined key_zdfddm 
    168    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_temp      !: salinity vertical diffusivity coeff. at w-point   [m/s] 
    169 # endif 
    170164   ! 
    171165   CHARACTER(len=20), PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  cn_trc_dflt          ! Default OBC condition for all tracers 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r7753 r7953  
    196196      USE trcadv , ONLY:  trc_adv_ini 
    197197      USE trcldf , ONLY:  trc_ldf_ini 
    198       USE trczdf , ONLY:  trc_zdf_ini 
    199198      USE trcrad , ONLY:  trc_rad_ini 
    200199      ! 
    … …  
    205204                       CALL  trc_adv_ini          ! advection 
    206205                       CALL  trc_ldf_ini          ! lateral diffusion 
    207                        CALL  trc_zdf_ini          ! vertical diffusion 
     206                       !                          ! vertical diffusion: always implicit time stepping scheme 
    208207                       CALL  trc_rad_ini          ! positivity of passive tracers  
    209208      ! 
    … …  
    223222      !!---------------------------------------------------------------------- 
    224223      ! 
    225       ! Initialisation of tracers Initial Conditions 
    226       IF( ln_trcdta )      CALL trc_dta_ini(jptra) 
    227  
    228       ! Initialisation of tracers Boundary Conditions 
    229       IF( ln_my_trc )     CALL trc_bc_ini(jptra) 
    230  
    231       IF( ln_rsttr ) THEN 
     224 
     225      IF( ln_trcdta )   CALL trc_dta_ini( jptra )      ! set initial tracers values 
     226 
     227      IF( ln_my_trc )   CALL trc_bc_ini ( jptra )      ! set tracers Boundary Conditions 
     228 
     229 
     230      IF( ln_rsttr ) THEN              ! restart from a file 
    232231        ! 
    233         CALL trc_rst_read              ! restart from a file 
     232        CALL trc_rst_read 
    234233        ! 
    235       ELSE 
    236         ! Initialisation of tracer from a file that may also be used for damping 
     234      ELSE                             ! Initialisation of tracer from a file that may also be used for damping 
     235!!gm BUG ?   if damping and restart, what's happening ? 
    237236        IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN 
    238237            ! update passive tracers arrays with input data read from file 
    … …  
    250249                  ENDIF 
    251250               ENDIF 
    252             ENDDO 
     251            END DO 
    253252            ! 
    254253        ENDIF 
    … …  
    262261   END SUBROUTINE trc_ini_state 
    263262 
     263 
    264264   SUBROUTINE top_alloc 
    265265      !!---------------------------------------------------------------------- 

  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/TOP_SRC/trcsub.F90

    r7646 r7953  
    8484          tsn_tm  (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)   
    8585          rhop_tm (:,:,:)        = rhop_tm (:,:,:)        + rhop (:,:,:)        * e3t_n(:,:,:)   
    86           avt_tm  (:,:,:)        = avt_tm  (:,:,:)        + avt  (:,:,:)        * e3w_n(:,:,:)   
    87 # if defined key_zdfddm 
    8886          avs_tm  (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * e3w_n(:,:,:)   
    89 # endif 
    9087         IF( l_ldfslp ) THEN 
    9188            uslp_tm (:,:,:)      = uslp_tm (:,:,:)        + uslp (:,:,:) 
    … …  
    122119         tsn_temp   (:,:,:,:)    = tsn   (:,:,:,:) 
    123120         rhop_temp  (:,:,:)      = rhop  (:,:,:)     
    124          avt_temp   (:,:,:)      = avt   (:,:,:) 
    125 # if defined key_zdfddm 
    126121         avs_temp   (:,:,:)      = avs   (:,:,:) 
    127 # endif 
    128122         IF( l_ldfslp ) THEN 
    129123            uslp_temp  (:,:,:)   = uslp  (:,:,:)   ;   wslpi_temp (:,:,:)   = wslpi (:,:,:) 
    … …  
    161155         tsn_tm   (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)   
    162156         rhop_tm (:,:,:)         = rhop_tm (:,:,:)        + rhop (:,:,:)        * e3t_n(:,:,:)   
    163          avt_tm   (:,:,:)        = avt_tm  (:,:,:)        + avt  (:,:,:)        * e3w_n(:,:,:)   
    164 # if defined key_zdfddm 
    165157         avs_tm   (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * e3w_n(:,:,:)   
    166 # endif 
    167158         IF( l_ldfslp ) THEN 
    168159            uslp_tm  (:,:,:)     = uslp_tm (:,:,:)        + uslp (:,:,:)  
    … …  
    245236                  tsn  (ji,jj,jk,jp_sal) = tsn_tm  (ji,jj,jk,jp_sal) * z1_ne3t 
    246237                  rhop (ji,jj,jk)        = rhop_tm (ji,jj,jk)        * z1_ne3t 
    247 !!gm : BUG? ==>> for avt & avs I don't understand the division by e3w 
    248                   avt  (ji,jj,jk)        = avt_tm  (ji,jj,jk)        * z1_ne3w 
    249 # if defined key_zdfddm 
     238!!gm : BUG ==>> for avs I don't understand the division by e3w 
    250239                  avs  (ji,jj,jk)        = avs_tm  (ji,jj,jk)        * z1_ne3w 
    251 # endif 
    252240               END DO 
    253241            END DO 
    … …  
    297285      rhop_tm (:,:,:)        = rhop (:,:,:)        * e3t_n(:,:,:)   
    298286!!gm : BUG? ==>> for avt & avs I don't understand the division by e3w 
    299       avt_tm  (:,:,:)        = avt  (:,:,:)        * e3w_n(:,:,:)   
    300 # if defined key_zdfddm 
    301287      avs_tm  (:,:,:)        = avs  (:,:,:)        * e3w_n(:,:,:)   
    302 # endif 
    303288      IF( l_ldfslp ) THEN 
    304289         wslpi_tm(:,:,:)     = wslpi(:,:,:) 
    … …  
    354339      tsn   (:,:,:,:) =  tsn_temp   (:,:,:,:) 
    355340      rhop  (:,:,:)   =  rhop_temp  (:,:,:) 
    356       avt   (:,:,:)   =  avt_temp   (:,:,:) 
    357 # if defined key_zdfddm 
    358341      avs   (:,:,:)   =  avs_temp   (:,:,:) 
    359 # endif 
    360342      IF( l_ldfslp ) THEN 
    361343         wslpi (:,:,:)=  wslpi_temp (:,:,:) 
    … …  
    396378         tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)   
    397379         rhop_tm (:,:,:)        = rhop (:,:,:)        * e3t_n(:,:,:)   
    398          avt_tm  (:,:,:)        = avt  (:,:,:)        * e3w_n(:,:,:)   
    399 # if defined key_zdfddm 
    400380         avs_tm  (:,:,:)        = avs  (:,:,:)        * e3w_n(:,:,:)   
    401 # endif 
    402381      IF( l_ldfslp ) THEN 
    403382         uslp_tm (:,:,:)        = uslp (:,:,:) 
    … …  
    534513      ! 
    535514      ALLOCATE( un_temp(jpi,jpj,jpk)        ,  vn_temp(jpi,jpj,jpk)  ,   & 
    536          &      wn_temp(jpi,jpj,jpk)        ,  avt_temp(jpi,jpj,jpk) ,   & 
     515         &      wn_temp(jpi,jpj,jpk)        ,                            & 
    537516         &      rhop_temp(jpi,jpj,jpk)      ,  rhop_tm(jpi,jpj,jpk) ,   & 
    538517         &      sshn_temp(jpi,jpj)          ,  sshb_temp(jpi,jpj) ,      & 
    … …  
    548527         &      fr_i_temp(jpi,jpj)          ,  fr_i_tm(jpi,jpj) ,        & 
    549528         &      wndm_temp(jpi,jpj)          ,  wndm_tm(jpi,jpj) ,        & 
    550 # if defined key_zdfddm 
    551529         &      avs_tm(jpi,jpj,jpk)         ,  avs_temp(jpi,jpj,jpk) ,   & 
    552 # endif 
    553530         &      hdivn_temp(jpi,jpj,jpk)     ,  hdivb_temp(jpi,jpj,jpk),  & 
    554531         &      un_tm(jpi,jpj,jpk)          ,  vn_tm(jpi,jpj,jpk)  ,     & 
    555          &      avt_tm(jpi,jpj,jpk)                                ,     & 
    556532         &      sshn_tm(jpi,jpj)            ,  sshb_hold(jpi,jpj) ,      & 
    557533         &      tsn_tm(jpi,jpj,jpk,2)       ,                            & 
Note: See TracChangeset for help on using the changeset viewer.