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

Changeset 8568


Ignore:
Timestamp:
2017-09-27T16:29:24+02:00 (7 years ago)
Author:
gm
Message:

#1911 (ENHANCE-09): PART I.2 - _NONE option + remove zts + see associated wiki page

Location:
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM
Files:
191 edited

Legend:

Unmodified
Added
Removed

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

    r8215 r8568  
    210210/ 
    211211!----------------------------------------------------------------------- 
    212 &namtra_adv    !   advection scheme for tracer 
     212&namtra_adv    !   advection scheme for tracer                          (default: NO advection) 
    213213!----------------------------------------------------------------------- 
    214214   ln_traadv_fct =  .true.   !  FCT scheme 
    215215      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order  
    216216      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order  
    217       nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    218       !                             !        (number of sub-timestep = nn_fct_zts) 
    219217/ 
    220218!----------------------------------------------------------------------- 
    … …  
    226224!---------------------------------------------------------------------------------- 
    227225   !                       !  Operator type: 
     226   ln_traldf_NONE  = .false.   !           No operator (no explicit diffusion) 
    228227   ln_traldf_lap   =  .true.   !    laplacian operator 
    229228   ln_traldf_blp   =  .false.  !  bilaplacian operator 
    … …  
    264263/ 
    265264!----------------------------------------------------------------------- 
    266 &namdyn_adv    !   formulation of the momentum advection 
    267 !----------------------------------------------------------------------- 
     265&namdyn_adv    !   formulation of the momentum advection                (default: None) 
     266!----------------------------------------------------------------------- 
     267   ln_dynadv_vec = .true.  !  vector form - 2nd centered scheme 
     268     nn_dynkeg     = 0        ! grad(KE) scheme: =0   C2  ;  =1   Hollingsworth correction 
    268269/ 
    269270!----------------------------------------------------------------------- 
    … …  
    293294!----------------------------------------------------------------------- 
    294295   !                       !  Type of the operator : 
    295    !                           !  no diffusion: set ln_dynldf_lap=..._blp=F  
     296   ln_dynldf_NONE=  .false.    !           No operator (no explicit diffusion) 
    296297   ln_dynldf_lap =  .false.    !    laplacian operator 
    297298   ln_dynldf_blp =  .true.     !  bilaplacian operator 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg

    r8215 r8568  
    6060/ 
    6161!----------------------------------------------------------------------- 
    62 &namcrs        !   Grid coarsening for dynamics output and/or 
    63                !   passive tracer coarsened online simulations 
    64 !----------------------------------------------------------------------- 
    65 / 
    66 !----------------------------------------------------------------------- 
    6762&namc1d        !   1D configuration options                             ("key_c1d") 
    6863!----------------------------------------------------------------------- 
    … …  
    110105   sn_slp      = 'slp.15JUNE2009_fill'        ,         6         , 'SLP',        .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , '' 
    111106 
    112    nn_bulk_algo = 1        !  Bulk algorithm to use to compute bulk transfer coefficients Cd, Ce and Ch 
    113                            !  1 => "NCAR" algorithm        (Large and Yeager, 2008) 
    114                            !  2 => "COARE 3.0" algorithm   (Fairall et al 2003) 
    115                            !  3 => "ECMWF" algorithm       (IFS cycle 31) 
    116                            !  4 => "COARE 3.5" algorithm   (Edson et al 2013) 
     107   !                    !  bulk algorithm : 
     108   ln_NCAR     = .true.    ! "NCAR"      algorithm   (Large and Yeager 2008) 
     109   ln_COARE_3p0= .false.   ! "COARE 3.0" algorithm   (Fairall et al. 2003) 
     110   ln_COARE_3p5= .false.   ! "COARE 3.5" algorithm   (Edson et al. 2013) 
     111   ln_ECMWF    = .false.   ! "ECMWF"     algorithm   (IFS cycle 31) 
    117112 
    118113   rn_zqt      =  2.       !  Air temperature and humidity reference height (m) 
    … …  
    123118/ 
    124119!----------------------------------------------------------------------- 
    125 &namsbc_sas    !   analytical surface boundary condition 
    126 !----------------------------------------------------------------------- 
    127 / 
    128 !----------------------------------------------------------------------- 
    129 &namtra_qsr    !   penetrative solar radiation 
     120&namtra_qsr    !   penetrative solar radiation                          (ln_traqsr =T) 
    130121!----------------------------------------------------------------------- 
    131122!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    … …  
    134125/ 
    135126!----------------------------------------------------------------------- 
    136 &namsbc_rnf    !   runoffs namelist surface boundary condition 
    137 !----------------------------------------------------------------------- 
    138    ln_rnf_mouth = .false.   !  specific treatment at rivers mouths 
    139 / 
    140 !----------------------------------------------------------------------- 
    141127&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk 
    142128!----------------------------------------------------------------------- 
    … …  
    154140/ 
    155141!----------------------------------------------------------------------- 
    156 &namberg       !   iceberg parameters 
    157 !----------------------------------------------------------------------- 
    158 / 
    159 !----------------------------------------------------------------------- 
    160 &namlbc        !   lateral momentum boundary condition 
    161 !----------------------------------------------------------------------- 
    162    rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat 
    163 / 
    164 !----------------------------------------------------------------------- 
    165 &namagrif      !  AGRIF zoom                                            ("key_agrif") 
    166 !----------------------------------------------------------------------- 
    167 / 
    168 !----------------------------------------------------------------------- 
    169 &nam_tide      !    tide parameters 
    170 !----------------------------------------------------------------------- 
    171 / 
    172 !----------------------------------------------------------------------- 
    173 &nambdy        !  unstructured open boundaries                           
    174 !----------------------------------------------------------------------- 
    175 / 
    176 !----------------------------------------------------------------------- 
    177 &nambdy_dta      !  open boundaries - external data            
    178 !----------------------------------------------------------------------- 
    179 / 
    180 !----------------------------------------------------------------------- 
    181 &nambdy_tide     ! tidal forcing at open boundaries 
    182 !----------------------------------------------------------------------- 
    183 / 
    184 !----------------------------------------------------------------------- 
    185142&namdrg            !   top/bottom drag coefficient                      (default: NO selection) 
    186143!----------------------------------------------------------------------- 
    … …  
    192149/ 
    193150!----------------------------------------------------------------------- 
    194 &nambbl        !   bottom boundary layer scheme 
    195 !----------------------------------------------------------------------- 
    196 / 
    197 !----------------------------------------------------------------------- 
    198151&nameos        !   ocean physical parameters 
    199152!----------------------------------------------------------------------- 
    … …  
    203156&namtra_adv    !   advection scheme for tracer 
    204157!----------------------------------------------------------------------- 
    205 ! C1D : no advection scheme  
    206 / 
    207 !----------------------------------------------------------------------- 
    208 &namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param) 
     158   ln_traadv_NONE= .true.  !  No tracer advection 
     159/ 
     160!----------------------------------------------------------------------- 
     161&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)  (default: NO) 
    209162!----------------------------------------------------------------------- 
    210163/ 
    … …  
    212165&namtra_ldf    !   lateral diffusion scheme for tracers 
    213166!----------------------------------------------------------------------- 
    214 ! C1D : no lateral diffusion   
    215 / 
    216 !----------------------------------------------------------------------- 
    217 &namtra_ldfeiv !   eddy induced velocity param. 
    218 !----------------------------------------------------------------------- 
    219 ! C1D : no eiv   
     167   ln_traldf_NONE= .true.  ! No operator (no explicit diffusion) 
     168/ 
     169!----------------------------------------------------------------------- 
     170&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO) 
     171!----------------------------------------------------------------------- 
    220172/ 
    221173!----------------------------------------------------------------------- 
    … …  
    225177/ 
    226178!----------------------------------------------------------------------- 
    227 &namdyn_adv    !   formulation of the momentum advection 
    228 !----------------------------------------------------------------------- 
    229 ! C1D : no advection scheme  
     179&namdyn_adv    !   formulation of the momentum advection                (default: None) 
     180!----------------------------------------------------------------------- 
     181   ln_dynadv_NONE= .true.  !  linear dynamics (no momentum advection) 
    230182/ 
    231183!----------------------------------------------------------------------- 
    … …  
    252204&namdyn_ldf    !   lateral diffusion on momentum 
    253205!----------------------------------------------------------------------- 
    254    ln_dynldf_lap    =  .false.  !  laplacian operator 
     206   ln_dynldf_NONE= .true.     ! No operator (no explicit diffusion) 
    255207/ 
    256208!----------------------------------------------------------------------- 
    … …  
    302254/ 
    303255!----------------------------------------------------------------------- 
    304 &nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi) 
    305 !----------------------------------------------------------------------- 
    306 / 
    307 !----------------------------------------------------------------------- 
    308256&namctl        !   Control prints & Benchmark 
    309 !----------------------------------------------------------------------- 
    310 / 
    311 !----------------------------------------------------------------------- 
    312 &namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4") 
    313257!----------------------------------------------------------------------- 
    314258/ 
    … …  
    319263/ 
    320264!----------------------------------------------------------------------- 
    321 &namflo       !   float parameters                                      ("key_float") 
    322 !----------------------------------------------------------------------- 
    323 / 
    324 !----------------------------------------------------------------------- 
    325 &namptr       !   Poleward Transport Diagnostic 
    326 !----------------------------------------------------------------------- 
    327 / 
    328 !----------------------------------------------------------------------- 
    329265&namhsb       !  Heat and salt budgets 
    330266!----------------------------------------------------------------------- 
    331267/ 
    332268!----------------------------------------------------------------------- 
    333 &namdct        ! transports through sections 
    334 !----------------------------------------------------------------------- 
    335     nn_dct      = 60       !  time step frequency for transports computing 
    336     nn_dctwri   = 60       !  time step frequency for transports writing 
    337     nn_secdebug = 0        !      0 : no section to debug 
    338 / 
    339 !----------------------------------------------------------------------- 
    340269&namobs       !  observation usage switch                               ('key_diaobs') 
    341270!----------------------------------------------------------------------- 
    342271/ 
    343272!----------------------------------------------------------------------- 
    344 &nam_asminc   !   assimilation increments                               ('key_asminc') 
    345 !----------------------------------------------------------------------- 
    346 / 
    347 !----------------------------------------------------------------------- 
    348273&namsbc_wave   ! External fields from wave model 
    349274!----------------------------------------------------------------------- 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg

    r8215 r8568  
    142142/ 
    143143!----------------------------------------------------------------------- 
    144 &namtra_adv    !   advection scheme for tracer 
     144&namtra_adv    !   advection scheme for tracer                          (default: No selection) 
    145145!----------------------------------------------------------------------- 
    146146   ln_traadv_fct =  .true.   !  FCT scheme 
    147147      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order  
    148148      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order  
    149       nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    150       !                             !        (number of sub-timestep = nn_fct_zts) 
    151 / 
    152 !----------------------------------------------------------------------- 
    153 &namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param) 
    154 !----------------------------------------------------------------------- 
    155 / 
    156 !---------------------------------------------------------------------------------- 
    157 &namtra_ldf    !   lateral diffusion scheme for tracers 
    158 !---------------------------------------------------------------------------------- 
     149/ 
     150!----------------------------------------------------------------------- 
     151&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)  (default: NO) 
     152!----------------------------------------------------------------------- 
     153/ 
     154!----------------------------------------------------------------------- 
     155&namtra_ldf    !   lateral diffusion scheme for tracers                 (default: No selection) 
     156!----------------------------------------------------------------------- 
    159157   !                       !  Operator type: 
     158   ln_traldf_NONE  = .false.   !           No operator (no explicit advection) 
    160159   ln_traldf_lap   =  .true.   !    laplacian operator 
    161160   ln_traldf_blp   =  .false.  !  bilaplacian operator 
    … …  
    185184   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s] 
    186185/ 
    187 !---------------------------------------------------------------------------------- 
    188 &namtra_ldfeiv !   eddy induced velocity param. 
    189 !---------------------------------------------------------------------------------- 
     186!----------------------------------------------------------------------- 
     187&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO) 
     188!----------------------------------------------------------------------- 
    190189   ln_ldfeiv     =.false.   ! use eddy induced velocity parameterization 
    191190/ 
    … …  
    196195/ 
    197196!----------------------------------------------------------------------- 
    198 &namdyn_adv    !   formulation of the momentum advection 
    199 !----------------------------------------------------------------------- 
     197&namdyn_adv    !   formulation of the momentum advection                (default: No selection) 
     198!----------------------------------------------------------------------- 
     199   ln_dynadv_vec = .true.  !  vector form - 2nd centered scheme 
     200     nn_dynkeg     = 0        ! grad(KE) scheme: =0   C2  ;  =1   Hollingsworth correction 
    200201/ 
    201202!----------------------------------------------------------------------- 
    … …  
    219220!----------------------------------------------------------------------- 
    220221   !                       !  Type of the operator : 
    221    !                           !  no diffusion: set ln_dynldf_lap=..._blp=F  
     222   ln_dynldf_NONE=  .false.    !           No operator (no explicit diffusion) 
    222223   ln_dynldf_lap =  .true.     !    laplacian operator 
    223224   ln_dynldf_blp =  .false.    !  bilaplacian operator 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_top_cfg

    r5836 r8568  
    2222/ 
    2323!----------------------------------------------------------------------- 
    24 &namtrc_adv    !   advection scheme for passive tracer  
     24&namtrc_adv    !   advection scheme for passive tracer                  (default: NO selection) 
    2525!----------------------------------------------------------------------- 
    2626   ln_trcadv_fct =  .true.   !  FCT scheme 
    2727      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order  
    2828      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order  
    29       nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    30       !                             !        (number of sub-timestep = nn_fct_zts) 
    3129/ 
    3230!----------------------------------------------------------------------- 

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

    r8215 r8568  
    9292/ 
    9393!----------------------------------------------------------------------- 
    94 &namtra_adv    !   advection scheme for tracer 
     94&namtra_adv    !   advection scheme for tracer                          (default: No selection) 
    9595!----------------------------------------------------------------------- 
    9696   ln_traadv_fct =  .true.   !  FCT scheme 
    9797      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order  
    9898      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order  
    99       nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    100       !                             !        (number of sub-timestep = nn_fct_zts) 
    101 / 
    102 !----------------------------------------------------------------------- 
    103 &namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param) 
    104 !----------------------------------------------------------------------- 
    105 / 
    106 !---------------------------------------------------------------------------------- 
    107 &namtra_ldf    !   lateral diffusion scheme for tracers 
    108 !---------------------------------------------------------------------------------- 
     99/ 
     100!----------------------------------------------------------------------- 
     101&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)  (default: NO) 
     102!----------------------------------------------------------------------- 
     103/ 
     104!----------------------------------------------------------------------- 
     105&namtra_ldf    !   lateral diffusion scheme for tracers                 (default: No selection) 
     106!----------------------------------------------------------------------- 
    109107   !                       !  Operator type: 
     108   ln_traldf_NONE  =  .false.  !           No operator (no explicit advection) 
    110109   ln_traldf_lap   =  .true.   !    laplacian operator 
    111110   ln_traldf_blp   =  .false.  !  bilaplacian operator 
    … …  
    146145/ 
    147146!----------------------------------------------------------------------- 
    148 &namdyn_adv    !   formulation of the momentum advection 
    149 !----------------------------------------------------------------------- 
    150 / 
    151 !----------------------------------------------------------------------- 
    152 &namdyn_vor    !   option of physics/algorithm (not control by CPP keys) 
     147&namdyn_adv    !   formulation of the momentum advection                (default: No selection) 
     148!----------------------------------------------------------------------- 
     149   ln_dynadv_vec = .true.  !  vector form - 2nd centered scheme 
     150     nn_dynkeg     = 0        ! grad(KE) scheme: =0   C2  ;  =1   Hollingsworth correction 
     151/ 
     152!----------------------------------------------------------------------- 
     153&namdyn_vor    !   option of physics/algorithm                          (default: No selection) 
    153154!----------------------------------------------------------------------- 
    154155   ln_dynvor_ene = .true.  !  enstrophy conserving scheme 
    … …  
    170171/ 
    171172!----------------------------------------------------------------------- 
    172 &namdyn_ldf    !   lateral diffusion on momentum 
     173&namdyn_ldf    !   lateral diffusion on momentum                        (default: No selection) 
    173174!----------------------------------------------------------------------- 
    174175   !                       !  Type of the operator : 
    175    !                           !  no diffusion: set ln_dynldf_lap=..._blp=F  
     176   ln_dynldf_NONE=  .false.    !           No operator (no explicit diffusion) 
    176177   ln_dynldf_lap =  .true.     !    laplacian operator 
    177178   ln_dynldf_blp =  .false.    !  bilaplacian operator 
    … …  
    197198   rn_ahm_0_lap     = 100000.   !  horizontal laplacian eddy viscosity   [m2/s] 
    198199/ 
     200 
    199201!!====================================================================== 
    200202!!                     vertical physics namelists                     !! 

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

    r8215 r8568  
    2929/ 
    3030!----------------------------------------------------------------------- 
    31 &namtrc_adv    !   advection scheme for passive tracer 
     31&namtrc_adv    !   advection scheme for passive tracer                  (default: NO selection) 
    3232!----------------------------------------------------------------------- 
    3333   ln_trcadv_fct =  .true.   !  FCT scheme 
    3434      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
    3535      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
    36       nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    37       !                             !        (number of sub-timestep = nn_fct_zts) 
    3836/ 
    3937!----------------------------------------------------------------------- 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/1_namelist_cfg

    r8215 r8568  
    116116/ 
    117117!----------------------------------------------------------------------- 
    118 &namtra_adv    !   advection scheme for tracer 
     118&namtra_adv    !   advection scheme for tracer                          (default: NO selection) 
    119119!----------------------------------------------------------------------- 
    120120   ln_traadv_fct =  .true.    !  FCT scheme 
    121121      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order  
    122122      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order  
    123       nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    124       !                             !        (number of sub-timestep = nn_fct_zts) 
    125123/ 
    126124!----------------------------------------------------------------------- 
    127125&namtra_ldf    !   lateral diffusion scheme for tracers 
    128 !---------------------------------------------------------------------------------- 
     126!----------------------------------------------------------------------- 
    129127   !                       !  Operator type: 
    130128   ln_traldf_lap   =  .true.   !    laplacian operator 
    … …  
    161159/ 
    162160!----------------------------------------------------------------------- 
    163 &namdyn_adv    !   formulation of the momentum advection 
    164 !----------------------------------------------------------------------- 
     161&namdyn_adv    !   formulation of the momentum advection                (default: No selection) 
     162!----------------------------------------------------------------------- 
     163   ln_dynadv_NONE= .false. !  linear dynamics (no momentum advection) 
     164   ln_dynadv_vec = .true.  !  vector form - 2nd centered scheme 
     165     nn_dynkeg     = 0        ! grad(KE) scheme: =0   C2  ;  =1   Hollingsworth correction 
     166   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
     167   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
    165168/   
    166169!----------------------------------------------------------------------- 

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

    r8215 r8568  
    123123/ 
    124124!----------------------------------------------------------------------- 
    125 &namtra_adv    !   advection scheme for tracer 
    126 !----------------------------------------------------------------------- 
    127    ln_traadv_fct =  .true.    !  FCT scheme 
     125&namtra_adv    !   advection scheme for tracer                          (default: NO advection) 
     126!----------------------------------------------------------------------- 
     127   ln_traadv_fct = .true.     !  FCT scheme 
    128128      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order  
    129129      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order  
    130       nn_fct_zts =  0               !  > 1 , 2nd order FCT scheme with vertical sub-timestepping 
    131       !                             !        (number of sub-timestep = nn_fct_zts) 
    132 / 
    133 !----------------------------------------------------------------------- 
    134 &namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param) 
     130/ 
     131!----------------------------------------------------------------------- 
     132&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) 
    135133!----------------------------------------------------------------------- 
    136134   ln_mle      = .true.   ! (T) use the Mixed Layer Eddy (MLE) parameterisation 
    … …  
    140138!---------------------------------------------------------------------------------- 
    141139   !                       !  Operator type: 
     140   ln_traldf_NONE  =  .false.  !           No operator (no explicit advection) 
    142141   ln_traldf_lap   =  .true.   !    laplacian operator 
    143142   ln_traldf_blp   =  .false.  !  bilaplacian operator 
    … …  
    186185/ 
    187186!----------------------------------------------------------------------- 
    188 &namdyn_adv    !   formulation of the momentum advection 
    189 !----------------------------------------------------------------------- 
     187&namdyn_adv    !   formulation of the momentum advection                (default: No selection) 
     188!----------------------------------------------------------------------- 
     189   ln_dynadv_NONE= .false. !  linear dynamics (no momentum advection) 
     190   ln_dynadv_vec = .true.  !  vector form - 2nd centered scheme 
     191     nn_dynkeg     = 0        ! grad(KE) scheme: =0   C2  ;  =1   Hollingsworth correction 
     192   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
     193   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
    190194/ 
    191195!----------------------------------------------------------------------- 
    … …  
    212216!----------------------------------------------------------------------- 
    213217   !                       !  Type of the operator : 
    214    !                           !  no diffusion: set ln_dynldf_lap=..._blp=F  
     218   ln_dynldf_NONE=  .false.    !           No operator (no explicit diffusion) 
    215219   ln_dynldf_lap =  .true.     !    laplacian operator 
    216220   ln_dynldf_blp =  .false.    !  bilaplacian operator 

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

    r8215 r8568  
    7171/ 
    7272!----------------------------------------------------------------------- 
    73 &namtrc_adv    !   advection scheme for passive tracer  
     73&namtrc_adv    !   advection scheme for passive tracer                  (default: NO selection) 
    7474!----------------------------------------------------------------------- 
    7575   ln_trcadv_mus =  .true.  !  MUSCL scheme 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_cfg

    r8215 r8568  
    7171!---------------------------------------------------------------------------------- 
    7272   !                       !  Operator type: 
     73   ln_traldf_NONE  =  .false.  !           No operator (no explicit advection) 
    7374   ln_traldf_lap   =  .true.   !    laplacian operator 
    7475   ln_traldf_blp   =  .false.  !  bilaplacian operator 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top_cfg

    r7646 r8568  
    7171/ 
    7272!----------------------------------------------------------------------- 
    73 &namtrc_adv    !   advection scheme for passive tracer  
     73&namtrc_adv    !   advection scheme for passive tracer                  (default: No selection) 
    7474!----------------------------------------------------------------------- 
    7575   ln_trcadv_mus =  .true.  !  MUSCL scheme 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/namelist_cfg

    r8215 r8568  
    7272!---------------------------------------------------------------------------------- 
    7373   !                       !  Operator type: 
     74   ln_traldf_NONE  =  .false.  ! No explicit diffusion 
    7475   ln_traldf_lap   =  .true.   !    laplacian operator 
    7576   ln_traldf_blp   =  .false.  !  bilaplacian operator 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_cfg

    r8215 r8568  
    7474/ 
    7575!----------------------------------------------------------------------- 
    76 &namtra_adv    !   advection scheme for tracer 
     76&namtra_adv    !   advection scheme for tracer                          (default: NO selection) 
    7777!----------------------------------------------------------------------- 
    78    ln_traadv_fct =  .true.    !  FCT scheme 
    79       nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order  
    80       nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order  
    81       nn_fct_zts =  0               !  > 1 , 2nd order FCT scheme with vertical sub-timestepping 
    82       !                             !        (number of sub-timestep = nn_fct_zts) 
    8378/ 
    8479!----------------------------------------------------------------------- 

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

    r8215 r8568  
    306306/ 
    307307!----------------------------------------------------------------------- 
    308 &namsbc_sas    !   Stand Alone Surface boundary condition 
     308&namsbc_sas    !   Stand-Alone Surface boundary condition 
    309309!----------------------------------------------------------------------- 
    310310!              !  file name  ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    … …  
    602602!!                ***  top/Bottom boundary condition  ***             !! 
    603603!!====================================================================== 
    604 !!   namdrg        top/bottom drag coefficient                          (default: NONE) 
     604!!   namdrg        top/bottom drag coefficient                          (default: NO selection) 
    605605!!   namdrg_top    top    friction                                      (ln_isfcav=T) 
    606606!!   namdrg_bot    bottom friction                                       
    … …  
    666666 
    667667!!====================================================================== 
    668 !!                        Tracer (T & S ) namelists 
     668!!                        Tracer (T & S) namelists 
    669669!!====================================================================== 
    670670!!   nameos           equation of state 
    … …  
    679679&nameos        !   ocean Equation Of Seawater                           (default: NO) 
    680680!----------------------------------------------------------------------- 
    681    ln_teos10   = .false.         !  = Use TEOS-10 equation of state 
    682    ln_eos80    = .false.         !  = Use EOS80 equation of state 
    683    ln_seos     = .false.         !  = Use simplified equation of state (S-EOS) 
     681   ln_teos10   = .false.         !  = Use TEOS-10 
     682   ln_eos80    = .false.         !  = Use EOS80 
     683   ln_seos     = .false.         !  = Use S-EOS (simplified Eq.) 
    684684                                 ! 
    685685   !                     ! S-EOS coefficients (ln_seos=T): 
    … …  
    694694/ 
    695695!----------------------------------------------------------------------- 
    696 &namtra_adv    !   advection scheme for tracer                          (default: NO advection) 
    697 !----------------------------------------------------------------------- 
     696&namtra_adv    !   advection scheme for tracer                          (default: NO selection) 
     697!----------------------------------------------------------------------- 
     698   ln_traadv_NONE= .false. !  No tracer advection 
    698699   ln_traadv_cen = .false. !  2nd order centered scheme 
    699700      nn_cen_h   =  4            !  =2/4, horizontal 2nd order CEN / 4th order CEN 
    … …  
    702703      nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order  
    703704      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order  
    704       nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    705       !                          !        (number of sub-timestep = nn_fct_zts) 
    706705   ln_traadv_mus = .false. !  MUSCL scheme 
    707706      ln_mus_ups = .false.       !  use upstream scheme near river mouths 
    … …  
    724723/ 
    725724!----------------------------------------------------------------------- 
    726 &namtra_ldf    !   lateral diffusion scheme for tracers                 (default: NO diffusion) 
     725&namtra_ldf    !   lateral diffusion scheme for tracers                 (default: NO selection) 
    727726!----------------------------------------------------------------------- 
    728727   !                       !  Operator type: 
    729    !                           !  no diffusion: set ln_traldf_lap=..._blp=F  
     728   ln_traldf_NONE  =  .false.  !  No explicit diffusion 
    730729   ln_traldf_lap   =  .false.  !    laplacian operator 
    731730   ln_traldf_blp   =  .false.  !  bilaplacian operator 
    … …  
    759758&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO) 
    760759!----------------------------------------------------------------------- 
    761    ln_ldfeiv     =.false. ! use eddy induced velocity parameterization 
     760   ln_ldfeiv     = .false. ! use eddy induced velocity parameterization 
    762761      rn_aeiv_0     = 2000.   ! eddy induced velocity coefficient   [m2/s] 
    763762      nn_aei_ijk_t  = 21      ! space/time variation of the eiv coeficient 
    … …  
    790789!!====================================================================== 
    791790! 
    792 !----------------------------------------------------------------------- 
    793 &namdyn_adv    !   formulation of the momentum advection                (default: vector form) 
    794 !----------------------------------------------------------------------- 
    795    ln_dynadv_vec = .true.  !  vector form (T) or flux form (F) 
    796    nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction 
    797    ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
    798    ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
    799    ln_dynzad_zts = .false. !  sub-time-stepping for vertical momentum advection 
    800 / 
    801791!----------------------------------------------------------------------- 
    802792&nam_vvl    !   vertical coordinate options                             (default: zstar) 
    … …  
    814804/ 
    815805!----------------------------------------------------------------------- 
     806&namdyn_adv    !   formulation of the momentum advection                (default: NO selection) 
     807!----------------------------------------------------------------------- 
     808   ln_dynadv_NONE= .false. !  linear dynamics (no momentum advection) 
     809   ln_dynadv_vec = .false. !  vector form - 2nd centered scheme 
     810     nn_dynkeg     = 0        ! grad(KE) scheme: =0   C2  ;  =1   Hollingsworth correction 
     811   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
     812   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
     813/ 
     814!----------------------------------------------------------------------- 
    816815&namdyn_vor    !   Vorticity / Coriolis scheme                          (default: NO) 
    817816!----------------------------------------------------------------------- 
    … …  
    848847/ 
    849848!----------------------------------------------------------------------- 
    850 &namdyn_ldf    !   lateral diffusion on momentum                        (default: NO) 
     849&namdyn_ldf    !   lateral diffusion on momentum                        (default: NO selection) 
    851850!----------------------------------------------------------------------- 
    852851   !                       !  Type of the operator : 
    853    !                           !  no diffusion: set ln_dynldf_lap=..._blp=F  
     852   ln_dynldf_NONE=  .false.    !  No operator (i.e. no explicit diffusion) 
    854853   ln_dynldf_lap =  .false.    !    laplacian operator 
    855854   ln_dynldf_blp =  .false.    !  bilaplacian operator 
    … …  
    891890&namzdf        !   vertical physics                                     (default: NO selection) 
    892891!----------------------------------------------------------------------- 
    893    !                       ! type of vertical closure 
     892   !                       ! type of vertical closure (required) 
    894893   ln_zdfcst   = .false.      !  constant mixing 
    895894   ln_zdfric   = .false.      !  local Richardson dependent formulation (T =>   fill namzdf_ric) 
    … …  
    971970   rn_charn      = 70000.  !  Charnock constant for wb induced roughness length 
    972971   rn_hsro       =  0.02   !  Minimum surface roughness 
    973    rn_frac_hs    =   1.3   !  Fraction of wave height as roughness (if nn_z0_met=2) 
     972   rn_frac_hs    =   1.3   !  Fraction of wave height as roughness (if nn_z0_met>1) 
    974973   nn_z0_met     =     2   !  Method for surface roughness computation (0/1/2/3) 
    975974   !                             ! =3 requires ln_wave=T 
    … …  
    10161015   nn_isplt    =    1      !  number of processors in i-direction 
    10171016   nn_jsplt    =    1      !  number of processors in j-direction 
    1018    nn_timing   =    0      !  timing by routine activated (=1) creates timing.output file, or not (=0) 
    1019    nn_diacfl   =    0      !  Write out CFL diagnostics (=1) in cfl_diagnostics.ascii, or not (=0) 
     1017   ln_timing   = .false.   !  timing by routine write out in timing.output file 
     1018   ln_diacfl   = .false.   !  CFL diagnostics write out in cfl_diagnostics.ascii 
    10201019/ 
    10211020!----------------------------------------------------------------------- 

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

    r8215 r8568  
    6161/ 
    6262!----------------------------------------------------------------------- 
    63 &namtrc_adv      !   advection scheme for passive tracer  
     63&namtrc_adv      !   advection scheme for passive tracer                (default: NO selection) 
    6464!----------------------------------------------------------------------- 
     65   ln_trcadv_NONE=  .false.  !  No passive tracer advection 
    6566   ln_trcadv_cen =  .false.  !  2nd order centered scheme 
    6667      nn_cen_h   =  4               !  =2/4, horizontal 2nd order CEN / 4th order CEN 
    … …  
    6970      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order  
    7071      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order  
    71       nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    72       !                             !        (number of sub-timestep = nn_fct_zts) 
    7372   ln_trcadv_mus =  .false.  !  MUSCL scheme 
    7473      ln_mus_ups =  .false.         !  use upstream scheme near river mouths 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/namelist_cfg

    r8215 r8568  
    230230      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order  
    231231      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order  
    232       nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    233       !                             !        (number of sub-timestep = nn_fct_zts) 
    234232/ 
    235233!----------------------------------------------------------------------- 
    … …  
    280278!----------------------------------------------------------------------- 
    281279&namdyn_adv    !   formulation of the momentum advection 
     280!----------------------------------------------------------------------- 
     281   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F) 
     282   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction 
     283   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
     284   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
     285/ 
    282286!----------------------------------------------------------------------- 
    283287/ 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_flux_cen2_cfg

    r8215 r8568  
    9595      nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order 
    9696      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order 
    97       nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    98       !                          !        (number of sub-timestep = nn_fct_zts) 
    9997   ln_traadv_mus = .false. !  MUSCL scheme 
    10098      ln_mus_ups = .false.       !  use upstream scheme near river mouths 
    … …  
    130128   ln_dynadv_cen2= .true.  !  flux form - 2nd order centered scheme 
    131129   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
    132    ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection 
    133130/ 
    134131!----------------------------------------------------------------------- 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_flux_ubs_cfg

    r8215 r8568  
    9595      nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order 
    9696      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order 
    97       nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    98       !                          !        (number of sub-timestep = nn_fct_zts) 
    9997   ln_traadv_mus = .false. !  MUSCL scheme 
    10098      ln_mus_ups = .false.       !  use upstream scheme near river mouths 
    … …  
    130128   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
    131129   ln_dynadv_ubs = .true.  !  flux form - 3rd order UBS      scheme 
    132    ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection 
    133130/ 
    134131!----------------------------------------------------------------------- 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_eenH_cfg

    r8215 r8568  
    9595      nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order 
    9696      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order 
    97       nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    98       !                          !        (number of sub-timestep = nn_fct_zts) 
    9997   ln_traadv_mus = .false. !  MUSCL scheme 
    10098      ln_mus_ups = .false.       !  use upstream scheme near river mouths 
    … …  
    130128   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
    131129   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
    132    ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection 
    133130/ 
    134131!----------------------------------------------------------------------- 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_een_cfg

    r8215 r8568  
    9595      nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order 
    9696      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order 
    97       nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    98       !                          !        (number of sub-timestep = nn_fct_zts) 
    9997   ln_traadv_mus = .false. !  MUSCL scheme 
    10098      ln_mus_ups = .false.       !  use upstream scheme near river mouths 
    … …  
    130128   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
    131129   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
    132    ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection 
    133130/ 
    134131!----------------------------------------------------------------------- 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_ene_cfg

    r8215 r8568  
    9595      nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order 
    9696      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order 
    97       nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    98       !                          !        (number of sub-timestep = nn_fct_zts) 
    9997   ln_traadv_mus = .false. !  MUSCL scheme 
    10098      ln_mus_ups = .false.       !  use upstream scheme near river mouths 
    … …  
    130128   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
    131129   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
    132    ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection 
    133130/ 
    134131!----------------------------------------------------------------------- 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_ens_cfg

    r8215 r8568  
    9595      nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order 
    9696      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order 
    97       nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    98       !                          !        (number of sub-timestep = nn_fct_zts) 
    9997   ln_traadv_mus = .false. !  MUSCL scheme 
    10098      ln_mus_ups = .false.       !  use upstream scheme near river mouths 
    … …  
    130128   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
    131129   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
    132    ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection 
    133130/ 
    134131!----------------------------------------------------------------------- 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_flux_cen2_cfg

    r8215 r8568  
    9595      nn_fct_h   =  4            !  =2/4, horizontal 2nd / 4th order 
    9696      nn_fct_v   =  4            !  =2/4, vertical   2nd / COMPACT 4th order 
    97       nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    98       !                          !        (number of sub-timestep = nn_fct_zts) 
    9997   ln_traadv_mus = .false. !  MUSCL scheme 
    10098      ln_mus_ups = .false.       !  use upstream scheme near river mouths 
    … …  
    130128   ln_dynadv_cen2= .true.  !  flux form - 2nd order centered scheme 
    131129   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
    132    ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection 
    133130/ 
    134131!----------------------------------------------------------------------- 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_flux_ubs_cfg

    r8215 r8568  
    9595      nn_fct_h   =  4            !  =2/4, horizontal 2nd / 4th order 
    9696      nn_fct_v   =  4            !  =2/4, vertical   2nd / COMPACT 4th order 
    97       nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    98       !                          !        (number of sub-timestep = nn_fct_zts) 
    9997   ln_traadv_mus = .false. !  MUSCL scheme 
    10098      ln_mus_ups = .false.       !  use upstream scheme near river mouths 
    … …  
    130128   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
    131129   ln_dynadv_ubs = .true.  !  flux form - 3rd order UBS      scheme 
    132    ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection 
    133130/ 
    134131!----------------------------------------------------------------------- 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_eenH_cfg

    r8215 r8568  
    9595      nn_fct_h   =  4            !  =2/4, horizontal 2nd / 4th order 
    9696      nn_fct_v   =  4            !  =2/4, vertical   2nd / COMPACT 4th order 
    97       nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    98       !                          !        (number of sub-timestep = nn_fct_zts) 
    9997   ln_traadv_mus = .false. !  MUSCL scheme 
    10098      ln_mus_ups = .false.       !  use upstream scheme near river mouths 
    … …  
    130128   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
    131129   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
    132    ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection 
    133130/ 
    134131!----------------------------------------------------------------------- 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_een_cfg

    r8215 r8568  
    9595      nn_fct_h   =  4            !  =2/4, horizontal 2nd / 4th order 
    9696      nn_fct_v   =  4            !  =2/4, vertical   2nd / COMPACT 4th order 
    97       nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    98       !                          !        (number of sub-timestep = nn_fct_zts) 
    9997   ln_traadv_mus = .false. !  MUSCL scheme 
    10098      ln_mus_ups = .false.       !  use upstream scheme near river mouths 
    … …  
    130128   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
    131129   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
    132    ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection 
    133130/ 
    134131!----------------------------------------------------------------------- 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_ene_cfg

    r8215 r8568  
    9595      nn_fct_h   =  4            !  =2/4, horizontal 2nd / 4th order 
    9696      nn_fct_v   =  4            !  =2/4, vertical   2nd / COMPACT 4th order 
    97       nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    98       !                          !        (number of sub-timestep = nn_fct_zts) 
    9997   ln_traadv_mus = .false. !  MUSCL scheme 
    10098      ln_mus_ups = .false.       !  use upstream scheme near river mouths 
    … …  
    130128   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
    131129   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
    132    ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection 
    133130/ 
    134131!----------------------------------------------------------------------- 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_ens_cfg

    r8215 r8568  
    9595      nn_fct_h   =  4            !  =2/4, horizontal 2nd / 4th order 
    9696      nn_fct_v   =  4            !  =2/4, vertical   2nd / COMPACT 4th order 
    97       nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    98       !                          !        (number of sub-timestep = nn_fct_zts) 
    9997   ln_traadv_mus = .false. !  MUSCL scheme 
    10098      ln_mus_ups = .false.       !  use upstream scheme near river mouths 
    … …  
    130128   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
    131129   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
    132    ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection 
    133130/ 
    134131!----------------------------------------------------------------------- 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_cfg

    r8215 r8568  
    9595      nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order 
    9696      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order 
    97       nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    98       !                          !        (number of sub-timestep = nn_fct_zts) 
    9997   ln_traadv_mus = .false. !  MUSCL scheme 
    10098      ln_mus_ups = .false.       !  use upstream scheme near river mouths 
    … …  
    130128   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
    131129   ln_dynadv_ubs = .true.  !  flux form - 3rd order UBS      scheme 
    132    ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection 
    133130/ 
    134131!----------------------------------------------------------------------- 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_cfg

    r8215 r8568  
    8080/ 
    8181!----------------------------------------------------------------------- 
    82 &namtra_adv    !   advection scheme for tracer 
     82&namtra_adv    !   advection scheme for tracer                          (default: NO selection) 
    8383!----------------------------------------------------------------------- 
    8484   ln_traadv_cen = .false. !  2nd order centered scheme 
    … …  
    8888      nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order 
    8989      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order 
    90       nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    91       !                          !        (number of sub-timestep = nn_fct_zts) 
    9290   ln_traadv_mus = .false. !  MUSCL scheme 
    9391      ln_mus_ups = .false.       !  use upstream scheme near river mouths 
    … …  
    117115/ 
    118116!----------------------------------------------------------------------- 
    119 &namdyn_adv    !   formulation of the momentum advection 
    120 !----------------------------------------------------------------------- 
     117&namdyn_adv    !   formulation of the momentum advection                (default: NO selection) 
     118!----------------------------------------------------------------------- 
     119   ln_dynadv_NONE= .false. !  linear dynamics (no momentum advection) 
    121120   ln_dynadv_vec = .false. !  vector form (T) or flux form (F) 
    122121   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction 
    123122   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
    124123   ln_dynadv_ubs = .true.  !  flux form - 3rd order UBS      scheme 
    125    ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection 
    126124/ 
    127125!----------------------------------------------------------------------- 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_sco_FCT2_flux_ubs_cfg

    r8215 r8568  
    8989      nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order 
    9090      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order 
    91       nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    92       !                          !        (number of sub-timestep = nn_fct_zts) 
    9391   ln_traadv_mus = .false. !  MUSCL scheme 
    9492      ln_mus_ups = .false.       !  use upstream scheme near river mouths 
    … …  
    118116/ 
    119117!----------------------------------------------------------------------- 
    120 &namdyn_adv    !   formulation of the momentum advection 
    121 !----------------------------------------------------------------------- 
     118&namdyn_adv    !   formulation of the momentum advection                (default: NO selection) 
     119!----------------------------------------------------------------------- 
     120   ln_dynadv_NONE= .false. !  linear dynamics (no momentum advection) 
    122121   ln_dynadv_vec = .false. !  vector form (T) or flux form (F) 
    123122   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction 
    124123   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
    125124   ln_dynadv_ubs = .true.  !  flux form - 3rd order UBS      scheme 
    126    ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection 
    127125/ 
    128126!----------------------------------------------------------------------- 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_zps_FCT2_flux_ubs_cfg

    r8215 r8568  
    8989      nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order 
    9090      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order 
    91       nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    92       !                          !        (number of sub-timestep = nn_fct_zts) 
    9391   ln_traadv_mus = .false. !  MUSCL scheme 
    9492      ln_mus_ups = .false.       !  use upstream scheme near river mouths 
    … …  
    118116/ 
    119117!----------------------------------------------------------------------- 
    120 &namdyn_adv    !   formulation of the momentum advection 
    121 !----------------------------------------------------------------------- 
     118&namdyn_adv    !   formulation of the momentum advection                (default: NO selection) 
     119!----------------------------------------------------------------------- 
     120   ln_dynadv_NONE= .false. !  linear dynamics (no momentum advection) 
    122121   ln_dynadv_vec = .false. !  vector form (T) or flux form (F) 
    123122   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction 
    124123   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
    125124   ln_dynadv_ubs = .true.  !  flux form - 3rd order UBS      scheme 
    126    ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection 
    127125/ 
    128126!----------------------------------------------------------------------- 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_zps_FCT4_flux_ubs_cfg

    r8215 r8568  
    8989      nn_fct_h   =  4            !  =2/4, horizontal 2nd / 4th order 
    9090      nn_fct_v   =  4            !  =2/4, vertical   2nd / COMPACT 4th order 
    91       nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    92       !                          !        (number of sub-timestep = nn_fct_zts) 
    9391   ln_traadv_mus = .false. !  MUSCL scheme 
    9492      ln_mus_ups = .false.       !  use upstream scheme near river mouths 
    … …  
    118116/ 
    119117!----------------------------------------------------------------------- 
    120 &namdyn_adv    !   formulation of the momentum advection 
    121 !----------------------------------------------------------------------- 
     118&namdyn_adv    !   formulation of the momentum advection                (default: NO selection) 
     119!----------------------------------------------------------------------- 
     120   ln_dynadv_NONE= .false. !  linear dynamics (no momentum advection) 
    122121   ln_dynadv_vec = .false. !  vector form (T) or flux form (F) 
    123122   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction 
    124123   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
    125124   ln_dynadv_ubs = .true.  !  flux form - 3rd order UBS      scheme 
    126    ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection 
    127125/ 
    128126!----------------------------------------------------------------------- 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_zps_FCT4_vect_een_cfg

    r8215 r8568  
    8989      nn_fct_h   =  4            !  =2/4, horizontal 2nd / 4th order 
    9090      nn_fct_v   =  4            !  =2/4, vertical   2nd / COMPACT 4th order 
    91       nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    92       !                          !        (number of sub-timestep = nn_fct_zts) 
    9391   ln_traadv_mus = .false. !  MUSCL scheme 
    9492      ln_mus_ups = .false.       !  use upstream scheme near river mouths 
    … …  
    118116/ 
    119117!----------------------------------------------------------------------- 
    120 &namdyn_adv    !   formulation of the momentum advection 
    121 !----------------------------------------------------------------------- 
     118&namdyn_adv    !   formulation of the momentum advection                (default: NO selection) 
     119!----------------------------------------------------------------------- 
     120   ln_dynadv_NONE= .false. !  linear dynamics (no momentum advection) 
    122121   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F) 
    123122   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction 
    124123   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
    125124   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
    126    ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection 
    127125/ 
    128126!----------------------------------------------------------------------- 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/1_namelist_cfg

    r8215 r8568  
    9999      nn_fct_h   =  4               !  =2/4, horizontal 2nd / 4th order  
    100100      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order  
    101       nn_fct_zts =  0               !  > 1 , 2nd order FCT scheme with vertical sub-timestepping 
    102       !                             !        (number of sub-timestep = nn_fct_zts) 
    103101/ 
    104102!----------------------------------------------------------------------- 
    … …  
    144142&namtra_dmp    !   tracer: T & S newtonian damping                      (default: NO) 
    145143!----------------------------------------------------------------------- 
    146 !----------------------------------------------------------------------- 
    147 &namdyn_adv    !   formulation of the momentum advection 
     144/ 
     145!----------------------------------------------------------------------- 
     146&namdyn_adv    !   formulation of the momentum advection                (default: NO selection) 
     147!----------------------------------------------------------------------- 
     148   ln_dynadv_NONE= .false. !  linear dynamics (no momentum advection) 
     149   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F) 
     150   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction 
     151   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
     152   ln_dynadv_ubs = .true.  !  flux form - 3rd order UBS      scheme 
    148153!----------------------------------------------------------------------- 
    149154/ 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_cfg

    r8215 r8568  
    100100/ 
    101101!----------------------------------------------------------------------- 
    102 &namtra_adv    !   advection scheme for tracer 
     102&namtra_adv    !   advection scheme for tracer                          (default: NO selection) 
    103103!----------------------------------------------------------------------- 
    104104   ln_traadv_fct =  .true.    !  FCT scheme 
    105105      nn_fct_h   =  4               !  =2/4, horizontal 2nd / 4th order  
    106106      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order  
    107       nn_fct_zts =  0               !  > 1 , 2nd order FCT scheme with vertical sub-timestepping 
    108       !                             !        (number of sub-timestep = nn_fct_zts) 
    109107/ 
    110108!----------------------------------------------------------------------- 
    … …  
    160158&namtra_dmp    !   tracer: T & S newtonian damping                      (default: NO) 
    161159!----------------------------------------------------------------------- 
    162 !----------------------------------------------------------------------- 
    163 &namdyn_adv    !   formulation of the momentum advection 
    164 !----------------------------------------------------------------------- 
     160/ 
     161!----------------------------------------------------------------------- 
     162&namdyn_adv    !   formulation of the momentum advection                (default: NO selection) 
     163!----------------------------------------------------------------------- 
     164   ln_dynadv_NONE= .false. !  linear dynamics (no momentum advection) 
     165   ln_dynadv_vec = .true. !  vector form - 2nd centered scheme 
     166     nn_dynkeg     = 0        ! grad(KE) scheme: =0   C2  ;  =1   Hollingsworth correction 
     167   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
     168   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
    165169/ 
    166170!----------------------------------------------------------------------- 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/namelist_cfg

    r8215 r8568  
    219219/ 
    220220!----------------------------------------------------------------------- 
    221 &namtra_adv    !   advection scheme for tracer 
    222 !----------------------------------------------------------------------- 
     221&namtra_adv    !   advection scheme for tracer                          (default: No selection) 
     222!----------------------------------------------------------------------- 
     223   ln_traadv_NONE=  .false.  !  No tracer advection 
    223224   ln_traadv_cen =  .false.  !  2nd order centered scheme 
    224225   ln_traadv_mus =  .false.  !  MUSCL scheme 
    … …  
    226227      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order  
    227228      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order  
    228       nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping 
    229       !                             !        (number of sub-timestep = nn_fct_zts) 
    230229/ 
    231230!----------------------------------------------------------------------- 
    … …  
    275274/ 
    276275!----------------------------------------------------------------------- 
    277 &namdyn_adv    !   formulation of the momentum advection 
     276&namdyn_adv    !   formulation of the momentum advection                (default: NO selection) 
     277!----------------------------------------------------------------------- 
     278   ln_dynadv_NONE= .false. !  linear dynamics (no momentum advection) 
     279   ln_dynadv_vec = .true. !  vector form - 2nd centered scheme 
     280     nn_dynkeg     = 0        ! grad(KE) scheme: =0   C2  ;  =1   Hollingsworth correction 
     281   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme 
     282   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
    278283!----------------------------------------------------------------------- 
    279284/ 

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

    r8215 r8568  
    66ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC 
    77ORCA2_OFF_TRC OPA_SRC OFF_SRC TOP_SRC 
     8GYRE_PISCES_XIOS OPA_SRC TOP_SRC 
    89ORCA2_LIM3_PISCES OPA_SRC LIM_SRC_3 TOP_SRC NST_SRC 
    9 GYRE_PISCES_XIOS OPA_SRC TOP_SRC 
     10GYRE_PISCES_RK3 RK3_SRC TOP_SRC 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

    r7753 r8568  
    674674      ! print charge ellipse 
    675675      ! This can be desactivated once the user is sure that the stress state 
    676       ! lie on the charge ellipse. See Bouillon et al. 08 for more details 
     676      ! lie on the charge ellipse. See Bouillon et al. (2008) for more details 
    677677      IF(ln_ctl) THEN 
    678678         CALL prt_ctl_info('lim_rhg  : numit  :',ivar1=numit) 

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

    r8215 r8568  
    157157      NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   & 
    158158         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   & 
    159          &             nn_timing, nn_diacfl 
     159         &             ln_timing, ln_diacfl 
    160160 
    161161      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
    … …  
    289289      ENDIF 
    290290      ! 
    291       IF( nn_timing == 1 )  CALL timing_init 
     291      IF( ln_timing    )   CALL timing_init 
    292292      ! 
    293293 
    294294      !                                      ! General initialization 
    295       IF( nn_timing == 1 )  CALL timing_start( 'nemo_init') 
    296       ! 
    297                             CALL     phy_cst    ! Physical constants 
    298                             CALL     eos_init   ! Equation of state 
    299       IF( lk_c1d        )   CALL     c1d_init   ! 1D column configuration 
    300  
    301                             CALL     dom_init   ! Domain 
    302  
    303                             CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
    304  
    305       IF( ln_nnogather )    CALL nemo_northcomms   ! Initialise the northfold neighbour lists (must be done after the masks are defined) 
    306  
    307       IF( ln_ctl        )   CALL prt_ctl_init   ! Print control 
    308  
    309                             CALL     sbc_init   ! Forcings : surface module 
    310  
    311                             CALL ldf_tra_init   ! Lateral ocean tracer physics 
    312                             CALL ldf_eiv_init   ! Eddy induced velocity param 
    313                             CALL tra_ldf_init   ! lateral mixing 
    314       IF( l_ldfslp )        CALL ldf_slp_init   ! slope of lateral mixing 
    315  
    316                             CALL tra_qsr_init   ! penetrative solar radiation qsr 
    317       IF( ln_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme 
    318  
    319                             CALL trc_nam_run    ! Needed to get restart parameters for passive tracers 
    320                             CALL trc_rst_cal( nit000, 'READ' )   ! calendar 
    321                             CALL dta_dyn_init   ! Initialization for the dynamics 
    322  
    323                             CALL     trc_init   ! Passive tracers initialization 
    324                             CALL dia_ptr_init   ! Initialise diaptr as some variables are used  
     295      IF( ln_timing    )   CALL timing_start( 'nemo_init') 
     296      ! 
     297                           CALL     phy_cst    ! Physical constants 
     298                           CALL     eos_init   ! Equation of state 
     299      IF( lk_c1d       )   CALL     c1d_init   ! 1D column configuration 
     300 
     301                           CALL     dom_init   ! Domain 
     302 
     303                           CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
     304 
     305      IF( ln_nnogather )   CALL nemo_northcomms   ! Initialise the northfold neighbour lists (must be done after the masks are defined) 
     306 
     307      IF( ln_ctl       )   CALL prt_ctl_init   ! Print control 
     308 
     309                           CALL     sbc_init   ! Forcings : surface module 
     310 
     311                           CALL ldf_tra_init   ! Lateral ocean tracer physics 
     312                           CALL ldf_eiv_init   ! Eddy induced velocity param 
     313                           CALL tra_ldf_init   ! lateral mixing 
     314      IF( l_ldfslp     )   CALL ldf_slp_init   ! slope of lateral mixing 
     315 
     316                           CALL tra_qsr_init   ! penetrative solar radiation qsr 
     317      IF( ln_trabbl    )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme 
     318 
     319                           CALL trc_nam_run    ! Needed to get restart parameters for passive tracers 
     320                           CALL trc_rst_cal( nit000, 'READ' )   ! calendar 
     321                           CALL dta_dyn_init   ! Initialization for the dynamics 
     322 
     323                           CALL     trc_init   ! Passive tracers initialization 
     324                           CALL dia_ptr_init   ! Initialise diaptr as some variables are used  
    325325      !                                         ! in various advection and diffusion routines 
    326326      IF(lwp) WRITE(numout,cform_aaa)           ! Flag AAAAAAA 
    327327      ! 
    328       IF( nn_timing == 1 )  CALL timing_stop( 'nemo_init') 
     328      IF( ln_timing    )   CALL timing_stop( 'nemo_init') 
    329329      ! 
    330330   END SUBROUTINE nemo_init 
    … …  
    353353         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    354354         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    355          WRITE(numout,*) '      timing activated    (0/1)       nn_timing  = ', nn_timing 
     355         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing 
     356         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl 
    356357      ENDIF 
    357358      ! 
    … …  
    363364      isplt     = nn_isplt 
    364365      jsplt     = nn_jsplt 
     366!!gm to be remove at the end of the 2017 merge party 
     367      if( ln_timing ) then  ;  nn_timing = 1 
     368      else                  ;  nn_timing = 0 
     369      endif 
     370!!gm end 
    365371 
    366372 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DIA/diacfl.F90

    r7753 r8568  
    11MODULE diacfl 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                       ***  MODULE  diacfl  *** 
    44   !! Output CFL diagnostics to ascii file 
    5    !!============================================================================== 
    6    !! History :  1.0  !  2010-03  (E. Blockley)  Original code 
    7    !!                 !  2014-06  (T Graham) Removed CPP key & Updated to vn3.6 
    8    !!  
     5   !!====================================================================== 
     6   !! History :  3.4  !  2010-03  (E. Blockley)  Original code 
     7   !!            3.6  !  2014-06  (T. Graham) Removed CPP key & Updated to vn3.6 
     8   !!            4.0  !  2017-09  (G. Madec)  style + comments 
    99   !!---------------------------------------------------------------------- 
    1010   !!   dia_cfl        : Compute and output Courant numbers at each timestep 
    … …  
    1212   USE oce             ! ocean dynamics and active tracers 
    1313   USE dom_oce         ! ocean space and time domain 
     14   USE domvvl          !  
     15   ! 
    1416   USE lib_mpp         ! distribued memory computing 
    1517   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    1618   USE in_out_manager  ! I/O manager 
    17    USE domvvl      
    1819   USE timing          ! Performance output 
    1920 
    … …  
    2122   PRIVATE 
    2223 
    23    REAL(wp) :: cu_max, cv_max, cw_max                      ! Run max U Courant number  
    24    INTEGER, DIMENSION(3) :: cu_loc, cv_loc, cw_loc         ! Run max locations 
    25    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zcu_cfl           ! Courant number arrays 
    26    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zcv_cfl           ! Courant number arrays 
    27    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zcw_cfl           ! Courant number arrays 
     24   CHARACTER(LEN=50) :: clname="cfl_diagnostics.ascii"    ! ascii filename 
     25   INTEGER           :: numcfl                            ! outfile unit 
     26   ! 
     27   INTEGER, DIMENSION(3) ::   nCu_loc, nCv_loc, nCw_loc   ! U, V, and W run max locations in the global domain 
     28   REAL(wp)              ::   rCu_max, rCv_max, rCw_max   ! associated run max Courant number  
    2829 
    29    INTEGER  :: numcfl                                       ! outfile unit 
    30    CHARACTER(LEN=50) :: clname="cfl_diagnostics.ascii"      ! ascii filename 
     30!!gm CAUTION: need to declare these arrays here, otherwise the calculation fails in multi-proc ! 
     31!!gm          8 don't understand why. 
     32   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zCu_cfl, zCv_cfl, zCw_cfl         ! workspace 
     33!!gm end 
    3134 
    3235   PUBLIC   dia_cfl       ! routine called by step.F90 
    … …  
    4043   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4144   !!---------------------------------------------------------------------- 
    42  
    43  
    4445CONTAINS 
    45  
    4646 
    4747   SUBROUTINE dia_cfl ( kt ) 
    … …  
    5252      !!               and output to ascii file 'cfl_diagnostics.ascii' 
    5353      !!---------------------------------------------------------------------- 
     54      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     55      ! 
     56      INTEGER :: ji, jj, jk   ! dummy loop indices 
     57      REAL(wp)::   z2dt, zCu_max, zCv_max, zCw_max       ! local scalars 
     58      INTEGER , DIMENSION(3)           ::   iloc_u , iloc_v , iloc_w , iloc   ! workspace 
     59!!gm this does not work      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zCu_cfl, zCv_cfl, zCw_cfl         ! workspace 
     60      !!---------------------------------------------------------------------- 
     61      ! 
     62      IF( nn_timing == 1 )   CALL timing_start('dia_cfl') 
     63      ! 
     64      !                       ! setup timestep multiplier to account for initial Eulerian timestep 
     65      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;    z2dt = rdt 
     66      ELSE                                        ;    z2dt = rdt * 2._wp 
     67      ENDIF 
     68      ! 
     69      !                 
     70      DO jk = 1, jpk       ! calculate Courant numbers 
     71         DO jj = 1, jpj 
     72            DO ji = 1, fs_jpim1   ! vector opt. 
     73               zCu_cfl(ji,jj,jk) = ABS( un(ji,jj,jk) ) * z2dt / e1u  (ji,jj)      ! for i-direction 
     74               zCv_cfl(ji,jj,jk) = ABS( vn(ji,jj,jk) ) * z2dt / e2v  (ji,jj)      ! for j-direction 
     75               zCw_cfl(ji,jj,jk) = ABS( wn(ji,jj,jk) ) * z2dt / e3w_n(ji,jj,jk)   ! for k-direction 
     76            END DO 
     77         END DO          
     78      END DO 
     79      ! 
     80      !                    ! calculate maximum values and locations 
     81      IF( lk_mpp ) THEN 
     82         CALL mpp_maxloc( zCu_cfl, umask, zCu_max, iloc_u(1), iloc_u(2), iloc_u(3) ) 
     83         CALL mpp_maxloc( zCv_cfl, vmask, zCv_max, iloc_v(1), iloc_v(2), iloc_v(3) ) 
     84         CALL mpp_maxloc( zCw_cfl, wmask, zCw_max, iloc_w(1), iloc_w(2), iloc_w(3) ) 
     85      ELSE 
     86         iloc = MAXLOC( ABS( zcu_cfl(:,:,:) ) ) 
     87         iloc_u(1) = iloc(1) + nimpp - 1 
     88         iloc_u(2) = iloc(2) + njmpp - 1 
     89         iloc_u(3) = iloc(3) 
     90         zCu_max = zCu_cfl(iloc(1),iloc(2),iloc(3)) 
     91         ! 
     92         iloc = MAXLOC( ABS( zcv_cfl(:,:,:) ) ) 
     93         iloc_v(1) = iloc(1) + nimpp - 1 
     94         iloc_v(2) = iloc(2) + njmpp - 1 
     95         iloc_v(3) = iloc(3) 
     96         zCv_max = zCv_cfl(iloc(1),iloc(2),iloc(3)) 
     97         ! 
     98         iloc = MAXLOC( ABS( zcw_cfl(:,:,:) ) ) 
     99         iloc_w(1) = iloc(1) + nimpp - 1 
     100         iloc_w(2) = iloc(2) + njmpp - 1 
     101         iloc_w(3) = iloc(3) 
     102         zCw_max = zCw_cfl(iloc(1),iloc(2),iloc(3)) 
     103      ENDIF 
     104      ! 
     105      !                    ! write out to file 
     106      IF( lwp ) THEN 
     107         WRITE(numcfl,FMT='(2x,i4,5x,a6,5x,f6.4,1x,i4,1x,i4,1x,i4)') kt, 'Max Cu', zCu_max, iloc_u(1), iloc_u(2), iloc_u(3) 
     108         WRITE(numcfl,FMT='(11x,     a6,5x,f6.4,1x,i4,1x,i4,1x,i4)')     'Max Cv', zCv_max, iloc_v(1), iloc_v(2), iloc_v(3) 
     109         WRITE(numcfl,FMT='(11x,     a6,5x,f6.4,1x,i4,1x,i4,1x,i4)')     'Max Cw', zCw_max, iloc_w(1), iloc_w(2), iloc_w(3) 
     110      ENDIF 
     111      ! 
     112      !                    ! update maximum Courant numbers from whole run if applicable 
     113      IF( zCu_max > rCu_max ) THEN   ;   rCu_max = zCu_max   ;   nCu_loc(:) = iloc_u(:)   ;   ENDIF 
     114      IF( zCv_max > rCv_max ) THEN   ;   rCv_max = zCv_max   ;   nCv_loc(:) = iloc_v(:)   ;   ENDIF 
     115      IF( zCw_max > rCw_max ) THEN   ;   rCw_max = zCw_max   ;   nCw_loc(:) = iloc_w(:)   ;   ENDIF 
    54116 
    55       INTEGER, INTENT(in) ::  kt                            ! ocean time-step index 
     117      !                    ! at end of run output max Cu and Cv and close ascii file 
     118      IF( kt == nitend .AND. lwp ) THEN 
     119         ! to ascii file 
     120         WRITE(numcfl,*) '******************************************' 
     121         WRITE(numcfl,FMT='(3x,a12,7x,f6.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cu', rCu_max, nCu_loc(1), nCu_loc(2), nCu_loc(3) 
     122         WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', z2dt/rCu_max 
     123         WRITE(numcfl,*) '******************************************' 
     124         WRITE(numcfl,FMT='(3x,a12,7x,f6.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cv', rCv_max, nCv_loc(1), nCv_loc(2), nCv_loc(3) 
     125         WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', z2dt/rCv_max 
     126         WRITE(numcfl,*) '******************************************' 
     127         WRITE(numcfl,FMT='(3x,a12,7x,f6.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cw', rCw_max, nCw_loc(1), nCw_loc(2), nCw_loc(3) 
     128         WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', z2dt/rCw_max 
     129         CLOSE( numcfl )  
     130         ! 
     131         ! to ocean output 
     132         WRITE(numout,*) 
     133         WRITE(numout,*) 'dia_cfl : Maximum Courant number information for the run ' 
     134         WRITE(numout,*) '~~~~~~~' 
     135         WRITE(numout,*) '   Max Cu = ', rCu_max, ' at (i,j,k) = (',nCu_loc(1),nCu_loc(2),nCu_loc(3),') => dt/C = ', z2dt/rCu_max 
     136         WRITE(numout,*) '   Max Cv = ', rCv_max, ' at (i,j,k) = (',nCv_loc(1),nCv_loc(2),nCv_loc(3),') => dt/C = ', z2dt/rCv_max 
     137         WRITE(numout,*) '   Max Cw = ', rCw_max, ' at (i,j,k) = (',nCw_loc(1),nCw_loc(2),nCw_loc(3),') => dt/C = ', z2dt/rCw_max 
     138      ENDIF 
     139      ! 
     140      IF( nn_timing == 1 )   CALL timing_stop('dia_cfl') 
     141      ! 
     142   END SUBROUTINE dia_cfl 
    56143 
    57       REAL(wp) :: zcu_max, zcv_max, zcw_max                 ! max Courant numbers per timestep 
    58       INTEGER, DIMENSION(3) :: zcu_loc, zcv_loc, zcw_loc    ! max Courant number locations 
    59  
    60       REAL(wp) :: dt                                        ! temporary scalars 
    61       INTEGER, DIMENSION(3) :: zlocu, zlocv, zlocw          ! temporary arrays  
    62       INTEGER  :: ji, jj, jk                                ! dummy loop indices 
    63  
    64        
    65       IF( nn_diacfl == 1) THEN 
    66          IF( nn_timing == 1 )   CALL timing_start('dia_cfl') 
    67          ! setup timestep multiplier to account for initial Eulerian timestep 
    68          IF( neuler == 0 .AND. kt == nit000 ) THEN   ;    dt = rdt 
    69          ELSE                                        ;    dt = rdt * 2.0 
    70          ENDIF 
    71  
    72              ! calculate Courant numbers 
    73          DO jk = 1, jpk 
    74             DO jj = 1, jpj 
    75                DO ji = 1, fs_jpim1   ! vector opt. 
    76  
    77                   ! Courant number for x-direction (zonal current) 
    78                   zcu_cfl(ji,jj,jk) = ABS(un(ji,jj,jk))*dt/e1u(ji,jj) 
    79  
    80                   ! Courant number for y-direction (meridional current) 
    81                   zcv_cfl(ji,jj,jk) = ABS(vn(ji,jj,jk))*dt/e2v(ji,jj) 
    82  
    83                   ! Courant number for z-direction (vertical current) 
    84                   zcw_cfl(ji,jj,jk) = ABS(wn(ji,jj,jk))*dt/e3w_n(ji,jj,jk) 
    85                END DO 
    86             END DO          
    87          END DO 
    88  
    89          ! calculate maximum values and locations 
    90          IF( lk_mpp ) THEN 
    91             CALL mpp_maxloc(zcu_cfl,umask,zcu_max, zcu_loc(1), zcu_loc(2), zcu_loc(3)) 
    92             CALL mpp_maxloc(zcv_cfl,vmask,zcv_max, zcv_loc(1), zcv_loc(2), zcv_loc(3)) 
    93             CALL mpp_maxloc(zcw_cfl,tmask,zcw_max, zcw_loc(1), zcw_loc(2), zcw_loc(3)) 
    94          ELSE 
    95             zlocu = MAXLOC( ABS( zcu_cfl(:,:,:) ) ) 
    96             zcu_loc(1) = zlocu(1) + nimpp - 1 
    97             zcu_loc(2) = zlocu(2) + njmpp - 1 
    98             zcu_loc(3) = zlocu(3) 
    99             zcu_max = zcu_cfl(zcu_loc(1),zcu_loc(2),zcu_loc(3)) 
    100  
    101             zlocv = MAXLOC( ABS( zcv_cfl(:,:,:) ) ) 
    102             zcv_loc(1) = zlocv(1) + nimpp - 1 
    103             zcv_loc(2) = zlocv(2) + njmpp - 1 
    104             zcv_loc(3) = zlocv(3) 
    105             zcv_max = zcv_cfl(zcv_loc(1),zcv_loc(2),zcv_loc(3)) 
    106  
    107             zlocw = MAXLOC( ABS( zcw_cfl(:,:,:) ) ) 
    108             zcw_loc(1) = zlocw(1) + nimpp - 1 
    109             zcw_loc(2) = zlocw(2) + njmpp - 1 
    110             zcw_loc(3) = zlocw(3) 
    111             zcw_max = zcw_cfl(zcw_loc(1),zcw_loc(2),zcw_loc(3)) 
    112          ENDIF 
    113        
    114          ! write out to file 
    115          IF( lwp ) THEN 
    116             WRITE(numcfl,FMT='(2x,i4,5x,a6,5x,f6.4,1x,i4,1x,i4,1x,i4)') kt, 'Max Cu', zcu_max, zcu_loc(1), zcu_loc(2), zcu_loc(3) 
    117             WRITE(numcfl,FMT='(11x,a6,5x,f6.4,1x,i4,1x,i4,1x,i4)') 'Max Cv', zcv_max, zcv_loc(1), zcv_loc(2), zcv_loc(3) 
    118             WRITE(numcfl,FMT='(11x,a6,5x,f6.4,1x,i4,1x,i4,1x,i4)') 'Max Cw', zcw_max, zcw_loc(1), zcw_loc(2), zcw_loc(3) 
    119          ENDIF 
    120  
    121          ! update maximum Courant numbers from whole run if applicable 
    122          IF( zcu_max > cu_max ) THEN 
    123             cu_max = zcu_max 
    124             cu_loc = zcu_loc 
    125          ENDIF 
    126          IF( zcv_max > cv_max ) THEN 
    127             cv_max = zcv_max 
    128             cv_loc = zcv_loc 
    129          ENDIF 
    130          IF( zcw_max > cw_max ) THEN 
    131             cw_max = zcw_max 
    132             cw_loc = zcw_loc 
    133          ENDIF 
    134  
    135          ! at end of run output max Cu and Cv and close ascii file 
    136          IF( kt == nitend .AND. lwp ) THEN 
    137             ! to ascii file 
    138             WRITE(numcfl,*) '******************************************' 
    139             WRITE(numcfl,FMT='(3x,a12,7x,f6.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cu', cu_max, cu_loc(1), cu_loc(2), cu_loc(3) 
    140             WRITE(numcfl,FMT='(3x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cu_max) 
    141             WRITE(numcfl,*) '******************************************' 
    142             WRITE(numcfl,FMT='(3x,a12,7x,f6.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cv', cv_max, cv_loc(1), cv_loc(2), cv_loc(3) 
    143             WRITE(numcfl,FMT='(3x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cv_max) 
    144             WRITE(numcfl,*) '******************************************' 
    145             WRITE(numcfl,FMT='(3x,a12,7x,f6.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cw', cw_max, cw_loc(1), cw_loc(2), cw_loc(3) 
    146             WRITE(numcfl,FMT='(3x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cw_max) 
    147             CLOSE( numcfl )  
    148  
    149             ! to ocean output 
    150             WRITE(numout,*) 
    151             WRITE(numout,*) 'dia_cfl     : Maximum Courant number information for the run:' 
    152             WRITE(numout,*) '~~~~~~~~~~~~' 
    153             WRITE(numout,FMT='(12x,a12,7x,f6.4,5x,a16,i4,1x,i4,1x,i4,a1)') 'Run Max Cu', cu_max, 'at (i, j, k) = (', cu_loc(1), cu_loc(2), cu_loc(3), ')' 
    154             WRITE(numout,FMT='(12x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cu_max) 
    155             WRITE(numout,FMT='(12x,a12,7x,f6.4,5x,a16,i4,1x,i4,1x,i4,a1)') 'Run Max Cv', cv_max, 'at (i, j, k) = (', cv_loc(1), cv_loc(2), cv_loc(3), ')' 
    156             WRITE(numout,FMT='(12x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cv_max) 
    157             WRITE(numout,FMT='(12x,a12,7x,f6.4,5x,a16,i4,1x,i4,1x,i4,a1)') 'Run Max Cw', cw_max, 'at (i, j, k) = (', cw_loc(1), cw_loc(2), cw_loc(3), ')' 
    158             WRITE(numout,FMT='(12x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cw_max) 
    159  
    160          ENDIF 
    161  
    162          IF( nn_timing == 1 )   CALL timing_stop('dia_cfl') 
    163       ENDIF 
    164  
    165    END SUBROUTINE dia_cfl 
    166144 
    167145   SUBROUTINE dia_cfl_init 
    … …  
    171149      !! ** Purpose :   create output file, initialise arrays 
    172150      !!---------------------------------------------------------------------- 
    173  
    174  
    175       IF( nn_diacfl == 1 ) THEN 
    176          IF( nn_timing == 1 )   CALL timing_start('dia_cfl_init') 
    177  
    178          cu_max=0.0 
    179          cv_max=0.0 
    180          cw_max=0.0 
    181  
    182          ALLOCATE( zcu_cfl(jpi, jpj, jpk), zcv_cfl(jpi, jpj, jpk), zcw_cfl(jpi, jpj, jpk) ) 
    183  
    184          zcu_cfl(:,:,:)=0.0 
    185          zcv_cfl(:,:,:)=0.0 
    186          zcw_cfl(:,:,:)=0.0 
    187  
    188          IF( lwp ) THEN 
    189             WRITE(numout,*) 
    190             WRITE(numout,*) 'dia_cfl     : Outputting CFL diagnostics to '//TRIM(clname) 
    191             WRITE(numout,*) '~~~~~~~~~~~~' 
    192             WRITE(numout,*) 
    193  
    194             ! create output ascii file 
    195             CALL ctl_opn( numcfl, clname, 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 ) 
    196             WRITE(numcfl,*) 'Timestep  Direction  Max C     i    j    k' 
    197             WRITE(numcfl,*) '******************************************' 
    198          ENDIF 
    199  
    200          IF( nn_timing == 1 )   CALL timing_stop('dia_cfl_init') 
    201  
     151      ! 
     152      IF(lwp) THEN 
     153         WRITE(numout,*) 
     154         WRITE(numout,*) 'dia_cfl : Outputting CFL diagnostics to ',TRIM(clname), ' file' 
     155         WRITE(numout,*) '~~~~~~~' 
     156         WRITE(numout,*) 
     157         ! 
     158         ! create output ascii file 
     159         CALL ctl_opn( numcfl, clname, 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 ) 
     160         WRITE(numcfl,*) 'Timestep  Direction  Max C     i    j    k' 
     161         WRITE(numcfl,*) '******************************************' 
    202162      ENDIF 
    203  
     163      ! 
     164      rCu_max = 0._wp 
     165      rCv_max = 0._wp 
     166      rCw_max = 0._wp 
     167      ! 
     168!!gm required to work 
     169      ALLOCATE ( zCu_cfl(jpi,jpj,jpk), zCv_cfl(jpi,jpj,jpk), zCw_cfl(jpi,jpj,jpk) ) 
     170!!gm end 
     171      !       
    204172   END SUBROUTINE dia_cfl_init 
    205173 
     174   !!====================================================================== 
    206175END MODULE diacfl 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90

    r7646 r8568  
    222222      !!---------------------------------------------------------------------- 
    223223      ! 
    224       IF( nn_timing == 1 )  CALL timing_start('day') 
     224      IF( ln_timing )   CALL timing_start('day') 
    225225      ! 
    226226      zprec = 0.1 / rday 
    … …  
    276276      IF( lrst_oce         ) CALL day_rst( kt, 'WRITE' )      ! write day restart information 
    277277      ! 
    278       IF( nn_timing == 1 )  CALL timing_stop('day') 
     278      IF( ln_timing )   CALL timing_stop('day') 
    279279      ! 
    280280   END SUBROUTINE day 
    … …  
    402402         CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj            )   ! number of elapsed days since 
    403403         !                                                                     ! the begining of the run [s] 
    404     CALL iom_rstput( kt, nitrst, numrow, 'ntime'  , REAL( nn_time0, wp) ) ! time 
     404         CALL iom_rstput( kt, nitrst, numrow, 'ntime'  , REAL( nn_time0, wp) ) ! time 
    405405      ENDIF 
    406406      ! 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/depth_e3.F90

    r7753 r8568  
    2020   USE lbclnk            ! ocean lateral boundary conditions (or mpp link) 
    2121   USE lib_mpp           ! distributed memory computing library 
    22    USE wrk_nemo          ! Memory allocation 
    2322   USE timing            ! Timing 
    2423 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r7822 r8568  
    4545   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
    4646   USE lib_mpp        ! distributed memory computing library 
    47    USE wrk_nemo       ! Memory Allocation 
    4847   USE timing         ! Timing 
    4948 
    … …  
    8382      !!---------------------------------------------------------------------- 
    8483      ! 
    85       IF( nn_timing == 1 )   CALL timing_start('dom_init') 
     84      IF( ln_timing )   CALL timing_start('dom_init') 
    8685      ! 
    8786      IF(lwp) THEN         ! Ocean domain Parameters (control print) 
    … …  
    199198      IF( ln_write_cfg )   CALL cfg_write         ! create the configuration file 
    200199      ! 
    201       IF( nn_timing == 1 )   CALL timing_stop('dom_init') 
     200      IF( ln_timing )   CALL timing_stop('dom_init') 
    202201      ! 
    203202   END SUBROUTINE dom_init 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

    r7753 r8568  
    7979      !!---------------------------------------------------------------------- 
    8080      ! 
    81       IF( nn_timing == 1 )  CALL timing_start('dom_hgr') 
     81      IF( ln_timing )   CALL timing_start('dom_hgr') 
    8282      ! 
    8383      IF(lwp) THEN 
    … …  
    152152      ! 
    153153      ! 
    154       IF( nn_timing == 1 )  CALL timing_stop('dom_hgr') 
     154      IF( ln_timing )   CALL timing_stop('dom_hgr') 
    155155      ! 
    156156   END SUBROUTINE dom_hgr 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r7753 r8568  
    3030   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    3131   USE lib_mpp        ! Massively Parallel Processing library 
    32    USE wrk_nemo       ! Memory allocation 
    3332   USE timing         ! Timing 
    3433 
    … …  
    9291      INTEGER  ::   iktop, ikbot   !   -       - 
    9392      INTEGER  ::   ios, inum 
    94       REAL(wp), POINTER, DIMENSION(:,:) ::   zwf   ! 2D workspace 
     93      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zwf   ! 2D workspace 
    9594      !! 
    9695      NAMELIST/namlbc/ rn_shlat, ln_vorlat 
    … …  
    104103      !!--------------------------------------------------------------------- 
    105104      ! 
    106       IF( nn_timing == 1 )  CALL timing_start('dom_msk') 
     105      IF( ln_timing )   CALL timing_start('dom_msk') 
    107106      ! 
    108107      REWIND( numnam_ref )              ! Namelist namlbc in reference namelist : Lateral momentum boundary condition 
    … …  
    248247      IF( rn_shlat /= 0 ) THEN      ! Not free-slip lateral boundary condition 
    249248         ! 
    250          CALL wrk_alloc( jpi,jpj,   zwf ) 
     249         ALLOCATE( zwf(jpi,jpj) ) 
    251250         ! 
    252251         DO jk = 1, jpk 
    … …  
    278277         END DO 
    279278         ! 
    280          CALL wrk_dealloc( jpi,jpj,  zwf ) 
     279         DEALLOCATE( zwf ) 
    281280         ! 
    282281         CALL lbc_lnk( fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask 
    … …  
    292291      ! 
    293292      ! 
    294       IF( nn_timing == 1 )  CALL timing_stop('dom_msk') 
     293      IF( ln_timing )   CALL timing_stop('dom_msk') 
    295294      ! 
    296295   END SUBROUTINE dom_msk 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90

    r7646 r8568  
    1111   !!---------------------------------------------------------------------- 
    1212   USE dom_oce        ! ocean space and time domain 
     13   ! 
    1314   USE in_out_manager ! I/O manager 
    1415   USE lib_mpp        ! for mppsum 
    15    USE wrk_nemo       ! Memory allocation 
    1616   USE timing         ! Timing 
    1717 
    … …  
    4545      INTEGER , DIMENSION(2) ::   iloc 
    4646      REAL(wp)               ::   zlon, zmini 
    47       REAL(wp), POINTER, DIMENSION(:,:) ::  zglam, zgphi, zmask, zdist 
     47      REAL(wp), DIMENSION(jpi,jpj) ::   zglam, zgphi, zmask, zdist 
    4848      !!-------------------------------------------------------------------- 
    4949      ! 
    50       IF( nn_timing == 1 )  CALL timing_start('dom_ngb') 
    51       ! 
    52       CALL wrk_alloc( jpi,jpj,   zglam, zgphi, zmask, zdist ) 
     50      IF( ln_timing )   CALL timing_start('dom_ngb') 
    5351      ! 
    5452      zmask(:,:) = 0._wp 
    … …  
    7977      ENDIF 
    8078      ! 
    81       CALL wrk_dealloc( jpi,jpj,   zglam, zgphi, zmask, zdist ) 
    82       ! 
    83       IF( nn_timing == 1 )  CALL timing_stop('dom_ngb') 
     79      IF( ln_timing )   CALL timing_stop('dom_ngb') 
    8480      ! 
    8581   END SUBROUTINE dom_ngb 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r7753 r8568  
    66   !! History :  2.0  !  2006-06  (B. Levier, L. Marie)  original code 
    77   !!            3.1  !  2009-02  (G. Madec, M. Leclair, R. Benshila)  pure z* coordinate 
    8    !!            3.3  !  2011-10  (M. Leclair) totally rewrote domvvl: 
    9    !!                                          vvl option includes z_star and z_tilde coordinates 
     8   !!            3.3  !  2011-10  (M. Leclair) totally rewrote domvvl: vvl option includes z_star and z_tilde coordinates 
    109   !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability 
    1110   !!---------------------------------------------------------------------- 
    … …  
    3130   USE lib_mpp         ! distributed memory computing library 
    3231   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    33    USE wrk_nemo        ! Memory allocation 
    3432   USE timing          ! Timing 
    3533 
    … …  
    122120      !!---------------------------------------------------------------------- 
    123121      ! 
    124       IF( nn_timing == 1 )   CALL timing_start('dom_vvl_init') 
     122      IF( ln_timing )   CALL timing_start('dom_vvl_init') 
    125123      ! 
    126124      IF(lwp) WRITE(numout,*) 
    … …  
    242240      ENDIF 
    243241      ! 
    244       IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_init') 
     242      IF( ln_timing )   CALL timing_stop('dom_vvl_init') 
    245243      ! 
    246244   END SUBROUTINE dom_vvl_init 
    … …  
    276274      REAL(wp)               ::   z2dt, z_tmin, z_tmax  ! local scalars 
    277275      LOGICAL                ::   ll_do_bclinic         ! local logical 
    278       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze3t 
    279       REAL(wp), POINTER, DIMENSION(:,:  ) ::   zht, z_scale, zwu, zwv, zhdiv 
     276      REAL(wp), DIMENSION(jpi,jpj)     ::   zht, z_scale, zwu, zwv, zhdiv 
     277      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3t 
    280278      !!---------------------------------------------------------------------- 
    281279      ! 
    282280      IF( ln_linssh )   RETURN      ! No calculation in linear free surface 
    283281      ! 
    284       IF( nn_timing == 1 )   CALL timing_start('dom_vvl_sf_nxt') 
    285       ! 
    286       CALL wrk_alloc( jpi,jpj,zht,   z_scale, zwu, zwv, zhdiv ) 
    287       CALL wrk_alloc( jpi,jpj,jpk,   ze3t ) 
    288  
     282      IF( ln_timing )   CALL timing_start('dom_vvl_sf_nxt') 
     283      ! 
    289284      IF( kt == nit000 ) THEN 
    290285         IF(lwp) WRITE(numout,*) 
    … …  
    543538      r1_hv_a(:,:) = ssvmask(:,:) / ( hv_a(:,:) + 1._wp - ssvmask(:,:) ) 
    544539      ! 
    545       CALL wrk_dealloc( jpi,jpj,       zht, z_scale, zwu, zwv, zhdiv ) 
    546       CALL wrk_dealloc( jpi,jpj,jpk,   ze3t ) 
    547       ! 
    548       IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_sf_nxt') 
     540      IF( ln_timing )   CALL timing_stop('dom_vvl_sf_nxt') 
    549541      ! 
    550542   END SUBROUTINE dom_vvl_sf_nxt 
    … …  
    583575      IF( ln_linssh )   RETURN      ! No calculation in linear free surface 
    584576      ! 
    585       IF( nn_timing == 1 )  CALL timing_start('dom_vvl_sf_swp') 
     577      IF( ln_timing )   CALL timing_start('dom_vvl_sf_swp') 
    586578      ! 
    587579      IF( kt == nit000 )   THEN 
    … …  
    657649      ! write restart file 
    658650      ! ================== 
    659       IF( lrst_oce )   CALL dom_vvl_rst( kt, 'WRITE' ) 
    660       ! 
    661       IF( nn_timing == 1 )   CALL timing_stop('dom_vvl_sf_swp') 
     651      IF( lrst_oce  )   CALL dom_vvl_rst( kt, 'WRITE' ) 
     652      ! 
     653      IF( ln_timing )   CALL timing_stop('dom_vvl_sf_swp') 
    662654      ! 
    663655   END SUBROUTINE dom_vvl_sf_swp 
    … …  
    683675      !!---------------------------------------------------------------------- 
    684676      ! 
    685       IF( nn_timing == 1 )   CALL timing_start('dom_vvl_interpol') 
     677      IF( ln_timing )   CALL timing_start('dom_vvl_interpol') 
    686678      ! 
    687679      IF(ln_wd) THEN 
    … …  
    770762      END SELECT 
    771763      ! 
    772       IF( nn_timing == 1 )   CALL timing_stop('dom_vvl_interpol') 
     764      IF( ln_timing )   CALL timing_stop('dom_vvl_interpol') 
    773765      ! 
    774766   END SUBROUTINE dom_vvl_interpol 
    … …  
    794786      !!---------------------------------------------------------------------- 
    795787      ! 
    796       IF( nn_timing == 1 )  CALL timing_start('dom_vvl_rst') 
     788      IF( ln_timing )   CALL timing_start('dom_vvl_rst') 
     789      ! 
    797790      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise  
    798791         !                                   ! =============== 
    … …  
    947940      ENDIF 
    948941      ! 
    949       IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_rst') 
     942      IF( ln_timing )   CALL timing_stop('dom_vvl_rst') 
    950943      ! 
    951944   END SUBROUTINE dom_vvl_rst 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90

    r7646 r8568  
    2424   USE lbclnk          ! lateral boundary conditions - mpp exchanges 
    2525   USE lib_mpp         ! MPP library 
    26    USE wrk_nemo        ! Memory allocation 
    2726   USE timing          ! Timing 
    2827 
    … …  
    7574      INTEGER           ::   izco, izps, isco, icav 
    7675      !                                
    77       REAL(wp), POINTER, DIMENSION(:,:)   ::   zprt, zprw     ! 2D workspace 
    78       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdepu, zdepv   ! 3D workspace 
    79       !!---------------------------------------------------------------------- 
    80       ! 
    81       IF( nn_timing == 1 )  CALL timing_start('dom_wri') 
    82       ! 
    83       CALL wrk_alloc( jpi,jpj,       zprt , zprw  ) 
    84       CALL wrk_alloc( jpi,jpj,jpk,   zdepu, zdepv ) 
     76      REAL(wp), DIMENSION(jpi,jpj)     ::   zprt, zprw     ! 2D workspace 
     77      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdepu, zdepv   ! 3D workspace 
     78      !!---------------------------------------------------------------------- 
     79      ! 
     80      IF( ln_timing )   CALL timing_start('dom_wri') 
    8581      ! 
    8682      IF(lwp) WRITE(numout,*) 
    … …  
    206202      !                                     ! ============================ 
    207203      ! 
    208       CALL wrk_dealloc( jpi, jpj, zprt, zprw ) 
    209       CALL wrk_dealloc( jpi, jpj, jpk, zdepu, zdepv ) 
    210       ! 
    211       IF( nn_timing == 1 )  CALL timing_stop('dom_wri') 
     204      IF( ln_timing )   CALL timing_stop('dom_wri') 
    212205      ! 
    213206   END SUBROUTINE dom_wri 
    … …  
    229222      INTEGER  ::  ji       ! dummy loop indices 
    230223      LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) ::  lldbl  ! store whether each point is unique or not 
    231       REAL(wp), POINTER, DIMENSION(:,:) :: ztstref 
    232       !!---------------------------------------------------------------------- 
    233       ! 
    234       IF( nn_timing == 1 )  CALL timing_start('dom_uniq') 
    235       ! 
    236       CALL wrk_alloc( jpi, jpj, ztstref ) 
     224      REAL(wp), DIMENSION(jpi,jpj) ::   ztstref 
     225      !!---------------------------------------------------------------------- 
     226      ! 
     227      IF( ln_timing )   CALL timing_start('dom_uniq') 
    237228      ! 
    238229      ! build an array with different values for each element  
    … …  
    250241      puniq(nldi:nlei,nldj:nlej) = REAL( COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ) , wp ) 
    251242      ! 
    252       CALL wrk_dealloc( jpi, jpj, ztstref ) 
    253       ! 
    254       IF( nn_timing == 1 )  CALL timing_stop('dom_uniq') 
     243      IF( ln_timing )   CALL timing_stop('dom_uniq') 
    255244      ! 
    256245   END SUBROUTINE dom_uniq 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r7753 r8568  
    3636   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    3737   USE lib_mpp        ! distributed memory computing library 
    38    USE wrk_nemo       ! Memory allocation 
    3938   USE timing         ! Timing 
    4039 
    … …  
    7776      !!---------------------------------------------------------------------- 
    7877      ! 
    79       IF( nn_timing == 1 )   CALL timing_start('dom_zgr') 
     78      IF( ln_timing )   CALL timing_start('dom_zgr') 
    8079      ! 
    8180      IF(lwp) THEN                     ! Control print 
    … …  
    164163      ENDIF 
    165164      ! 
    166       IF( nn_timing == 1 )  CALL timing_stop('dom_zgr') 
     165      IF( ln_timing )   CALL timing_stop('dom_zgr') 
    167166      ! 
    168167   END SUBROUTINE dom_zgr 
    … …  
    284283      ! 
    285284      INTEGER ::   ji, jj   ! dummy loop indices 
    286       REAL(wp), POINTER, DIMENSION(:,:) ::  zk 
    287       !!---------------------------------------------------------------------- 
    288       ! 
    289       IF( nn_timing == 1 )  CALL timing_start('zgr_top_bot') 
    290       ! 
    291       CALL wrk_alloc( jpi,jpj,   zk ) 
     285      REAL(wp), DIMENSION(jpi,jpj) ::   zk   ! workspace 
     286      !!---------------------------------------------------------------------- 
     287      ! 
     288      IF( ln_timing )   CALL timing_start('zgr_top_bot') 
    292289      ! 
    293290      IF(lwp) WRITE(numout,*) 
    … …  
    319316      zk(:,:) = REAL( mbkv(:,:), wp )   ;   CALL lbc_lnk( zk, 'V', 1. )   ;   mbkv(:,:) = MAX( INT( zk(:,:) ), 1 ) 
    320317      ! 
    321       CALL wrk_dealloc( jpi,jpj,   zk ) 
    322       ! 
    323       IF( nn_timing == 1 )  CALL timing_stop('zgr_top_bot') 
     318      IF( ln_timing )   CALL timing_stop('zgr_top_bot') 
    324319      ! 
    325320   END SUBROUTINE zgr_top_bot 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90

    r7753 r8568  
    1616   !!---------------------------------------------------------------------- 
    1717   USE oce             ! ocean dynamics and tracers 
     18   USE phycst          ! physical constants 
    1819   USE dom_oce         ! ocean space and time domain 
    1920   USE fldread         ! read input fields 
     21   ! 
    2022   USE in_out_manager  ! I/O manager 
    21    USE phycst          ! physical constants 
    2223   USE lib_mpp         ! MPP library 
    23    USE wrk_nemo        ! Memory allocation 
    2424   USE timing          ! Timing 
    2525 
    … …  
    6262      !!---------------------------------------------------------------------- 
    6363      ! 
    64       IF( nn_timing == 1 )  CALL timing_start('dta_tsd_init') 
     64      IF( ln_timing )   CALL timing_start('dta_tsd_init') 
    6565      ! 
    6666      !  Initialisation 
    … …  
    120120      ENDIF 
    121121      ! 
    122       IF( nn_timing == 1 )  CALL timing_stop('dta_tsd_init') 
     122      IF( ln_timing )   CALL timing_stop('dta_tsd_init') 
    123123      ! 
    124124   END SUBROUTINE dta_tsd_init 
    … …  
    145145      INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies 
    146146      INTEGER ::   ik, il0, il1, ii0, ii1, ij0, ij1   ! local integers 
    147       REAL(wp)::   zl, zi 
    148       REAL(wp), POINTER, DIMENSION(:) ::  ztp, zsp   ! 1D workspace 
    149       !!---------------------------------------------------------------------- 
    150       ! 
    151       IF( nn_timing == 1 )  CALL timing_start('dta_tsd') 
     147      REAL(wp)::   zl, zi                             ! local scalars 
     148      REAL(wp), DIMENSION(jpk) ::  ztp, zsp   ! 1D workspace 
     149      !!---------------------------------------------------------------------- 
     150      ! 
     151      IF( ln_timing )   CALL timing_start('dta_tsd') 
    152152      ! 
    153153      CALL fld_read( kt, 1, sf_tsd )      !==   read T & S data at kt time step   ==! 
    … …  
    185185      ! 
    186186      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==! 
    187          ! 
    188          CALL wrk_alloc( jpk, ztp, zsp ) 
    189187         ! 
    190188         IF( kt == nit000 .AND. lwp )THEN 
    … …  
    222220         END DO 
    223221         !  
    224          CALL wrk_dealloc( jpk, ztp, zsp ) 
    225          !  
    226222      ELSE                                !==   z- or zps- coordinate   ==! 
    227223         !                              
    … …  
    260256      ENDIF 
    261257      ! 
    262       IF( nn_timing == 1 )  CALL timing_stop('dta_tsd') 
     258      IF( ln_timing )   CALL timing_stop('dta_tsd') 
    263259      ! 
    264260   END SUBROUTINE dta_tsd 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90

    r7646 r8568  
    1313   !!   iscpl_div      : correction of divergence to keep volume conservation 
    1414   !!---------------------------------------------------------------------- 
     15   USE oce             ! global tra/dyn variable 
    1516   USE dom_oce         ! ocean space and time domain 
    1617   USE domwri          ! ocean space and time domain 
     18   USE domngb          !  
    1719   USE phycst          ! physical constants 
    1820   USE sbc_oce         ! surface boundary condition variables 
    19    USE oce             ! global tra/dyn variable 
     21   USE iscplini        !  
     22   ! 
    2023   USE in_out_manager  ! I/O manager 
    2124   USE lib_mpp         ! MPP library 
    2225   USE lib_fortran     ! MPP library 
    23    USE wrk_nemo        ! Memory allocation 
    2426   USE lbclnk          ! 
    25    USE domngb          ! 
    26    USE iscplini 
    2727 
    2828   IMPLICIT NONE 
    … …  
    5656      REAL(wp), DIMENSION(:,:,:  ), INTENT(out) :: pvol_flx    !! corrective flux to have volume conservation 
    5757      REAL(wp),                     INTENT(in ) :: prdt_iscpl  !! coupling period  
    58       !! 
    59       INTEGER :: ji, jj, jk                                    !! loop index 
    60       INTEGER :: jip1, jim1, jjp1, jjm1 
    61       !! 
    62       REAL(wp):: summsk, zsum, zsum1, zarea, zsumn, zsumb 
    63       REAL(wp):: r1_rdtiscpl 
    64       REAL(wp):: zjip1_ratio  , zjim1_ratio  , zjjp1_ratio  , zjjm1_ratio 
    65       !! 
    66       REAL(wp):: zde3t, zdtem, zdsal 
    67       REAL(wp), DIMENSION(:,:), POINTER :: zdssh 
    68       !! 
    69       REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon, zlat 
    70       REAL(wp), DIMENSION(:), ALLOCATABLE :: zcorr_vol, zcorr_tem, zcorr_sal 
    71       INTEGER , DIMENSION(:), ALLOCATABLE :: ixpts, iypts, izpts, inpts 
     58      ! 
     59      INTEGER  ::   ji  , jj  , jk           ! loop index 
     60      INTEGER  ::   jip1, jim1, jjp1, jjm1 
     61      REAL(wp) ::   summsk, zsum , zsumn, zjip1_ratio  , zjim1_ratio, zdtem, zde3t, z1_rdtiscpl 
     62      REAL(wp) ::   zarea , zsum1, zsumb, zjjp1_ratio  , zjjm1_ratio, zdsal 
     63      REAL(wp), DIMENSION(jpi,jpj)        ::   zdssh   ! workspace 
     64      REAL(wp), DIMENSION(:), ALLOCATABLE ::   zlon, zlat 
     65      REAL(wp), DIMENSION(:), ALLOCATABLE ::   zcorr_vol, zcorr_tem, zcorr_sal 
     66      INTEGER , DIMENSION(:), ALLOCATABLE ::   ixpts, iypts, izpts, inpts 
    7267      INTEGER :: jpts, npts 
    73  
    74       CALL wrk_alloc(jpi,jpj, zdssh ) 
     68      !!---------------------------------------------------------------------- 
    7569 
    7670      ! get imbalance (volume heat and salt) 
    7771      ! initialisation difference 
    78       zde3t = 0.0_wp; zdsal = 0.0_wp ; zdtem = 0.0_wp 
     72      zde3t = 0._wp   ;   zdsal = 0._wp   ;   zdtem = 0._wp 
    7973 
    8074      ! initialisation correction term 
    81       pvol_flx(:,:,:  ) = 0.0_wp 
    82       pts_flx (:,:,:,:) = 0.0_wp 
     75      pvol_flx(:,:,:  ) = 0._wp 
     76      pts_flx (:,:,:,:) = 0._wp 
    8377       
    84       r1_rdtiscpl = 1._wp / prdt_iscpl  
     78      z1_rdtiscpl = 1._wp / prdt_iscpl  
    8579 
    8680      ! mask tsn and tsb  
    87       tsb(:,:,:,jp_tem)=tsb(:,:,:,jp_tem)*ptmask_b(:,:,:); tsn(:,:,:,jp_tem)=tsn(:,:,:,jp_tem)*tmask(:,:,:); 
    88       tsb(:,:,:,jp_sal)=tsb(:,:,:,jp_sal)*ptmask_b(:,:,:); tsn(:,:,:,jp_sal)=tsn(:,:,:,jp_sal)*tmask(:,:,:); 
     81      tsb(:,:,:,jp_tem) = tsb(:,:,:,jp_tem) * ptmask_b(:,:,:) 
     82      tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) *  tmask  (:,:,:) 
     83      tsb(:,:,:,jp_sal) = tsb(:,:,:,jp_sal) * ptmask_b(:,:,:) 
     84      tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) *  tmask  (:,:,:) 
    8985 
    9086      !============================================================================== 
    … …  
    118114 
    119115                  ! volume, heat and salt differences in each cell  
    120                   pvol_flx(ji,jj,jk)       =   pvol_flx(ji,jj,jk)        + zde3t * r1_rdtiscpl 
    121                   pts_flx (ji,jj,jk,jp_sal)=   pts_flx (ji,jj,jk,jp_sal) + zdsal * r1_rdtiscpl  
    122                   pts_flx (ji,jj,jk,jp_tem)=   pts_flx (ji,jj,jk,jp_tem) + zdtem * r1_rdtiscpl 
     116                  pvol_flx(ji,jj,jk)       =   pvol_flx(ji,jj,jk)        + zde3t * z1_rdtiscpl 
     117                  pts_flx (ji,jj,jk,jp_sal)=   pts_flx (ji,jj,jk,jp_sal) + zdsal * z1_rdtiscpl  
     118                  pts_flx (ji,jj,jk,jp_tem)=   pts_flx (ji,jj,jk,jp_tem) + zdtem * z1_rdtiscpl 
    123119 
    124120                  ! case where we close a cell: check if the neighbour cells are wet  
    … …  
    190186      ! if no neighbour wet cell in case of 2close a cell", need to find the nearest wet point  
    191187      ! allocation and initialisation of the list of problematic point 
    192       ALLOCATE(inpts(jpnij)) 
    193       inpts(:)=0 
     188      ALLOCATE( inpts(jpnij) ) 
     189      inpts(:) = 0 
    194190 
    195191      ! fill narea location with the number of problematic point 
    … …  
    287283      CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1._wp) 
    288284      CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1._wp) 
    289  
    290       ! deallocate variables 
    291       CALL wrk_dealloc(jpi,jpj, zdssh )  
    292  
     285      ! 
    293286   END SUBROUTINE iscpl_cons 
     287 
    294288 
    295289   SUBROUTINE iscpl_div( phdivn ) 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/iscplini.F90

    r7646 r8568  
    1111   !!   iscpl_alloc    : allocation of correction variables 
    1212   !!---------------------------------------------------------------------- 
     13   USE oce             ! global tra/dyn variable 
    1314   USE dom_oce         ! ocean space and time domain 
    14    USE oce             ! global tra/dyn variable 
     15   ! 
    1516   USE lib_mpp         ! MPP library 
    1617   USE lib_fortran     ! MPP library 
    … …  
    4748   END FUNCTION iscpl_alloc 
    4849 
     50 
    4951   SUBROUTINE iscpl_init() 
     52      !!---------------------------------------------------------------------- 
    5053      INTEGER ::   ios           ! Local integer output status for namelist read 
    51       NAMELIST/namsbc_iscpl/nn_fiscpl,ln_hsb,nn_drown 
     54      NAMELIST/namsbc_iscpl/ nn_fiscpl, ln_hsb, nn_drown 
    5255      !!---------------------------------------------------------------------- 
    53       !                                   ! ============ 
    54       !                                   !   Namelist 
    55       !                                   ! ============ 
    5656      ! 
    5757      nn_fiscpl = 0 
    … …  
    7979         WRITE(numout,*) ' coupling time step                       = ', rdt_iscpl 
    8080         WRITE(numout,*) ' number of call of the extrapolation loop = ', nn_drown 
    81       END IF 
    82  
     81      ENDIF 
     82      ! 
    8383   END SUBROUTINE iscpl_init 
    8484 
     85   !!====================================================================== 
    8586END MODULE iscplini 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90

    r7646 r8568  
    1111   !!   iscpl_rst_interpol : restart interpolation in case of coupling with ice sheet 
    1212   !!---------------------------------------------------------------------- 
     13   USE oce             ! global tra/dyn variable 
    1314   USE dom_oce         ! ocean space and time domain 
    1415   USE domwri          ! ocean space and time domain 
    15    USE domvvl, ONLY : dom_vvl_interpol 
     16   USE domvvl   , ONLY : dom_vvl_interpol 
    1617   USE phycst          ! physical constants 
    1718   USE sbc_oce         ! surface boundary condition variables 
    18    USE oce             ! global tra/dyn variable 
     19   USE iscplini        ! ice sheet coupling: initialisation 
     20   USE iscplhsb        ! ice sheet coupling: conservation 
     21   ! 
    1922   USE in_out_manager  ! I/O manager 
    2023   USE iom             ! I/O module 
    2124   USE lib_mpp         ! MPP library 
    2225   USE lib_fortran     ! MPP library 
    23    USE wrk_nemo        ! Memory allocation 
    2426   USE lbclnk          ! communication 
    25    USE iscplini        ! ice sheet coupling: initialisation 
    26    USE iscplhsb        ! ice sheet coupling: conservation 
    2727 
    2828   IMPLICIT NONE 
    … …  
    5050      !!---------------------------------------------------------------------- 
    5151      INTEGER  ::   inum0 
    52       REAL(wp), DIMENSION(:,:  ), POINTER ::   zsmask_b 
    53       REAL(wp), DIMENSION(:,:,:), POINTER ::   ztmask_b, zumask_b, zvmask_b 
    54       REAL(wp), DIMENSION(:,:,:), POINTER ::   ze3t_b  , ze3u_b  , ze3v_b   
    55       REAL(wp), DIMENSION(:,:,:), POINTER ::   zdepw_b 
     52      REAL(wp), DIMENSION(jpi,jpj)    ::   zsmask_b 
     53      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztmask_b, zumask_b, zvmask_b 
     54      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3t_b  , ze3u_b  , ze3v_b   
     55      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdepw_b 
    5656      CHARACTER(20) :: cfile 
    5757      !!---------------------------------------------------------------------- 
    58  
    59       CALL wrk_alloc(jpi,jpj,jpk,   ztmask_b, zumask_b, zvmask_b) ! mask before 
    60       CALL wrk_alloc(jpi,jpj,jpk,   ze3t_b  , ze3u_b  , ze3v_b  ) ! e3   before 
    61       CALL wrk_alloc(jpi,jpj,jpk,   zdepw_b ) 
    62       CALL wrk_alloc(jpi,jpj,       zsmask_b                    ) 
    63  
    64  
    65       !! get restart variable 
     58      ! 
     59      !                       ! get restart variable 
    6660      CALL iom_get( numror, jpdom_autoglo, 'tmask'  , ztmask_b   ) ! need to extrapolate T/S 
    6761      CALL iom_get( numror, jpdom_autoglo, 'umask'  , zumask_b   ) ! need to correct barotropic velocity 
    … …  
    7266      CALL iom_get( numror, jpdom_autoglo, 'e3v_n'  , ze3v_b(:,:,:) )  ! need to correct barotropic velocity 
    7367      CALL iom_get( numror, jpdom_autoglo, 'gdepw_n', zdepw_b(:,:,:) ) ! need to interpol vertical profile (vvl) 
    74  
    75       !! read namelist 
    76       CALL iscpl_init() 
    77  
    78       !!  ! Extrapolation/interpolation of modify cell and new cells ... (maybe do it later after domvvl) 
     68      ! 
     69      CALL iscpl_init()       ! read namelist 
     70      !                       ! Extrapolation/interpolation of modify cell and new cells ... (maybe do it later after domvvl) 
    7971      CALL iscpl_rst_interpol( ztmask_b, zumask_b, zvmask_b, zsmask_b, ze3t_b, ze3u_b, ze3v_b, zdepw_b ) 
    80  
    81       !! compute correction if conservation needed 
    82       IF ( ln_hsb ) THEN 
     72      ! 
     73      IF ( ln_hsb ) THEN      ! compute correction if conservation needed 
    8374         IF( iscpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'rst_iscpl : unable to allocate rst_iscpl arrays' ) 
    8475         CALL iscpl_cons(ztmask_b, zsmask_b, ze3t_b, htsc_iscpl, hdiv_iscpl, rdt_iscpl) 
    8576      END IF 
    8677          
    87       !! print mesh/mask 
    88       IF( nn_msh /= 0 .AND. ln_iscpl )   CALL dom_wri      ! Create a domain file 
    89  
     78      !                       ! create  a domain file 
     79      IF( nn_msh /= 0 .AND. ln_iscpl )   CALL dom_wri 
     80      ! 
    9081      IF ( ln_hsb ) THEN 
    9182         cfile='correction' 
    … …  
    9788         CALL iom_close ( inum0 ) 
    9889      END IF 
    99  
    100       CALL wrk_dealloc(jpi,jpj,jpk,   ztmask_b,zumask_b,zvmask_b )   
    101       CALL wrk_dealloc(jpi,jpj,jpk,   ze3t_b  ,ze3u_b  ,ze3v_b   )   
    102       CALL wrk_dealloc(jpi,jpj,jpk,   zdepw_b                    ) 
    103       CALL wrk_dealloc(jpi,jpj,       zsmask_b                   ) 
    104  
    105       !! next step is an euler time step 
    106       neuler = 0 
    107  
    108       !! set _b and _n variables equal 
     90      ! 
     91      neuler = 0              ! next step is an euler time step 
     92      ! 
     93      !                       ! set _b and _n variables equal 
    10994      tsb (:,:,:,:) = tsn (:,:,:,:) 
    11095      ub  (:,:,:)   = un  (:,:,:) 
    11196      vb  (:,:,:)   = vn  (:,:,:) 
    11297      sshb(:,:)     = sshn(:,:) 
    113  
    114       !! set _b and _n vertical scale factor equal 
     98      ! 
     99      !                       ! set _b and _n vertical scale factor equal 
    115100      e3t_b (:,:,:) = e3t_n (:,:,:) 
    116101      e3u_b (:,:,:) = e3u_n (:,:,:) 
    117102      e3v_b (:,:,:) = e3v_n (:,:,:) 
    118  
     103      ! 
    119104      e3uw_b (:,:,:) = e3uw_n (:,:,:) 
    120105      e3vw_b (:,:,:) = e3vw_n (:,:,:) 
    … …  
    150135      REAL(wp):: zdz, zdzm1, zdzp1 
    151136      !! 
    152       REAL(wp), DIMENSION(:,:    ), POINTER :: zdmask , zdsmask, zvcorr, zucorr, zde3t 
    153       REAL(wp), DIMENSION(:,:    ), POINTER :: zbub   , zbvb   , zbun  , zbvn 
    154       REAL(wp), DIMENSION(:,:    ), POINTER :: zssh0  , zssh1, zhu1, zhv1 
    155       REAL(wp), DIMENSION(:,:    ), POINTER :: zsmask0, zsmask1 
    156       REAL(wp), DIMENSION(:,:,:  ), POINTER :: ztmask0, ztmask1, ztrp 
    157       REAL(wp), DIMENSION(:,:,:  ), POINTER :: zwmaskn, zwmaskb, ztmp3d 
    158       REAL(wp), DIMENSION(:,:,:,:), POINTER :: zts0 
     137      REAL(wp), DIMENSION(jpi,jpj)          :: zdmask , zsmask0, zucorr, zbub, zbun, zssh0, zhu1, zde3t 
     138      REAL(wp), DIMENSION(jpi,jpj)          :: zdsmask, zsmask1, zvcorr, zbvb, zbvn, zssh1, zhv1 
     139      REAL(wp), DIMENSION(jpi,jpj,jpk)      :: ztmask0, zwmaskn, ztrp 
     140      REAL(wp), DIMENSION(jpi,jpj,jpk)      :: ztmask1, zwmaskb, ztmp3d 
     141      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts0 
    159142      !!---------------------------------------------------------------------- 
    160  
    161       !! allocate variables 
    162       CALL wrk_alloc(jpi,jpj,jpk,2, zts0                                   ) 
    163       CALL wrk_alloc(jpi,jpj,jpk,   ztmask0, ztmask1 , ztrp, ztmp3d        )  
    164       CALL wrk_alloc(jpi,jpj,jpk,   zwmaskn, zwmaskb                       )  
    165       CALL wrk_alloc(jpi,jpj,       zsmask0, zsmask1                       )  
    166       CALL wrk_alloc(jpi,jpj,       zdmask , zdsmask, zvcorr, zucorr, zde3t)  
    167       CALL wrk_alloc(jpi,jpj,       zbub   , zbvb    , zbun , zbvn         )  
    168       CALL wrk_alloc(jpi,jpj,       zssh0  , zssh1, zhu1, zhv1             )  
    169  
    170       !! mask value to be sure 
     143      ! 
     144      !                 ! mask value to be sure 
    171145      tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * ptmask_b(:,:,:) 
    172146      tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * ptmask_b(:,:,:) 
    173        
    174       ! compute wmask 
     147      ! 
     148      !                 ! compute wmask 
    175149      zwmaskn(:,:,1) = tmask   (:,:,1) 
    176150      zwmaskb(:,:,1) = ptmask_b(:,:,1) 
    … …  
    179153         zwmaskb(:,:,jk) = ptmask_b(:,:,jk) * ptmask_b(:,:,jk-1) 
    180154      END DO 
    181             
    182       ! compute new ssh if we open a full water column (average of the closest neigbourgs)   
     155      !     
     156      !                 ! compute new ssh if we open a full water column (average of the closest neigbourgs)   
    183157      sshb (:,:)=sshn(:,:) 
    184158      zssh0(:,:)=sshn(:,:) 
    185159      zsmask0(:,:) = psmask_b(:,:) 
    186160      zsmask1(:,:) = psmask_b(:,:) 
    187       DO iz = 1,10    ! need to be tuned (configuration dependent) (OK for ISOMIP+) 
     161      DO iz = 1, 10                 ! need to be tuned (configuration dependent) (OK for ISOMIP+) 
    188162         zdsmask(:,:) = ssmask(:,:)-zsmask0(:,:) 
    189163         DO jj = 2,jpj-1 
    … …  
    198172                  &           + zssh0(ji,jjm1)*zsmask0(ji,jjm1))/summsk 
    199173                  zsmask1(ji,jj)=1._wp 
    200                END IF 
     174               ENDIF 
    201175            END DO 
    202176         END DO 
    203          CALL lbc_lnk(sshn,'T',1._wp) 
    204          CALL lbc_lnk(zsmask1,'T',1._wp) 
     177         CALL lbc_lnk( sshn   , 'T', 1._wp ) 
     178         CALL lbc_lnk( zsmask1, 'T', 1._wp ) 
    205179         zssh0   = sshn 
    206180         zsmask0 = zsmask1 
    … …  
    210184!============================================================================= 
    211185!PM: Is this needed since introduction of VVL by default? 
    212       IF (.NOT.ln_linssh) THEN 
     186      IF ( .NOT.ln_linssh ) THEN 
    213187      ! Reconstruction of all vertical scale factors at now time steps 
    214188      ! ============================================================================= 
    … …  
    224198            END DO 
    225199         END DO 
    226  
     200         ! 
    227201         CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' ) 
    228202         CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 
    229203         CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' ) 
    230204 
    231       ! Vertical scale factor interpolations 
    232       ! ------------------------------------ 
     205         ! Vertical scale factor interpolations 
     206         ! ------------------------------------ 
    233207         CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  ) 
    234208         CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' ) 
    235209         CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) 
    236  
    237       ! t- and w- points depth 
    238       ! ---------------------- 
     210          
     211         ! t- and w- points depth 
     212         ! ---------------------- 
    239213         gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 
    240214         gdepw_n(:,:,1) = 0.0_wp 
    … …  
    429403      ! nothing to do 
    430404      !  
    431       ! deallocation tmp arrays 
    432       CALL wrk_dealloc(jpi,jpj,jpk,2, zts0                                   ) 
    433       CALL wrk_dealloc(jpi,jpj,jpk,   ztmask0, ztmask1 , ztrp                )  
    434       CALL wrk_dealloc(jpi,jpj,jpk,   zwmaskn, zwmaskb , ztmp3d              )  
    435       CALL wrk_dealloc(jpi,jpj,       zsmask0, zsmask1                       )  
    436       CALL wrk_dealloc(jpi,jpj,       zdmask , zdsmask, zvcorr, zucorr, zde3t)  
    437       CALL wrk_dealloc(jpi,jpj,       zbub   , zbvb    , zbun  , zbvn        )  
    438       CALL wrk_dealloc(jpi,jpj,       zssh0  , zssh1  , zhu1 , zhv1          )  
    439       ! 
    440405   END SUBROUTINE iscpl_rst_interpol 
    441406 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    r7753 r8568  
    3636   USE lib_mpp         ! MPP library 
    3737   USE restart         ! restart 
    38    USE wrk_nemo        ! Memory allocation 
    3938   USE timing          ! Timing 
    4039 
    … …  
    6059      !!---------------------------------------------------------------------- 
    6160      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    62       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zuvd    ! U & V data workspace 
     61!!gm see comment further down 
     62      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   zuvd    ! U & V data workspace 
     63!!gm end 
    6364      !!---------------------------------------------------------------------- 
    6465      ! 
    65       IF( nn_timing == 1 )   CALL timing_start('istate_init') 
     66      IF( ln_timing )   CALL timing_start('istate_init') 
    6667      ! 
    6768      IF(lwp) WRITE(numout,*) 
    … …  
    121122!!gm to be moved in usrdef of C1D case 
    122123!         IF ( ln_uvd_init .AND. lk_c1d ) THEN ! read 3D U and V data at nit000 
    123 !            CALL wrk_alloc( jpi,jpj,jpk,2,   zuvd ) 
     124!            ALLOCATE( zuvd(jpi,jpj,jpk,2) ) 
    124125!            CALL dta_uvd( nit000, zuvd ) 
    125126!            ub(:,:,:) = zuvd(:,:,:,1) ;  un(:,:,:) = ub(:,:,:) 
    126127!            vb(:,:,:) = zuvd(:,:,:,2) ;  vn(:,:,:) = vb(:,:,:) 
    127 !            CALL wrk_dealloc( jpi,jpj,jpk,2,  zuvd ) 
     128!            DEALLOCATE( zuvd ) 
    128129!         ENDIF 
    129130         ! 
    … …  
    164165      vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:) 
    165166      ! 
    166       IF( nn_timing == 1 )   CALL timing_stop('istate_init') 
     167      IF( ln_timing )   CALL timing_stop('istate_init') 
    167168      ! 
    168169   END SUBROUTINE istate_init 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90

    r7753 r8568  
    2929   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    3030   USE lib_mpp         ! MPP library 
    31    USE wrk_nemo        ! Memory Allocation 
    3231   USE timing          ! Timing 
    3332 
    … …  
    4039#  include "vectopt_loop_substitute.h90" 
    4140   !!---------------------------------------------------------------------- 
    42    !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
     41   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    4342   !! $Id$  
    4443   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    6463      !!---------------------------------------------------------------------- 
    6564      ! 
    66       IF( nn_timing == 1 )   CALL timing_start('div_hor') 
     65      IF( ln_timing )   CALL timing_start('div_hor') 
    6766      ! 
    6867      IF( kt == nit000 ) THEN 
    … …  
    7574         DO jj = 2, jpjm1 
    7675            DO ji = fs_2, fs_jpim1   ! vector opt. 
    77                hdivn(ji,jj,jk) = (  e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) * un(ji  ,jj,jk)        & 
    78                   &               - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * un(ji-1,jj,jk)        & 
    79                   &               + e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * vn(ji,jj  ,jk)        & 
    80                   &               - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vn(ji,jj-1,jk)   )    & 
    81                   &            / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
     76               hdivn(ji,jj,jk) = (  e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) * un(ji  ,jj,jk)      & 
     77                  &               - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * un(ji-1,jj,jk)      & 
     78                  &               + e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * vn(ji,jj  ,jk)      & 
     79                  &               - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vn(ji,jj-1,jk)  )   & 
     80                  &            * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    8281            END DO   
    8382         END DO   
    … …  
    9089      END DO 
    9190      ! 
    92       IF( ln_rnf )   CALL sbc_rnf_div( hdivn )      !==  runoffs    ==!   (update hdivn field) 
     91      IF( ln_rnf )   CALL sbc_rnf_div( hdivn )              !==  runoffs    ==!   (update hdivn field) 
    9392      ! 
    94       IF( ln_isf )   CALL sbc_isf_div( hdivn )      !==  ice shelf  ==!   (update hdivn field) 
     93      IF( ln_isf )   CALL sbc_isf_div( hdivn )              !==  ice shelf  ==!   (update hdivn field) 
    9594      ! 
    96       IF( ln_iscpl .AND. ln_hsb ) CALL iscpl_div( hdivn ) !==  ice sheet  ==!   (update hdivn field) 
     95      IF( ln_iscpl .AND. ln_hsb )   CALL iscpl_div( hdivn ) !==  ice sheet  ==!   (update hdivn field) 
    9796      ! 
    98       CALL lbc_lnk( hdivn, 'T', 1. )                !==  lateral boundary cond.  ==!   (no sign change) 
     97      CALL lbc_lnk( hdivn, 'T', 1. )   !   (no sign change) 
    9998      ! 
    100       IF( nn_timing == 1 )  CALL timing_stop('div_hor') 
     99      IF( ln_timing )   CALL timing_stop('div_hor') 
    101100      ! 
    102101   END SUBROUTINE div_hor 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90

    r7646 r8568  
    77   !!            3.3  !  2010-10  (C. Ethe, G. Madec)  reorganisation of initialisation phase 
    88   !!            3.6  !  2015-05  (N. Ducousso, G. Madec)  add Hollingsworth scheme as an option  
     9   !!            4.0  !  2017-07  (G. Madec)  add a linear dynamics option 
    910   !!---------------------------------------------------------------------- 
    1011 
    … …  
    3031  
    3132   !                                    !* namdyn_adv namelist * 
    32    LOGICAL, PUBLIC ::   ln_dynadv_vec   !: vector form flag 
    33    INTEGER, PUBLIC ::   nn_dynkeg       !: scheme of kinetic energy gradient: =0 C2 ; =1 Hollingsworth 
     33   LOGICAL, PUBLIC ::   ln_dynadv_NONE  !: linear dynamics (no momentum advection) 
     34   LOGICAL, PUBLIC ::   ln_dynadv_vec   !: vector form 
     35   INTEGER, PUBLIC ::      nn_dynkeg       !: scheme of grad(KE): =0 C2 ; =1 Hollingsworth 
    3436   LOGICAL, PUBLIC ::   ln_dynadv_cen2  !: flux form - 2nd order centered scheme flag 
    3537   LOGICAL, PUBLIC ::   ln_dynadv_ubs   !: flux form - 3rd order UBS scheme flag 
    36    LOGICAL, PUBLIC ::   ln_dynzad_zts   !: vertical advection with sub-timestepping (requires vector form) 
    3738    
    38    INTEGER ::   nadv   ! choice of the formulation and scheme for the advection 
     39   INTEGER, PUBLIC ::   n_dynadv   !: choice of the formulation and scheme for momentum advection 
     40   !                               !  associated indices: 
     41   INTEGER, PUBLIC, PARAMETER ::   np_LIN_dyn = 0   ! no advection: linear dynamics 
     42   INTEGER, PUBLIC, PARAMETER ::   np_VEC_c2  = 1   ! vector form : 2nd order centered scheme 
     43   INTEGER, PUBLIC, PARAMETER ::   np_FLX_c2  = 2   ! flux   form : 2nd order centered scheme 
     44   INTEGER, PUBLIC, PARAMETER ::   np_FLX_ubs = 3   ! flux   form : 3rd order Upstream Biased Scheme 
    3945 
    4046   !! * Substitutions 
    4147#  include "vectopt_loop_substitute.h90" 
    4248   !!---------------------------------------------------------------------- 
    43    !! NEMO/OPA 3.6 , NEMO Consortium (2015) 
     49   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    4450   !! $Id$ 
    4551   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    5359      !! ** Purpose :   compute the ocean momentum advection trend. 
    5460      !! 
    55       !! ** Method  : - Update (ua,va) with the advection term following nadv 
     61      !! ** Method  : - Update (ua,va) with the advection term following n_dynadv 
     62      !! 
    5663      !!      NB: in flux form advection (ln_dynadv_cen2 or ln_dynadv_ubs=T)  
    5764      !!      a metric term is add to the coriolis term while in vector form  
    … …  
    6269      !!---------------------------------------------------------------------- 
    6370      ! 
    64       IF( nn_timing == 1 )  CALL timing_start('dyn_adv') 
     71      IF( ln_timing )   CALL timing_start( 'dyn_adv' ) 
    6572      ! 
    66       SELECT CASE ( nadv )                  ! compute advection trend and add it to general trend 
    67       CASE ( 0 )      
    68                       CALL dyn_keg     ( kt, nn_dynkeg )    ! vector form : horizontal gradient of kinetic energy 
    69                       CALL dyn_zad     ( kt )               ! vector form : vertical advection 
    70       CASE ( 1 )      
    71                       CALL dyn_keg     ( kt, nn_dynkeg )    ! vector form : horizontal gradient of kinetic energy 
    72                       CALL dyn_zad_zts ( kt )               ! vector form : vertical advection with sub-timestepping 
    73       CASE ( 2 )  
    74                       CALL dyn_adv_cen2( kt )               ! 2nd order centered scheme 
    75       CASE ( 3 )    
    76                       CALL dyn_adv_ubs ( kt )               ! 3rd order UBS      scheme 
     73      SELECT CASE( n_dynadv )    !==  compute advection trend and add it to general trend  ==! 
     74      CASE( np_VEC_c2  )      
     75         CALL dyn_keg     ( kt, nn_dynkeg )    ! vector form : horizontal gradient of kinetic energy 
     76         CALL dyn_zad     ( kt )               ! vector form : vertical advection 
     77      CASE( np_FLX_c2  )  
     78         CALL dyn_adv_cen2( kt )               ! 2nd order centered scheme 
     79      CASE( np_FLX_ubs )    
     80         CALL dyn_adv_ubs ( kt )               ! 3rd order UBS      scheme (UP3) 
    7781      END SELECT 
    7882      ! 
    79       IF( nn_timing == 1 )  CALL timing_stop('dyn_adv') 
     83      IF( ln_timing )   CALL timing_stop( 'dyn_adv' ) 
    8084      ! 
    8185   END SUBROUTINE dyn_adv 
    … …  
    8791      !!                 
    8892      !! ** Purpose :   Control the consistency between namelist options for  
    89       !!              momentum advection formulation & scheme and set nadv 
     93      !!              momentum advection formulation & scheme and set n_dynadv 
    9094      !!---------------------------------------------------------------------- 
    9195      INTEGER ::   ioptio, ios   ! Local integer 
    9296      ! 
    93       NAMELIST/namdyn_adv/ ln_dynadv_vec, nn_dynkeg, ln_dynadv_cen2 , ln_dynadv_ubs, ln_dynzad_zts 
     97      NAMELIST/namdyn_adv/ ln_dynadv_NONE, ln_dynadv_vec, nn_dynkeg, ln_dynadv_cen2, ln_dynadv_ubs 
    9498      !!---------------------------------------------------------------------- 
    9599      ! 
    … …  
    108112         WRITE(numout,*) '~~~~~~~~~~~~' 
    109113         WRITE(numout,*) '   Namelist namdyn_adv : chose a advection formulation & scheme for momentum' 
    110          WRITE(numout,*) '      Vector/flux form (T/F)                           ln_dynadv_vec  = ', ln_dynadv_vec 
    111          WRITE(numout,*) '      = 0 standard scheme  ; =1 Hollingsworth scheme   nn_dynkeg      = ', nn_dynkeg 
    112          WRITE(numout,*) '      2nd order centred advection scheme               ln_dynadv_cen2 = ', ln_dynadv_cen2 
    113          WRITE(numout,*) '      3rd order UBS advection scheme                   ln_dynadv_ubs  = ', ln_dynadv_ubs 
    114          WRITE(numout,*) '      Sub timestepping of vertical advection           ln_dynzad_zts  = ', ln_dynzad_zts 
     114         WRITE(numout,*) '      linear dynamics : no momentum advection          ln_dynadv_NONE = ', ln_dynadv_NONE 
     115         WRITE(numout,*) '      Vector form: 2nd order centered scheme           ln_dynadv_vec  = ', ln_dynadv_vec 
     116         WRITE(numout,*) '         with Hollingsworth scheme (=1) or not (=0)       nn_dynkeg   = ', nn_dynkeg 
     117         WRITE(numout,*) '      flux form: 2nd order centred scheme              ln_dynadv_cen2 = ', ln_dynadv_cen2 
     118         WRITE(numout,*) '                 3rd order UBS scheme                  ln_dynadv_ubs  = ', ln_dynadv_ubs 
    115119      ENDIF 
    116120 
    117       ioptio = 0                      ! Parameter control 
    118       IF( ln_dynadv_vec  )   ioptio = ioptio + 1 
    119       IF( ln_dynadv_cen2 )   ioptio = ioptio + 1 
    120       IF( ln_dynadv_ubs  )   ioptio = ioptio + 1 
     121      ioptio = 0                      ! parameter control and set n_dynadv 
     122      IF( ln_dynadv_NONE ) THEN   ;   ioptio = ioptio + 1   ;   n_dynadv = np_LIN_dyn   ;   ENDIF 
     123      IF( ln_dynadv_vec  ) THEN   ;   ioptio = ioptio + 1   ;   n_dynadv = np_VEC_c2    ;   ENDIF 
     124      IF( ln_dynadv_cen2 ) THEN   ;   ioptio = ioptio + 1   ;   n_dynadv = np_FLX_c2    ;   ENDIF 
     125      IF( ln_dynadv_ubs  ) THEN   ;   ioptio = ioptio + 1   ;   n_dynadv = np_FLX_ubs   ;   ENDIF 
    121126 
    122       IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namdyn_adv' ) 
    123       IF( ln_dynzad_zts .AND. .NOT. ln_dynadv_vec )   & 
    124          CALL ctl_stop( 'Sub timestepping of vertical advection requires vector form; set ln_dynadv_vec = .TRUE.' ) 
    125       IF( nn_dynkeg /= nkeg_C2 .AND. nn_dynkeg /= nkeg_HW )   &   
    126          CALL ctl_stop( 'KEG scheme wrong value of nn_dynkeg' ) 
     127      IF( ioptio /= 1 )   CALL ctl_stop( 'choose ONE and only ONE advection scheme' ) 
     128      IF( nn_dynkeg /= nkeg_C2 .AND. nn_dynkeg /= nkeg_HW )   CALL ctl_stop( 'KEG scheme wrong value of nn_dynkeg' ) 
    127129 
    128       !                               ! Set nadv 
    129       IF( ln_dynadv_vec  )   nadv =  0  
    130       IF( ln_dynzad_zts  )   nadv =  1 
    131       IF( ln_dynadv_cen2 )   nadv =  2 
    132       IF( ln_dynadv_ubs  )   nadv =  3 
    133130 
    134131      IF(lwp) THEN                    ! Print the choice 
    135132         WRITE(numout,*) 
    136          IF( nadv ==  0 )   WRITE(numout,*) '      ===>>   vector form : keg + zad + vor is used'  
    137          IF( nadv ==  1 )   WRITE(numout,*) '      ===>>   vector form : keg + zad_zts + vor is used' 
    138          IF( nadv ==  0 .OR. nadv ==  1 ) THEN 
     133         SELECT CASE( n_dynadv ) 
     134         CASE( np_LIN_dyn )   ;   WRITE(numout,*) '      ===>>   linear dynamics : no momentum advection used' 
     135         CASE( np_VEC_c2  )   ;   WRITE(numout,*) '      ===>>   vector form : keg + zad + vor is used'  
    139136            IF( nn_dynkeg == nkeg_C2  )   WRITE(numout,*) '              with Centered standard keg scheme' 
    140137            IF( nn_dynkeg == nkeg_HW  )   WRITE(numout,*) '              with Hollingsworth keg scheme' 
    141          ENDIF 
    142          IF( nadv ==  2 )   WRITE(numout,*) '      ===>>   flux form   : 2nd order scheme is used' 
    143          IF( nadv ==  3 )   WRITE(numout,*) '      ===>>   flux form   : UBS       scheme is used' 
     138         CASE( np_FLX_c2  )   ;   WRITE(numout,*) '      ===>>   flux form   : 2nd order scheme is used' 
     139         CASE( np_FLX_ubs )   ;   WRITE(numout,*) '      ===>>   flux form   : UBS      scheme is used' 
     140         END SELECT 
    144141      ENDIF 
    145142      ! 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90

    r6750 r8568  
    2020   USE lib_mpp        ! MPP library 
    2121   USE prtctl         ! Print control 
    22    USE wrk_nemo       ! Memory Allocation 
    2322   USE timing         ! Timing 
    2423 
    … …  
    3130#  include "vectopt_loop_substitute.h90" 
    3231   !!---------------------------------------------------------------------- 
    33    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     32   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    3433   !! $Id$ 
    3534   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    5150      ! 
    5251      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    53       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfw 
    54       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zfu, zfv 
     52      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zfu_t, zfu_f, zfu_uw, zfu 
     53      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zfv_t, zfv_f, zfv_vw, zfv, zfw 
    5554      !!---------------------------------------------------------------------- 
    5655      ! 
    57       IF( nn_timing == 1 )  CALL timing_start('dyn_adv_cen2') 
    58       ! 
    59       CALL wrk_alloc( jpi,jpj,jpk,   zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw ) 
     56      IF( ln_timing )   CALL timing_start('dyn_adv_cen2') 
    6057      ! 
    6158      IF( kt == nit000 .AND. lwp ) THEN 
    … …  
    148145         &                       tab3d_2=va, clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    149146      ! 
    150       CALL wrk_dealloc( jpi, jpj, jpk, zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw ) 
    151       ! 
    152       IF( nn_timing == 1 )  CALL timing_stop('dyn_adv_cen2') 
     147      IF( ln_timing )   CALL timing_stop('dyn_adv_cen2') 
    153148      ! 
    154149   END SUBROUTINE dyn_adv_cen2 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90

    r6750 r8568  
    2323   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    2424   USE lib_mpp        ! MPP library 
    25    USE wrk_nemo       ! Memory Allocation 
    2625   USE timing         ! Timing 
    2726 
    … …  
    3736#  include "vectopt_loop_substitute.h90" 
    3837   !!---------------------------------------------------------------------- 
    39    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     38   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    4039   !! $Id$ 
    4140   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    7473      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    7574      REAL(wp) ::   zui, zvj, zfuj, zfvi, zl_u, zl_v   ! local scalars 
    76       REAL(wp), POINTER, DIMENSION(:,:,:  ) ::  zfu, zfv 
    77       REAL(wp), POINTER, DIMENSION(:,:,:  ) ::  zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfw 
    78       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zlu_uu, zlv_vv, zlu_uv, zlv_vu 
     75      REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zfu_t, zfu_f, zfu_uw, zfu 
     76      REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zfv_t, zfv_f, zfv_vw, zfv, zfw 
     77      REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   zlu_uu, zlu_uv 
     78      REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   zlv_vv, zlv_vu 
    7979      !!---------------------------------------------------------------------- 
    8080      ! 
    81       IF( nn_timing == 1 )  CALL timing_start('dyn_adv_ubs') 
    82       ! 
    83       CALL wrk_alloc( jpi,jpj,jpk,        zfu_t , zfv_t , zfu_f , zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw ) 
    84       CALL wrk_alloc( jpi,jpj,jpk,jpts,   zlu_uu, zlv_vv, zlu_uv, zlv_vu                               ) 
     81      IF( ln_timing )   CALL timing_start('dyn_adv_ubs') 
    8582      ! 
    8683      IF( kt == nit000 ) THEN 
    … …  
    241238         &                       tab3d_2=va, clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    242239      ! 
    243       CALL wrk_dealloc( jpi,jpj,jpk,        zfu_t , zfv_t , zfu_f , zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw ) 
    244       CALL wrk_dealloc( jpi,jpj,jpk,jpts,   zlu_uu, zlv_vv, zlu_uv, zlv_vu                               ) 
    245       ! 
    246       IF( nn_timing == 1 )  CALL timing_stop('dyn_adv_ubs') 
     240      IF( ln_timing )   CALL timing_stop('dyn_adv_ubs') 
    247241      ! 
    248242   END SUBROUTINE dyn_adv_ubs 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90

    r8215 r8568  
    5757      !!--------------------------------------------------------------------- 
    5858      ! 
    59       IF( nn_timing == 1 )  CALL timing_start('dyn_bfr') 
     59      IF( ln_timing )   CALL timing_start('dyn_bfr') 
    6060      ! 
    6161!!gm bug : time step is only rdt (not 2 rdt if euler start !) 
    … …  
    109109         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    110110      ! 
    111       IF( nn_timing == 1 )  CALL timing_stop('dyn_bfr') 
     111      IF( ln_timing )   CALL timing_stop('dyn_bfr') 
    112112      ! 
    113113   END SUBROUTINE dyn_bfr 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r8215 r8568  
    4444   USE lib_mpp         ! MPP library 
    4545   USE eosbn2          ! compute density 
    46    USE wrk_nemo        ! Memory Allocation 
    4746   USE timing          ! Timing 
    4847   USE iom 
    … …  
    8483      !!---------------------------------------------------------------------- 
    8584      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    86       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
    87       !!---------------------------------------------------------------------- 
    88       ! 
    89       IF( nn_timing == 1 )  CALL timing_start('dyn_hpg') 
     85      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv 
     86      !!---------------------------------------------------------------------- 
     87      ! 
     88      IF( ln_timing )   CALL timing_start('dyn_hpg') 
    9089      ! 
    9190      IF( l_trddyn ) THEN                    ! Temporary saving of ua and va trends (l_trddyn) 
    92          CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
     91         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 
    9392         ztrdu(:,:,:) = ua(:,:,:) 
    9493         ztrdv(:,:,:) = va(:,:,:) 
    … …  
    108107         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    109108         CALL trd_dyn( ztrdu, ztrdv, jpdyn_hpg, kt ) 
    110          CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
     109         DEALLOCATE( ztrdu , ztrdv ) 
    111110      ENDIF 
    112111      ! 
    … …  
    114113         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    115114      ! 
    116       IF( nn_timing == 1 )  CALL timing_stop('dyn_hpg') 
     115      IF( ln_timing )   CALL timing_stop('dyn_hpg') 
    117116      ! 
    118117   END SUBROUTINE dyn_hpg 
    … …  
    134133      INTEGER  ::   ji, jj, jk, ikt    ! dummy loop indices      ISF 
    135134      REAL(wp) ::   znad 
    136       REAL(wp), POINTER, DIMENSION(:,:,:)   ::  ztstop, zrhd ! hypothesys on isf density 
    137       REAL(wp), POINTER, DIMENSION(:,:)     ::  zrhdtop_isf  ! density at bottom of ISF 
    138       REAL(wp), POINTER, DIMENSION(:,:)     ::  ziceload     ! density at bottom of ISF 
     135      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  zts_top, zrhd  ! hypothesys on isf density 
     136      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::  zrhdtop_isf    ! density at bottom of ISF 
     137      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::  ziceload       ! density at bottom of ISF 
    139138      !! 
    140139      NAMELIST/namdyn_hpg/ ln_hpg_zco, ln_hpg_zps, ln_hpg_sco,     & 
    … …  
    165164      ! 
    166165      IF( ln_hpg_djc )   & 
    167          &   CALL ctl_stop('dyn_hpg_init : Density Jacobian: Cubic polynominal method & 
    168                            & currently disabled (bugs under investigation). Please select & 
    169                            & either  ln_hpg_sco or  ln_hpg_prj instead') 
    170       ! 
    171       IF( .NOT.ln_linssh .AND. .NOT.(ln_hpg_sco.OR.ln_hpg_prj.OR.ln_hpg_isf) )        & 
    172          &   CALL ctl_stop('dyn_hpg_init : non-linear free surface requires either ', & 
    173          &                 '   the standard jacobian formulation hpg_sco    or '    , & 
    174          &                 '   the pressure jacobian formulation hpg_prj'            ) 
    175  
    176       IF(       ln_hpg_isf .AND. .NOT. ln_isfcav )   & 
    177          &   CALL ctl_stop( ' hpg_isf not available if ln_isfcav = false ' ) 
    178       IF( .NOT. ln_hpg_isf .AND.       ln_isfcav )   & 
    179          &   CALL ctl_stop( 'Only hpg_isf has been corrected to work with ice shelf cavity.' ) 
     166         &   CALL ctl_stop('dyn_hpg_init : Density Jacobian: Cubic polynominal method',   & 
     167         &                 '   currently disabled (bugs under investigation).'        ,   & 
     168         &                 '   Please select either  ln_hpg_sco or  ln_hpg_prj instead' ) 
     169         ! 
     170      IF( .NOT.ln_linssh .AND. .NOT.(ln_hpg_sco.OR.ln_hpg_prj.OR.ln_hpg_isf) )          & 
     171         &   CALL ctl_stop('dyn_hpg_init : non-linear free surface requires either ',   & 
     172         &                 '   the standard jacobian formulation hpg_sco    or '    ,   & 
     173         &                 '   the pressure jacobian formulation hpg_prj'             ) 
     174         ! 
     175      IF( ln_hpg_isf ) THEN 
     176         IF( .NOT. ln_isfcav )   CALL ctl_stop( ' hpg_isf not available if ln_isfcav = false ' ) 
     177       ELSE 
     178         IF(       ln_isfcav )   CALL ctl_stop( 'Only hpg_isf has been corrected to work with ice shelf cavity.' ) 
     179      ENDIF 
    180180      ! 
    181181      !                               ! Set nhpg from ln_hpg_... flags 
    … …  
    197197      IF( ioptio /= 1 )   CALL ctl_stop( 'NO or several hydrostatic pressure gradient options used' ) 
    198198      !  
    199       ! initialisation of ice shelf load 
    200       IF ( .NOT. ln_isfcav ) riceload(:,:)=0.0 
    201       IF (       ln_isfcav ) THEN 
    202          CALL wrk_alloc( jpi,jpj, 2,  ztstop)  
    203          CALL wrk_alloc( jpi,jpj,jpk, zrhd  ) 
    204          CALL wrk_alloc( jpi,jpj,     zrhdtop_isf, ziceload)  
     199      !                           
     200      IF ( .NOT. ln_isfcav ) THEN     !--- no ice shelf load 
     201         riceload(:,:) = 0._wp 
     202         ! 
     203      ELSE                            !--- set an ice shelf load 
    205204         ! 
    206205         IF(lwp) WRITE(numout,*) 
    207          IF(lwp) WRITE(numout,*) 'dyn:hpg_isf : hydrostatic pressure gradient trend for ice shelf' 
    208          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'   
    209  
    210          ! To use density and not density anomaly 
    211          znad=1._wp 
    212           
    213          ! assume water displaced by the ice shelf is at T=-1.9 and S=34.4 (rude) 
    214          ztstop(:,:,1)=-1.9_wp ; ztstop(:,:,2)=34.4_wp 
    215  
    216          ! compute density of the water displaced by the ice shelf  
    217          DO jk = 1, jpk 
    218             CALL eos(ztstop(:,:,:),gdept_n(:,:,jk),zrhd(:,:,jk)) 
    219          END DO 
    220        
    221          ! compute rhd at the ice/oce interface (ice shelf side) 
    222          CALL eos(ztstop,risfdep,zrhdtop_isf) 
    223  
    224          ! Surface value + ice shelf gradient 
    225          ! compute pressure due to ice shelf load (used to compute hpgi/j for all the level from 1 to miku/v) 
    226          ! divided by 2 later 
    227          ziceload = 0._wp 
    228          DO jj = 1, jpj 
    229             DO ji = 1, jpi 
    230                ikt=mikt(ji,jj) 
     206         IF(lwp) WRITE(numout,*) '   ice shelf case: set the ice-shelf load' 
     207         ALLOCATE( zts_top(jpi,jpj,jpts) , zrhd(jpi,jpj,jpk) , zrhdtop_isf(jpi,jpj) , ziceload(jpi,jpj) )  
     208         ! 
     209         znad = 1._wp                     !- To use density and not density anomaly 
     210         ! 
     211         !                                !- assume water displaced by the ice shelf is at T=-1.9 and S=34.4 (rude) 
     212         zts_top(:,:,jp_tem) = -1.9_wp   ;   zts_top(:,:,jp_sal) = 34.4_wp 
     213         ! 
     214         DO jk = 1, jpk                   !- compute density of the water displaced by the ice shelf  
     215            CALL eos( zts_top(:,:,:), gdept_n(:,:,jk), zrhd(:,:,jk) ) 
     216         END DO 
     217         ! 
     218         !                                !- compute rhd at the ice/oce interface (ice shelf side) 
     219         CALL eos( zts_top , risfdep, zrhdtop_isf ) 
     220         ! 
     221         !                                !- Surface value + ice shelf gradient 
     222         ziceload = 0._wp                       ! compute pressure due to ice shelf load  
     223         DO jj = 1, jpj                         ! (used to compute hpgi/j for all the level from 1 to miku/v) 
     224            DO ji = 1, jpi                      ! divided by 2 later 
     225               ikt = mikt(ji,jj) 
    231226               ziceload(ji,jj) = ziceload(ji,jj) + (znad + zrhd(ji,jj,1) ) * e3w_n(ji,jj,1) * (1._wp - tmask(ji,jj,1)) 
    232                DO jk=2,ikt-1 
     227               DO jk = 2, ikt-1 
    233228                  ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhd(ji,jj,jk-1) + zrhd(ji,jj,jk)) * e3w_n(ji,jj,jk) & 
    234229                     &                              * (1._wp - tmask(ji,jj,jk)) 
    235230               END DO 
    236231               IF (ikt  >=  2) ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhdtop_isf(ji,jj) + zrhd(ji,jj,ikt-1)) & 
    237                                   &                              * ( risfdep(ji,jj) - gdept_1d(ikt-1) ) 
    238             END DO 
    239          END DO 
    240          riceload(:,:)=ziceload(:,:)  ! need to be saved for diaar5 
    241  
    242          CALL wrk_dealloc( jpi,jpj, 2,  ztstop)  
    243          CALL wrk_dealloc( jpi,jpj,jpk, zrhd  ) 
    244          CALL wrk_dealloc( jpi,jpj,     zrhdtop_isf, ziceload)  
    245       END IF 
     232                  &                                              * ( risfdep(ji,jj) - gdept_1d(ikt-1) ) 
     233            END DO 
     234         END DO 
     235         riceload(:,:) = ziceload(:,:)  ! need to be saved for diaar5 
     236         ! 
     237         DEALLOCATE( zts_top , zrhd , zrhdtop_isf , ziceload )  
     238      ENDIF 
    246239      ! 
    247240   END SUBROUTINE dyn_hpg_init 
    … …  
    268261      INTEGER  ::   ji, jj, jk       ! dummy loop indices 
    269262      REAL(wp) ::   zcoef0, zcoef1   ! temporary scalars 
    270       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj 
    271       !!---------------------------------------------------------------------- 
    272       ! 
    273       CALL wrk_alloc( jpi,jpj,jpk,   zhpi, zhpj ) 
     263      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zhpi, zhpj 
     264      !!---------------------------------------------------------------------- 
    274265      ! 
    275266      IF( kt == nit000 ) THEN 
    … …  
    315306      END DO 
    316307      ! 
    317       CALL wrk_dealloc( jpi,jpj,jpk,   zhpi, zhpj ) 
    318       ! 
    319308   END SUBROUTINE hpg_zco 
    320309 
    … …  
    333322      INTEGER  ::   iku, ikv                         ! temporary integers 
    334323      REAL(wp) ::   zcoef0, zcoef1, zcoef2, zcoef3   ! temporary scalars 
    335       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj 
    336       !!---------------------------------------------------------------------- 
    337       ! 
    338       CALL wrk_alloc( jpi,jpj,jpk,   zhpi, zhpj ) 
     324      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zhpi, zhpj 
     325      !!---------------------------------------------------------------------- 
    339326      ! 
    340327      IF( kt == nit000 ) THEN 
    … …  
    405392      END DO 
    406393      ! 
    407       CALL wrk_dealloc( jpi,jpj,jpk,   zhpi, zhpj ) 
    408       ! 
    409394   END SUBROUTINE hpg_zps 
    410395 
    … …  
    433418      REAL(wp) ::   zcoef0, zuap, zvap, znad, ztmp       ! temporary scalars 
    434419      LOGICAL  ::   ll_tmp1, ll_tmp2                     ! local logical variables 
    435       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj 
    436       REAL(wp), POINTER, DIMENSION(:,:)   ::  zcpx, zcpy !W/D pressure filter 
    437       !!---------------------------------------------------------------------- 
    438       ! 
    439       CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj ) 
    440       IF( ln_wd ) CALL wrk_alloc( jpi,jpj, zcpx, zcpy ) 
     420      REAL(wp), DIMENSION(jpi,jpj,jpk)      ::   zhpi, zhpj 
     421      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zcpx, zcpy   !W/D pressure filter 
     422      !!---------------------------------------------------------------------- 
    441423      ! 
    442424      IF( kt == nit000 ) THEN 
    … …  
    452434      ! 
    453435      IF( ln_wd ) THEN 
    454         DO jj = 2, jpjm1 
    455            DO ji = 2, jpim1  
    456              ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                & 
     436         ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 
     437         DO jj = 2, jpjm1 
     438            DO ji = 2, jpim1  
     439               ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                & 
    457440                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) .AND.            & 
    458441                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji+1,jj) + ht_wd(ji+1,jj) ) & 
    459442                  &                                                         > rn_wdmin1 + rn_wdmin2 
    460              ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji+1,jj) ) > 1.E-12 ) .AND. (             & 
     443               ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji+1,jj) ) > 1.E-12 ) .AND. (             & 
    461444                  &    MAX(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                & 
    462445                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 ) 
    463446 
    464              IF(ll_tmp1) THEN 
    465                zcpx(ji,jj) = 1.0_wp 
    466              ELSE IF(ll_tmp2) THEN 
    467                ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here 
    468                zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) & 
    469                            &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) ) 
    470              ELSE 
    471                zcpx(ji,jj) = 0._wp 
    472              END IF 
    473        
    474              ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                & 
     447               IF(ll_tmp1) THEN 
     448                  zcpx(ji,jj) = 1.0_wp 
     449               ELSE IF(ll_tmp2) THEN 
     450                  ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here 
     451                  zcpx(ji,jj) = ABS(   ( sshn(ji+1,jj)+ht_wd(ji+1,jj) - sshn(ji,jj)-ht_wd(ji,jj) )  & 
     452                     &                / ( sshn(ji+1,jj)                - sshn(ji,jj)              )  ) 
     453               ELSE 
     454                  zcpx(ji,jj) = 0._wp 
     455               ENDIF 
     456               ! 
     457               ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                & 
    475458                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) .AND.            & 
    476459                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji,jj+1) + ht_wd(ji,jj+1) ) & 
    477460                  &                                                         > rn_wdmin1 + rn_wdmin2 
    478              ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji,jj+1) ) > 1.E-12 ) .AND. (             & 
     461               ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji,jj+1) ) > 1.E-12 ) .AND. (             & 
    479462                  &    MAX(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                & 
    480463                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 ) 
    481  
    482              IF(ll_tmp1) THEN 
    483                zcpy(ji,jj) = 1.0_wp 
    484              ELSE IF(ll_tmp2) THEN 
    485                ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here 
    486                zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) & 
    487                            &    / (sshn(ji,jj+1) -  sshn(ji,jj  )) ) 
    488              ELSE 
    489                zcpy(ji,jj) = 0._wp 
    490              END IF 
    491            END DO 
    492         END DO 
    493         CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp ) 
    494       END IF 
     464                  ! 
     465               IF(ll_tmp1) THEN 
     466                  zcpy(ji,jj) = 1.0_wp 
     467               ELSE IF(ll_tmp2) THEN 
     468                  ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here 
     469                  zcpy(ji,jj) = ABS(   ( sshn(ji,jj+1)+ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj) )  & 
     470                     &               / ( sshn(ji,jj+1)                - sshn(ji,jj)                )  ) 
     471               ELSE 
     472                  zcpy(ji,jj) = 0._wp 
     473               ENDIF 
     474            END DO 
     475         END DO 
     476         CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp ) 
     477      ENDIF 
    495478 
    496479      ! Surface value 
    … …  
    507490            zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) + 2._wp * znad )   & 
    508491               &           * ( gde3w_n(ji,jj+1,1) - gde3w_n(ji,jj,1) ) * r1_e2v(ji,jj) 
    509  
    510  
     492            ! 
    511493            IF( ln_wd ) THEN 
    512  
    513               zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj) 
    514               zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj)  
    515               zuap = zuap * zcpx(ji,jj) 
    516               zvap = zvap * zcpy(ji,jj) 
     494               zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj) 
     495               zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj)  
     496               zuap = zuap * zcpx(ji,jj) 
     497               zvap = zvap * zcpy(ji,jj) 
    517498            ENDIF 
    518  
     499            ! 
    519500            ! add to the general momentum trend 
    520501            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap 
    … …  
    539520               zvap = -zcoef0 * ( rhd    (ji  ,jj+1,jk) + rhd    (ji,jj,jk) + 2._wp * znad )   & 
    540521                  &           * ( gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk) ) * r1_e2v(ji,jj) 
    541  
     522               ! 
    542523               IF( ln_wd ) THEN 
    543                  zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj) 
    544                  zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj)  
    545                  zuap = zuap * zcpx(ji,jj) 
    546                  zvap = zvap * zcpy(ji,jj) 
    547                ENDIF 
    548  
     524                  zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj) 
     525                  zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj)  
     526                  zuap = zuap * zcpx(ji,jj) 
     527                  zvap = zvap * zcpy(ji,jj) 
     528               ENDIF 
     529               ! 
    549530               ! add to the general momentum trend 
    550531               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) + zuap 
    … …  
    554535      END DO 
    555536      ! 
    556       CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj ) 
    557       IF( ln_wd ) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy ) 
     537      IF( ln_wd )   DEALLOCATE( zcpx , zcpy ) 
    558538      ! 
    559539   END SUBROUTINE hpg_sco 
    … …  
    583563      INTEGER  ::   ji, jj, jk, ikt, iktp1i, iktp1j   ! dummy loop indices 
    584564      REAL(wp) ::   zcoef0, zuap, zvap, znad          ! temporary scalars 
    585       REAL(wp), POINTER, DIMENSION(:,:,:)   ::  zhpi, zhpj 
    586       REAL(wp), POINTER, DIMENSION(:,:,:)   ::  ztstop 
    587       REAL(wp), POINTER, DIMENSION(:,:)     ::  zrhdtop_oce 
    588       !!---------------------------------------------------------------------- 
    589       ! 
    590       CALL wrk_alloc( jpi,jpj,  2, ztstop)  
    591       CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj) 
    592       CALL wrk_alloc( jpi,jpj,     zrhdtop_oce ) 
    593       ! 
    594       ! Local constant initialization 
    595       zcoef0 = - grav * 0.5_wp 
    596    
    597       ! To use density and not density anomaly 
    598       znad=1._wp 
    599  
    600       ! iniitialised to 0. zhpi zhpi  
    601       zhpi(:,:,:)=0._wp ; zhpj(:,:,:)=0._wp 
     565      REAL(wp), DIMENSION(jpi,jpj,jpk ) ::  zhpi, zhpj 
     566      REAL(wp), DIMENSION(jpi,jpj,jpts) ::  zts_top 
     567      REAL(wp), DIMENSION(jpi,jpj)      ::  zrhdtop_oce 
     568      !!---------------------------------------------------------------------- 
     569      ! 
     570      zcoef0 = - grav * 0.5_wp   ! Local constant initialization 
     571      ! 
     572      znad=1._wp                 ! To use density and not density anomaly 
     573      ! 
     574      !                          ! iniitialised to 0. zhpi zhpi  
     575      zhpi(:,:,:) = 0._wp   ;   zhpj(:,:,:) = 0._wp 
    602576 
    603577      ! compute rhd at the ice/oce interface (ocean side) 
    604578      ! usefull to reduce residual current in the test case ISOMIP with no melting 
    605       DO ji=1,jpi 
    606         DO jj=1,jpj 
    607           ikt=mikt(ji,jj) 
    608           ztstop(ji,jj,1)=tsn(ji,jj,ikt,1) 
    609           ztstop(ji,jj,2)=tsn(ji,jj,ikt,2) 
     579      DO ji = 1, jpi 
     580        DO jj = 1, jpj 
     581          ikt = mikt(ji,jj) 
     582          zts_top(ji,jj,1) = tsn(ji,jj,ikt,1) 
     583          zts_top(ji,jj,2) = tsn(ji,jj,ikt,2) 
    610584        END DO 
    611585      END DO 
    612       CALL eos( ztstop, risfdep, zrhdtop_oce ) 
     586      CALL eos( zts_top, risfdep, zrhdtop_oce ) 
    613587 
    614588!==================================================================================      
    … …  
    667641         END DO 
    668642      END DO 
    669      ! 
    670       CALL wrk_dealloc( jpi,jpj,2  , ztstop) 
    671       CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj) 
    672       CALL wrk_dealloc( jpi,jpj    , zrhdtop_oce ) 
    673643      ! 
    674644   END SUBROUTINE hpg_isf 
    … …  
    690660      REAL(wp) ::   z1_12, cffv, cffy   !    "         " 
    691661      LOGICAL  ::   ll_tmp1, ll_tmp2    ! local logical variables 
    692       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj 
    693       REAL(wp), POINTER, DIMENSION(:,:,:) ::  dzx, dzy, dzz, dzu, dzv, dzw 
    694       REAL(wp), POINTER, DIMENSION(:,:,:) ::  drhox, drhoy, drhoz, drhou, drhov, drhow 
    695       REAL(wp), POINTER, DIMENSION(:,:,:) ::  rho_i, rho_j, rho_k 
    696       REAL(wp), POINTER, DIMENSION(:,:)   ::  zcpx, zcpy    !W/D pressure filter 
    697       !!---------------------------------------------------------------------- 
    698       ! 
    699       CALL wrk_alloc( jpi, jpj, jpk, dzx  , dzy  , dzz  , dzu  , dzv  , dzw   ) 
    700       CALL wrk_alloc( jpi, jpj, jpk, drhox, drhoy, drhoz, drhou, drhov, drhow ) 
    701       CALL wrk_alloc( jpi, jpj, jpk, rho_i, rho_j, rho_k,  zhpi,  zhpj        ) 
    702       IF( ln_wd ) CALL wrk_alloc( jpi,jpj, zcpx, zcpy ) 
    703       ! 
     662      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zhpi, zhpj 
     663      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   dzx, dzy, dzz, dzu, dzv, dzw 
     664      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   drhox, drhoy, drhoz, drhou, drhov, drhow 
     665      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   rho_i, rho_j, rho_k 
     666      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zcpx, zcpy   !W/D pressure filter 
     667      !!---------------------------------------------------------------------- 
    704668      ! 
    705669      IF( ln_wd ) THEN 
    706         DO jj = 2, jpjm1 
    707            DO ji = 2, jpim1  
    708              ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                & 
     670         ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 
     671         DO jj = 2, jpjm1 
     672            DO ji = 2, jpim1  
     673               ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                & 
    709674                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) .AND.            & 
    710675                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji+1,jj) + ht_wd(ji+1,jj) ) & 
    711676                  &                                                         > rn_wdmin1 + rn_wdmin2 
    712              ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji+1,jj) ) > 1.E-12 ) .AND. (             & 
     677               ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji+1,jj) ) > 1.E-12 ) .AND. (             & 
    713678                  &    MAX(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                & 
    714679                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 ) 
    715680 
    716              IF(ll_tmp1) THEN 
    717                zcpx(ji,jj) = 1.0_wp 
    718              ELSE IF(ll_tmp2) THEN 
    719                ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here 
    720                zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) & 
    721                            &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) ) 
    722              ELSE 
    723                zcpx(ji,jj) = 0._wp 
    724              END IF 
     681               IF(ll_tmp1) THEN 
     682                  zcpx(ji,jj) = 1.0_wp 
     683               ELSE IF(ll_tmp2) THEN 
     684                  ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here 
     685                  zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) & 
     686                              &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) ) 
     687               ELSE 
     688                  zcpx(ji,jj) = 0._wp 
     689               ENDIF 
    725690       
    726              ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                & 
     691               ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                & 
    727692                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) .AND.            & 
    728693                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji,jj+1) + ht_wd(ji,jj+1) ) & 
    729694                  &                                                         > rn_wdmin1 + rn_wdmin2 
    730              ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji,jj+1) ) > 1.E-12 ) .AND. (             & 
     695               ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji,jj+1) ) > 1.E-12 ) .AND. (             & 
    731696                  &    MAX(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                & 
    732697                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 ) 
    733698 
    734              IF(ll_tmp1) THEN 
    735                zcpy(ji,jj) = 1.0_wp 
    736              ELSE IF(ll_tmp2) THEN 
    737                ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here 
    738                zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) & 
    739                            &    / (sshn(ji,jj+1) -  sshn(ji,jj  )) ) 
    740              ELSE 
    741                zcpy(ji,jj) = 0._wp 
    742              END IF 
    743            END DO 
    744         END DO 
    745         CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp ) 
    746       END IF 
     699               IF(ll_tmp1) THEN 
     700                  zcpy(ji,jj) = 1.0_wp 
     701               ELSE IF(ll_tmp2) THEN 
     702                  ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here 
     703                  zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) & 
     704                              &    / (sshn(ji,jj+1) -  sshn(ji,jj  )) ) 
     705               ELSE 
     706                  zcpy(ji,jj) = 0._wp 
     707               ENDIF 
     708            END DO 
     709         END DO 
     710         CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp ) 
     711      ENDIF 
    747712 
    748713      IF( kt == nit000 ) THEN 
    … …  
    903868         END DO 
    904869      END DO 
    905       CALL lbc_lnk(rho_k,'W',1.) 
    906       CALL lbc_lnk(rho_i,'U',1.) 
    907       CALL lbc_lnk(rho_j,'V',1.) 
     870      CALL lbc_lnk( rho_k, 'W', 1. ) 
     871      CALL lbc_lnk( rho_i, 'U', 1. ) 
     872      CALL lbc_lnk( rho_j, 'V', 1. ) 
    908873 
    909874 
    … …  
    949914      END DO 
    950915      ! 
    951       CALL wrk_dealloc( jpi, jpj, jpk, dzx  , dzy  , dzz  , dzu  , dzv  , dzw   ) 
    952       CALL wrk_dealloc( jpi, jpj, jpk, drhox, drhoy, drhoz, drhou, drhov, drhow ) 
    953       CALL wrk_dealloc( jpi, jpj, jpk, rho_i, rho_j, rho_k,  zhpi,  zhpj        ) 
    954       IF( ln_wd ) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy ) 
     916      IF( ln_wd )   DEALLOCATE( zcpx, zcpy ) 
    955917      ! 
    956918   END SUBROUTINE hpg_djc 
    … …  
    980942      REAL(wp) :: zrhdt1 
    981943      REAL(wp) :: zdpdx1, zdpdx2, zdpdy1, zdpdy2 
    982       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdept, zrhh 
    983       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp 
    984       REAL(wp), POINTER, DIMENSION(:,:)   ::   zsshu_n, zsshv_n 
    985       REAL(wp), POINTER, DIMENSION(:,:)   ::  zcpx, zcpy    !W/D pressure filter 
    986       !!---------------------------------------------------------------------- 
    987       ! 
    988       CALL wrk_alloc( jpi,jpj,jpk,   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp ) 
    989       CALL wrk_alloc( jpi,jpj,jpk,   zdept, zrhh ) 
    990       CALL wrk_alloc( jpi,jpj,       zsshu_n, zsshv_n ) 
    991       IF( ln_wd ) CALL wrk_alloc( jpi,jpj, zcpx, zcpy ) 
     944      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdept, zrhh 
     945      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp 
     946      REAL(wp), DIMENSION(jpi,jpj)   ::   zsshu_n, zsshv_n 
     947      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zcpx, zcpy   !W/D pressure filter 
     948      !!---------------------------------------------------------------------- 
    992949      ! 
    993950      IF( kt == nit000 ) THEN 
    … …  
    1003960 
    1004961      IF( ln_wd ) THEN 
    1005         DO jj = 2, jpjm1 
    1006            DO ji = 2, jpim1  
    1007              ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                & 
     962         ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 
     963         DO jj = 2, jpjm1 
     964            DO ji = 2, jpim1  
     965               ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                & 
    1008966                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) .AND.            & 
    1009967                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji+1,jj) + ht_wd(ji+1,jj) ) & 
    1010968                  &                                                         > rn_wdmin1 + rn_wdmin2 
    1011              ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji+1,jj) ) > 1.E-12 ) .AND. (             & 
     969               ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji+1,jj) ) > 1.E-12 ) .AND. (             & 
    1012970                  &    MAX(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                & 
    1013971                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 ) 
    1014972 
    1015              IF(ll_tmp1) THEN 
    1016                zcpx(ji,jj) = 1.0_wp 
    1017              ELSE IF(ll_tmp2) THEN 
    1018                ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here 
    1019                zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) & 
    1020                            &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) ) 
    1021              ELSE 
    1022                zcpx(ji,jj) = 0._wp 
    1023              END IF 
     973               IF(ll_tmp1) THEN 
     974                  zcpx(ji,jj) = 1.0_wp 
     975               ELSE IF(ll_tmp2) THEN 
     976                  ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here 
     977                  zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) & 
     978                             &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) ) 
     979               ELSE 
     980                  zcpx(ji,jj) = 0._wp 
     981               ENDIF 
    1024982       
    1025              ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                & 
     983               ll_tmp1 = MIN(   sshn(ji,jj)             ,   sshn(ji,jj+1) ) >                & 
    1026984                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) .AND.            & 
    1027985                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji,jj+1) + ht_wd(ji,jj+1) ) & 
    1028986                  &                                                         > rn_wdmin1 + rn_wdmin2 
    1029              ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji,jj+1) ) > 1.E-12 ) .AND. (             & 
     987               ll_tmp2 = ( ABS( sshn(ji,jj)             -   sshn(ji,jj+1) ) > 1.E-12 ) .AND. (             & 
    1030988                  &    MAX(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                & 
    1031989                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 ) 
    1032990 
    1033              IF(ll_tmp1) THEN 
    1034                zcpy(ji,jj) = 1.0_wp 
    1035              ELSE IF(ll_tmp2) THEN 
    1036                ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here 
    1037                zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) & 
     991               IF(ll_tmp1) THEN 
     992                  zcpy(ji,jj) = 1.0_wp 
     993               ELSE IF(ll_tmp2) THEN 
     994                  ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here 
     995                  zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) & 
    1038996                           &    / (sshn(ji,jj+1) -  sshn(ji,jj  )) ) 
    1039              ELSE 
    1040                zcpy(ji,jj) = 0._wp 
    1041              END IF 
    1042            END DO 
    1043         END DO 
    1044         CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp ) 
    1045       END IF 
     997               ELSE 
     998                  zcpy(ji,jj) = 0._wp 
     999               ENDIF 
     1000            END DO 
     1001         END DO 
     1002         CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp ) 
     1003      ENDIF 
    10461004 
    10471005      ! Clean 3-D work arrays 
    … …  
    12981256      END DO 
    12991257      ! 
    1300       CALL wrk_dealloc( jpi,jpj,jpk,   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp ) 
    1301       CALL wrk_dealloc( jpi,jpj,jpk,   zdept, zrhh ) 
    1302       CALL wrk_dealloc( jpi,jpj,       zsshu_n, zsshv_n ) 
    1303       IF( ln_wd ) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy ) 
     1258      IF( ln_wd )   DEALLOCATE( zcpx, zcpy ) 
    13041259      ! 
    13051260   END SUBROUTINE hpg_prj 
    … …  
    13531308           !!Simply geometric average 
    13541309               DO jk = 2, jpkm1-1 
    1355                   zdf1 = (fsp(ji,jj,jk) - fsp(ji,jj,jk-1)) / (xsp(ji,jj,jk) - xsp(ji,jj,jk-1)) 
    1356                   zdf2 = (fsp(ji,jj,jk+1) - fsp(ji,jj,jk)) / (xsp(ji,jj,jk+1) - xsp(ji,jj,jk)) 
     1310                  zdf1 = (fsp(ji,jj,jk  ) - fsp(ji,jj,jk-1)) / (xsp(ji,jj,jk  ) - xsp(ji,jj,jk-1)) 
     1311                  zdf2 = (fsp(ji,jj,jk+1) - fsp(ji,jj,jk  )) / (xsp(ji,jj,jk+1) - xsp(ji,jj,jk  )) 
    13571312 
    13581313                  IF(zdf1 * zdf2 <= 0._wp) THEN 
    … …  
    14031358            END DO 
    14041359         END DO 
    1405  
     1360         ! 
    14061361      ELSE 
    1407            CALL ctl_stop( 'invalid polynomial type in cspline' ) 
    1408       ENDIF 
    1409  
     1362         CALL ctl_stop( 'invalid polynomial type in cspline' ) 
     1363      ENDIF 
     1364      ! 
    14101365   END SUBROUTINE cspline 
    14111366 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90

    r7753 r8568  
    2222   USE lib_mpp         ! MPP library 
    2323   USE prtctl          ! Print control 
    24    USE wrk_nemo        ! Memory Allocation 
    2524   USE timing          ! Timing 
    2625   USE bdy_oce         ! ocean open boundary conditions 
    … …  
    3938#  include "vectopt_loop_substitute.h90" 
    4039   !!---------------------------------------------------------------------- 
    41    !! NEMO/OPA 3.6 , NEMO Consortium (2015) 
     40   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    4241   !! $Id$  
    4342   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    7574      INTEGER, INTENT( in ) ::   kscheme   ! =0/1   type of KEG scheme  
    7675      ! 
    77       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    78       REAL(wp) ::   zu, zv       ! temporary scalars 
    79       REAL(wp), POINTER, DIMENSION(:,:,:) :: zhke 
    80       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv  
    81       INTEGER  ::   jb                 ! dummy loop indices 
    82       INTEGER  ::   ii, ij, igrd, ib_bdy   ! local integers 
    83       INTEGER  ::   fu, fv 
     76      INTEGER  ::   ji, jj, jk, jb    ! dummy loop indices 
     77      INTEGER  ::   ii, ifu, ib_bdy   ! local integers 
     78      INTEGER  ::   ij, ifv, igrd     !   -       - 
     79      REAL(wp) ::   zu, zv            ! local scalars 
     80      REAL(wp), DIMENSION(jpi,jpj,jpk)        ::   zhke 
     81      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv  
    8482      !!---------------------------------------------------------------------- 
    8583      ! 
    86       IF( nn_timing == 1 )   CALL timing_start('dyn_keg') 
    87       ! 
    88       CALL wrk_alloc( jpi,jpj,jpk,   zhke ) 
     84      IF( ln_timing )   CALL timing_start('dyn_keg') 
    8985      ! 
    9086      IF( kt == nit000 ) THEN 
    … …  
    9490      ENDIF 
    9591 
    96       IF( l_trddyn ) THEN           ! Save ua and va trends 
    97          CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
     92      IF( l_trddyn ) THEN           ! Save the input trends 
     93         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 
    9894         ztrdu(:,:,:) = ua(:,:,:)  
    9995         ztrdv(:,:,:) = va(:,:,:)  
    … …  
    112108                     ii   = idx_bdy(ib_bdy)%nbi(jb,igrd) 
    113109                     ij   = idx_bdy(ib_bdy)%nbj(jb,igrd) 
    114                      fu   = NINT( idx_bdy(ib_bdy)%flagu(jb,igrd) ) 
    115                      un(ii-fu,ij,jk) = un(ii,ij,jk) * umask(ii,ij,jk) 
     110                     ifu   = NINT( idx_bdy(ib_bdy)%flagu(jb,igrd) ) 
     111                     un(ii-ifu,ij,jk) = un(ii,ij,jk) * umask(ii,ij,jk) 
    116112                  END DO 
    117113               END DO 
    … …  
    122118                     ii   = idx_bdy(ib_bdy)%nbi(jb,igrd) 
    123119                     ij   = idx_bdy(ib_bdy)%nbj(jb,igrd) 
    124                      fv   = NINT( idx_bdy(ib_bdy)%flagv(jb,igrd) ) 
    125                      vn(ii,ij-fv,jk) = vn(ii,ij,jk) * vmask(ii,ij,jk) 
     120                     ifv   = NINT( idx_bdy(ib_bdy)%flagv(jb,igrd) ) 
     121                     vn(ii,ij-ifv,jk) = vn(ii,ij,jk) * vmask(ii,ij,jk) 
    126122                  END DO 
    127123               END DO 
    … …  
    172168      ENDIF       
    173169 
    174  
    175170      ! 
    176171      DO jk = 1, jpkm1                    !==  grad( KE ) added to the general momentum trends  ==! 
    … …  
    187182         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    188183         CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt ) 
    189          CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
     184         DEALLOCATE( ztrdu , ztrdv ) 
    190185      ENDIF 
    191186      ! 
    … …  
    193188         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    194189      ! 
    195       CALL wrk_dealloc( jpi,jpj,jpk,   zhke ) 
    196       ! 
    197       IF( nn_timing == 1 )   CALL timing_stop('dyn_keg') 
     190      IF( ln_timing )   CALL timing_stop('dyn_keg') 
    198191      ! 
    199192   END SUBROUTINE dyn_keg 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90

    r8215 r8568  
    2727   USE lib_mpp        ! distribued memory computing library 
    2828   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    29    USE wrk_nemo       ! Memory Allocation 
    3029   USE timing         ! Timing 
    3130 
    … …  
    4847#  include "vectopt_loop_substitute.h90" 
    4948   !!---------------------------------------------------------------------- 
    50    !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
     49   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    5150   !! $Id$ 
    5251   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    6261      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    6362      ! 
    64       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
     63      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv 
    6564      !!---------------------------------------------------------------------- 
    6665      ! 
    67       IF( nn_timing == 1 )  CALL timing_start('dyn_ldf') 
     66      IF( ln_timing )   CALL timing_start('dyn_ldf') 
    6867      ! 
    6968      IF( l_trddyn )   THEN                      ! temporary save of momentum trends 
    70          CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
     69         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 
    7170         ztrdu(:,:,:) = ua(:,:,:)  
    7271         ztrdv(:,:,:) = va(:,:,:)  
    … …  
    8584         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    8685         CALL trd_dyn( ztrdu, ztrdv, jpdyn_ldf, kt ) 
    87          CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
     86         DEALLOCATE ( ztrdu , ztrdv ) 
    8887      ENDIF 
    8988      !                                          ! print sum trends (used for debugging) 
    … …  
    9190         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    9291      ! 
    93       IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf') 
     92      IF( ln_timing )   CALL timing_stop('dyn_ldf') 
    9493      ! 
    9594   END SUBROUTINE dyn_ldf 
    … …  
    102101      !! ** Purpose :   initializations of the horizontal ocean dynamics physics 
    103102      !!---------------------------------------------------------------------- 
    104       INTEGER ::   ioptio, ierr         ! temporary integers  
     103      INTEGER ::   ioptio, ierr   ! temporary integers  
    105104      !!---------------------------------------------------------------------- 
    106105      ! 
    107       !                                   ! Namelist nam_dynldf: already read in ldfdyn module 
     106      !                                !==  Namelist nam_dynldf  ==!  already read in ldfdyn module 
    108107      ! 
    109       IF(lwp) THEN                        ! Namelist print 
     108      IF(lwp) THEN                     !== Namelist print  ==! 
    110109         WRITE(numout,*) 
    111110         WRITE(numout,*) 'dyn_ldf_init : Choice of the lateral diffusive operator on dynamics' 
    112111         WRITE(numout,*) '~~~~~~~~~~~~' 
    113112         WRITE(numout,*) '   Namelist nam_dynldf : set lateral mixing parameters (type, direction, coefficients)' 
    114          WRITE(numout,*) '      laplacian operator          ln_dynldf_lap = ', ln_dynldf_lap 
    115          WRITE(numout,*) '      bilaplacian operator        ln_dynldf_blp = ', ln_dynldf_blp 
    116          WRITE(numout,*) '      iso-level                   ln_dynldf_lev = ', ln_dynldf_lev 
    117          WRITE(numout,*) '      horizontal (geopotential)   ln_dynldf_hor = ', ln_dynldf_hor 
    118          WRITE(numout,*) '      iso-neutral                 ln_dynldf_iso = ', ln_dynldf_iso 
     113         WRITE(numout,*) '      Type of operator' 
     114         WRITE(numout,*) '         no explicit diffusion       ln_dynldf_NONE = ', ln_dynldf_NONE 
     115         WRITE(numout,*) '         laplacian operator          ln_dynldf_lap  = ', ln_dynldf_lap 
     116         WRITE(numout,*) '         bilaplacian operator        ln_dynldf_blp  = ', ln_dynldf_blp 
     117         WRITE(numout,*) '      Direction of action' 
     118         WRITE(numout,*) '         iso-level                   ln_dynldf_lev  = ', ln_dynldf_lev 
     119         WRITE(numout,*) '         horizontal (geopotential)   ln_dynldf_hor  = ', ln_dynldf_hor 
     120         WRITE(numout,*) '         iso-neutral                 ln_dynldf_iso  = ', ln_dynldf_iso 
    119121      ENDIF 
    120       !                                   ! use of lateral operator or not 
     122      !                                !==  use of lateral operator or not  ==! 
    121123      nldf = np_ERROR 
    122124      ioptio = 0 
    123       IF( ln_dynldf_lap )   ioptio = ioptio + 1 
    124       IF( ln_dynldf_blp )   ioptio = ioptio + 1 
    125       IF( ioptio >  1   )   CALL ctl_stop( 'dyn_ldf_init: use ONE or NONE of the 2 lap/bilap operator type on momentum' ) 
    126       IF( ioptio == 0   )   nldf = np_no_ldf     ! No lateral mixing operator 
     125      IF( ln_dynldf_NONE ) THEN   ;   nldf = np_no_ldf   ;   ioptio = ioptio + 1   ;   ENDIF 
     126      IF( ln_dynldf_lap  ) THEN   ;                          ioptio = ioptio + 1   ;   ENDIF 
     127      IF( ln_dynldf_blp  ) THEN   ;                          ioptio = ioptio + 1   ;   ENDIF 
     128      IF( ioptio /= 1    )   CALL ctl_stop( 'dyn_ldf_init: use ONE of the 3 operator options (NONE/lap/blp)' ) 
    127129      ! 
    128       IF( nldf /= np_no_ldf ) THEN        ! direction ==>> type of operator   
     130      IF(.NOT.ln_dynldf_NONE ) THEN    !==  direction ==>> type of operator  ==! 
    129131         ioptio = 0 
    130132         IF( ln_dynldf_lev )   ioptio = ioptio + 1 
    131133         IF( ln_dynldf_hor )   ioptio = ioptio + 1 
    132134         IF( ln_dynldf_iso )   ioptio = ioptio + 1 
    133          IF( ioptio >  1   )   CALL ctl_stop( '          use only ONE direction (level/hor/iso)' ) 
    134          IF( ioptio == 0   )   CALL ctl_stop( '          use at least ONE direction (level/hor/iso)' ) 
     135         IF( ioptio /= 1   )   CALL ctl_stop( 'dyn_ldf_init: use ONE of the 3 direction options (level/hor/iso)' ) 
    135136         ! 
    136          !                                   ! Set nldf, the type of lateral diffusion, from ln_dynldf_... logicals 
     137         !                             ! Set nldf, the type of lateral diffusion, from ln_dynldf_... logicals 
    137138         ierr = 0 
    138          IF ( ln_dynldf_lap ) THEN      ! laplacian operator 
    139             IF ( ln_zco ) THEN                ! z-coordinate 
     139         IF( ln_dynldf_lap ) THEN         ! laplacian operator 
     140            IF( ln_zco ) THEN                ! z-coordinate 
    140141               IF ( ln_dynldf_lev )   nldf = np_lap     ! iso-level = horizontal (no rotation) 
    141142               IF ( ln_dynldf_hor )   nldf = np_lap     ! iso-level = horizontal (no rotation) 
    142143               IF ( ln_dynldf_iso )   nldf = np_lap_i   ! iso-neutral            (   rotation) 
    143144            ENDIF 
    144             IF ( ln_zps ) THEN             ! z-coordinate with partial step 
     145            IF( ln_zps ) THEN                ! z-coordinate with partial step 
    145146               IF ( ln_dynldf_lev )   nldf = np_lap     ! iso-level              (no rotation) 
    146147               IF ( ln_dynldf_hor )   nldf = np_lap     ! iso-level              (no rotation) 
    147148               IF ( ln_dynldf_iso )   nldf = np_lap_i   ! iso-neutral            (   rotation) 
    148149            ENDIF 
    149             IF ( ln_sco ) THEN             ! s-coordinate 
     150            IF( ln_sco ) THEN                ! s-coordinate 
    150151               IF ( ln_dynldf_lev )   nldf = np_lap     ! iso-level = horizontal (no rotation) 
    151152               IF ( ln_dynldf_hor )   nldf = np_lap_i   ! horizontal             (   rotation) 
    … …  
    154155         ENDIF 
    155156         ! 
    156          IF( ln_dynldf_blp ) THEN          ! bilaplacian operator 
    157             IF ( ln_zco ) THEN                ! z-coordinate 
    158                IF ( ln_dynldf_lev )   nldf = np_blp     ! iso-level = horizontal (no rotation) 
    159                IF ( ln_dynldf_hor )   nldf = np_blp     ! iso-level = horizontal (no rotation) 
    160                IF ( ln_dynldf_iso )   ierr = 2          ! iso-neutral            (   rotation) 
     157         IF( ln_dynldf_blp ) THEN         ! bilaplacian operator 
     158            IF( ln_zco ) THEN                ! z-coordinate 
     159               IF( ln_dynldf_lev )   nldf = np_blp     ! iso-level = horizontal (no rotation) 
     160               IF( ln_dynldf_hor )   nldf = np_blp     ! iso-level = horizontal (no rotation) 
     161               IF( ln_dynldf_iso )   ierr = 2          ! iso-neutral            (   rotation) 
    161162            ENDIF 
    162             IF ( ln_zps ) THEN             ! z-coordinate with partial step 
    163                IF ( ln_dynldf_lev )   nldf = np_blp     ! iso-level              (no rotation) 
    164                IF ( ln_dynldf_hor )   nldf = np_blp     ! iso-level              (no rotation) 
    165                IF ( ln_dynldf_iso )   ierr = 2          ! iso-neutral            (   rotation) 
     163            IF( ln_zps ) THEN                ! z-coordinate with partial step 
     164               IF( ln_dynldf_lev )   nldf = np_blp     ! iso-level              (no rotation) 
     165               IF( ln_dynldf_hor )   nldf = np_blp     ! iso-level              (no rotation) 
     166               IF( ln_dynldf_iso )   ierr = 2          ! iso-neutral            (   rotation) 
    166167            ENDIF 
    167             IF ( ln_sco ) THEN             ! s-coordinate 
    168                IF ( ln_dynldf_lev )   nldf = np_blp     ! iso-level              (no rotation) 
    169                IF ( ln_dynldf_hor )   ierr = 2          ! horizontal             (   rotation) 
    170                IF ( ln_dynldf_iso )   ierr = 2          ! iso-neutral            (   rotation) 
     168            IF( ln_sco ) THEN                ! s-coordinate 
     169               IF( ln_dynldf_lev )   nldf = np_blp     ! iso-level              (no rotation) 
     170               IF( ln_dynldf_hor )   ierr = 2          ! horizontal             (   rotation) 
     171               IF( ln_dynldf_iso )   ierr = 2          ! iso-neutral            (   rotation) 
    171172            ENDIF 
    172173         ENDIF 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90

    r8215 r8568  
    2828   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2929   USE prtctl          ! Print control 
    30    USE wrk_nemo        ! Memory Allocation 
    3130   USE timing          ! Timing 
    3231 
    … …  
    4544#  include "vectopt_loop_substitute.h90" 
    4645   !!---------------------------------------------------------------------- 
    47    !! NEMO/OPA 3.3 , NEMO Consortium (2011) 
     46   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    4847   !! $Id$ 
    4948   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    108107      ! 
    109108      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    110       REAL(wp) ::   zabe1, zabe2, zcof1, zcof2                       ! local scalars 
    111       REAL(wp) ::   zmskt, zmskf                                     !   -      - 
    112       REAL(wp) ::   zcoef0, zcoef3, zcoef4, zmkt, zmkf               !   -      - 
    113       REAL(wp) ::   zuav, zvav, zuwslpi, zuwslpj, zvwslpi, zvwslpj   !   -      - 
    114       ! 
    115       REAL(wp), POINTER, DIMENSION(:,:) :: ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v 
     109      REAL(wp) ::   zabe1, zmskt, zmkt, zuav, zuwslpi, zuwslpj   ! local scalars 
     110      REAL(wp) ::   zabe2, zmskf, zmkf, zvav, zvwslpi, zvwslpj   !   -      - 
     111      REAL(wp) ::   zcof0, zcof1, zcof2, zcof3, zcof4            !   -      - 
     112      REAL(wp), DIMENSION(jpi,jpj) ::   ziut, zivf, zdku, zdk1u  ! 2D workspace 
     113      REAL(wp), DIMENSION(jpi,jpj) ::   zjuf, zjvt, zdkv, zdk1v  !  -      - 
    116114      !!---------------------------------------------------------------------- 
    117115      ! 
    118       IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_iso') 
    119       ! 
    120       CALL wrk_alloc( jpi, jpj, ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v )  
     116      IF( ln_timing )   CALL timing_start('dyn_ldf_iso') 
    121117      ! 
    122118      IF( kt == nit000 ) THEN 
    … …  
    343339         DO jk = 2, jpkm1 
    344340            DO ji = 2, jpim1 
    345                zcoef0= 0.5 * rn_aht_0 * umask(ji,jj,jk) 
     341               zcof0 = 0.5_wp * rn_aht_0 * umask(ji,jj,jk) 
    346342               ! 
    347                zuwslpi = zcoef0 * ( wslpi(ji+1,jj,jk) + wslpi(ji,jj,jk) ) 
    348                zuwslpj = zcoef0 * ( wslpj(ji+1,jj,jk) + wslpj(ji,jj,jk) ) 
     343               zuwslpi = zcof0 * ( wslpi(ji+1,jj,jk) + wslpi(ji,jj,jk) ) 
     344               zuwslpj = zcof0 * ( wslpj(ji+1,jj,jk) + wslpj(ji,jj,jk) ) 
    349345               ! 
    350                zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji+1,jj,jk-1)   & 
    351                              + tmask(ji,jj,jk  )+tmask(ji+1,jj,jk  ), 1. ) 
    352                zmkf = 1./MAX(  fmask(ji,jj-1,jk-1) + fmask(ji,jj,jk-1)   & 
    353                              + fmask(ji,jj-1,jk  ) + fmask(ji,jj,jk  ), 1. ) 
    354  
    355                zcoef3 = - e2u(ji,jj) * zmkt * zuwslpi 
    356                zcoef4 = - e1u(ji,jj) * zmkf * zuwslpj 
     346               zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji+1,jj,jk-1)      & 
     347                             + tmask(ji,jj,jk  )+tmask(ji+1,jj,jk  ) , 1. ) 
     348               zmkf = 1./MAX(  fmask(ji,jj-1,jk-1) + fmask(ji,jj,jk-1)      & 
     349                             + fmask(ji,jj-1,jk  ) + fmask(ji,jj,jk  ) , 1. ) 
     350 
     351               zcof3 = - e2u(ji,jj) * zmkt * zuwslpi 
     352               zcof4 = - e1u(ji,jj) * zmkf * zuwslpj 
    357353               ! vertical flux on u field 
    358                zfuw(ji,jk) = zcoef3 * ( zdiu (ji,jk-1) + zdiu (ji+1,jk-1)     & 
    359                                        +zdiu (ji,jk  ) + zdiu (ji+1,jk  ) )   & 
    360                            + zcoef4 * ( zdj1u(ji,jk-1) + zdju (ji  ,jk-1)     & 
    361                                        +zdj1u(ji,jk  ) + zdju (ji  ,jk  ) ) 
     354               zfuw(ji,jk) = zcof3 * (  zdiu (ji,jk-1) + zdiu (ji+1,jk-1)      & 
     355                  &                   + zdiu (ji,jk  ) + zdiu (ji+1,jk  ) )   & 
     356                  &        + zcof4 * (  zdj1u(ji,jk-1) + zdju (ji  ,jk-1)      & 
     357                  &                   + zdj1u(ji,jk  ) + zdju (ji  ,jk  ) ) 
    362358               ! vertical mixing coefficient (akzu) 
    363                ! Note: zcoef0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0 
     359               ! Note: zcof0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0 
    364360               akzu(ji,jj,jk) = ( zuwslpi * zuwslpi + zuwslpj * zuwslpj ) / rn_aht_0 
    365361            END DO 
    … …  
    369365         DO jk = 2, jpkm1 
    370366            DO ji = 2, jpim1 
    371                zcoef0 = 0.5 * rn_aht_0 * vmask(ji,jj,jk) 
    372  
    373                zvwslpi = zcoef0 * ( wslpi(ji,jj+1,jk) + wslpi(ji,jj,jk) ) 
    374                zvwslpj = zcoef0 * ( wslpj(ji,jj+1,jk) + wslpj(ji,jj,jk) ) 
    375  
    376                zmkf = 1./MAX(  fmask(ji-1,jj,jk-1)+fmask(ji,jj,jk-1)   & 
    377                              + fmask(ji-1,jj,jk  )+fmask(ji,jj,jk  ), 1. ) 
    378                zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji,jj+1,jk-1)   & 
    379                              + tmask(ji,jj,jk  )+tmask(ji,jj+1,jk  ), 1. ) 
    380  
    381                zcoef3 = - e2v(ji,jj) * zmkf * zvwslpi 
    382                zcoef4 = - e1v(ji,jj) * zmkt * zvwslpj 
     367               zcof0 = 0.5_wp * rn_aht_0 * vmask(ji,jj,jk) 
     368               ! 
     369               zvwslpi = zcof0 * ( wslpi(ji,jj+1,jk) + wslpi(ji,jj,jk) ) 
     370               zvwslpj = zcof0 * ( wslpj(ji,jj+1,jk) + wslpj(ji,jj,jk) ) 
     371               ! 
     372               zmkf = 1./MAX(  fmask(ji-1,jj,jk-1)+fmask(ji,jj,jk-1)      & 
     373                  &          + fmask(ji-1,jj,jk  )+fmask(ji,jj,jk  ) , 1. ) 
     374               zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji,jj+1,jk-1)      & 
     375                  &          + tmask(ji,jj,jk  )+tmask(ji,jj+1,jk  ) , 1. ) 
     376 
     377               zcof3 = - e2v(ji,jj) * zmkf * zvwslpi 
     378               zcof4 = - e1v(ji,jj) * zmkt * zvwslpj 
    383379               ! vertical flux on v field 
    384                zfvw(ji,jk) = zcoef3 * ( zdiv (ji,jk-1) + zdiv (ji-1,jk-1)     & 
    385                   &                    +zdiv (ji,jk  ) + zdiv (ji-1,jk  ) )   & 
    386                   &        + zcoef4 * ( zdjv (ji,jk-1) + zdj1v(ji  ,jk-1)     & 
    387                   &                    +zdjv (ji,jk  ) + zdj1v(ji  ,jk  ) ) 
     380               zfvw(ji,jk) = zcof3 * (  zdiv (ji,jk-1) + zdiv (ji-1,jk-1)      & 
     381                  &                   + zdiv (ji,jk  ) + zdiv (ji-1,jk  ) )   & 
     382                  &        + zcof4 * (  zdjv (ji,jk-1) + zdj1v(ji  ,jk-1)      & 
     383                  &                   + zdjv (ji,jk  ) + zdj1v(ji  ,jk  ) ) 
    388384               ! vertical mixing coefficient (akzv) 
    389                ! Note: zcoef0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0 
     385               ! Note: zcof0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0 
    390386               akzv(ji,jj,jk) = ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) / rn_aht_0 
    391387            END DO 
    … …  
    404400      END DO                                           !   End of slab 
    405401      !                                                ! =============== 
    406       CALL wrk_dealloc( jpi, jpj, ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v )  
    407402      ! 
    408       IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_iso') 
     403      IF( ln_timing )   CALL timing_stop('dyn_ldf_iso') 
    409404      ! 
    410405   END SUBROUTINE dyn_ldf_iso 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap_blp.F90

    r7753 r8568  
    1919   USE in_out_manager ! I/O manager 
    2020   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    21    USE wrk_nemo       ! Memory Allocation 
    2221   USE timing         ! Timing 
    2322 
    … …  
    3130#  include "vectopt_loop_substitute.h90" 
    3231   !!---------------------------------------------------------------------- 
    33    !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
     32   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    3433   !! $Id$  
    3534   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    5756      REAL(wp) ::   zsign        ! local scalars 
    5857      REAL(wp) ::   zua, zva     ! local scalars 
    59       REAL(wp), POINTER, DIMENSION(:,:) ::  zcur, zdiv 
     58      REAL(wp), DIMENSION(jpi,jpj) ::   zcur, zdiv 
    6059      !!---------------------------------------------------------------------- 
    6160      ! 
    … …  
    6665      ENDIF 
    6766      ! 
    68       IF( nn_timing == 1 )   CALL timing_start('dyn_ldf_lap') 
    69       ! 
    70       CALL wrk_alloc( jpi, jpj, zcur, zdiv )  
     67      IF( ln_timing )   CALL timing_start('dyn_ldf_lap') 
    7168      ! 
    7269      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign 
    … …  
    107104      END DO                                           !   End of slab 
    108105      !                                                ! =============== 
    109       CALL wrk_dealloc( jpi, jpj, zcur, zdiv )  
    110106      ! 
    111       IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_lap') 
     107      IF( ln_timing )   CALL timing_stop('dyn_ldf_lap') 
    112108      ! 
    113109   END SUBROUTINE dyn_ldf_lap 
    … …  
    131127      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva   ! momentum trend 
    132128      ! 
    133       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zulap, zvlap   ! laplacian at u- and v-point 
     129      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zulap, zvlap   ! laplacian at u- and v-point 
    134130      !!---------------------------------------------------------------------- 
    135131      ! 
    136       IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_blp') 
    137       ! 
    138       CALL wrk_alloc( jpi, jpj, jpk, zulap, zvlap )  
     132      IF( ln_timing )   CALL timing_start('dyn_ldf_blp') 
    139133      ! 
    140134      IF( kt == nit000 )  THEN 
    … …  
    154148      CALL dyn_ldf_lap( kt, zulap, zvlap, pua, pva, 2 )   ! rotated laplacian applied to zlap (output in pta) 
    155149      ! 
    156       CALL wrk_dealloc( jpi, jpj, jpk, zulap, zvlap )  
    157       ! 
    158       IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_blp') 
     150      IF( ln_timing )   CALL timing_stop('dyn_ldf_blp') 
    159151      ! 
    160152   END SUBROUTINE dyn_ldf_blp 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r7753 r8568  
    4444   USE lbclnk         ! lateral boundary condition (or mpp link) 
    4545   USE lib_mpp        ! MPP library 
    46    USE wrk_nemo       ! Memory Allocation 
    4746   USE prtctl         ! Print control 
    4847   USE timing         ! Timing 
    … …  
    5756 
    5857   !!---------------------------------------------------------------------- 
    59    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     58   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    6059   !! $Id$  
    6160   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    9796      REAL(wp) ::   zue3a, zue3n, zue3b, zuf, zcoef    ! local scalars 
    9897      REAL(wp) ::   zve3a, zve3n, zve3b, zvf, z1_2dt   !   -      - 
    99       REAL(wp), POINTER, DIMENSION(:,:)   ::  zue, zve 
    100       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ze3u_f, ze3v_f, zua, zva  
     98      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zue, zve 
     99      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ze3u_f, ze3v_f, zua, zva  
    101100      !!---------------------------------------------------------------------- 
    102101      ! 
    103       IF( nn_timing == 1 )   CALL timing_start('dyn_nxt') 
    104       ! 
    105       IF( ln_dynspg_ts       )   CALL wrk_alloc( jpi,jpj,       zue, zve) 
    106       IF( l_trddyn           )   CALL wrk_alloc( jpi,jpj,jpk,   zua, zva) 
     102      IF( ln_timing    )   CALL timing_start('dyn_nxt') 
     103      IF( ln_dynspg_ts )   ALLOCATE( zue(jpi,jpj)     , zve(jpi,jpj)     ) 
     104      IF( l_trddyn     )   ALLOCATE( zua(jpi,jpj,jpk) , zva(jpi,jpj,jpk) ) 
    107105      ! 
    108106      IF( kt == nit000 ) THEN 
    … …  
    253251            ELSE                          ! Asselin filter applied on thickness weighted velocity 
    254252               ! 
    255                CALL wrk_alloc( jpi,jpj,jpk,   ze3u_f, ze3v_f ) 
     253               ALLOCATE( ze3u_f(jpi,jpj,jpk) , ze3v_f(jpi,jpj,jpk) ) 
    256254               ! Before filtered scale factor at (u/v)-points stored in ze3u_f, ze3v_f 
    257255               CALL dom_vvl_interpol( e3t_b(:,:,:), ze3u_f, 'U' ) 
    … …  
    280278               e3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1) 
    281279               ! 
    282                CALL wrk_dealloc( jpi,jpj,jpk,   ze3u_f, ze3v_f ) 
     280               DEALLOCATE( ze3u_f , ze3v_f ) 
    283281            ENDIF 
    284282            ! 
    … …  
    346344         &                       tab3d_2=vn, clinfo2=' Vn: '       , mask2=vmask ) 
    347345      !  
    348       IF( ln_dynspg_ts )   CALL wrk_dealloc( jpi,jpj,       zue, zve ) 
    349       IF( l_trddyn     )   CALL wrk_dealloc( jpi,jpj,jpk,   zua, zva ) 
    350       ! 
    351       IF( nn_timing == 1 )  CALL timing_stop('dyn_nxt') 
     346      IF( ln_dynspg_ts )   DEALLOCATE( zue, zve ) 
     347      IF( l_trddyn     )   DEALLOCATE( zua, zva ) 
     348      IF( ln_timing    )   CALL timing_stop('dyn_nxt') 
    352349      ! 
    353350   END SUBROUTINE dyn_nxt 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r7753 r8568  
    2828   USE in_out_manager ! I/O manager 
    2929   USE lib_mpp        ! MPP library 
    30    USE wrk_nemo       ! Memory Allocation 
    3130   USE timing         ! Timing 
    3231 
    … …  
    4746#  include "vectopt_loop_substitute.h90" 
    4847   !!---------------------------------------------------------------------- 
    49    !! NEMO/OPA 3.2 , LODYC-IPSL  (2009) 
     48   !! NEMO/OPA 4.0 , LODYC-IPSL  (2017) 
    5049   !! $Id$  
    5150   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    7170      !!             period is used to prevent the divergence of odd and even time step. 
    7271      !!---------------------------------------------------------------------- 
    73       INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
    74       ! 
    75       INTEGER  ::   ji, jj, jk                             ! dummy loop indices 
    76       REAL(wp) ::   z2dt, zg_2, zintp, zgrau0r             ! temporary scalar 
    77       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
    78       REAL(wp), POINTER, DIMENSION(:,:)   ::  zpice 
    79       !!---------------------------------------------------------------------- 
    80       ! 
    81       IF( nn_timing == 1 )  CALL timing_start('dyn_spg') 
     72      INTEGER, INTENT(in   ) ::   kt   ! ocean time-step index 
     73      ! 
     74      INTEGER  ::   ji, jj, jk                   ! dummy loop indices 
     75      REAL(wp) ::   z2dt, zg_2, zintp, zgrau0r   ! local scalars 
     76      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zpice 
     77      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv 
     78      !!---------------------------------------------------------------------- 
     79      ! 
     80      IF( ln_timing )   CALL timing_start('dyn_spg') 
    8281      ! 
    8382      IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends 
    84          CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv )  
     83         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) )  
    8584         ztrdu(:,:,:) = ua(:,:,:) 
    8685         ztrdv(:,:,:) = va(:,:,:) 
    … …  
    124123         ! 
    125124         IF( nn_ice_embd == 2 ) THEN          !== embedded sea ice: Pressure gradient due to snow-ice mass ==! 
    126             CALL wrk_alloc( jpi,jpj,   zpice ) 
    127             !                                             
     125            ALLOCATE( zpice(jpi,jpj) ) 
    128126            zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc ) 
    129127            zgrau0r     = - grav * r1_rau0 
    … …  
    135133               END DO 
    136134            END DO 
    137             ! 
    138             CALL wrk_dealloc( jpi,jpj,   zpice )          
     135            DEALLOCATE( zpice )          
    139136         ENDIF 
    140137         ! 
    … …  
    161158         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    162159         CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt ) 
    163          CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv )  
     160         DEALLOCATE( ztrdu , ztrdv )  
    164161      ENDIF 
    165162      !                                      ! print mean trends (used for debugging) 
    … …  
    167164         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    168165      ! 
    169       IF( nn_timing == 1 )  CALL timing_stop('dyn_spg') 
     166      IF( ln_timing )   CALL timing_stop('dyn_spg') 
    170167      ! 
    171168   END SUBROUTINE dyn_spg 
    … …  
    186183      !!---------------------------------------------------------------------- 
    187184      ! 
    188       IF( nn_timing == 1 )  CALL timing_start('dyn_spg_init') 
     185      IF( ln_timing )   CALL timing_start('dyn_spg_init') 
    189186      ! 
    190187      REWIND( numnam_ref )              ! Namelist namdyn_spg in reference namelist : Free surface 
    … …  
    227224      ENDIF 
    228225      ! 
    229       IF( nn_timing == 1 )  CALL timing_stop('dyn_spg_init') 
     226      IF( ln_timing )   CALL timing_stop('dyn_spg_init') 
    230227      ! 
    231228   END SUBROUTINE dyn_spg_init 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90

    r6140 r8568  
    6161      !!---------------------------------------------------------------------- 
    6262      ! 
    63       IF( nn_timing == 1 )  CALL timing_start('dyn_spg_exp') 
     63      IF( ln_timing )   CALL timing_start('dyn_spg_exp') 
    6464      ! 
    6565      IF( kt == nit000 ) THEN 
    … …  
    9393      ENDIF 
    9494      ! 
    95       IF( nn_timing == 1 )  CALL timing_stop('dyn_spg_exp') 
     95      IF( ln_timing )   CALL timing_stop('dyn_spg_exp') 
    9696      ! 
    9797   END SUBROUTINE dyn_spg_exp 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r8215 r8568  
    162162      !!---------------------------------------------------------------------- 
    163163      ! 
    164       IF( nn_timing == 1 )   CALL timing_start('dyn_spg_ts') 
     164      IF( ln_timing )   CALL timing_start('dyn_spg_ts') 
    165165      ! 
    166166      IF( ln_wd ) ALLOCATE( zcpx(jpi,jpj), zcpy(jpi,jpj) ) 
    … …  
    11251125      IF( ln_wd )   DEALLOCATE( zcpx, zcpy ) 
    11261126      ! 
    1127       IF ( ln_diatmb ) THEN 
     1127      IF( ln_diatmb ) THEN 
    11281128         CALL iom_put( "baro_u" , un_b*umask(:,:,1)+zmdi*(1-umask(:,:,1 ) ) )  ! Barotropic  U Velocity 
    11291129         CALL iom_put( "baro_v" , vn_b*vmask(:,:,1)+zmdi*(1-vmask(:,:,1 ) ) )  ! Barotropic  V Velocity 
    11301130      ENDIF 
    1131       IF( nn_timing == 1 )  CALL timing_stop('dyn_spg_ts') 
     1131      IF( ln_timing )   CALL timing_stop('dyn_spg_ts') 
    11321132      ! 
    11331133   END SUBROUTINE dyn_spg_ts 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r7753 r8568  
    1414   !!            2.0  ! 2006-11  (G. Madec)  flux form advection: add metric term 
    1515   !!            3.2  ! 2009-04  (R. Benshila)  vvl: correction of een scheme 
    16    !!            3.3  ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    17    !!            3.7  ! 2014-04  (G. Madec) trend simplification: suppress jpdyn_trd_dat vorticity  
    18    !!             -   ! 2014-06  (G. Madec) suppression of velocity curl from in-core memory 
     16   !!            3.3  ! 2010-10  (C. Ethe, G. Madec)  reorganisation of initialisation phase 
     17   !!            3.7  ! 2014-04  (G. Madec)  trend simplification: suppress jpdyn_trd_dat vorticity  
     18   !!             -   ! 2014-06  (G. Madec)  suppression of velocity curl from in-core memory 
    1919   !!             -   ! 2016-12  (G. Madec, E. Clementi) add Stokes-Coriolis trends (ln_stcor=T) 
     20   !!            4.0  ! 2017-07  (G. Madec)  linear dynamics + trends diag. with Stokes-Coriolis 
    2021   !!---------------------------------------------------------------------- 
    2122 
    2223   !!---------------------------------------------------------------------- 
    23    !!   dyn_vor      : Update the momentum trend with the vorticity trend 
    24    !!       vor_ens  : enstrophy conserving scheme       (ln_dynvor_ens=T) 
    25    !!       vor_ene  : energy conserving scheme          (ln_dynvor_ene=T) 
    26    !!       vor_een  : energy and enstrophy conserving   (ln_dynvor_een=T) 
    27    !!   dyn_vor_init : set and control of the different vorticity option 
     24   !!   dyn_vor       : Update the momentum trend with the vorticity trend 
     25   !!       vor_ens   : enstrophy conserving scheme       (ln_dynvor_ens=T) 
     26   !!       vor_ene   : energy conserving scheme          (ln_dynvor_ene=T) 
     27   !!       vor_een   : energy and enstrophy conserving   (ln_dynvor_een=T) 
     28   !!   dyn_vor_init  : set and control of the different vorticity option 
    2829   !!---------------------------------------------------------------------- 
    2930   USE oce            ! ocean dynamics and tracers 
    3031   USE dom_oce        ! ocean space and time domain 
    3132   USE dommsk         ! ocean mask 
    32    USE dynadv         ! momentum advection (use ln_dynadv_vec value) 
     33   USE dynadv         ! momentum advection 
    3334   USE trd_oce        ! trends: ocean variables 
    3435   USE trddyn         ! trend manager: dynamics 
    … …  
    4041   USE in_out_manager ! I/O manager 
    4142   USE lib_mpp        ! MPP library 
    42    USE wrk_nemo       ! Memory Allocation 
    4343   USE timing         ! Timing 
    44  
    4544 
    4645   IMPLICIT NONE 
    … …  
    8079#  include "vectopt_loop_substitute.h90" 
    8180   !!---------------------------------------------------------------------- 
    82    !! NEMO/OPA 3.7 , NEMO Consortium (2016) 
     81   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    8382   !! $Id$ 
    8483   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    9897      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    9998      ! 
    100       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
    101       !!---------------------------------------------------------------------- 
    102       ! 
    103       IF( nn_timing == 1 )  CALL timing_start('dyn_vor') 
    104       ! 
    105       IF( l_trddyn )   CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
    106       ! 
    107       SELECT CASE ( nvor_scheme )               !==  vorticity trend added to the general trend  ==! 
    108       ! 
    109       CASE ( np_ENE )                                 !* energy conserving scheme 
    110          IF( l_trddyn ) THEN                                ! trend diagnostics: split the trend in two 
     99      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
     100      !!---------------------------------------------------------------------- 
     101      ! 
     102      IF( ln_timing )   CALL timing_start('dyn_vor') 
     103      ! 
     104      IF( l_trddyn ) THEN     !==  trend diagnostics case : split the added trend in two parts  ==! 
     105         ! 
     106         ALLOCATE( ztrdu(jpi,jpj,jpk), ztrdv(jpi,jpj,jpk) ) 
     107         ! 
     108         ztrdu(:,:,:) = ua(:,:,:)            !* planetary vorticity trend (including Stokes-Coriolis force) 
     109         ztrdv(:,:,:) = va(:,:,:) 
     110         SELECT CASE( nvor_scheme ) 
     111         CASE( np_ENE, np_MIX )   ;   CALL vor_ene( kt, ncor, un , vn , ua, va )   ! energy conserving scheme 
     112            IF( ln_stcor )            CALL vor_ene( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend 
     113         CASE( np_ENS )           ;   CALL vor_ens( kt, ncor, un , vn , ua, va )   ! enstrophy conserving scheme 
     114            IF( ln_stcor )            CALL vor_ens( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend 
     115         CASE( np_EEN )           ;   CALL vor_een( kt, ncor, un , vn , ua, va )   ! energy & enstrophy scheme 
     116            IF( ln_stcor )            CALL vor_een( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend 
     117         END SELECT 
     118         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
     119         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     120         CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
     121         ! 
     122         IF( n_dynadv /= np_LIN_dyn ) THEN   !* relative vorticity or metric trend (only in non-linear case) 
    111123            ztrdu(:,:,:) = ua(:,:,:) 
    112124            ztrdv(:,:,:) = va(:,:,:) 
    113             CALL vor_ene( kt, nrvm, un , vn , ua, va )                    ! relative vorticity or metric trend 
     125            SELECT CASE( nvor_scheme ) 
     126            CASE( np_ENE )           ;   CALL vor_ene( kt, nrvm, un , vn , ua, va )  ! energy conserving scheme 
     127            CASE( np_ENS, np_MIX )   ;   CALL vor_ens( kt, nrvm, un , vn , ua, va )  ! enstrophy conserving scheme 
     128            CASE( np_EEN )           ;   CALL vor_een( kt, nrvm, un , vn , ua, va )  ! energy & enstrophy scheme 
     129            END SELECT 
    114130            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    115131            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    116132            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 
    117             ztrdu(:,:,:) = ua(:,:,:) 
    118             ztrdv(:,:,:) = va(:,:,:) 
    119             CALL vor_ene( kt, ncor, un , vn , ua, va )                    ! planetary vorticity trend 
    120             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    121             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    122             CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
    123          ELSE                                               ! total vorticity trend 
     133         ENDIF 
     134         ! 
     135         DEALLOCATE( ztrdu, ztrdv ) 
     136         ! 
     137      ELSE              !==  total vorticity trend added to the general trend  ==! 
     138         ! 
     139         SELECT CASE ( nvor_scheme )      !==  vorticity trend added to the general trend  ==! 
     140         CASE( np_ENE )                        !* energy conserving scheme 
    124141                             CALL vor_ene( kt, ntot, un , vn , ua, va )   ! total vorticity trend 
    125142            IF( ln_stcor )   CALL vor_ene( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend 
    126          ENDIF 
    127          ! 
    128       CASE ( np_ENS )                                 !* enstrophy conserving scheme 
    129          IF( l_trddyn ) THEN                                ! trend diagnostics: splitthe trend in two     
    130             ztrdu(:,:,:) = ua(:,:,:) 
    131             ztrdv(:,:,:) = va(:,:,:) 
    132             CALL vor_ens( kt, nrvm, un , vn , ua, va )            ! relative vorticity or metric trend 
    133             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    134             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    135             CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 
    136             ztrdu(:,:,:) = ua(:,:,:) 
    137             ztrdv(:,:,:) = va(:,:,:) 
    138             CALL vor_ens( kt, ncor, un , vn , ua, va )            ! planetary vorticity trend 
    139             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    140             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    141             CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
    142          ELSE                                               ! total vorticity trend 
     143         CASE( np_ENS )                        !* enstrophy conserving scheme 
    143144                             CALL vor_ens( kt, ntot, un , vn , ua, va )  ! total vorticity trend 
    144145            IF( ln_stcor )   CALL vor_ens( kt, ncor, usd, vsd, ua, va )  ! add the Stokes-Coriolis trend 
    145          ENDIF 
    146          ! 
    147       CASE ( np_MIX )                                 !* mixed ene-ens scheme 
    148          IF( l_trddyn ) THEN                                ! trend diagnostics: split the trend in two 
    149             ztrdu(:,:,:) = ua(:,:,:) 
    150             ztrdv(:,:,:) = va(:,:,:) 
    151             CALL vor_ens( kt, nrvm, un , vn , ua, va )            ! relative vorticity or metric trend (ens) 
    152             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    153             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    154             CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 
    155             ztrdu(:,:,:) = ua(:,:,:) 
    156             ztrdv(:,:,:) = va(:,:,:) 
    157             CALL vor_ene( kt, ncor, un , vn , ua, va )            ! planetary vorticity trend (ene) 
    158             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    159             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    160             CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
    161          ELSE                                               ! total vorticity trend 
     146         CASE( np_MIX )                        !* mixed ene-ens scheme 
    162147                             CALL vor_ens( kt, nrvm, un , vn , ua, va )   ! relative vorticity or metric trend (ens) 
    163148                             CALL vor_ene( kt, ncor, un , vn , ua, va )   ! planetary vorticity trend (ene) 
    164149            IF( ln_stcor )   CALL vor_ene( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend 
    165         ENDIF 
    166          ! 
    167       CASE ( np_EEN )                                 !* energy and enstrophy conserving scheme 
    168          IF( l_trddyn ) THEN                                ! trend diagnostics: split the trend in two 
    169             ztrdu(:,:,:) = ua(:,:,:) 
    170             ztrdv(:,:,:) = va(:,:,:) 
    171             CALL vor_een( kt, nrvm, un , vn , ua, va )            ! relative vorticity or metric trend 
    172             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    173             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    174             CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 
    175             ztrdu(:,:,:) = ua(:,:,:) 
    176             ztrdv(:,:,:) = va(:,:,:) 
    177             CALL vor_een( kt, ncor, un , vn , ua, va )            ! planetary vorticity trend 
    178             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    179             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    180             CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
    181          ELSE                                               ! total vorticity trend 
     150         CASE( np_EEN )                        !* energy and enstrophy conserving scheme 
    182151                             CALL vor_een( kt, ntot, un , vn , ua, va )   ! total vorticity trend 
    183152            IF( ln_stcor )   CALL vor_ene( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend 
    184          ENDIF 
    185          ! 
    186       END SELECT 
     153         END SELECT 
     154         ! 
     155      ENDIF 
    187156      ! 
    188157      !                       ! print sum trends (used for debugging) 
    … …  
    190159         &                     tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    191160      ! 
    192       IF( l_trddyn )   CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
    193       ! 
    194       IF( nn_timing == 1 )  CALL timing_stop('dyn_vor') 
     161      IF( ln_timing )   CALL timing_stop('dyn_vor') 
    195162      ! 
    196163   END SUBROUTINE dyn_vor 
    … …  
    217184      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
    218185      !!---------------------------------------------------------------------- 
    219       INTEGER , INTENT(in   )                         ::   kt          ! ocean time-step index 
    220       INTEGER , INTENT(in   )                         ::   kvor        ! =ncor (planetary) ; =ntot (total) ; 
    221       !                                                                ! =nrvm (relative vorticity or metric) 
    222       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pun, pvn    ! now velocities 
    223       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua, pva    ! total v-trend 
     186      INTEGER                          , INTENT(in   )::   kt          ! ocean time-step index 
     187      INTEGER                          , INTENT(in   )::   kvor        ! total, planetary, relative, or metric 
     188      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun, pvn    ! now velocities 
     189      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva    ! total v-trend 
    224190      ! 
    225191      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    226192      REAL(wp) ::   zx1, zy1, zx2, zy2   ! local scalars 
    227       REAL(wp), POINTER, DIMENSION(:,:) ::   zwx, zwy, zwz   ! 2D workspace 
    228       !!---------------------------------------------------------------------- 
    229       ! 
    230       IF( nn_timing == 1 )  CALL timing_start('vor_ene') 
    231       ! 
    232       CALL wrk_alloc( jpi,jpj,   zwx, zwy, zwz )  
     193      REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz   ! 2D workspace 
     194      !!---------------------------------------------------------------------- 
     195      ! 
     196      IF( ln_timing )  CALL timing_start('vor_ene') 
    233197      ! 
    234198      IF( kt == nit000 ) THEN 
    … …  
    264228               DO ji = 1, fs_jpim1   ! vector opt. 
    265229                  zwz(ji,jj) = ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pvn(ji+1,jj  ,jk) - e2v(ji,jj) * pvn(ji,jj,jk)    & 
    266                      &                      - e1u(ji  ,jj+1) * pun(ji  ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) & 
     230                     &                      - e1u(ji  ,jj+1) * pun(ji  ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  )   & 
    267231                     &                   * r1_e1e2f(ji,jj) 
    268232               END DO 
    … …  
    311275      END DO                                           !   End of slab 
    312276      !                                                ! =============== 
    313       CALL wrk_dealloc( jpi, jpj, zwx, zwy, zwz )  
    314       ! 
    315       IF( nn_timing == 1 )  CALL timing_stop('vor_ene') 
     277      ! 
     278      IF( ln_timing )  CALL timing_stop('vor_ene') 
    316279      ! 
    317280   END SUBROUTINE vor_ene 
    … …  
    338301      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
    339302      !!---------------------------------------------------------------------- 
    340       INTEGER , INTENT(in   )                         ::   kt          ! ocean time-step index 
    341       INTEGER , INTENT(in   )                         ::   kvor        ! =ncor (planetary) ; =ntot (total) ; 
    342          !                                                             ! =nrvm (relative vorticity or metric) 
    343       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pun, pvn    ! now velocities 
    344       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua, pva    ! total v-trend 
     303      INTEGER                          , INTENT(in   )::   kt          ! ocean time-step index 
     304      INTEGER                          , INTENT(in   )::   kvor        ! total, planetary, relative, or metric 
     305      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun, pvn    ! now velocities 
     306      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva    ! total v-trend 
    345307      ! 
    346308      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    347309      REAL(wp) ::   zuav, zvau   ! local scalars 
    348       REAL(wp), POINTER, DIMENSION(:,:) ::   zwx, zwy, zwz, zww   ! 2D workspace 
    349       !!---------------------------------------------------------------------- 
    350       ! 
    351       IF( nn_timing == 1 )  CALL timing_start('vor_ens') 
    352       ! 
    353       CALL wrk_alloc( jpi,jpj,   zwx, zwy, zwz )  
     310      REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz, zww   ! 2D workspace 
     311      !!---------------------------------------------------------------------- 
     312      ! 
     313      IF( ln_timing )   CALL timing_start('vor_ens') 
    354314      ! 
    355315      IF( kt == nit000 ) THEN 
    … …  
    431391      END DO                                           !   End of slab 
    432392      !                                                ! =============== 
    433       CALL wrk_dealloc( jpi, jpj, zwx, zwy, zwz )  
    434       ! 
    435       IF( nn_timing == 1 )  CALL timing_stop('vor_ens') 
     393      ! 
     394      IF( ln_timing )   CALL timing_stop('vor_ens') 
    436395      ! 
    437396   END SUBROUTINE vor_ens 
    … …  
    455414      !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36 
    456415      !!---------------------------------------------------------------------- 
    457       INTEGER , INTENT(in   )                         ::   kt          ! ocean time-step index 
    458       INTEGER , INTENT(in   )                         ::   kvor        ! =ncor (planetary) ; =ntot (total) ; 
    459          !                                                             ! =nrvm (relative vorticity or metric) 
    460       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pun, pvn    ! now velocities 
    461       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua, pva    ! total v-trend 
     416      INTEGER                          , INTENT(in   )::   kt          ! ocean time-step index 
     417      INTEGER                          , INTENT(in   )::   kvor        ! total, planetary, relative, or metric 
     418      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun, pvn    ! now velocities 
     419      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva    ! total v-trend 
    462420      ! 
    463421      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    465423      REAL(wp) ::   zua, zva     ! local scalars 
    466424      REAL(wp) ::   zmsk, ze3    ! local scalars 
    467       ! 
    468       REAL(wp), POINTER, DIMENSION(:,:)   :: zwx, zwy, zwz, z1_e3f 
    469       REAL(wp), POINTER, DIMENSION(:,:)   :: ztnw, ztne, ztsw, ztse 
    470       !!---------------------------------------------------------------------- 
    471       ! 
    472       IF( nn_timing == 1 )  CALL timing_start('vor_een') 
    473       ! 
    474       CALL wrk_alloc( jpi,jpj,   zwx , zwy , zwz , z1_e3f )  
    475       CALL wrk_alloc( jpi,jpj,   ztnw, ztne, ztsw, ztse   )  
     425      REAL(wp), DIMENSION(jpi,jpj)   :: zwx , zwy , zwz , z1_e3f 
     426      REAL(wp), DIMENSION(jpi,jpj)   :: ztnw, ztne, ztsw, ztse 
     427      !!---------------------------------------------------------------------- 
     428      ! 
     429      IF( ln_timing )   CALL timing_start('vor_een') 
    476430      ! 
    477431      IF( kt == nit000 ) THEN 
    … …  
    599553      !                                                ! =============== 
    600554      ! 
    601       CALL wrk_dealloc( jpi,jpj,   zwx , zwy , zwz , z1_e3f )  
    602       CALL wrk_dealloc( jpi,jpj,   ztnw, ztne, ztsw, ztse   )  
    603       ! 
    604       IF( nn_timing == 1 )  CALL timing_stop('vor_een') 
     555      IF( ln_timing )   CALL timing_stop('vor_een') 
    605556      ! 
    606557   END SUBROUTINE vor_een 
    … …  
    618569      INTEGER ::   ios             ! Local integer output status for namelist read 
    619570      !! 
    620       NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix, ln_dynvor_een, nn_een_e3f, ln_dynvor_msk 
     571      NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix,   & 
     572         &                 ln_dynvor_een, nn_een_e3f   , ln_dynvor_msk 
    621573      !!---------------------------------------------------------------------- 
    622574 
    … …  
    672624      !                       
    673625      IF(lwp) WRITE(numout,*)        ! type of calculated vorticity (set ncor, nrvm, ntot) 
    674       ncor = np_COR 
    675       IF( ln_dynadv_vec ) THEN      
    676          IF(lwp) WRITE(numout,*) '      ===>>   Vector form advection : vorticity = Coriolis + relative vorticity' 
     626      ncor = np_COR                       ! planetary vorticity 
     627      SELECT CASE( n_dynadv ) 
     628      CASE( np_LIN_dyn ) 
     629         IF(lwp) WRITE(numout,*) '      ===>>   linear dynamics : total vorticity = Coriolis' 
     630         nrvm = np_COR        ! planetary vorticity 
     631         ntot = np_COR        !     -         - 
     632      CASE( np_VEC_c2  ) 
     633         IF(lwp) WRITE(numout,*) '      ===>>   vector form dynamics : total vorticity = Coriolis + relative vorticity'  
    677634         nrvm = np_RVO        ! relative vorticity 
    678          ntot = np_CRV        ! relative + planetary vorticity 
    679       ELSE                         
    680          IF(lwp) WRITE(numout,*) '      ===>>   Flux form advection   : vorticity = Coriolis + metric term' 
     635         ntot = np_CRV        ! relative + planetary vorticity          
     636      CASE( np_FLX_c2 , np_FLX_ubs  ) 
     637         IF(lwp) WRITE(numout,*) '      ===>>   flux form dynamics : total vorticity = Coriolis + metric term' 
    681638         nrvm = np_MET        ! metric term 
    682639         ntot = np_CME        ! Coriolis + metric term 
    683       ENDIF 
     640      END SELECT 
    684641       
    685642      IF(lwp) THEN                   ! Print the choice 
    686643         WRITE(numout,*) 
    687          IF( nvor_scheme ==  np_ENE )   WRITE(numout,*) '      ===>>   energy conserving scheme' 
    688          IF( nvor_scheme ==  np_ENS )   WRITE(numout,*) '      ===>>   enstrophy conserving scheme' 
    689          IF( nvor_scheme ==  np_MIX )   WRITE(numout,*) '      ===>>   mixed enstrophy/energy conserving scheme' 
    690          IF( nvor_scheme ==  np_EEN )   WRITE(numout,*) '      ===>>   energy and enstrophy conserving scheme' 
     644         SELECT CASE( nvor_scheme ) 
     645         CASE( np_ENE )   ;   WRITE(numout,*) '      ===>>   energy conserving scheme' 
     646         CASE( np_ENS )   ;   WRITE(numout,*) '      ===>>   enstrophy conserving scheme' 
     647         CASE( np_MIX )   ;   WRITE(numout,*) '      ===>>   mixed enstrophy/energy conserving scheme' 
     648         CASE( np_EEN )   ;   WRITE(numout,*) '      ===>>   energy and enstrophy conserving scheme' 
     649         END SELECT          
    691650      ENDIF 
    692651      ! 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90

    r7753 r8568  
    55   !!====================================================================== 
    66   !! History :  OPA  ! 1991-01  (G. Madec) Original code 
    7    !!            7.0  ! 1991-11  (G. Madec) 
    8    !!            7.5  ! 1996-01  (G. Madec) statement function for e3 
    97   !!   NEMO     0.5  ! 2002-07  (G. Madec) Free form, F90 
    108   !!---------------------------------------------------------------------- 
    … …  
    2220   USE lib_mpp        ! MPP library 
    2321   USE prtctl         ! Print control 
    24    USE wrk_nemo       ! Memory Allocation 
    2522   USE timing         ! Timing 
    2623 
    … …  
    2926    
    3027   PUBLIC   dyn_zad       ! routine called by dynadv.F90 
    31    PUBLIC   dyn_zad_zts   ! routine called by dynadv.F90 
    3228 
    3329   !! * Substitutions 
    3430#  include "vectopt_loop_substitute.h90" 
    3531   !!---------------------------------------------------------------------- 
    36    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     32   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    3733   !! $Id$ 
    3834   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    5854      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx 
    5955      ! 
    60       INTEGER  ::   ji, jj, jk      ! dummy loop indices 
    61       REAL(wp) ::   zua, zva        ! temporary scalars 
    62       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwuw , zwvw 
    63       REAL(wp), POINTER, DIMENSION(:,:  ) ::  zww 
    64       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
     56      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     57      REAL(wp) ::   zua, zva     ! local scalars 
     58      REAL(wp), DIMENSION(jpi,jpj)     ::   zww 
     59      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwuw, zwvw 
     60      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdu, ztrdv 
    6561      !!---------------------------------------------------------------------- 
    6662      ! 
    67       IF( nn_timing == 1 )  CALL timing_start('dyn_zad') 
    68       ! 
    69       CALL wrk_alloc( jpi,jpj, zww )  
    70       CALL wrk_alloc( jpi,jpj,jpk, zwuw , zwvw )  
     63      IF( ln_timing )   CALL timing_start('dyn_zad') 
    7164      ! 
    7265      IF( kt == nit000 ) THEN 
    73          IF(lwp)WRITE(numout,*) 
    74          IF(lwp)WRITE(numout,*) 'dyn_zad : arakawa advection scheme' 
     66         IF(lwp) WRITE(numout,*) 
     67         IF(lwp) WRITE(numout,*) 'dyn_zad : 2nd order vertical advection scheme' 
    7568      ENDIF 
    7669 
    7770      IF( l_trddyn )   THEN         ! Save ua and va trends 
    78          CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv )  
     71         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) )  
    7972         ztrdu(:,:,:) = ua(:,:,:)  
    8073         ztrdv(:,:,:) = va(:,:,:)  
    … …  
    9689      ! 
    9790      ! Surface and bottom advective fluxes set to zero 
    98       IF ( ln_isfcav ) THEN 
     91      IF( ln_isfcav ) THEN 
    9992         DO jj = 2, jpjm1 
    10093            DO ji = fs_2, fs_jpim1           ! vector opt. 
    … …  
    119112         DO jj = 2, jpjm1 
    120113            DO ji = fs_2, fs_jpim1       ! vector opt. 
    121                !                         ! vertical momentum advective trends 
    122                zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 
    123                zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 
    124                !                         ! add the trends to the general momentum trends 
    125                ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
    126                va(ji,jj,jk) = va(ji,jj,jk) + zva 
     114               ua(ji,jj,jk) = ua(ji,jj,jk) - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 
     115               va(ji,jj,jk) = va(ji,jj,jk) - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 
    127116            END DO   
    128117         END DO   
    … …  
    133122         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    134123         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt ) 
    135          CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )  
     124         DEALLOCATE( ztrdu, ztrdv )  
    136125      ENDIF 
    137126      !                             ! Control print 
    … …  
    139128         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    140129      ! 
    141       CALL wrk_dealloc( jpi,jpj, zww )  
    142       CALL wrk_dealloc( jpi,jpj,jpk, zwuw , zwvw )  
    143       ! 
    144       IF( nn_timing == 1 )  CALL timing_stop('dyn_zad') 
     130      IF( ln_timing )   CALL timing_stop('dyn_zad') 
    145131      ! 
    146132   END SUBROUTINE dyn_zad 
    147133 
    148  
    149    SUBROUTINE dyn_zad_zts ( kt ) 
    150       !!---------------------------------------------------------------------- 
    151       !!                  ***  ROUTINE dynzad_zts  *** 
    152       !!  
    153       !! ** Purpose :   Compute the now vertical momentum advection trend and  
    154       !!      add it to the general trend of momentum equation. This version 
    155       !!      uses sub-timesteps for improved numerical stability with small 
    156       !!      vertical grid sizes. This is especially relevant when using  
    157       !!      embedded ice with thin surface boxes. 
    158       !! 
    159       !! ** Method  :   The now vertical advection of momentum is given by: 
    160       !!         w dz(u) = ua + 1/(e1u*e2u*e3u) mk+1[ mi(e1t*e2t*wn) dk(un) ] 
    161       !!         w dz(v) = va + 1/(e1v*e2v*e3v) mk+1[ mj(e1t*e2t*wn) dk(vn) ] 
    162       !!      Add this trend to the general trend (ua,va): 
    163       !!         (ua,va) = (ua,va) + w dz(u,v) 
    164       !! 
    165       !! ** Action  : - Update (ua,va) with the vert. momentum adv. trends 
    166       !!              - Save the trends in (ztrdu,ztrdv) ('key_trddyn') 
    167       !!---------------------------------------------------------------------- 
    168       INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx 
    169       ! 
    170       INTEGER  ::   ji, jj, jk, jl  ! dummy loop indices 
    171       INTEGER  ::   jnzts = 5       ! number of sub-timesteps for vertical advection 
    172       INTEGER  ::   jtb, jtn, jta   ! sub timestep pointers for leap-frog/euler forward steps 
    173       REAL(wp) ::   zua, zva        ! temporary scalars 
    174       REAL(wp) ::   zr_rdt          ! temporary scalar 
    175       REAL(wp) ::   z2dtzts         ! length of Euler forward sub-timestep for vertical advection 
    176       REAL(wp) ::   zts             ! length of sub-timestep for vertical advection 
    177       REAL(wp), POINTER, DIMENSION(:,:,:)   ::  zwuw , zwvw, zww 
    178       REAL(wp), POINTER, DIMENSION(:,:,:)   ::  ztrdu, ztrdv 
    179       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zus , zvs 
    180       !!---------------------------------------------------------------------- 
    181       ! 
    182       IF( nn_timing == 1 )  CALL timing_start('dyn_zad_zts') 
    183       ! 
    184       CALL wrk_alloc( jpi,jpj,jpk,     zwuw, zwvw, zww )  
    185       CALL wrk_alloc( jpi,jpj,jpk,3,   zus , zvs )  
    186       ! 
    187       IF( kt == nit000 ) THEN 
    188          IF(lwp)WRITE(numout,*) 
    189          IF(lwp)WRITE(numout,*) 'dyn_zad_zts : arakawa advection scheme with sub-timesteps' 
    190       ENDIF 
    191  
    192       IF( l_trddyn )   THEN         ! Save ua and va trends 
    193          CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv )  
    194          ztrdu(:,:,:) = ua(:,:,:)  
    195          ztrdv(:,:,:) = va(:,:,:)  
    196       ENDIF 
    197        
    198       IF( neuler == 0 .AND. kt == nit000 ) THEN 
    199           z2dtzts =         rdt / REAL( jnzts, wp )   ! = rdt (restart with Euler time stepping) 
    200       ELSE 
    201           z2dtzts = 2._wp * rdt / REAL( jnzts, wp )   ! = 2 rdt (leapfrog) 
    202       ENDIF 
    203        
    204       DO jk = 2, jpkm1                    ! Calculate and store vertical fluxes 
    205          DO jj = 2, jpj                    
    206             DO ji = fs_2, jpi             ! vector opt. 
    207                zww(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk) 
    208             END DO 
    209          END DO 
    210       END DO 
    211  
    212       DO jj = 2, jpjm1                    ! Surface and bottom advective fluxes set to zero 
    213          DO ji = fs_2, fs_jpim1           ! vector opt. 
    214  !!gm missing ISF boundary condition 
    215             zwuw(ji,jj, 1 ) = 0._wp 
    216             zwvw(ji,jj, 1 ) = 0._wp 
    217             zwuw(ji,jj,jpk) = 0._wp 
    218             zwvw(ji,jj,jpk) = 0._wp 
    219          END DO   
    220       END DO 
    221  
    222 ! Start with before values and use sub timestepping to reach after values 
    223  
    224       zus(:,:,:,1) = ub(:,:,:) 
    225       zvs(:,:,:,1) = vb(:,:,:) 
    226  
    227       DO jl = 1, jnzts                   ! Start of sub timestepping loop 
    228  
    229          IF( jl == 1 ) THEN              ! Euler forward to kick things off 
    230            jtb = 1   ;   jtn = 1   ;   jta = 2 
    231            zts = z2dtzts 
    232          ELSEIF( jl == 2 ) THEN          ! First leapfrog step 
    233            jtb = 1   ;   jtn = 2   ;   jta = 3 
    234            zts = 2._wp * z2dtzts 
    235          ELSE                            ! Shuffle pointers for subsequent leapfrog steps 
    236            jtb = MOD(jtb,3) + 1 
    237            jtn = MOD(jtn,3) + 1 
    238            jta = MOD(jta,3) + 1 
    239          ENDIF 
    240  
    241          DO jk = 2, jpkm1           ! Vertical momentum advection at level w and u- and v- vertical 
    242             DO jj = 2, jpjm1                 ! vertical momentum advection at w-point 
    243                DO ji = fs_2, fs_jpim1        ! vector opt. 
    244                   zwuw(ji,jj,jk) = ( zww(ji+1,jj  ,jk) + zww(ji,jj,jk) ) * ( zus(ji,jj,jk-1,jtn)-zus(ji,jj,jk,jtn) ) !* wumask(ji,jj,jk) 
    245                   zwvw(ji,jj,jk) = ( zww(ji  ,jj+1,jk) + zww(ji,jj,jk) ) * ( zvs(ji,jj,jk-1,jtn)-zvs(ji,jj,jk,jtn) ) !* wvmask(ji,jj,jk) 
    246                END DO   
    247             END DO    
    248          END DO 
    249          DO jk = 1, jpkm1           ! Vertical momentum advection at u- and v-points 
    250             DO jj = 2, jpjm1 
    251                DO ji = fs_2, fs_jpim1       ! vector opt. 
    252                   !                         ! vertical momentum advective trends 
    253                   zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 
    254                   zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 
    255                   zus(ji,jj,jk,jta) = zus(ji,jj,jk,jtb) + zua * zts 
    256                   zvs(ji,jj,jk,jta) = zvs(ji,jj,jk,jtb) + zva * zts 
    257                END DO   
    258             END DO   
    259          END DO 
    260  
    261       END DO      ! End of sub timestepping loop 
    262  
    263       zr_rdt = 1._wp / ( REAL( jnzts, wp ) * z2dtzts ) 
    264       DO jk = 1, jpkm1              ! Recover trends over the outer timestep 
    265          DO jj = 2, jpjm1 
    266             DO ji = fs_2, fs_jpim1       ! vector opt. 
    267                !                         ! vertical momentum advective trends 
    268                !                         ! add the trends to the general momentum trends 
    269                ua(ji,jj,jk) = ua(ji,jj,jk) + ( zus(ji,jj,jk,jta) - ub(ji,jj,jk)) * zr_rdt 
    270                va(ji,jj,jk) = va(ji,jj,jk) + ( zvs(ji,jj,jk,jta) - vb(ji,jj,jk)) * zr_rdt 
    271             END DO   
    272          END DO   
    273       END DO 
    274  
    275       IF( l_trddyn ) THEN           ! save the vertical advection trends for diagnostic 
    276          ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    277          ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    278          CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt ) 
    279          CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )  
    280       ENDIF 
    281       !                             ! Control print 
    282       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' zad  - Ua: ', mask1=umask,   & 
    283          &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    284       ! 
    285       CALL wrk_dealloc( jpi,jpj,jpk,     zwuw, zwvw, zww )  
    286       CALL wrk_dealloc( jpi,jpj,jpk,3,   zus , zvs )  
    287       ! 
    288       IF( nn_timing == 1 )  CALL timing_stop('dyn_zad_zts') 
    289       ! 
    290    END SUBROUTINE dyn_zad_zts 
    291  
    292134   !!====================================================================== 
    293135END MODULE dynzad 

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

    r8215 r8568  
    7676      !!--------------------------------------------------------------------- 
    7777      ! 
    78       IF( nn_timing == 1 )   CALL timing_start('dyn_zdf') 
     78      IF( ln_timing )   CALL timing_start('dyn_zdf') 
    7979      ! 
    8080      IF( kt == nit000 ) THEN       !* initialization 
    … …  
    392392         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    393393         ! 
    394       IF( nn_timing == 1 )   CALL timing_stop('dyn_zdf') 
     394      IF( ln_timing )   CALL timing_stop('dyn_zdf') 
    395395      ! 
    396396   END SUBROUTINE dyn_zdf 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r7753 r8568  
    2222   USE divhor         ! horizontal divergence 
    2323   USE phycst         ! physical constants 
    24    USE bdy_oce   , ONLY: ln_bdy, bdytmask 
     24   USE bdy_oce , ONLY : ln_bdy, bdytmask   ! Open BounDarY 
    2525   USE bdydyn2d       ! bdy_ssh routine 
    2626#if defined key_agrif 
    … …  
    3636   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
    3737   USE lib_mpp        ! MPP library 
    38    USE wrk_nemo       ! Memory Allocation 
    3938   USE timing         ! Timing 
    40    USE wet_dry         ! Wetting/Drying flux limting 
     39   USE wet_dry        ! Wetting/Drying flux limting 
    4140 
    4241   IMPLICIT NONE 
    … …  
    7473      INTEGER  ::   jk            ! dummy loop indice 
    7574      REAL(wp) ::   z2dt, zcoef   ! local scalars 
    76       REAL(wp), POINTER, DIMENSION(:,:  ) ::   zhdiv   ! 2D workspace 
    77       !!---------------------------------------------------------------------- 
    78       ! 
    79       IF( nn_timing == 1 )   CALL timing_start('ssh_nxt') 
    80       ! 
    81       CALL wrk_alloc( jpi,jpj,   zhdiv )  
     75      REAL(wp), DIMENSION(jpi,jpj) ::   zhdiv   ! 2D workspace 
     76      !!---------------------------------------------------------------------- 
     77      ! 
     78      IF( ln_timing )   CALL timing_start('ssh_nxt') 
    8279      ! 
    8380      IF( kt == nit000 ) THEN 
    … …  
    134131      IF(ln_ctl)   CALL prt_ctl( tab2d_1=ssha, clinfo1=' ssha  - : ', mask1=tmask, ovlap=1 ) 
    135132      ! 
    136       CALL wrk_dealloc( jpi, jpj, zhdiv )  
    137       ! 
    138       IF( nn_timing == 1 )  CALL timing_stop('ssh_nxt') 
     133      IF( ln_timing )   CALL timing_stop('ssh_nxt') 
    139134      ! 
    140135   END SUBROUTINE ssh_nxt 
    … …  
    160155      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    161156      REAL(wp) ::   z1_2dt       ! local scalars 
    162       REAL(wp), POINTER, DIMENSION(:,:  ) ::  z2d 
    163       REAL(wp), POINTER, DIMENSION(:,:,:) ::  z3d, zhdiv 
    164       !!---------------------------------------------------------------------- 
    165       ! 
    166       IF( nn_timing == 1 )   CALL timing_start('wzv') 
     157      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zhdiv 
     158      !!---------------------------------------------------------------------- 
     159      ! 
     160      IF( ln_timing )   CALL timing_start('wzv') 
    167161      ! 
    168162      IF( kt == nit000 ) THEN 
    … …  
    180174      ! 
    181175      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN      ! z_tilde and layer cases 
    182          CALL wrk_alloc( jpi, jpj, jpk, zhdiv )  
     176         ALLOCATE( zhdiv(jpi,jpj,jpk) )  
    183177         ! 
    184178         DO jk = 1, jpkm1 
    … …  
    200194         END DO 
    201195         !          IF( ln_vvl_layer ) wn(:,:,:) = 0.e0 
    202          CALL wrk_dealloc( jpi, jpj, jpk, zhdiv )  
     196         DEALLOCATE( zhdiv )  
    203197      ELSE   ! z_star and linear free surface cases 
    204198         DO jk = jpkm1, 1, -1                       ! integrate from the bottom the hor. divergence 
    … …  
    215209      ENDIF 
    216210      ! 
    217       IF( nn_timing == 1 )  CALL timing_stop('wzv') 
     211      IF( ln_timing )   CALL timing_stop('wzv') 
    218212      ! 
    219213   END SUBROUTINE wzv 
    … …  
    244238      !!---------------------------------------------------------------------- 
    245239      ! 
    246       IF( nn_timing == 1 )  CALL timing_start('ssh_swp') 
     240      IF( ln_timing )  CALL timing_start('ssh_swp') 
    247241      ! 
    248242      IF( kt == nit000 ) THEN 
    … …  
    271265      IF(ln_ctl)   CALL prt_ctl( tab2d_1=sshb, clinfo1=' sshb  - : ', mask1=tmask, ovlap=1 ) 
    272266      ! 
    273       IF( nn_timing == 1 )   CALL timing_stop('ssh_swp') 
     267      IF( ln_timing )   CALL timing_stop('ssh_swp') 
    274268      ! 
    275269   END SUBROUTINE ssh_swp 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/wet_dry.F90

    r7646 r8568  
    1111 
    1212   !!---------------------------------------------------------------------- 
    13    !!   wad_lmt    : Compute the horizontal flux limiter and the limited velocity 
    14    !!                when wetting and drying happens  
    15    !!---------------------------------------------------------------------- 
    16    USE oce             ! ocean dynamics and tracers 
    17    USE dom_oce         ! ocean space and time domain 
    18    USE sbc_oce, ONLY : ln_rnf   ! surface boundary condition: ocean 
    19    USE sbcrnf          ! river runoff  
    20    USE in_out_manager  ! I/O manager 
    21    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    22    USE lib_mpp         ! MPP library 
    23    USE wrk_nemo        ! Memory Allocation 
    24    USE timing          ! Timing 
     13   !!   wad_init      : initialisation of wetting and drying 
     14   !!   wad_lmt       : horizontal flux limiter and limited velocity when wetting and drying happens 
     15   !!   wad_lmt_bt    : same as wad_lmt for the barotropic stepping (dynspg_ts) 
     16   !!---------------------------------------------------------------------- 
     17   USE oce            ! ocean dynamics and tracers 
     18   USE dom_oce        ! ocean space and time domain 
     19   USE sbc_oce  , ONLY: ln_rnf   ! surface boundary condition: ocean 
     20   USE sbcrnf         ! river runoff  
     21   ! 
     22   USE in_out_manager ! I/O manager 
     23   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     24   USE lib_mpp        ! MPP library 
     25   USE timing         ! Timing 
    2526 
    2627   IMPLICIT NONE 
    … …  
    3132   !! --------------------------------------------------------------------- 
    3233 
    33    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   wdmask         !: u- and v- limiter  
    34    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   ht_wd          !: wetting and drying t-pt depths 
    35                                                                      !  (can include negative depths) 
     34   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   wdmask   !: u- and v- limiter  
     35   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   ht_wd    !: wetting and drying t-pt depths 
     36   !                                                           !  (can include negative depths) 
    3637 
    3738   LOGICAL,  PUBLIC  ::   ln_wd       !: Wetting/drying activation switch (T:on,F:off) 
    3839   REAL(wp), PUBLIC  ::   rn_wdmin1   !: minimum water depth on dried cells 
    3940   REAL(wp), PUBLIC  ::   rn_wdmin2   !: tolerrance of minimum water depth on dried cells 
    40    REAL(wp), PUBLIC  ::   rn_wdld     !: land elevation below which wetting/drying  
    41                                            !: will be considered 
     41   REAL(wp), PUBLIC  ::   rn_wdld     !: land elevation below which wetting/drying will be considered 
    4242   INTEGER , PUBLIC  ::   nn_wdit     !: maximum number of iteration for W/D limiter 
    4343 
    … …  
    4848   !! * Substitutions 
    4949#  include "vectopt_loop_substitute.h90" 
     50   !!---------------------------------------------------------------------- 
    5051CONTAINS 
    5152 
    … …  
    5859      !! ** input   : - namwad namelist 
    5960      !!---------------------------------------------------------------------- 
     61      INTEGER  ::   ios, ierr   ! Local integer 
     62      !! 
    6063      NAMELIST/namwad/ ln_wd, rn_wdmin1, rn_wdmin2, rn_wdld, nn_wdit 
    61       INTEGER  ::   ios                 ! Local integer output status for namelist read 
    62       INTEGER  ::   ierr                ! Local integer status array allocation  
    63       !!---------------------------------------------------------------------- 
    64  
    65       REWIND( numnam_ref )              ! Namelist namwad in reference namelist  
    66                                         ! : Parameters for Wetting/Drying 
     64      !!---------------------------------------------------------------------- 
     65      ! 
     66      REWIND( numnam_ref )              ! Namelist namwad in reference namelist : Parameters for Wetting/Drying 
    6767      READ  ( numnam_ref, namwad, IOSTAT = ios, ERR = 905) 
    6868905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namwad in reference namelist', .TRUE.)  
    69       REWIND( numnam_cfg )              ! Namelist namwad in configuration namelist  
    70                                         ! : Parameters for Wetting/Drying 
     69      REWIND( numnam_cfg )              ! Namelist namwad in configuration namelist : Parameters for Wetting/Drying 
    7170      READ  ( numnam_cfg, namwad, IOSTAT = ios, ERR = 906) 
    7271906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namwad in configuration namelist', .TRUE. ) 
    7372      IF(lwm) WRITE ( numond, namwad ) 
    74  
     73      ! 
    7574      IF(lwp) THEN                  ! control print 
    7675         WRITE(numout,*) 
    … …  
    103102      !! ** Action  : - calculate flux limiter and W/D flag 
    104103      !!---------------------------------------------------------------------- 
    105       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   sshb1 
    106       REAL(wp), DIMENSION(:,:), INTENT(in)    ::   sshemp 
    107       REAL(wp), INTENT(in) :: z2dt 
     104      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   sshb1        !!gm DOCTOR names: should start with p ! 
     105      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   sshemp 
     106      REAL(wp)                , INTENT(in   ) ::  z2dt 
    108107      ! 
    109108      INTEGER  ::   ji, jj, jk, jk1     ! dummy loop indices 
    … …  
    113112      REAL(wp) ::   zdepwd              ! local scalar, always wet cell depth 
    114113      REAL(wp) ::   ztmp                ! local scalars 
    115       REAL(wp), POINTER,  DIMENSION(:,:) ::   zwdlmtu, zwdlmtv         !: W/D flux limiters 
    116       REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxp,  zflxn            ! local 2D workspace 
    117       REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxu,  zflxv            ! local 2D workspace 
    118       REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxu1, zflxv1           ! local 2D workspace 
    119       !!---------------------------------------------------------------------- 
    120       ! 
    121  
    122       IF( nn_timing == 1 )  CALL timing_start('wad_lmt') 
    123  
    124       IF(ln_wd) THEN 
    125  
    126         CALL wrk_alloc( jpi, jpj, zflxp, zflxn, zflxu, zflxv, zflxu1, zflxv1 ) 
    127         CALL wrk_alloc( jpi, jpj, zwdlmtu, zwdlmtv) 
    128         ! 
    129         
    130         !IF(lwp) WRITE(numout,*) 
    131         !IF(lwp) WRITE(numout,*) 'wad_lmt : wetting/drying limiters and velocity limiting' 
    132         
    133         jflag  = 0 
    134         zdepwd = 50._wp   !maximum depth on which that W/D could possibly happen 
    135  
    136         
    137         zflxp(:,:)   = 0._wp 
    138         zflxn(:,:)   = 0._wp 
    139         zflxu(:,:)   = 0._wp 
    140         zflxv(:,:)   = 0._wp 
    141  
    142         zwdlmtu(:,:)  = 1._wp 
    143         zwdlmtv(:,:)  = 1._wp 
    144         
    145         ! Horizontal Flux in u and v direction 
    146         DO jk = 1, jpkm1   
    147            DO jj = 1, jpj 
    148               DO ji = 1, jpi 
    149                  zflxu(ji,jj) = zflxu(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 
    150                  zflxv(ji,jj) = zflxv(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 
    151               END DO   
    152            END DO   
    153         END DO 
    154         
    155         zflxu(:,:) = zflxu(:,:) * e2u(:,:) 
    156         zflxv(:,:) = zflxv(:,:) * e1v(:,:) 
    157         
    158         wdmask(:,:) = 1 
    159         DO jj = 2, jpj 
    160            DO ji = 2, jpi  
    161  
    162              IF( tmask(ji, jj, 1) < 0.5_wp ) CYCLE   ! we don't care about land cells 
    163              IF( ht_wd(ji,jj) > zdepwd )      CYCLE   ! and cells which are unlikely to dry 
    164  
    165               zflxp(ji,jj) = max(zflxu(ji,jj), 0._wp) - min(zflxu(ji-1,jj),   0._wp) + & 
    166                            & max(zflxv(ji,jj), 0._wp) - min(zflxv(ji,  jj-1), 0._wp)  
    167               zflxn(ji,jj) = min(zflxu(ji,jj), 0._wp) - max(zflxu(ji-1,jj),   0._wp) + & 
    168                            & min(zflxv(ji,jj), 0._wp) - max(zflxv(ji,  jj-1), 0._wp)  
    169  
    170               zdep2 = ht_wd(ji,jj) + sshb1(ji,jj) - rn_wdmin1 
    171               IF(zdep2 .le. 0._wp) THEN  !add more safty, but not necessary 
    172                 sshb1(ji,jj) = rn_wdmin1 - ht_wd(ji,jj) 
    173                 IF(zflxu(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = 0._wp 
    174                 IF(zflxu(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = 0._wp 
    175                 IF(zflxv(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = 0._wp 
    176                 IF(zflxv(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = 0._wp  
    177                 wdmask(ji,jj) = 0._wp 
    178               END IF 
    179            ENDDO 
    180         END DO 
    181  
    182        
    183         !! start limiter iterations  
    184         DO jk1 = 1, nn_wdit + 1 
    185         
    186            
    187            zflxu1(:,:) = zflxu(:,:) * zwdlmtu(:,:) 
    188            zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:) 
    189            jflag = 0     ! flag indicating if any further iterations are needed 
    190            
    191            DO jj = 2, jpj 
    192               DO ji = 2, jpi  
    193          
    194                  IF( tmask(ji, jj, 1) < 0.5_wp ) CYCLE  
    195                  IF( ht_wd(ji,jj) > zdepwd )      CYCLE 
    196          
    197                  ztmp = e1e2t(ji,jj) 
    198  
    199                  zzflxp = max(zflxu1(ji,jj), 0._wp) - min(zflxu1(ji-1,jj),   0._wp) + & 
    200                         & max(zflxv1(ji,jj), 0._wp) - min(zflxv1(ji,  jj-1), 0._wp)  
    201                  zzflxn = min(zflxu1(ji,jj), 0._wp) - max(zflxu1(ji-1,jj),   0._wp) + & 
    202                         & min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji,  jj-1), 0._wp)  
    203            
    204                  zdep1 = (zzflxp + zzflxn) * z2dt / ztmp 
    205                  zdep2 = ht_wd(ji,jj) + sshb1(ji,jj) - rn_wdmin1 - z2dt * sshemp(ji,jj) 
    206            
    207                  IF( zdep1 > zdep2 ) THEN 
    208                    wdmask(ji, jj) = 0 
    209                    zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt ) 
    210                    !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt ) 
    211                    ! flag if the limiter has been used but stop flagging if the only 
    212                    ! changes have zeroed the coefficient since further iterations will 
    213                    ! not change anything 
    214                    IF( zcoef > 0._wp ) THEN 
    215                       jflag = 1  
    216                    ELSE 
    217                       zcoef = 0._wp 
    218                    ENDIF 
    219                    IF(jk1 > nn_wdit) zcoef = 0._wp 
    220                    IF(zflxu1(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = zcoef 
    221                    IF(zflxu1(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = zcoef 
    222                    IF(zflxv1(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = zcoef 
    223                    IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = zcoef 
    224                  END IF 
    225               END DO ! ji loop 
    226            END DO  ! jj loop 
    227  
    228            CALL lbc_lnk( zwdlmtu, 'U', 1. ) 
    229            CALL lbc_lnk( zwdlmtv, 'V', 1. ) 
    230  
    231            IF(lk_mpp) CALL mpp_max(jflag)   !max over the global domain 
    232  
    233            IF(jflag == 0) EXIT 
    234            
    235         END DO  ! jk1 loop 
    236         
    237         DO jk = 1, jpkm1 
    238           un(:,:,jk) = un(:,:,jk) * zwdlmtu(:, :)  
    239           vn(:,:,jk) = vn(:,:,jk) * zwdlmtv(:, :)  
    240         END DO 
    241  
    242         CALL lbc_lnk( un, 'U', -1. ) 
    243         CALL lbc_lnk( vn, 'V', -1. ) 
    244       ! 
    245         un_b(:,:) = un_b(:,:) * zwdlmtu(:, :) 
    246         vn_b(:,:) = vn_b(:,:) * zwdlmtv(:, :) 
    247         CALL lbc_lnk( un_b, 'U', -1. ) 
    248         CALL lbc_lnk( vn_b, 'V', -1. ) 
    249         
    250         IF(jflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt!!!' 
    251         
    252         !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field) 
    253         !IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field) 
    254         ! 
    255         ! 
    256         CALL wrk_dealloc( jpi, jpj, zflxp, zflxn, zflxu, zflxv, zflxu1, zflxv1 ) 
    257         CALL wrk_dealloc( jpi, jpj, zwdlmtu, zwdlmtv) 
    258         ! 
    259       ENDIF 
    260       ! 
    261       IF( nn_timing == 1 )  CALL timing_stop('wad_lmt') 
     114      REAL(wp),  DIMENSION(jpi,jpj) ::   zwdlmtu, zwdlmtv   ! W/D flux limiters 
     115      REAL(wp),  DIMENSION(jpi,jpj) ::   zflxp  ,  zflxn    ! local 2D workspace 
     116      REAL(wp),  DIMENSION(jpi,jpj) ::   zflxu  ,  zflxv    ! local 2D workspace 
     117      REAL(wp),  DIMENSION(jpi,jpj) ::   zflxu1 , zflxv1    ! local 2D workspace 
     118      !!---------------------------------------------------------------------- 
     119      ! 
     120      IF( ln_timing )   CALL timing_start('wad_lmt') 
     121      ! 
     122      !IF(lwp) WRITE(numout,*) 
     123      !IF(lwp) WRITE(numout,*) 'wad_lmt : wetting/drying limiters and velocity limiting' 
     124      ! 
     125      jflag  = 0 
     126      zdepwd = 50._wp   !maximum depth on which that W/D could possibly happen 
     127      !  
     128      zflxp(:,:)   = 0._wp 
     129      zflxn(:,:)   = 0._wp 
     130      zflxu(:,:)   = 0._wp 
     131      zflxv(:,:)   = 0._wp 
     132      ! 
     133      zwdlmtu(:,:) = 1._wp 
     134      zwdlmtv(:,:) = 1._wp 
     135      !  
     136      ! Horizontal Flux in u and v direction 
     137      DO jk = 1, jpkm1   
     138         DO jj = 1, jpj 
     139            DO ji = 1, jpi 
     140               zflxu(ji,jj) = zflxu(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 
     141               zflxv(ji,jj) = zflxv(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 
     142            END DO   
     143         END DO   
     144      END DO 
     145      ! 
     146      zflxu(:,:) = zflxu(:,:) * e2u(:,:) 
     147      zflxv(:,:) = zflxv(:,:) * e1v(:,:) 
     148      !  
     149      wdmask(:,:) = 1 
     150      DO jj = 2, jpj 
     151         DO ji = 2, jpi  
     152            ! 
     153            IF( tmask(ji, jj, 1) < 0.5_wp )   CYCLE   ! we don't care about land cells 
     154            IF( ht_wd(ji,jj)     > zdepwd )   CYCLE   ! and cells which are unlikely to dry 
     155            ! 
     156            zflxp(ji,jj) = MAX( zflxu(ji,jj) , 0._wp ) - MIN( zflxu(ji-1,jj) , 0._wp )   & 
     157               &         + MAX( zflxv(ji,jj) , 0._wp ) - MIN( zflxv(ji,jj-1) , 0._wp )  
     158            zflxn(ji,jj) = MIN( zflxu(ji,jj) , 0._wp ) - MAX( zflxu(ji-1,jj) , 0._wp )   & 
     159               &         + MIN( zflxv(ji,jj) , 0._wp ) - MAX( zflxv(ji,jj-1) , 0._wp )  
     160            ! 
     161            zdep2 = ht_wd(ji,jj) + sshb1(ji,jj) - rn_wdmin1 
     162            IF( zdep2 .le. 0._wp) THEN  !add more safty, but not necessary 
     163               sshb1(ji,jj) = rn_wdmin1 - ht_wd(ji,jj) 
     164               IF( zflxu(ji,  jj) > 0._wp )   zwdlmtu(ji  ,jj) = 0._wp 
     165               IF( zflxu(ji-1,jj) < 0._wp )   zwdlmtu(ji-1,jj) = 0._wp 
     166               IF( zflxv(ji,  jj) > 0._wp )   zwdlmtv(ji  ,jj) = 0._wp 
     167               IF( zflxv(ji,jj-1) < 0._wp )   zwdlmtv(ji,jj-1) = 0._wp  
     168               wdmask(ji,jj) = 0._wp 
     169            ENDIF 
     170         END DO 
     171      END DO 
     172      !! 
     173      !! start limiter iterations  
     174      DO jk1 = 1, nn_wdit + 1 
     175         !  
     176         zflxu1(:,:) = zflxu(:,:) * zwdlmtu(:,:) 
     177         zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:) 
     178         jflag = 0     ! flag indicating if any further iterations are needed 
     179         !  
     180         DO jj = 2, jpj 
     181            DO ji = 2, jpi  
     182               ! 
     183               IF( tmask(ji,jj,1) < 0.5_wp )   CYCLE  
     184               IF( ht_wd(ji,jj)   > zdepwd )   CYCLE 
     185               ! 
     186               ztmp = e1e2t(ji,jj) 
     187               ! 
     188               zzflxp = MAX( zflxu1(ji,jj) , 0._wp ) - MIN( zflxu1(ji-1,jj) , 0._wp )   & 
     189                  &   + MAX( zflxv1(ji,jj) , 0._wp ) - MIN( zflxv1(ji,jj-1) , 0._wp )  
     190               zzflxn = MIN( zflxu1(ji,jj) , 0._wp ) - MAX( zflxu1(ji-1,jj) , 0._wp )   & 
     191                  &   + MIN( zflxv1(ji,jj) , 0._wp ) - MAX( zflxv1(ji,jj-1) , 0._wp )  
     192               ! 
     193               zdep1 = (zzflxp + zzflxn) * z2dt / ztmp 
     194               zdep2 = ht_wd(ji,jj) + sshb1(ji,jj) - rn_wdmin1 - z2dt * sshemp(ji,jj) 
     195               ! 
     196               IF( zdep1 > zdep2 ) THEN 
     197                  wdmask(ji, jj) = 0 
     198                  zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt ) 
     199                  !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt ) 
     200                  ! flag if the limiter has been used but stop flagging if the only 
     201                  ! changes have zeroed the coefficient since further iterations will 
     202                  ! not change anything 
     203                  IF( zcoef > 0._wp ) THEN   ;   jflag = 1  
     204                  ELSE                       ;   zcoef = 0._wp 
     205                  ENDIF 
     206                  IF( jk1 > nn_wdit )   zcoef = 0._wp 
     207                  IF( zflxu1(ji,  jj) > 0._wp )   zwdlmtu(ji  ,jj) = zcoef 
     208                  IF( zflxu1(ji-1,jj) < 0._wp )   zwdlmtu(ji-1,jj) = zcoef 
     209                  IF( zflxv1(ji,  jj) > 0._wp )   zwdlmtv(ji  ,jj) = zcoef 
     210                  IF( zflxv1(ji,jj-1) < 0._wp )   zwdlmtv(ji,jj-1) = zcoef 
     211               ENDIF 
     212            END DO ! ji loop 
     213         END DO  ! jj loop 
     214         ! 
     215         CALL lbc_lnk( zwdlmtu, 'U', 1. ) 
     216         CALL lbc_lnk( zwdlmtv, 'V', 1. ) 
     217         ! 
     218         IF(lk_mpp)   CALL mpp_max(jflag)   !max over the global domain 
     219         ! 
     220         IF(jflag == 0)   EXIT 
     221         !  
     222      END DO  ! jk1 loop 
     223        
     224      DO jk = 1, jpkm1 
     225         un(:,:,jk) = un(:,:,jk) * zwdlmtu(:,:)  
     226         vn(:,:,jk) = vn(:,:,jk) * zwdlmtv(:,:)  
     227      END DO 
     228 
     229!!gm ==> Andrew  : the lbclnk below is useless since above lbclnk is applied on zwdlmtu/v 
     230!!                                             and un, vn always with lbclnk 
     231      CALL lbc_lnk( un, 'U', -1. ) 
     232      CALL lbc_lnk( vn, 'V', -1. ) 
     233!!gm end 
     234      ! 
     235      un_b(:,:) = un_b(:,:) * zwdlmtu(:,:) 
     236      vn_b(:,:) = vn_b(:,:) * zwdlmtv(:,:) 
     237!!gm ==> Andrew   : probably same as above 
     238      CALL lbc_lnk( un_b, 'U', -1. ) 
     239      CALL lbc_lnk( vn_b, 'V', -1. ) 
     240!!gm end 
     241        
     242      IF(jflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt!!!' 
     243        
     244      !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field) 
     245      !IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field) 
     246      ! 
     247      ! 
     248      ! 
     249      IF( ln_timing )   CALL timing_stop('wad_lmt') 
    262250      ! 
    263251   END SUBROUTINE wad_lmt 
    … …  
    284272      REAL(wp) ::   zdepwd              ! local scalar, always wet cell depth 
    285273      REAL(wp) ::   ztmp                ! local scalars 
    286       REAL(wp), POINTER,  DIMENSION(:,:) ::   zwdlmtu, zwdlmtv         !: W/D flux limiters 
    287       REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxp,  zflxn            ! local 2D workspace 
    288       REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxu1, zflxv1           ! local 2D workspace 
    289       !!---------------------------------------------------------------------- 
    290       ! 
    291       IF( nn_timing == 1 )  CALL timing_start('wad_lmt_bt') 
    292  
    293       IF(ln_wd) THEN 
    294  
    295         CALL wrk_alloc( jpi, jpj, zflxp, zflxn, zflxu1, zflxv1 ) 
    296         CALL wrk_alloc( jpi, jpj, zwdlmtu, zwdlmtv) 
    297         ! 
    298         
    299         !IF(lwp) WRITE(numout,*) 
    300         !IF(lwp) WRITE(numout,*) 'wad_lmt_bt : wetting/drying limiters and velocity limiting' 
    301         
    302         jflag  = 0 
    303         zdepwd = 50._wp   !maximum depth that ocean cells can have W/D processes 
    304  
    305         z2dt = rdtbt    
    306         
    307         zflxp(:,:)   = 0._wp 
    308         zflxn(:,:)   = 0._wp 
    309  
    310         zwdlmtu(:,:)  = 1._wp 
    311         zwdlmtv(:,:)  = 1._wp 
    312         
    313         ! Horizontal Flux in u and v direction 
    314         
    315         DO jj = 2, jpj 
    316            DO ji = 2, jpi  
    317  
    318              IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE   ! we don't care about land cells 
    319              IF( ht_wd(ji,jj) > zdepwd )      CYCLE   ! and cells which are unlikely to dry 
    320  
    321               zflxp(ji,jj) = max(zflxu(ji,jj), 0._wp) - min(zflxu(ji-1,jj),   0._wp) + & 
    322                            & max(zflxv(ji,jj), 0._wp) - min(zflxv(ji,  jj-1), 0._wp)  
    323               zflxn(ji,jj) = min(zflxu(ji,jj), 0._wp) - max(zflxu(ji-1,jj),   0._wp) + & 
    324                            & min(zflxv(ji,jj), 0._wp) - max(zflxv(ji,  jj-1), 0._wp)  
    325  
    326               zdep2 = ht_wd(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 
    327               IF(zdep2 .le. 0._wp) THEN  !add more safety, but not necessary 
    328                 sshn_e(ji,jj) = rn_wdmin1 - ht_wd(ji,jj) 
    329                 IF(zflxu(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = 0._wp 
    330                 IF(zflxu(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = 0._wp 
    331                 IF(zflxv(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = 0._wp 
    332                 IF(zflxv(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = 0._wp  
    333               END IF 
    334            ENDDO 
    335         END DO 
     274      REAL(wp), DIMENSION(jpi,jpj) ::   zwdlmtu, zwdlmtv         !: W/D flux limiters 
     275      REAL(wp), DIMENSION(jpi,jpj) ::   zflxp,  zflxn            ! local 2D workspace 
     276      REAL(wp), DIMENSION(jpi,jpj) ::   zflxu1, zflxv1           ! local 2D workspace 
     277      !!---------------------------------------------------------------------- 
     278      ! 
     279      IF( ln_timing )  CALL timing_start('wad_lmt_bt') 
     280      !        
     281      !IF(lwp) WRITE(numout,*) 
     282      !IF(lwp) WRITE(numout,*) 'wad_lmt_bt : wetting/drying limiters and velocity limiting' 
     283        
     284      jflag  = 0 
     285      zdepwd = 50._wp   !maximum depth that ocean cells can have W/D processes 
     286 
     287      z2dt = rdtbt    
     288        
     289      zflxp(:,:)   = 0._wp 
     290      zflxn(:,:)   = 0._wp 
     291 
     292      zwdlmtu(:,:) = 1._wp 
     293      zwdlmtv(:,:) = 1._wp 
     294        
     295      ! Horizontal Flux in u and v direction 
     296        
     297      DO jj = 2, jpj 
     298         DO ji = 2, jpi  
     299            ! 
     300            IF( tmask(ji,jj,1) < 0.5_wp )   CYCLE   ! we don't care about land cells 
     301            IF( ht_wd(ji,jj)   > zdepwd )   CYCLE   ! and cells which are unlikely to dry 
     302            ! 
     303            zflxp(ji,jj) = MAX( zflxu(ji,jj) , 0._wp ) - MIN( zflxu(ji-1,jj) , 0._wp )   & 
     304               &         + MAX( zflxv(ji,jj) , 0._wp ) - MIN( zflxv(ji,jj-1) , 0._wp )  
     305            zflxn(ji,jj) = MIN( zflxu(ji,jj) , 0._wp ) - MAX( zflxu(ji-1,jj) , 0._wp )   & 
     306               &         + MIN( zflxv(ji,jj) , 0._wp ) - MAX( zflxv(ji,jj-1) , 0._wp )  
     307 
     308            zdep2 = ht_wd(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 
     309            IF(zdep2 .le. 0._wp) THEN  !add more safety, but not necessary 
     310               sshn_e(ji,jj) = rn_wdmin1 - ht_wd(ji,jj) 
     311               IF( zflxu(ji,  jj) > 0._wp )   zwdlmtu(ji  ,jj) = 0._wp 
     312               IF( zflxu(ji-1,jj) < 0._wp )   zwdlmtu(ji-1,jj) = 0._wp 
     313               IF( zflxv(ji,  jj) > 0._wp )   zwdlmtv(ji  ,jj) = 0._wp 
     314               IF( zflxv(ji,jj-1) < 0._wp )   zwdlmtv(ji,jj-1) = 0._wp  
     315            ENDIF 
     316         END DO 
     317      END DO 
    336318 
    337319       
    338         !! start limiter iterations  
    339         DO jk1 = 1, nn_wdit + 1 
    340         
     320      !! start limiter iterations  
     321      DO jk1 = 1, nn_wdit + 1 
     322         !  
     323         zflxu1(:,:) = zflxu(:,:) * zwdlmtu(:,:) 
     324         zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:) 
     325         jflag = 0     ! flag indicating if any further iterations are needed 
     326         ! 
     327         DO jj = 2, jpj 
     328            DO ji = 2, jpi  
     329               ! 
     330               IF( tmask(ji,jj, 1 ) < 0.5_wp  )   CYCLE  
     331               IF( ht_wd(ji,jj)      > zdepwd )   CYCLE 
     332               ! 
     333               ztmp = e1e2t(ji,jj) 
     334               ! 
     335               zzflxp = MAX( zflxu1(ji,jj) , 0._wp ) - MIN( zflxu1(ji-1,jj) , 0._wp )   & 
     336                  &   + MAX( zflxv1(ji,jj) , 0._wp ) - MIN( zflxv1(ji,jj-1) , 0._wp )  
     337               zzflxn = MIN( zflxu1(ji,jj) , 0._wp ) - MAX( zflxu1(ji-1,jj) , 0._wp )   & 
     338                  &   + MIN( zflxv1(ji,jj) , 0._wp ) - MAX( zflxv1(ji,jj-1) , 0._wp )  
    341339           
    342            zflxu1(:,:) = zflxu(:,:) * zwdlmtu(:,:) 
    343            zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:) 
    344            jflag = 0     ! flag indicating if any further iterations are needed 
     340               zdep1 = (zzflxp + zzflxn) * z2dt / ztmp 
     341               zdep2 = ht_wd(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 - z2dt * zssh_frc(ji,jj) 
    345342           
    346            DO jj = 2, jpj 
    347               DO ji = 2, jpi  
    348          
    349                  IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE  
    350                  IF( ht_wd(ji,jj) > zdepwd )      CYCLE 
    351          
    352                  ztmp = e1e2t(ji,jj) 
    353  
    354                  zzflxp = max(zflxu1(ji,jj), 0._wp) - min(zflxu1(ji-1,jj),   0._wp) + & 
    355                         & max(zflxv1(ji,jj), 0._wp) - min(zflxv1(ji,  jj-1), 0._wp)  
    356                  zzflxn = min(zflxu1(ji,jj), 0._wp) - max(zflxu1(ji-1,jj),   0._wp) + & 
    357                         & min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji,  jj-1), 0._wp)  
    358            
    359                  zdep1 = (zzflxp + zzflxn) * z2dt / ztmp 
    360                  zdep2 = ht_wd(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 - z2dt * zssh_frc(ji,jj) 
    361            
    362                  IF(zdep1 > zdep2) THEN 
    363                    zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt ) 
    364                    !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt ) 
    365                    ! flag if the limiter has been used but stop flagging if the only 
    366                    ! changes have zeroed the coefficient since further iterations will 
    367                    ! not change anything 
    368                    IF( zcoef > 0._wp ) THEN 
     343               IF(zdep1 > zdep2) THEN 
     344                  zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt ) 
     345                  !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt ) 
     346                  ! flag if the limiter has been used but stop flagging if the only 
     347                  ! changes have zeroed the coefficient since further iterations will 
     348                  ! not change anything 
     349                  IF( zcoef > 0._wp ) THEN 
    369350                      jflag = 1  
    370                    ELSE 
     351                  ELSE 
    371352                      zcoef = 0._wp 
    372                    ENDIF 
    373                    IF(jk1 > nn_wdit) zcoef = 0._wp 
    374                    IF(zflxu1(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = zcoef 
    375                    IF(zflxu1(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = zcoef 
    376                    IF(zflxv1(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = zcoef 
    377                    IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = zcoef 
    378                  END IF 
    379               END DO ! ji loop 
    380            END DO  ! jj loop 
    381  
    382            CALL lbc_lnk( zwdlmtu, 'U', 1. ) 
    383            CALL lbc_lnk( zwdlmtv, 'V', 1. ) 
    384  
    385            IF(lk_mpp) CALL mpp_max(jflag)   !max over the global domain 
    386  
    387            IF(jflag == 0) EXIT 
    388            
    389         END DO  ! jk1 loop 
    390         
    391         zflxu(:,:) = zflxu(:,:) * zwdlmtu(:, :)  
    392         zflxv(:,:) = zflxv(:,:) * zwdlmtv(:, :)  
    393  
    394         CALL lbc_lnk( zflxu, 'U', -1. ) 
    395         CALL lbc_lnk( zflxv, 'V', -1. ) 
    396         
    397         IF(jflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt_bt!!!' 
    398         
    399         !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field) 
    400         !IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field) 
    401         ! 
    402         ! 
    403         CALL wrk_dealloc( jpi, jpj, zflxp, zflxn, zflxu1, zflxv1 ) 
    404         CALL wrk_dealloc( jpi, jpj, zwdlmtu, zwdlmtv) 
    405         ! 
    406       END IF 
    407  
    408       IF( nn_timing == 1 )  CALL timing_stop('wad_lmt') 
     353                  ENDIF 
     354                  IF( jk1 > nn_wdit )   zcoef = 0._wp 
     355                  IF( zflxu1(ji,  jj) > 0._wp )   zwdlmtu(ji  ,jj) = zcoef 
     356                  IF( zflxu1(ji-1,jj) < 0._wp )   zwdlmtu(ji-1,jj) = zcoef 
     357                  IF( zflxv1(ji,  jj) > 0._wp )   zwdlmtv(ji  ,jj) = zcoef 
     358                  IF( zflxv1(ji,jj-1) < 0._wp )   zwdlmtv(ji,jj-1) = zcoef 
     359               ENDIF 
     360            END DO ! ji loop 
     361         END DO  ! jj loop 
     362         ! 
     363         CALL lbc_lnk( zwdlmtu, 'U', 1. ) 
     364         CALL lbc_lnk( zwdlmtv, 'V', 1. ) 
     365         ! 
     366         IF(lk_mpp)   CALL mpp_max(jflag)   !max over the global domain 
     367         ! 
     368         IF( jflag == 0 )   EXIT 
     369         !     
     370      END DO  ! jk1 loop 
     371      !  
     372      zflxu(:,:) = zflxu(:,:) * zwdlmtu(:, :)  
     373      zflxv(:,:) = zflxv(:,:) * zwdlmtv(:, :)  
     374      ! 
     375      CALL lbc_lnk( zflxu, 'U', -1. ) 
     376      CALL lbc_lnk( zflxv, 'V', -1. ) 
     377      ! 
     378      IF(jflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt_bt!!!' 
     379        
     380      !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field) 
     381      !IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field) 
     382      ! 
     383      IF( ln_timing )  CALL timing_stop('wad_lmt') 
     384      ! 
    409385   END SUBROUTINE wad_lmt_bt 
    410386 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r8215 r8568  
    9696   !!---------------------------------------------------------------------- 
    9797   LOGICAL ::   ln_ctl           !: run control for debugging 
     98   LOGICAL ::   ln_timing        !: run control for timing 
     99!!gm to be removed at the end of the 2017 merge party 
    98100   INTEGER ::   nn_timing        !: run control for timing 
    99    INTEGER ::   nn_diacfl        !: flag whether to create CFL diagnostics 
     101!!gm end 
     102   LOGICAL ::   ln_diacfl        !: flag whether to create CFL diagnostics 
    100103   INTEGER ::   nn_print         !: level of print (0 no print) 
    101104   INTEGER ::   nn_ictls         !: Start i indice for the SUM control 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r8215 r8568  
    23502350      zain(2,:) = ki + 10000.*kj + 100000000.*kk 
    23512351      ! 
    2352       CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror) 
     2352      CALL MPI_ALLREDUCE( zain, zaout, 1, MPI_2DOUBLE_PRECISION, MPI_MAXLOC, MPI_COMM_OPA, ierror ) 
    23532353      ! 
    23542354      pmax = zaout(1,1) 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90

    r7753 r8568  
    2424   USE lib_mpp         ! distribued memory computing library 
    2525   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    26    USE wrk_nemo        ! Memory Allocation 
    2726 
    2827   IMPLICIT NONE 
    … …  
    3332 
    3433   !                                                !!* Namelist namdyn_ldf : lateral mixing on momentum * 
     34   LOGICAL , PUBLIC ::   ln_dynldf_NONE  !: No operator (i.e. no explicit diffusion) 
    3535   LOGICAL , PUBLIC ::   ln_dynldf_lap   !: laplacian operator 
    3636   LOGICAL , PUBLIC ::   ln_dynldf_blp   !: bilaplacian operator 
    … …  
    9696      REAL(wp) ::   zah0              ! local scalar 
    9797      ! 
    98       NAMELIST/namdyn_ldf/ ln_dynldf_lap, ln_dynldf_blp,                  & 
    99          &                 ln_dynldf_lev, ln_dynldf_hor, ln_dynldf_iso,   & 
    100          &                 nn_ahm_ijk_t , rn_ahm_0, rn_ahm_b, rn_bhm_0,   & 
    101          &                 rn_csmc      , rn_minfac, rn_maxfac 
     98      NAMELIST/namdyn_ldf/ ln_dynldf_NONE, ln_dynldf_lap, ln_dynldf_blp,   &   ! type of operator 
     99         &                 ln_dynldf_lev, ln_dynldf_hor, ln_dynldf_iso ,   &   ! acting direction of the operator 
     100         &                 nn_ahm_ijk_t , rn_ahm_0, rn_ahm_b, rn_bhm_0 ,   &   ! lateral eddy coefficient 
     101         &                 rn_csmc      , rn_minfac, rn_maxfac                 ! Smagorinsky settings 
    102102      !!---------------------------------------------------------------------- 
    103103      ! 
    … …  
    118118         ! 
    119119         WRITE(numout,*) '      type :' 
     120         WRITE(numout,*) '         no explicit diffusion                ln_dynldf_NONE= ', ln_dynldf_NONE 
    120121         WRITE(numout,*) '         laplacian operator                   ln_dynldf_lap = ', ln_dynldf_lap 
    121122         WRITE(numout,*) '         bilaplacian operator                 ln_dynldf_blp = ', ln_dynldf_blp 
    … …  
    131132         WRITE(numout,*) '         background viscosity (iso case)      rn_ahm_b      = ', rn_ahm_b, ' m2/s' 
    132133         WRITE(numout,*) '         lateral bilaplacian eddy viscosity   rn_bhm_0      = ', rn_bhm_0, ' m4/s' 
    133          WRITE(numout,*) '      smagorinsky settings (nn_ahm_ijk_t  = 32) :' 
     134         WRITE(numout,*) '      Smagorinsky settings (nn_ahm_ijk_t  = 32) :' 
    134135         WRITE(numout,*) '         Smagorinsky coefficient              rn_csmc       = ', rn_csmc 
    135136         WRITE(numout,*) '         factor multiplier for theorectical lower limit for ' 
    … …  
    140141 
    141142      !                                ! Parameter control 
    142       IF( .NOT.ln_dynldf_lap .AND. .NOT.ln_dynldf_blp ) THEN 
     143      IF( ln_dynldf_NONE ) THEN 
    143144         IF(lwp) WRITE(numout,*) '   No viscous operator selected. ahmt and ahmf are not allocated' 
    144145         l_ldfdyn_time = .FALSE. 
    … …  
    284285      !!---------------------------------------------------------------------- 
    285286      ! 
    286       IF( nn_timing == 1 )  CALL timing_start('ldf_dyn') 
     287      IF( ln_timing )   CALL timing_start('ldf_dyn') 
    287288      ! 
    288289      SELECT CASE(  nn_ahm_ijk_t  )       !== Eddy vicosity coefficients ==! 
    … …  
    411412      CALL iom_put( "ahmf_3d", ahmf(:,:,:) )   ! 3D      v-eddy diffusivity coeff. 
    412413      ! 
    413       IF( nn_timing == 1 )  CALL timing_stop('ldf_dyn') 
     414      IF( ln_timing )   CALL timing_stop('ldf_dyn') 
    414415      ! 
    415416   END SUBROUTINE ldf_dyn 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r7753 r8568  
    3232   USE lib_mpp        ! distribued memory computing library 
    3333   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    34    USE wrk_nemo       ! work arrays 
    3534   USE timing         ! Timing 
    3635 
    … …  
    118117      REAL(wp) ::   zck, zfk,      zbw             !   -      - 
    119118      REAL(wp) ::   zdepu, zdepv                   !   -      - 
    120       REAL(wp), POINTER, DIMENSION(:,:  ) ::  zslpml_hmlpu, zslpml_hmlpv 
    121       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwz, zww 
    122       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdzr 
    123       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zgru, zgrv 
    124       !!---------------------------------------------------------------------- 
    125       ! 
    126       IF( nn_timing == 1 )  CALL timing_start('ldf_slp') 
    127       ! 
    128       CALL wrk_alloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 
    129       CALL wrk_alloc( jpi,jpj, zslpml_hmlpu, zslpml_hmlpv ) 
    130  
     119      REAL(wp), DIMENSION(jpi,jpj)     ::  zslpml_hmlpu, zslpml_hmlpv 
     120      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zgru, zwz, zdzr 
     121      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zgrv, zww 
     122      !!---------------------------------------------------------------------- 
     123      ! 
     124      IF( ln_timing )   CALL timing_start('ldf_slp') 
     125      ! 
    131126      zeps   =  1.e-20_wp        !==   Local constant initialization   ==! 
    132127      z1_16  =  1.0_wp / 16._wp 
    … …  
    157152         DO jj = 1, jpjm1 
    158153            DO ji = 1, jpim1 
    159                IF ( miku(ji,jj) > 1 ) zgru(ji,jj,miku(ji,jj)) = grui(ji,jj)  
    160                IF ( mikv(ji,jj) > 1 ) zgrv(ji,jj,mikv(ji,jj)) = grvi(ji,jj) 
     154               IF( miku(ji,jj) > 1 )  zgru(ji,jj,miku(ji,jj)) = grui(ji,jj)  
     155               IF( mikv(ji,jj) > 1 )  zgrv(ji,jj,mikv(ji,jj)) = grvi(ji,jj) 
    161156            END DO 
    162157         END DO 
    … …  
    375370      ENDIF 
    376371      ! 
    377       CALL wrk_dealloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 
    378       CALL wrk_dealloc( jpi,jpj, zslpml_hmlpu, zslpml_hmlpv ) 
    379       ! 
    380       IF( nn_timing == 1 )  CALL timing_stop('ldf_slp') 
     372      IF( ln_timing )   CALL timing_stop('ldf_slp') 
    381373      ! 
    382374   END SUBROUTINE ldf_slp 
    … …  
    409401      REAL(wp) ::   zdzrho_raw 
    410402      REAL(wp) ::   zbeta0, ze3_e1, ze3_e2 
    411       REAL(wp), POINTER, DIMENSION(:,:)     ::   z1_mlbw 
    412       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalbet 
    413       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zdxrho , zdyrho, zdzrho     ! Horizontal and vertical density gradients 
    414       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zti_mlb, ztj_mlb            ! for Griffies operator only 
    415       !!---------------------------------------------------------------------- 
    416       ! 
    417       IF( nn_timing == 1 )  CALL timing_start('ldf_slp_triad') 
    418       ! 
    419       CALL wrk_alloc( jpi,jpj, z1_mlbw ) 
    420       CALL wrk_alloc( jpi,jpj,jpk, zalbet ) 
    421       CALL wrk_alloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  ) 
    422       CALL wrk_alloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  ) 
     403      REAL(wp), DIMENSION(jpi,jpj)     ::   z1_mlbw 
     404      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zalbet 
     405      REAL(wp), DIMENSION(jpi,jpj,jpk,0:1) ::   zdxrho , zdyrho, zdzrho     ! Horizontal and vertical density gradients 
     406      REAL(wp), DIMENSION(jpi,jpj,0:1,0:1) ::   zti_mlb, ztj_mlb            ! for Griffies operator only 
     407      !!---------------------------------------------------------------------- 
     408      ! 
     409      IF( ln_timing )   CALL timing_start('ldf_slp_triad') 
     410      ! 
    423411      ! 
    424412      !--------------------------------! 
    … …  
    624612      CALL lbc_lnk( wslp2, 'W', 1. )      ! lateral boundary confition on wslp2 only   ==>>> gm : necessary ? to be checked 
    625613      ! 
    626       CALL wrk_dealloc( jpi,jpj, z1_mlbw ) 
    627       CALL wrk_dealloc( jpi,jpj,jpk, zalbet ) 
    628       CALL wrk_dealloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  ) 
    629       CALL wrk_dealloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  ) 
    630       ! 
    631       IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_triad') 
     614      IF( ln_timing )   CALL timing_stop('ldf_slp_triad') 
    632615      ! 
    633616   END SUBROUTINE ldf_slp_triad 
    … …  
    663646      !!---------------------------------------------------------------------- 
    664647      ! 
    665       IF( nn_timing == 1 )  CALL timing_start('ldf_slp_mxl') 
     648      IF( ln_timing )   CALL timing_start('ldf_slp_mxl') 
    666649      ! 
    667650      zeps   =  1.e-20_wp        !==   Local constant initialization   ==! 
    … …  
    746729      CALL lbc_lnk( wslpiml, 'W', -1. )   ;   CALL lbc_lnk( wslpjml, 'W', -1. )   ! lateral boundary conditions 
    747730      ! 
    748       IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_mxl') 
     731      IF( ln_timing )   CALL timing_stop('ldf_slp_mxl') 
    749732      ! 
    750733   END SUBROUTINE ldf_slp_mxl 
    … …  
    763746      !!---------------------------------------------------------------------- 
    764747      ! 
    765       IF( nn_timing == 1 )  CALL timing_start('ldf_slp_init') 
     748      IF( ln_timing )   CALL timing_start('ldf_slp_init') 
    766749      ! 
    767750      IF(lwp) THEN 
    … …  
    821804      ENDIF 
    822805      ! 
    823       IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_init') 
     806      IF( ln_timing )   CALL timing_stop('ldf_slp_init') 
    824807      ! 
    825808   END SUBROUTINE ldf_slp_init 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90

    r7753 r8568  
    3030   USE lib_mpp         ! distribued memory computing library 
    3131   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    32    USE wrk_nemo        ! work arrays 
    3332   USE timing          ! timing 
    3433 
    … …  
    4544   !                                   !!* Namelist namtra_ldf : lateral mixing on tracers *  
    4645   !                                    != Operator type =! 
     46   LOGICAL , PUBLIC ::   ln_traldf_NONE      !: no operator: No explicit diffusion 
    4747   LOGICAL , PUBLIC ::   ln_traldf_lap       !: laplacian operator 
    4848   LOGICAL , PUBLIC ::   ln_traldf_blp       !: bilaplacian operator 
    … …  
    119119      INTEGER  ::   ierr, inum, ios   ! local integer 
    120120      REAL(wp) ::   zah0              ! local scalar 
    121       ! 
    122       NAMELIST/namtra_ldf/ ln_traldf_lap, ln_traldf_blp  ,                   &   ! type of operator 
    123          &                 ln_traldf_lev, ln_traldf_hor  , ln_traldf_triad,  &   ! acting direction of the operator 
    124          &                 ln_traldf_iso, ln_traldf_msc  ,  rn_slpmax     ,  &   ! option for iso-neutral operator 
    125          &                 ln_triad_iso , ln_botmix_triad, rn_sw_triad    ,  &   ! option for triad operator 
    126          &                 rn_aht_0     , rn_bht_0       , nn_aht_ijk_t          ! lateral eddy coefficient 
     121      !! 
     122      NAMELIST/namtra_ldf/ ln_traldf_NONE, ln_traldf_lap  , ln_traldf_blp  ,  &   ! type of operator 
     123         &                 ln_traldf_lev , ln_traldf_hor  , ln_traldf_triad,  &   ! acting direction of the operator 
     124         &                 ln_traldf_iso , ln_traldf_msc  ,  rn_slpmax     ,  &   ! option for iso-neutral operator 
     125         &                 ln_triad_iso  , ln_botmix_triad, rn_sw_triad    ,  &   ! option for triad operator 
     126         &                 rn_aht_0      , rn_bht_0       , nn_aht_ijk_t          ! lateral eddy coefficient 
    127127      !!---------------------------------------------------------------------- 
    128128      ! 
    … …  
    144144         WRITE(numout,*) '~~~~~~~~~~~~ ' 
    145145         WRITE(numout,*) '   Namelist namtra_ldf : lateral mixing parameters (type, direction, coefficients)' 
    146          ! 
    147146         WRITE(numout,*) '      type :' 
     147         WRITE(numout,*) '         no explicit diffusion                   ln_traldf_NONE  = ', ln_traldf_NONE 
    148148         WRITE(numout,*) '         laplacian operator                      ln_traldf_lap   = ', ln_traldf_lap 
    149149         WRITE(numout,*) '         bilaplacian operator                    ln_traldf_blp   = ', ln_traldf_blp 
    150          ! 
    151150         WRITE(numout,*) '      direction of action :' 
    152151         WRITE(numout,*) '         iso-level                               ln_traldf_lev   = ', ln_traldf_lev 
    … …  
    159158         WRITE(numout,*) '            switching triad or not               rn_sw_triad     = ', rn_sw_triad 
    160159         WRITE(numout,*) '            lateral mixing on bottom             ln_botmix_triad = ', ln_botmix_triad 
    161          ! 
    162160         WRITE(numout,*) '      coefficients :' 
    163161         WRITE(numout,*) '         lateral eddy diffusivity   (lap case)   rn_aht_0        = ', rn_aht_0 
    … …  
    168166      !                                ! Parameter control 
    169167      ! 
    170       IF( .NOT.ln_traldf_lap .AND. .NOT.ln_traldf_blp ) THEN 
     168      IF( ln_traldf_NONE ) THEN 
    171169         IF(lwp) WRITE(numout,*) '   No diffusive operator selected. ahtu and ahtv are not allocated' 
    172170         l_ldftra_time = .FALSE. 
    … …  
    490488      ! 
    491489      INTEGER  ::   ji, jj, jk    ! dummy loop indices 
    492       REAL(wp) ::   zfw, ze3w, zn2, z1_f20, zaht, zaht_min, zzaei   ! local scalars 
    493       REAL(wp), DIMENSION(:,:), POINTER ::   zn, zah, zhw, zross, zaeiw   ! 2D workspace 
    494       !!---------------------------------------------------------------------- 
    495       ! 
    496       IF( nn_timing == 1 )   CALL timing_start('ldf_eiv') 
    497       ! 
    498       CALL wrk_alloc( jpi,jpj,   zn, zah, zhw, zross, zaeiw ) 
    499       !       
     490      REAL(wp) ::   zfw, ze3w, zn2, z1_f20, zaht, zaht_min, zzaei    ! local scalars 
     491      REAL(wp), DIMENSION(jpi,jpj) ::   zn, zah, zhw, zross, zaeiw   ! 2D workspace 
     492      !!---------------------------------------------------------------------- 
     493      ! 
     494      IF( ln_timing )   CALL timing_start('ldf_eiv') 
     495      ! 
    500496      zn   (:,:) = 0._wp      ! Local initialization 
    501497      zhw  (:,:) = 5._wp 
    … …  
    575571      END DO 
    576572      !   
    577       CALL wrk_dealloc( jpi,jpj,   zn, zah, zhw, zross, zaeiw ) 
    578       ! 
    579       IF( nn_timing == 1 )   CALL timing_stop('ldf_eiv') 
     573      IF( ln_timing )   CALL timing_stop('ldf_eiv') 
    580574      ! 
    581575   END SUBROUTINE ldf_eiv 
    … …  
    610604      REAL(wp) ::   zuwk, zuwk1, zuwi, zuwi1   ! local scalars 
    611605      REAL(wp) ::   zvwk, zvwk1, zvwj, zvwj1   !   -      - 
    612       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zpsi_uw, zpsi_vw 
    613       !!---------------------------------------------------------------------- 
    614       ! 
    615       IF( nn_timing == 1 )   CALL timing_start( 'ldf_eiv_trp') 
    616       ! 
    617       CALL wrk_alloc( jpi,jpj,jpk,   zpsi_uw, zpsi_vw ) 
    618  
     606      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zpsi_uw, zpsi_vw 
     607      !!---------------------------------------------------------------------- 
     608      ! 
     609      IF( ln_timing )   CALL timing_start( 'ldf_eiv_trp') 
     610      ! 
    619611      IF( kt == kit000 )  THEN 
    620612         IF(lwp) WRITE(numout,*) 
    … …  
    658650      IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' )   CALL ldf_eiv_dia( zpsi_uw, zpsi_vw ) 
    659651      ! 
    660       CALL wrk_dealloc( jpi,jpj,jpk,   zpsi_uw, zpsi_vw ) 
    661       ! 
    662       IF( nn_timing == 1 )   CALL timing_stop( 'ldf_eiv_trp') 
     652      IF( ln_timing )   CALL timing_stop( 'ldf_eiv_trp') 
    663653      ! 
    664654    END SUBROUTINE ldf_eiv_trp 
    … …  
    679669      INTEGER  ::   ji, jj, jk    ! dummy loop indices 
    680670      REAL(wp) ::   zztmp   ! local scalar 
    681       REAL(wp), DIMENSION(:,:)  , POINTER ::   zw2d   ! 2D workspace 
    682       REAL(wp), DIMENSION(:,:,:), POINTER ::   zw3d   ! 3D workspace 
    683       !!---------------------------------------------------------------------- 
    684       ! 
    685       IF( nn_timing == 1 )  CALL timing_start( 'ldf_eiv_dia') 
     671      REAL(wp), DIMENSION(jpi,jpj)     ::   zw2d   ! 2D workspace 
     672      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d   ! 3D workspace 
     673      !!---------------------------------------------------------------------- 
     674      ! 
     675!!gm I don't like this routine....   Crazy  way of doing things, not optimal at all... 
     676!!gm     to be redesigned....    
     677      IF( ln_timing )   CALL timing_start( 'ldf_eiv_dia') 
    686678      ! 
    687679      !                                                  !==  eiv stream function: output  ==! 
    … …  
    693685      ! 
    694686      !                                                  !==  eiv velocities: calculate and output  ==! 
    695       CALL wrk_alloc( jpi,jpj,jpk,   zw3d ) 
    696687      ! 
    697688      zw3d(:,:,jpk) = 0._wp                                    ! bottom value always 0 
    … …  
    718709      CALL iom_put( "woce_eiv", zw3d ) 
    719710      ! 
    720       !       
    721       ! 
    722       CALL wrk_alloc( jpi,jpj,   zw2d ) 
    723711      ! 
    724712      zztmp = 0.5_wp * rau0 * rcp  
    … …  
    792780      IF( ln_diaptr ) CALL dia_ptr_hst( jp_sal, 'eiv', 0.5 * zw3d ) 
    793781      ! 
    794       CALL wrk_dealloc( jpi,jpj,   zw2d ) 
    795       CALL wrk_dealloc( jpi,jpj,jpk,   zw3d ) 
    796       ! 
    797       IF( nn_timing == 1 )  CALL timing_stop( 'ldf_eiv_dia')       
     782      ! 
     783      IF( ln_timing )   CALL timing_stop( 'ldf_eiv_dia')       
    798784      ! 
    799785   END SUBROUTINE ldf_eiv_dia 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r8215 r8568  
    4646   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    4747   USE prtctl         ! Print control 
    48    USE wrk_nemo       ! Memory Allocation 
    4948   USE lbclnk         ! ocean lateral boundary conditions 
    5049   USE timing         ! Timing 
    … …  
    231230      !!---------------------------------------------------------------------- 
    232231      ! 
    233       IF( nn_timing == 1 )   CALL timing_start('eos-insitu') 
     232      IF( ln_timing )   CALL timing_start('eos-insitu') 
    234233      ! 
    235234      SELECT CASE( neos ) 
    … …  
    298297      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu  : ', ovlap=1, kdim=jpk ) 
    299298      ! 
    300       IF( nn_timing == 1 )   CALL timing_stop('eos-insitu') 
     299      IF( ln_timing )   CALL timing_stop('eos-insitu') 
    301300      ! 
    302301   END SUBROUTINE eos_insitu 
    … …  
    329328      !!---------------------------------------------------------------------- 
    330329      ! 
    331       IF( nn_timing == 1 )   CALL timing_start('eos-pot') 
     330      IF( ln_timing )   CALL timing_start('eos-pot') 
    332331      ! 
    333332      SELECT CASE ( neos ) 
    … …  
    465464      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk ) 
    466465      ! 
    467       IF( nn_timing == 1 )   CALL timing_stop('eos-pot') 
     466      IF( ln_timing )   CALL timing_stop('eos-pot') 
    468467      ! 
    469468   END SUBROUTINE eos_insitu_pot 
    … …  
    491490      !!---------------------------------------------------------------------- 
    492491      ! 
    493       IF( nn_timing == 1 )   CALL timing_start('eos2d') 
     492      IF( ln_timing )   CALL timing_start('eos2d') 
    494493      ! 
    495494      prd(:,:) = 0._wp 
    … …  
    560559      IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' ) 
    561560      ! 
    562       IF( nn_timing == 1 )   CALL timing_stop('eos2d') 
     561      IF( ln_timing )   CALL timing_stop('eos2d') 
    563562      ! 
    564563   END SUBROUTINE eos_insitu_2d 
    … …  
    583582      !!---------------------------------------------------------------------- 
    584583      ! 
    585       IF( nn_timing == 1 )   CALL timing_start('rab_3d') 
     584      IF( ln_timing )   CALL timing_start('rab_3d') 
    586585      ! 
    587586      SELECT CASE ( neos ) 
    … …  
    674673         &                       tab3d_2=pab(:,:,:,jp_sal), clinfo2=' rab_3d_s : ', ovlap=1, kdim=jpk ) 
    675674      ! 
    676       IF( nn_timing == 1 )   CALL timing_stop('rab_3d') 
     675      IF( ln_timing )   CALL timing_stop('rab_3d') 
    677676      ! 
    678677   END SUBROUTINE rab_3d 
    … …  
    696695      !!---------------------------------------------------------------------- 
    697696      ! 
    698       IF( nn_timing == 1 ) CALL timing_start('rab_2d') 
     697      IF( ln_timing )  CALL timing_start('rab_2d') 
    699698      ! 
    700699      pab(:,:,:) = 0._wp 
    … …  
    791790         &                       tab2d_2=pab(:,:,jp_sal), clinfo2=' rab_2d_s : ' ) 
    792791      ! 
    793       IF( nn_timing == 1 )   CALL timing_stop('rab_2d') 
     792      IF( ln_timing )   CALL timing_stop('rab_2d') 
    794793      ! 
    795794   END SUBROUTINE rab_2d 
    … …  
    812811      !!---------------------------------------------------------------------- 
    813812      ! 
    814       IF( nn_timing == 1 ) CALL timing_start('rab_2d') 
     813      IF( ln_timing )  CALL timing_start('rab_2d') 
    815814      ! 
    816815      pab(:) = 0._wp 
    … …  
    888887      END SELECT 
    889888      ! 
    890       IF( nn_timing == 1 )   CALL timing_stop('rab_2d') 
     889      IF( ln_timing )   CALL timing_stop('rab_2d') 
    891890      ! 
    892891   END SUBROUTINE rab_0d 
    … …  
    915914      !!---------------------------------------------------------------------- 
    916915      ! 
    917       IF( nn_timing == 1 ) CALL timing_start('bn2') 
     916      IF( ln_timing )  CALL timing_start('bn2') 
    918917      ! 
    919918      DO jk = 2, jpkm1           ! interior points only (2=< jk =< jpkm1 ) 
    … …  
    935934      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2  : ', ovlap=1, kdim=jpk ) 
    936935      ! 
    937       IF( nn_timing == 1 )   CALL timing_stop('bn2') 
     936      IF( ln_timing )   CALL timing_stop('bn2') 
    938937      ! 
    939938   END SUBROUTINE bn2 
    … …  
    963962      !!---------------------------------------------------------------------- 
    964963      ! 
    965       IF ( nn_timing == 1 )   CALL timing_start('eos_pt_from_ct') 
     964      IF( ln_timing )   CALL timing_start('eos_pt_from_ct') 
    966965      ! 
    967966      zdeltaS = 5._wp 
    … …  
    994993      END DO 
    995994      ! 
    996       IF( nn_timing == 1 )   CALL timing_stop('eos_pt_from_ct') 
     995      IF( ln_timing )   CALL timing_stop('eos_pt_from_ct') 
    997996      ! 
    998997   END FUNCTION eos_pt_from_ct 
    … …  
    11281127      !!---------------------------------------------------------------------- 
    11291128      ! 
    1130       IF( nn_timing == 1 )   CALL timing_start('eos_pen') 
     1129      IF( ln_timing )   CALL timing_start('eos_pen') 
    11311130      ! 
    11321131      SELECT CASE ( neos ) 
    … …  
    12221221      END SELECT 
    12231222      ! 
    1224       IF( nn_timing == 1 )   CALL timing_stop('eos_pen') 
     1223      IF( ln_timing )   CALL timing_stop('eos_pen') 
    12251224      ! 
    12261225   END SUBROUTINE eos_pen 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r7753 r8568  
    1414   !!---------------------------------------------------------------------- 
    1515   !!   tra_adv       : compute ocean tracer advection trend 
    16    !!   tra_adv_ctl   : control the different options of advection scheme 
     16   !!   tra_adv_init  : control the different options of advection scheme 
    1717   !!---------------------------------------------------------------------- 
    1818   USE oce            ! ocean dynamics and active tracers 
    1919   USE dom_oce        ! ocean space and time domain 
    2020   USE domvvl         ! variable vertical scale factors 
     21   USE sbcwave        ! wave module 
     22   USE sbc_oce        ! surface boundary condition: ocean 
    2123   USE traadv_cen     ! centered scheme           (tra_adv_cen  routine) 
    2224   USE traadv_fct     ! FCT      scheme           (tra_adv_fct  routine) 
    … …  
    2729   USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff. 
    2830   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces 
    29    USE trd_oce         ! trends: ocean variables 
    30    USE trdtra          ! trends manager: tracers  
     31   USE trd_oce        ! trends: ocean variables 
     32   USE trdtra         ! trends manager: tracers  
     33   USE diaptr         ! Poleward heat transport  
    3134   ! 
    3235   USE in_out_manager ! I/O manager 
    … …  
    3437   USE prtctl         ! Print control 
    3538   USE lib_mpp        ! MPP library 
    36    USE wrk_nemo       ! Memory Allocation 
    3739   USE timing         ! Timing 
    38    USE sbcwave        ! wave module 
    39    USE sbc_oce        ! surface boundary condition: ocean 
    40    USE diaptr         ! Poleward heat transport  
    4140 
    4241   IMPLICIT NONE 
    4342   PRIVATE 
    4443 
    45    PUBLIC   tra_adv        ! routine called by step module 
    46    PUBLIC   tra_adv_init   ! routine called by opa module 
     44   PUBLIC   tra_adv        ! called by step.F90 
     45   PUBLIC   tra_adv_init   ! called by nemogcm.F90 
    4746 
    4847   !                            !!* Namelist namtra_adv * 
     48   LOGICAL ::   ln_traadv_NONE   ! no advection on T and S 
    4949   LOGICAL ::   ln_traadv_cen    ! centered scheme flag 
    5050   INTEGER ::      nn_cen_h, nn_cen_v   ! =2/4 : horizontal and vertical choices of the order of CEN scheme 
    5151   LOGICAL ::   ln_traadv_fct    ! FCT scheme flag 
    5252   INTEGER ::      nn_fct_h, nn_fct_v   ! =2/4 : horizontal and vertical choices of the order of FCT scheme 
    53    INTEGER ::      nn_fct_zts           ! >=1 : 2nd order FCT with vertical sub-timestepping 
    5453   LOGICAL ::   ln_traadv_mus    ! MUSCL scheme flag 
    5554   LOGICAL ::      ln_mus_ups           ! use upstream scheme in vivcinity of river mouths 
    … …  
    5857   LOGICAL ::   ln_traadv_qck    ! QUICKEST scheme flag 
    5958 
    60    INTEGER ::              nadv             ! choice of the type of advection scheme 
    61    ! 
    62    !                                        ! associated indices: 
     59   INTEGER ::   nadv             ! choice of the type of advection scheme 
     60   !                             ! associated indices: 
    6361   INTEGER, PARAMETER ::   np_NO_adv  = 0   ! no T-S advection 
    6462   INTEGER, PARAMETER ::   np_CEN     = 1   ! 2nd/4th order centered scheme 
    6563   INTEGER, PARAMETER ::   np_FCT     = 2   ! 2nd/4th order Flux Corrected Transport scheme 
    66    INTEGER, PARAMETER ::   np_FCT_zts = 3   ! 2nd order FCT scheme with vertical sub-timestepping 
    67    INTEGER, PARAMETER ::   np_MUS     = 4   ! MUSCL scheme 
    68    INTEGER, PARAMETER ::   np_UBS     = 5   ! 3rd order Upstream Biased Scheme 
    69    INTEGER, PARAMETER ::   np_QCK     = 6   ! QUICK scheme 
     64   INTEGER, PARAMETER ::   np_MUS     = 3   ! MUSCL scheme 
     65   INTEGER, PARAMETER ::   np_UBS     = 4   ! 3rd order Upstream Biased Scheme 
     66   INTEGER, PARAMETER ::   np_QCK     = 5   ! QUICK scheme 
    7067    
    7168   !! * Substitutions 
    7269#  include "vectopt_loop_substitute.h90" 
    7370   !!---------------------------------------------------------------------- 
    74    !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
     71   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    7572   !! $Id$ 
    7673   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    8683      !! ** Method  : - Update (ua,va) with the advection term following nadv 
    8784      !!---------------------------------------------------------------------- 
    88       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     85      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    8986      ! 
    9087      INTEGER ::   jk   ! dummy loop index 
    91       REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn 
    92       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt, ztrds   ! 3D workspace 
    93       !!---------------------------------------------------------------------- 
    94       ! 
    95       IF( nn_timing == 1 )  CALL timing_start('tra_adv') 
    96       ! 
    97       CALL wrk_alloc( jpi,jpj,jpk,   zun, zvn, zwn ) 
     88      REAL(wp), DIMENSION(jpi,jpj,jpk)        :: zun, zvn, zwn   ! 3D workspace 
     89      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds 
     90      !!---------------------------------------------------------------------- 
     91      ! 
     92      IF( ln_timing )   CALL timing_start('tra_adv') 
    9893      ! 
    9994      !                                          ! set time step 
    100       zun(:,:,:) = 0.0 
    101       zvn(:,:,:) = 0.0 
    102       zwn(:,:,:) = 0.0 
    103       !     
    104       IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000 
    105          r2dt = rdt                                 ! = rdt (restarting with Euler time stepping) 
    106       ELSEIF( kt <= nit000 + 1) THEN                ! at nit000 or nit000+1 
    107          r2dt = 2._wp * rdt                         ! = 2 rdt (leapfrog) 
     95      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dt =        rdt   ! at nit000             (Euler) 
     96      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dt = 2._wp* rdt   ! at nit000 or nit000+1 (Leapfrog) 
    10897      ENDIF 
    10998      ! 
    11099      !                                         !==  effective transport  ==! 
     100      zun(:,:,jpk) = 0._wp 
     101      zvn(:,:,jpk) = 0._wp 
     102      zwn(:,:,jpk) = 0._wp 
    111103      IF( ln_wave .AND. ln_sdw )  THEN 
    112104         DO jk = 1, jpkm1                                                       ! eulerian transport + Stokes Drift 
    … …  
    146138      ! 
    147139      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    148          CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     140         ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 
    149141         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    150142         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    … …  
    153145      SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==! 
    154146      ! 
    155       CASE ( np_CEN )                                    ! Centered scheme : 2nd / 4th order 
     147      CASE ( np_CEN )                                 ! Centered scheme : 2nd / 4th order 
    156148         CALL tra_adv_cen    ( kt, nit000, 'TRA',         zun, zvn, zwn     , tsn, tsa, jpts, nn_cen_h, nn_cen_v ) 
    157       CASE ( np_FCT )                                    ! FCT scheme      : 2nd / 4th order 
     149      CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order 
    158150         CALL tra_adv_fct    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts, nn_fct_h, nn_fct_v ) 
    159       CASE ( np_FCT_zts )                                ! 2nd order FCT with vertical time-splitting 
    160          CALL tra_adv_fct_zts( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts        , nn_fct_zts ) 
    161       CASE ( np_MUS )                                    ! MUSCL 
     151      CASE ( np_MUS )                                 ! MUSCL 
    162152         CALL tra_adv_mus    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb,      tsa, jpts        , ln_mus_ups )  
    163       CASE ( np_UBS )                                    ! UBS 
     153      CASE ( np_UBS )                                 ! UBS 
    164154         CALL tra_adv_ubs    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts        , nn_ubs_v   ) 
    165       CASE ( np_QCK )                                    ! QUICKEST 
     155      CASE ( np_QCK )                                 ! QUICKEST 
    166156         CALL tra_adv_qck    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts                     ) 
    167157      ! 
    … …  
    175165         CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt ) 
    176166         CALL trd_tra( kt, 'TRA', jp_sal, jptra_totad, ztrds ) 
    177          CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     167         DEALLOCATE( ztrdt, ztrds ) 
    178168      ENDIF 
    179169      !                                              ! print mean trends (used for debugging) 
    … …  
    181171         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    182172      ! 
    183       IF( nn_timing == 1 )  CALL timing_stop( 'tra_adv' ) 
    184       ! 
    185       CALL wrk_dealloc( jpi,jpj,jpk,   zun, zvn, zwn ) 
    186       !                                           
     173      IF( ln_timing )   CALL timing_stop( 'tra_adv' ) 
     174      ! 
    187175   END SUBROUTINE tra_adv 
    188176 
    … …  
    197185      INTEGER ::   ioptio, ios   ! Local integers 
    198186      ! 
    199       NAMELIST/namtra_adv/ ln_traadv_cen, nn_cen_h, nn_cen_v,               &   ! CEN 
    200          &                 ln_traadv_fct, nn_fct_h, nn_fct_v, nn_fct_zts,   &   ! FCT 
    201          &                 ln_traadv_mus,                     ln_mus_ups,   &   ! MUSCL 
    202          &                 ln_traadv_ubs,           nn_ubs_v,               &   ! UBS 
    203          &                 ln_traadv_qck                                        ! QCK 
     187      NAMELIST/namtra_adv/ ln_traadv_NONE,                       &   ! No advection 
     188         &                 ln_traadv_cen , nn_cen_h, nn_cen_v,   &   ! CEN 
     189         &                 ln_traadv_fct , nn_fct_h, nn_fct_v,   &   ! FCT 
     190         &                 ln_traadv_mus , ln_mus_ups,           &   ! MUSCL 
     191         &                 ln_traadv_ubs ,           nn_ubs_v,   &   ! UBS 
     192         &                 ln_traadv_qck                             ! QCK 
    204193      !!---------------------------------------------------------------------- 
    205194      ! 
    … …  
    217206         WRITE(numout,*) 
    218207         WRITE(numout,*) 'tra_adv_init : choice/control of the tracer advection scheme' 
    219          WRITE(numout,*) '~~~~~~~~~~~' 
     208         WRITE(numout,*) '~~~~~~~~~~~~' 
    220209         WRITE(numout,*) '   Namelist namtra_adv : chose a advection scheme for tracers' 
     210         WRITE(numout,*) '      No advection on T & S                     ln_traadv_NONE= ', ln_traadv_NONE 
    221211         WRITE(numout,*) '      centered scheme                           ln_traadv_cen = ', ln_traadv_cen 
    222212         WRITE(numout,*) '            horizontal 2nd/4th order               nn_cen_h   = ', nn_fct_h 
    … …  
    225215         WRITE(numout,*) '            horizontal 2nd/4th order               nn_fct_h   = ', nn_fct_h 
    226216         WRITE(numout,*) '            vertical   2nd/4th order               nn_fct_v   = ', nn_fct_v 
    227          WRITE(numout,*) '            2nd order + vertical sub-timestepping  nn_fct_zts = ', nn_fct_zts 
    228217         WRITE(numout,*) '      MUSCL scheme                              ln_traadv_mus = ', ln_traadv_mus 
    229218         WRITE(numout,*) '            + upstream scheme near river mouths    ln_mus_ups = ', ln_mus_ups 
    … …  
    233222      ENDIF 
    234223      ! 
    235       ioptio = 0                       !==  Parameter control  ==! 
    236       IF( ln_traadv_cen )   ioptio = ioptio + 1 
    237       IF( ln_traadv_fct )   ioptio = ioptio + 1 
    238       IF( ln_traadv_mus )   ioptio = ioptio + 1 
    239       IF( ln_traadv_ubs )   ioptio = ioptio + 1 
    240       IF( ln_traadv_qck )   ioptio = ioptio + 1 
    241       ! 
    242       IF( ioptio == 0 ) THEN 
    243          nadv = np_NO_adv 
    244          CALL ctl_warn( 'tra_adv_init: You are running without tracer advection.' ) 
    245       ENDIF 
    246       IF( ioptio /= 1 )   CALL ctl_stop( 'tra_adv_init: Choose ONE advection scheme in namelist namtra_adv' ) 
     224      !                                !==  Parameter control & set nadv ==! 
     225      ioptio = 0                        
     226      IF( ln_traadv_NONE ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_NO_adv   ;   ENDIF 
     227      IF( ln_traadv_cen  ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_CEN      ;   ENDIF 
     228      IF( ln_traadv_fct  ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_FCT      ;   ENDIF 
     229      IF( ln_traadv_mus  ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_MUS      ;   ENDIF 
     230      IF( ln_traadv_ubs  ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_UBS      ;   ENDIF 
     231      IF( ln_traadv_qck  ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_QCK      ;   ENDIF 
     232      ! 
     233      IF( ioptio /= 1 )   CALL ctl_stop( 'tra_adv_init: Choose ONE advection option in namelist namtra_adv' ) 
    247234      ! 
    248235      IF( ln_traadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 )   &          ! Centered 
    … …  
    254241        CALL ctl_stop( 'tra_adv_init: FCT scheme, choose 2nd or 4th order' ) 
    255242      ENDIF 
    256       IF( ln_traadv_fct .AND. nn_fct_zts > 0 ) THEN 
    257          IF( nn_fct_h == 4 ) THEN 
    258             nn_fct_h = 2 
    259             CALL ctl_stop( 'tra_adv_init: force 2nd order FCT scheme, 4th order does not exist with sub-timestepping' ) 
    260          ENDIF 
    261          IF( .NOT.ln_linssh ) THEN 
    262             CALL ctl_stop( 'tra_adv_init: vertical sub-timestepping not allow in non-linear free surface' ) 
    263          ENDIF 
    264          IF( nn_fct_zts == 1 )   CALL ctl_warn( 'tra_adv_init: FCT with ONE sub-timestep = FCT without sub-timestep' ) 
    265       ENDIF 
    266243      IF( ln_traadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 )   ) THEN     ! UBS 
    267244        CALL ctl_stop( 'tra_adv_init: UBS scheme, choose 2nd or 4th order' ) 
    … …  
    275252      ENDIF 
    276253      ! 
    277       !                                !==  used advection scheme  ==!   
    278       !                                      ! set nadv 
    279       IF( ln_traadv_cen                      )   nadv = np_CEN 
    280       IF( ln_traadv_fct                      )   nadv = np_FCT 
    281       IF( ln_traadv_fct .AND. nn_fct_zts > 0 )   nadv = np_FCT_zts 
    282       IF( ln_traadv_mus                      )   nadv = np_MUS 
    283       IF( ln_traadv_ubs                      )   nadv = np_UBS 
    284       IF( ln_traadv_qck                      )   nadv = np_QCK 
    285       ! 
    286       IF(lwp) THEN                           ! Print the choice 
     254      !                                !==  Print the choice  ==!   
     255      IF(lwp) THEN 
    287256         WRITE(numout,*) 
    288257         SELECT CASE ( nadv ) 
    … …  
    292261         CASE( np_FCT     )   ;   WRITE(numout,*) '      ===>>   FCT      scheme is used. Horizontal order: ', nn_fct_h,   & 
    293262            &                                                                      ' Vertical   order: ', nn_fct_v 
    294          CASE( np_FCT_zts )   ;   WRITE(numout,*) '      ===>>   use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping' 
    295263         CASE( np_MUS     )   ;   WRITE(numout,*) '      ===>>   MUSCL    scheme is used' 
    296264         CASE( np_UBS     )   ;   WRITE(numout,*) '      ===>>   UBS      scheme is used' 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90

    r7646 r8568  
    1111   !!                   NB: on the vertical it is actually a 4th order COMPACT scheme which is used 
    1212   !!---------------------------------------------------------------------- 
    13    USE oce      , ONLY: tsn ! now ocean temperature and salinity 
    1413   USE dom_oce        ! ocean space and time domain 
    1514   USE eosbn2         ! equation of state 
    … …  
    2423   USE trc_oce        ! share passive tracers/Ocean variables 
    2524   USE lib_mpp        ! MPP library 
    26    USE wrk_nemo       ! Memory Allocation 
    2725   USE timing         ! Timing 
    2826 
    … …  
    3028   PRIVATE 
    3129 
    32    PUBLIC   tra_adv_cen       ! routine called by step.F90 
     30   PUBLIC   tra_adv_cen   ! called by traadv.F90 
    3331    
    3432   REAL(wp) ::   r1_6 = 1._wp / 6._wp   ! =1/6 
    3533 
    36    LOGICAL :: l_trd   ! flag to compute trends 
    37    LOGICAL :: l_ptr   ! flag to compute poleward transport 
    38    LOGICAL :: l_hst   ! flag to compute heat/salt transport 
     34   LOGICAL ::   l_trd   ! flag to compute trends 
     35   LOGICAL ::   l_ptr   ! flag to compute poleward transport 
     36   LOGICAL ::   l_hst   ! flag to compute heat/salt transport 
    3937 
    4038   !! * Substitutions 
    4139#  include "vectopt_loop_substitute.h90" 
    4240   !!---------------------------------------------------------------------- 
    43    !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    44    !! $Id$ 
     41   !! NEMO/OPA 4.0, NEMO Consortium (2017) 
     42   !! $Id:$ 
    4543   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4644   !!---------------------------------------------------------------------- 
    … …  
    4846 
    4947   SUBROUTINE tra_adv_cen( kt, kit000, cdtype, pun, pvn, pwn,     & 
    50       &                                             ptn, pta, kjpt, kn_cen_h, kn_cen_v )  
     48      &                                        ptn, pta, kjpt, kn_cen_h, kn_cen_v )  
    5149      !!---------------------------------------------------------------------- 
    5250      !!                  ***  ROUTINE tra_adv_cen  *** 
    … …  
    8078      REAL(wp) ::   zC2t_u, zC4t_u   ! local scalars 
    8179      REAL(wp) ::   zC2t_v, zC4t_v   !   -      - 
    82       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx, zwy, zwz, ztu, ztv, ztw 
     80      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwx, zwy, zwz, ztu, ztv, ztw 
    8381      !!---------------------------------------------------------------------- 
    8482      ! 
    85       IF( nn_timing == 1 )  CALL timing_start('tra_adv_cen') 
    86       ! 
    87       CALL wrk_alloc( jpi,jpj,jpk,   zwx, zwy, zwz, ztu, ztv, ztw ) 
     83      IF( ln_timing )   CALL timing_start('tra_adv_cen') 
    8884      ! 
    8985      IF( kt == kit000 )  THEN 
    … …  
    9288         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ ' 
    9389      ENDIF 
    94       ! 
     90      !                          ! set local switches 
    9591      l_trd = .FALSE. 
    9692      l_hst = .FALSE. 
    … …  
    130126               END DO 
    131127            END DO 
    132             CALL lbc_lnk( ztu, 'U', -1. )   ;    CALL lbc_lnk( ztv, 'V', -1. )   ! Lateral boundary cond. (unchanged sgn) 
     128            CALL lbc_lnk( ztu, 'U', -1. )   ;    CALL lbc_lnk( ztv, 'V', -1. )   ! Lateral boundary cond. 
    133129            ! 
    134130            DO jk = 1, jpkm1                       ! Horizontal advective fluxes 
    … …  
    203199         END IF 
    204200         !                                 ! "Poleward" heat and salt transports  
    205          IF( l_ptr )  CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) 
     201         IF( l_ptr )   CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) 
    206202         !                                 !  heat and salt transport 
    207          IF( l_hst )  CALL dia_ar5_hst( jn, 'adv', zwx(:,:,:), zwy(:,:,:) ) 
     203         IF( l_hst )   CALL dia_ar5_hst( jn, 'adv', zwx(:,:,:), zwy(:,:,:) ) 
    208204         ! 
    209205      END DO 
    210206      ! 
    211       CALL wrk_dealloc( jpi,jpj,jpk,   zwx, zwy, zwz, ztu, ztv, ztw ) 
    212       ! 
    213       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_cen') 
     207      IF( ln_timing )   CALL timing_stop('tra_adv_cen') 
    214208      ! 
    215209   END SUBROUTINE tra_adv_cen 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90

    r7753 r8568  
    99   !!---------------------------------------------------------------------- 
    1010   !!  tra_adv_fct    : update the tracer trend with a 3D advective trends using a 2nd or 4th order FCT scheme 
    11    !!  tra_adv_fct_zts: update the tracer trend with a 3D advective trends using a 2nd order FCT scheme  
    1211   !!                   with sub-time-stepping in the vertical direction 
    1312   !!  nonosc         : compute monotonic tracer fluxes by a non-oscillatory algorithm  
    … …  
    2120   USE diaptr         ! poleward transport diagnostics 
    2221   USE diaar5         ! AR5 diagnostics 
    23    USE phycst, ONLY: rau0_rcp 
     22   USE phycst  , ONLY : rau0_rcp 
    2423   ! 
    2524   USE in_out_manager ! I/O manager 
    26    USE iom 
     25   USE iom            !  
    2726   USE lib_mpp        ! MPP library 
    2827   USE lbclnk         ! ocean lateral boundary condition (or mpp link)  
    2928   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    30    USE wrk_nemo       ! Memory Allocation 
    3129   USE timing         ! Timing 
    3230 
    … …  
    3432   PRIVATE 
    3533 
    36    PUBLIC   tra_adv_fct        ! routine called by traadv.F90 
    37    PUBLIC   tra_adv_fct_zts    ! routine called by traadv.F90 
    38    PUBLIC   interp_4th_cpt     ! routine called by traadv_cen.F90 
     34   PUBLIC   tra_adv_fct        ! called by traadv.F90 
     35   PUBLIC   interp_4th_cpt     ! called by traadv_cen.F90 
    3936 
    4037   LOGICAL  ::   l_trd   ! flag to compute trends 
    … …  
    5047#  include "vectopt_loop_substitute.h90" 
    5148   !!---------------------------------------------------------------------- 
    52    !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
     49   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    5350   !! $Id$ 
    5451   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    7067      !! 
    7168      !! ** Action : - update pta  with the now advective tracer trends 
    72       !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T) 
     69      !!             - send trends to trdtra module for further diagnostics (l_trdtra=T) 
    7370      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T) 
    7471      !!---------------------------------------------------------------------- 
    … …  
    8885      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk, zC2t_u, zC4t_u   !   -      - 
    8986      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk, zC2t_v, zC4t_v   !   -      - 
    90       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw 
    91       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdx, ztrdy, ztrdz, zptry 
    92       REAL(wp), POINTER, DIMENSION(:,:)   :: z2d 
    93       !!---------------------------------------------------------------------- 
    94       ! 
    95       IF( nn_timing == 1 )  CALL timing_start('tra_adv_fct') 
    96       ! 
    97       CALL wrk_alloc( jpi,jpj,jpk,   zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw ) 
     87      REAL(wp), DIMENSION(jpi,jpj,jpk)        ::   zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw 
     88      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdx, ztrdy, ztrdz, zptry 
     89      !!---------------------------------------------------------------------- 
     90      ! 
     91      IF( ln_timing )   CALL timing_start('tra_adv_fct') 
    9892      ! 
    9993      IF( kt == kit000 )  THEN 
    … …  
    10397      ENDIF 
    10498      ! 
    105       l_trd = .FALSE. 
     99      l_trd = .FALSE.            ! set local switches 
    106100      l_hst = .FALSE. 
    107101      l_ptr = .FALSE. 
    108       IF( ( cdtype == 'TRA'   .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )     l_trd = .TRUE. 
    109       IF(   cdtype == 'TRA'   .AND. ln_diaptr )                                              l_ptr = .TRUE.  
    110       IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
    111          &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE. 
     102      IF( ( cdtype =='TRA' .AND. l_trdtra  ) .OR. ( cdtype =='TRC' .AND. l_trdtrc ) )       l_trd = .TRUE. 
     103      IF(   cdtype =='TRA' .AND. ln_diaptr )                                                l_ptr = .TRUE.  
     104      IF(   cdtype =='TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
     105         &                         iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE. 
    112106      ! 
    113107      IF( l_trd .OR. l_hst )  THEN 
    114          CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
     108         ALLOCATE( ztrdx(jpi,jpj,jpk), ztrdy(jpi,jpj,jpk), ztrdz(jpi,jpj,jpk) ) 
    115109         ztrdx(:,:,:) = 0._wp   ;    ztrdy(:,:,:) = 0._wp   ;   ztrdz(:,:,:) = 0._wp 
    116110      ENDIF 
    117111      ! 
    118112      IF( l_ptr ) THEN   
    119          CALL wrk_alloc( jpi, jpj, jpk, zptry ) 
     113         ALLOCATE( zptry(jpi,jpj,jpk) ) 
    120114         zptry(:,:,:) = 0._wp 
    121115      ENDIF 
    … …  
    184178         END IF 
    185179         !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    186          IF( l_ptr )  zptry(:,:,:) = zwy(:,:,:)  
     180         IF( l_ptr )   zptry(:,:,:) = zwy(:,:,:)  
    187181         ! 
    188182         !        !==  anti-diffusive flux : high order minus low order  ==! 
    … …  
    308302         END DO 
    309303         ! 
    310          IF( l_trd .OR. l_hst ) THEN     ! trend diagnostics (contribution of upstream fluxes) 
    311             ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed 
    312             ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
    313             ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed 
     304         IF( l_trd .OR. l_hst ) THEN   ! trend diagnostics // heat/salt transport 
     305            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< add anti-diffusive fluxes  
     306            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  !     to upstream fluxes 
     307            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! 
     308            ! 
     309            IF( l_trd ) THEN              ! trend diagnostics 
     310               CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 
     311               CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 
     312               CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
     313            ENDIF 
     314            !                             ! heat/salt transport 
     315            IF( l_hst )   CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) ) 
     316            ! 
     317            DEALLOCATE( ztrdx, ztrdy, ztrdz ) 
    314318         ENDIF 
    315             ! 
    316          IF( l_trd ) THEN  
    317             CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 
    318             CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 
    319             CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
    320             ! 
    321          END IF 
    322          !                                !  heat/salt transport 
    323          IF( l_hst )  CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) ) 
    324  
    325          !                                ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    326          IF( l_ptr ) THEN   
    327             zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
     319         IF( l_ptr ) THEN              ! "Poleward" transports 
     320            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< add anti-diffusive fluxes 
    328321            CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) ) 
     322            DEALLOCATE( zptry ) 
    329323         ENDIF 
    330324         ! 
    331325      END DO                     ! end of tracer loop 
    332326      ! 
    333                               CALL wrk_dealloc( jpi,jpj,jpk,    zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw ) 
    334       IF( l_trd .OR. l_hst )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
    335       IF( l_ptr )             CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 
    336       ! 
    337       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_fct') 
     327      IF( ln_timing )   CALL timing_stop('tra_adv_fct') 
    338328      ! 
    339329   END SUBROUTINE tra_adv_fct 
    340  
    341  
    342    SUBROUTINE tra_adv_fct_zts( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      & 
    343       &                                                  ptb, ptn, pta, kjpt, kn_fct_zts ) 
    344       !!---------------------------------------------------------------------- 
    345       !!                  ***  ROUTINE tra_adv_fct_zts  *** 
    346       !!  
    347       !! **  Purpose :   Compute the now trend due to total advection of  
    348       !!       tracers and add it to the general trend of tracer equations 
    349       !! 
    350       !! **  Method  :   TVD ZTS scheme, i.e. 2nd order centered scheme with 
    351       !!       corrected flux (monotonic correction). This version use sub- 
    352       !!       timestepping for the vertical advection which increases stability 
    353       !!       when vertical metrics are small. 
    354       !!       note: - this advection scheme needs a leap-frog time scheme 
    355       !! 
    356       !! ** Action : - update (pta) with the now advective tracer trends 
    357       !!             - save the trends  
    358       !!---------------------------------------------------------------------- 
    359       INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    360       INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    361       CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    362       INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
    363       INTEGER                              , INTENT(in   ) ::   kn_fct_zts      ! number of number of vertical sub-timesteps 
    364       REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step 
    365       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components 
    366       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields 
    367       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    368       ! 
    369       REAL(wp), DIMENSION( jpk )                           ::   zts             ! length of sub-timestep for vertical advection 
    370       REAL(wp)                                             ::   zr_p2dt         ! reciprocal of tracer timestep 
    371       INTEGER  ::   ji, jj, jk, jl, jn       ! dummy loop indices   
    372       INTEGER  ::   jtb, jtn, jta   ! sub timestep pointers for leap-frog/euler forward steps 
    373       INTEGER  ::   jtaken          ! toggle for collecting appropriate fluxes from sub timesteps 
    374       REAL(wp) ::   z_rzts          ! Fractional length of Euler forward sub-timestep for vertical advection 
    375       REAL(wp) ::   ztra            ! local scalar 
    376       REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk   !   -      - 
    377       REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      - 
    378       REAL(wp), POINTER, DIMENSION(:,:  )   ::   zwx_sav , zwy_sav 
    379       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zwi, zwx, zwy, zwz, zhdiv, zwzts, zwz_sav 
    380       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   ztrdx, ztrdy, ztrdz 
    381       REAL(wp), POINTER, DIMENSION(:,:,:) :: zptry 
    382       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrs 
    383       !!---------------------------------------------------------------------- 
    384       ! 
    385       IF( nn_timing == 1 )  CALL timing_start('tra_adv_fct_zts') 
    386       ! 
    387       CALL wrk_alloc( jpi,jpj,             zwx_sav, zwy_sav ) 
    388       CALL wrk_alloc( jpi,jpj,jpk,         zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav ) 
    389       CALL wrk_alloc( jpi,jpj,jpk,kjpt+1,  ztrs ) 
    390       ! 
    391       IF( kt == kit000 )  THEN 
    392          IF(lwp) WRITE(numout,*) 
    393          IF(lwp) WRITE(numout,*) 'tra_adv_fct_zts : 2nd order FCT scheme with ', kn_fct_zts, ' vertical sub-timestep on ', cdtype 
    394          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    395       ENDIF 
    396       ! 
    397       l_trd = .FALSE. 
    398       l_hst = .FALSE. 
    399       l_ptr = .FALSE. 
    400       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )      l_trd = .TRUE. 
    401       IF(   cdtype == 'TRA' .AND. ln_diaptr )                                               l_ptr = .TRUE.  
    402       IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
    403          &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) ) l_hst = .TRUE. 
    404       ! 
    405       IF( l_trd .OR. l_hst )  THEN 
    406          CALL wrk_alloc( jpi,jpj,jpk,   ztrdx, ztrdy, ztrdz ) 
    407          ztrdx(:,:,:) = 0._wp  ;    ztrdy(:,:,:) = 0._wp  ;   ztrdz(:,:,:) = 0._wp 
    408       ENDIF 
    409       ! 
    410       IF( l_ptr ) THEN   
    411          CALL wrk_alloc( jpi, jpj,jpk, zptry ) 
    412          zptry(:,:,:) = 0._wp 
    413       ENDIF 
    414       zwi(:,:,:) = 0._wp 
    415       z_rzts = 1._wp / REAL( kn_fct_zts, wp ) 
    416       zr_p2dt = 1._wp / p2dt 
    417       ! 
    418       ! surface & Bottom value : flux set to zero for all tracers 
    419       zwz(:,:, 1 ) = 0._wp 
    420       zwx(:,:,jpk) = 0._wp   ;    zwz(:,:,jpk) = 0._wp 
    421       zwy(:,:,jpk) = 0._wp   ;    zwi(:,:,jpk) = 0._wp 
    422       ! 
    423       !                                                          ! =========== 
    424       DO jn = 1, kjpt                                            ! tracer loop 
    425          !                                                       ! =========== 
    426          ! 
    427          ! Upstream advection with initial mass fluxes & intermediate update 
    428          DO jk = 1, jpkm1        ! upstream tracer flux in the i and j direction 
    429             DO jj = 1, jpjm1 
    430                DO ji = 1, fs_jpim1   ! vector opt. 
    431                   ! upstream scheme 
    432                   zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) ) 
    433                   zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) ) 
    434                   zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) ) 
    435                   zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) ) 
    436                   zwx(ji,jj,jk) = 0.5_wp * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn) ) 
    437                   zwy(ji,jj,jk) = 0.5_wp * ( zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji  ,jj+1,jk,jn) ) 
    438                END DO 
    439             END DO 
    440          END DO 
    441          !                       ! upstream tracer flux in the k direction 
    442          DO jk = 2, jpkm1              ! Interior value 
    443             DO jj = 1, jpj 
    444                DO ji = 1, jpi 
    445                   zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) ) 
    446                   zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) ) 
    447                   zwz(ji,jj,jk) = 0.5_wp * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk) 
    448                END DO 
    449             END DO 
    450          END DO 
    451          IF( ln_linssh ) THEN          ! top value : linear free surface case only (as zwz is multiplied by wmask) 
    452             IF( ln_isfcav ) THEN             ! ice-shelf cavities: top value 
    453                DO jj = 1, jpj 
    454                   DO ji = 1, jpi 
    455                      zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)  
    456                   END DO 
    457                END DO    
    458             ELSE                             ! no cavities, surface value 
    459                zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) 
    460             ENDIF 
    461          ENDIF 
    462          ! 
    463          DO jk = 1, jpkm1         ! total advective trend 
    464             DO jj = 2, jpjm1 
    465                DO ji = fs_2, fs_jpim1   ! vector opt. 
    466                   !                             ! total intermediate advective trends 
    467                   ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
    468                      &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   & 
    469                      &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)   ) * r1_e1e2t(ji,jj) 
    470                   !                             ! update and guess with monotonic sheme 
    471                   pta(ji,jj,jk,jn) =                     pta(ji,jj,jk,jn) +        ztra   / e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
    472                   zwi(ji,jj,jk)    = ( e3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + p2dt * ztra ) / e3t_a(ji,jj,jk) * tmask(ji,jj,jk) 
    473                END DO 
    474             END DO 
    475          END DO 
    476          !                            
    477          CALL lbc_lnk( zwi, 'T', 1. )     ! Lateral boundary conditions on zwi  (unchanged sign) 
    478          !                 
    479          IF( l_trd .OR. l_hst )  THEN                ! trend diagnostics (contribution of upstream fluxes) 
    480             ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:) 
    481          END IF 
    482          !                                ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    483          IF( l_ptr )  zptry(:,:,:) = zwy(:,:,:) 
    484  
    485          ! 3. anti-diffusive flux : high order minus low order 
    486          ! --------------------------------------------------- 
    487  
    488          DO jk = 1, jpkm1                    !* horizontal anti-diffusive fluxes 
    489             ! 
    490             DO jj = 1, jpjm1 
    491                DO ji = 1, fs_jpim1   ! vector opt. 
    492                   zwx_sav(ji,jj) = zwx(ji,jj,jk) 
    493                   zwy_sav(ji,jj) = zwy(ji,jj,jk) 
    494                   ! 
    495                   zwx(ji,jj,jk) = 0.5_wp * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) 
    496                   zwy(ji,jj,jk) = 0.5_wp * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) 
    497                END DO 
    498             END DO 
    499             ! 
    500             DO jj = 2, jpjm1                    ! partial horizontal divergence 
    501                DO ji = fs_2, fs_jpim1 
    502                   zhdiv(ji,jj,jk) = (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk)   & 
    503                      &               + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk)  ) 
    504                END DO 
    505             END DO 
    506             ! 
    507             DO jj = 1, jpjm1 
    508                DO ji = 1, fs_jpim1   ! vector opt. 
    509                   zwx(ji,jj,jk) = zwx(ji,jj,jk) - zwx_sav(ji,jj) 
    510                   zwy(ji,jj,jk) = zwy(ji,jj,jk) - zwy_sav(ji,jj) 
    511                END DO 
    512             END DO 
    513          END DO 
    514          ! 
    515          !                                !* vertical anti-diffusive flux 
    516          zwz_sav(:,:,:)   = zwz(:,:,:) 
    517          ztrs   (:,:,:,1) = ptb(:,:,:,jn) 
    518          ztrs   (:,:,1,2) = ptb(:,:,1,jn) 
    519          ztrs   (:,:,1,3) = ptb(:,:,1,jn) 
    520          zwzts  (:,:,:)   = 0._wp 
    521          ! 
    522          DO jl = 1, kn_fct_zts                  ! Start of sub timestepping loop 
    523             ! 
    524             IF( jl == 1 ) THEN                        ! Euler forward to kick things off 
    525                jtb = 1   ;   jtn = 1   ;   jta = 2 
    526                zts(:) = p2dt * z_rzts 
    527                jtaken = MOD( kn_fct_zts + 1 , 2)            ! Toggle to collect every second flux 
    528                !                                            ! starting at jl =1 if kn_fct_zts is odd;  
    529                !                                            ! starting at jl =2 otherwise 
    530             ELSEIF( jl == 2 ) THEN                    ! First leapfrog step 
    531                jtb = 1   ;   jtn = 2   ;   jta = 3 
    532                zts(:) = 2._wp * p2dt * z_rzts 
    533             ELSE                                      ! Shuffle pointers for subsequent leapfrog steps 
    534                jtb = MOD(jtb,3) + 1 
    535                jtn = MOD(jtn,3) + 1 
    536                jta = MOD(jta,3) + 1 
    537             ENDIF 
    538             DO jk = 2, jpkm1                          ! interior value 
    539                DO jj = 2, jpjm1 
    540                   DO ji = fs_2, fs_jpim1 
    541                      zwz(ji,jj,jk) = 0.5_wp * pwn(ji,jj,jk) * ( ztrs(ji,jj,jk,jtn) + ztrs(ji,jj,jk-1,jtn) ) * wmask(ji,jj,jk) 
    542                      IF( jtaken == 0 )   zwzts(ji,jj,jk) = zwzts(ji,jj,jk) + zwz(ji,jj,jk) * zts(jk)    ! Accumulate time-weighted vertcal flux 
    543                   END DO 
    544                END DO 
    545             END DO 
    546             IF( ln_linssh ) THEN                    ! top value (only in linear free surface case) 
    547                IF( ln_isfcav ) THEN                      ! ice-shelf cavities 
    548                   DO jj = 1, jpj 
    549                      DO ji = 1, jpi 
    550                         zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface  
    551                      END DO 
    552                   END DO    
    553                ELSE                                      ! no ocean cavities 
    554                   zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) 
    555                ENDIF 
    556             ENDIF 
    557             ! 
    558             jtaken = MOD( jtaken + 1 , 2 ) 
    559             ! 
    560             DO jk = 2, jpkm1                             ! total advective trends 
    561                DO jj = 2, jpjm1 
    562                   DO ji = fs_2, fs_jpim1 
    563                      ztrs(ji,jj,jk,jta) = ztrs(ji,jj,jk,jtb)                                                 & 
    564                         &               - zts(jk) * (  zhdiv(ji,jj,jk) + zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )   & 
    565                         &                         * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    566                   END DO 
    567                END DO 
    568             END DO 
    569             ! 
    570          END DO 
    571  
    572          DO jk = 2, jpkm1          ! Anti-diffusive vertical flux using average flux from the sub-timestepping 
    573             DO jj = 2, jpjm1 
    574                DO ji = fs_2, fs_jpim1 
    575                   zwz(ji,jj,jk) = ( zwzts(ji,jj,jk) * zr_p2dt - zwz_sav(ji,jj,jk) ) * wmask(ji,jj,jk) 
    576                END DO 
    577             END DO 
    578          END DO 
    579          CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions 
    580          CALL lbc_lnk( zwz, 'W',  1. ) 
    581  
    582          ! 4. monotonicity algorithm 
    583          ! ------------------------- 
    584          CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt ) 
    585  
    586  
    587          ! 5. final trend with corrected fluxes 
    588          ! ------------------------------------ 
    589          DO jk = 1, jpkm1 
    590             DO jj = 2, jpjm1 
    591                DO ji = fs_2, fs_jpim1   ! vector opt.   
    592                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + (   zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )       & 
    593                      &                                    + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)   )   & 
    594                      &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    595                END DO 
    596             END DO 
    597          END DO 
    598  
    599         ! 
    600          IF( l_trd .OR. l_hst ) THEN     ! trend diagnostics (contribution of upstream fluxes) 
    601             ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed 
    602             ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
    603             ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed 
    604          ENDIF 
    605             ! 
    606          IF( l_trd ) THEN  
    607             CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 
    608             CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 
    609             CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
    610             ! 
    611          END IF 
    612          !                                             ! heat/salt transport 
    613          IF( l_hst )  CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) ) 
    614  
    615          !                                            ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    616          IF( l_ptr ) THEN   
    617             zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
    618             CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) ) 
    619          ENDIF 
    620          ! 
    621       END DO 
    622       ! 
    623                               CALL wrk_alloc( jpi,jpj,             zwx_sav, zwy_sav ) 
    624                               CALL wrk_alloc( jpi,jpj, jpk,        zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav ) 
    625                               CALL wrk_alloc( jpi,jpj,jpk,kjpt+1,  ztrs ) 
    626       IF( l_trd .OR. l_hst )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
    627       IF( l_ptr )             CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 
    628       ! 
    629       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_fct_zts') 
    630       ! 
    631    END SUBROUTINE tra_adv_fct_zts 
    632330 
    633331 
    … …  
    653351      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn    ! local scalars 
    654352      REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      - 
    655       REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo, zbup, zbdo 
    656       !!---------------------------------------------------------------------- 
    657       ! 
    658       IF( nn_timing == 1 )  CALL timing_start('nonosc') 
    659       ! 
    660       CALL wrk_alloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo ) 
     353      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zbetup, zbetdo, zbup, zbdo 
     354      !!---------------------------------------------------------------------- 
     355      ! 
     356      IF( ln_timing )   CALL timing_start('nonosc') 
    661357      ! 
    662358      zbig  = 1.e+40_wp 
    … …  
    734430      CALL lbc_lnk( paa, 'U', -1. )   ;   CALL lbc_lnk( pbb, 'V', -1. )   ! lateral boundary condition (changed sign) 
    735431      ! 
    736       CALL wrk_dealloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo ) 
    737       ! 
    738       IF( nn_timing == 1 )  CALL timing_stop('nonosc') 
     432      IF( ln_timing )   CALL timing_stop('nonosc') 
    739433      ! 
    740434   END SUBROUTINE nonosc 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90

    r7753 r8568  
    1515   USE phycst         ! physical constant 
    1616   USE zdfmxl         ! mixed layer depth 
     17   ! 
    1718   USE lbclnk         ! lateral boundary condition / mpp link 
    1819   USE in_out_manager ! I/O manager 
    1920   USE iom            ! IOM library 
    2021   USE lib_mpp        ! MPP library 
    21    USE wrk_nemo       ! work arrays 
    2222   USE timing         ! Timing 
    2323 
    … …  
    8686      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pw         !   increased by the MLE induced transport 
    8787      ! 
    88       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    89       INTEGER  ::   ikmax        ! temporary integer 
    90       REAL(wp) ::   zcuw, zmuw   ! local scalar 
    91       REAL(wp) ::   zcvw, zmvw   !   -      - 
    92       REAL(wp) ::   zc                                     !   -      - 
    93       ! 
    94       INTEGER  ::   ii, ij, ik              ! local integers 
    95       INTEGER, DIMENSION(3) ::   ilocu      ! 
    96       INTEGER, DIMENSION(2) ::   ilocs      ! 
    97       REAL(wp), POINTER, DIMENSION(:,:  ) :: zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH 
    98       REAL(wp), POINTER, DIMENSION(:,:,:) :: zpsi_uw, zpsi_vw 
    99       INTEGER, POINTER, DIMENSION(:,:) :: inml_mle 
    100       !!---------------------------------------------------------------------- 
    101       ! 
    102       IF( nn_timing == 1 )  CALL timing_start('tra_adv_mle') 
    103       CALL wrk_alloc( jpi, jpj, zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH) 
    104       CALL wrk_alloc( jpi, jpj, jpk, zpsi_uw, zpsi_vw) 
    105       CALL wrk_alloc( jpi, jpj, inml_mle) 
     88      INTEGER  ::   ji, jj, jk          ! dummy loop indices 
     89      INTEGER  ::   ii, ij, ik, ikmax   ! local integers 
     90      REAL(wp) ::   zcuw, zmuw, zc      ! local scalar 
     91      REAL(wp) ::   zcvw, zmvw          !   -      - 
     92      INTEGER , DIMENSION(jpi,jpj)     :: inml_mle 
     93      REAL(wp), DIMENSION(jpi,jpj)     :: zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH 
     94      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpsi_uw, zpsi_vw 
     95      !!---------------------------------------------------------------------- 
     96      ! 
     97      IF( ln_timing )   CALL timing_start('tra_adv_mle') 
    10698      ! 
    10799      !                                      !==  MLD used for MLE  ==! 
    … …  
    256248         CALL iom_put( "psiv_mle", zpsi_vw )    ! j-mle streamfunction 
    257249      ENDIF 
    258       CALL wrk_dealloc( jpi, jpj, zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH) 
    259       CALL wrk_dealloc( jpi, jpj, jpk, zpsi_uw, zpsi_vw) 
    260       CALL wrk_dealloc( jpi, jpj, inml_mle) 
    261  
    262       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_mle') 
     250      ! 
     251      IF( ln_timing )   CALL timing_stop('tra_adv_mle') 
    263252      ! 
    264253   END SUBROUTINE tra_adv_mle 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90

    r7753 r8568  
    2626 
    2727   ! 
    28    USE iom 
    29    USE wrk_nemo       ! Memory Allocation 
     28   USE iom            ! XIOS library 
    3029   USE timing         ! Timing 
    3130   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    … …  
    8584      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    8685      ! 
    87       INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices 
    88       INTEGER  ::   ierr                 ! local integer 
    89       REAL(wp) ::   zu, z0u, zzwx, zw    ! local scalars 
    90       REAL(wp) ::   zv, z0v, zzwy, z0w   !   -      - 
    91       REAL(wp) ::   zalpha               !   -      - 
    92       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zslpx, zslpy   ! 3D workspace 
    93       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx  , zwy     ! -      -  
     86      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     87      INTEGER  ::   ierr             ! local integer 
     88      REAL(wp) ::   zu, z0u, zzwx, zw , zalpha   ! local scalars 
     89      REAL(wp) ::   zv, z0v, zzwy, z0w           !   -      - 
     90      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwx, zslpx   ! 3D workspace 
     91      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwy, zslpy   ! -      -  
    9492      !!---------------------------------------------------------------------- 
    9593      ! 
    96       IF( nn_timing == 1 )  CALL timing_start('tra_adv_mus') 
    97       ! 
    98       CALL wrk_alloc( jpi,jpj,jpk,   zslpx, zslpy, zwx, zwy ) 
     94      IF( ln_timing )   CALL timing_start('tra_adv_mus') 
    9995      ! 
    10096      IF( kt == kit000 )  THEN 
    … …  
    279275      END DO                     ! end of tracer loop 
    280276      ! 
    281       CALL wrk_dealloc( jpi,jpj,jpk,   zslpx, zslpy, zwx, zwy ) 
    282       ! 
    283       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_mus') 
     277      IF( ln_timing )   CALL timing_stop('tra_adv_mus') 
    284278      ! 
    285279   END SUBROUTINE tra_adv_mus 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r7646 r8568  
    2525   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    2626   USE in_out_manager  ! I/O manager 
    27    USE wrk_nemo        ! Memory Allocation 
    2827   USE timing          ! Timing 
    2928   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    … …  
    4342#  include "vectopt_loop_substitute.h90" 
    4443   !!---------------------------------------------------------------------- 
    45    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     44   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    4645   !! $Id$ 
    4746   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    9695      !!---------------------------------------------------------------------- 
    9796      ! 
    98       IF( nn_timing == 1 )  CALL timing_start('tra_adv_qck') 
     97      IF( ln_timing )   CALL timing_start('tra_adv_qck') 
    9998      ! 
    10099      IF( kt == kit000 )  THEN 
    … …  
    118117      CALL tra_adv_cen2_k( kt, cdtype, pwn,         ptn, pta, kjpt ) 
    119118      ! 
    120       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_qck') 
     119      IF( ln_timing )   CALL timing_stop('tra_adv_qck') 
    121120      ! 
    122121   END SUBROUTINE tra_adv_qck 
    … …  
    138137      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    139138      REAL(wp) ::   ztra, zbtr, zdir, zdx, zmsk   ! local scalars 
    140       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx, zfu, zfc, zfd 
     139      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwx, zfu, zfc, zfd 
    141140      !---------------------------------------------------------------------- 
    142141      ! 
    143       CALL wrk_alloc( jpi, jpj, jpk, zwx, zfu, zfc, zfd ) 
    144142      !                                                          ! =========== 
    145143      DO jn = 1, kjpt                                            ! tracer loop 
    … …  
    230228         END DO 
    231229         !                                 ! trend diagnostics 
    232          IF( l_trd )                     CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) ) 
     230         IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) ) 
    233231         ! 
    234232      END DO 
    235       ! 
    236       CALL wrk_dealloc( jpi, jpj, jpk, zwx, zfu, zfc, zfd ) 
    237233      ! 
    238234   END SUBROUTINE tra_adv_qck_i 
    … …  
    252248      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
    253249      !! 
    254       INTEGER  :: ji, jj, jk, jn   ! dummy loop indices 
     250      INTEGER  :: ji, jj, jk, jn                ! dummy loop indices 
    255251      REAL(wp) :: ztra, zbtr, zdir, zdx, zmsk   ! local scalars 
    256       REAL(wp), POINTER, DIMENSION(:,:,:) :: zwy, zfu, zfc, zfd 
     252      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwy, zfu, zfc, zfd   ! 3D workspace 
    257253      !---------------------------------------------------------------------- 
    258       ! 
    259       CALL wrk_alloc( jpi, jpj, jpk, zwy, zfu, zfc, zfd ) 
    260254      ! 
    261255      !                                                          ! =========== 
    … …  
    320314            END DO 
    321315         END DO 
    322          !--- Lateral boundary conditions  
    323          CALL lbc_lnk( zfu(:,:,:), 'T', 1. )  
     316         CALL lbc_lnk( zfu(:,:,:), 'T', 1. )    !--- Lateral boundary conditions  
    324317         ! 
    325318         ! Tracer flux on the x-direction 
    … …  
    359352      END DO 
    360353      ! 
    361       CALL wrk_dealloc( jpi, jpj, jpk, zwy, zfu, zfc, zfd ) 
    362       ! 
    363354   END SUBROUTINE tra_adv_qck_j 
    364355 
    … …  
    377368      ! 
    378369      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    379       REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz 
    380       !!---------------------------------------------------------------------- 
    381       ! 
    382       CALL wrk_alloc( jpi,jpj,jpk,   zwz ) 
     370      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz   ! 3D workspace 
     371      !!---------------------------------------------------------------------- 
    383372      ! 
    384373      zwz(:,:, 1 ) = 0._wp       ! surface & bottom values set to zero for all tracers 
    … …  
    421410      END DO 
    422411      ! 
    423       CALL wrk_dealloc( jpi,jpj,jpk,   zwz ) 
    424       ! 
    425412   END SUBROUTINE tra_adv_cen2_k 
    426413 
    … …  
    443430      !---------------------------------------------------------------------- 
    444431      ! 
    445       IF( nn_timing == 1 )  CALL timing_start('quickest') 
     432      IF( ln_timing )   CALL timing_start('quickest') 
    446433      ! 
    447434      DO jk = 1, jpkm1 
    … …  
    475462      END DO 
    476463      ! 
    477       IF( nn_timing == 1 )  CALL timing_stop('quickest') 
     464      IF( ln_timing )   CALL timing_stop('quickest') 
    478465      ! 
    479466   END SUBROUTINE quickest 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    r7646 r8568  
    2222 
    2323   ! 
    24    USE iom 
    25    USE lib_mpp        ! I/O library 
     24   USE iom            ! XIOS library 
     25   USE lib_mpp        ! massively parallel library 
    2626   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
    2727   USE in_out_manager ! I/O manager 
    28    USE wrk_nemo       ! Memory Allocation 
    2928   USE timing         ! Timing 
    3029   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    … …  
    101100      REAL(wp) ::   zfp_ui, zfm_ui, zcenut, ztak, zfp_wk, zfm_wk   !   -      - 
    102101      REAL(wp) ::   zfp_vj, zfm_vj, zcenvt, zeeu, zeev, z_hdivn    !   -      - 
    103       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztu, ztv, zltu, zltv, zti, ztw 
    104       !!---------------------------------------------------------------------- 
    105       ! 
    106       IF( nn_timing == 1 )  CALL timing_start('tra_adv_ubs') 
    107       ! 
    108       CALL wrk_alloc( jpi,jpj,jpk,   ztu, ztv, zltu, zltv, zti, ztw ) 
     102      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztu, ztv, zltu, zltv, zti, ztw   ! 3D workspace 
     103      !!---------------------------------------------------------------------- 
     104      ! 
     105      IF( ln_timing )   CALL timing_start('tra_adv_ubs') 
    109106      ! 
    110107      IF( kt == kit000 )  THEN 
    … …  
    285282      END DO 
    286283      ! 
    287       CALL wrk_dealloc( jpi,jpj,jpk,   ztu, ztv, zltu, zltv, zti, ztw ) 
    288       ! 
    289       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_ubs') 
     284      IF( ln_timing )   CALL timing_stop('tra_adv_ubs') 
    290285      ! 
    291286   END SUBROUTINE tra_adv_ubs 
    … …  
    313308      INTEGER  ::   ikm1         ! local integer 
    314309      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn   ! local scalars 
    315       REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo 
    316       !!---------------------------------------------------------------------- 
    317       ! 
    318       IF( nn_timing == 1 )  CALL timing_start('nonosc_z') 
    319       ! 
    320       CALL wrk_alloc( jpi,jpj,jpk,   zbetup, zbetdo ) 
     310      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zbetup, zbetdo     ! 3D workspace 
     311      !!---------------------------------------------------------------------- 
     312      ! 
     313      IF( ln_timing )   CALL timing_start('nonosc_z') 
    321314      ! 
    322315      zbig  = 1.e+40_wp 
    … …  
    387380      END DO 
    388381      ! 
    389       CALL wrk_dealloc( jpi,jpj,jpk,   zbetup, zbetdo ) 
    390       ! 
    391       IF( nn_timing == 1 )  CALL timing_stop('nonosc_z') 
     382      IF( ln_timing )   CALL timing_stop('nonosc_z') 
    392383      ! 
    393384   END SUBROUTINE nonosc_z 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

    r7753 r8568  
    2727   USE lib_mpp        ! distributed memory computing library 
    2828   USE prtctl         ! Print control 
    29    USE wrk_nemo       ! Memory Allocation 
    3029   USE timing         ! Timing 
    3130 
    … …  
    7776      ! 
    7877      INTEGER  ::   ji, jj    ! dummy loop indices 
    79       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt 
     78      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt   ! 3D workspace 
    8079      !!---------------------------------------------------------------------- 
    8180      ! 
    82       IF( nn_timing == 1 )  CALL timing_start('tra_bbc') 
     81      IF( ln_timing )   CALL timing_start('tra_bbc') 
    8382      ! 
    8483      IF( l_trdtra )   THEN         ! Save the input temperature trend 
    85          CALL wrk_alloc( jpi,jpj,jpk,   ztrdt ) 
     84         ALLOCATE( ztrdt(jpi,jpj,jpk) ) 
    8685         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    8786      ENDIF 
    … …  
    9897         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    9998         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrdt ) 
    100          CALL wrk_dealloc( jpi,jpj,jpk,  ztrdt ) 
     99         DEALLOCATE( ztrdt ) 
    101100      ENDIF 
    102101      ! 
    103102      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 
    104103      ! 
    105       IF( nn_timing == 1 )  CALL timing_stop('tra_bbc') 
     104      IF( ln_timing )   CALL timing_stop('tra_bbc') 
    106105      ! 
    107106   END SUBROUTINE tra_bbc 
    … …  
    130129      TYPE(FLD_N)        ::   sn_qgh    ! informations about the geotherm. field to be read 
    131130      CHARACTER(len=256) ::   cn_dir    ! Root directory for location of ssr files 
    132       ! 
     131      !! 
    133132      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst, sn_qgh, cn_dir  
    134133      !!---------------------------------------------------------------------- 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r8215 r8568  
    3535   USE lbclnk         ! ocean lateral boundary conditions 
    3636   USE prtctl         ! Print control 
    37    USE wrk_nemo       ! Memory Allocation 
    3837   USE timing         ! Timing 
    3938   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    … …  
    104103      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
    105104      ! 
    106       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    107       !!---------------------------------------------------------------------- 
    108       ! 
    109       IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl') 
     105      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds 
     106      !!---------------------------------------------------------------------- 
     107      ! 
     108      IF( ln_timing )   CALL timing_start( 'tra_bbl') 
    110109      ! 
    111110      IF( l_trdtra )   THEN                         !* Save the T-S input trends 
    112          CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     111         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
    113112         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    114113         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    … …  
    148147         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrdt ) 
    149148         CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrds ) 
    150          CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
    151       ENDIF 
    152       ! 
    153       IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl') 
     149         DEALLOCATE( ztrdt, ztrds ) 
     150      ENDIF 
     151      ! 
     152      IF( ln_timing )  CALL timing_stop( 'tra_bbl') 
    154153      ! 
    155154   END SUBROUTINE tra_bbl 
    … …  
    184183      INTEGER  ::   ik           ! local integers 
    185184      REAL(wp) ::   zbtr         ! local scalars 
    186       REAL(wp), POINTER, DIMENSION(:,:) :: zptb 
    187       !!---------------------------------------------------------------------- 
    188       ! 
    189       IF( nn_timing == 1 )  CALL timing_start('tra_bbl_dif') 
    190       ! 
    191       CALL wrk_alloc( jpi, jpj, zptb ) 
     185      REAL(wp), DIMENSION(jpi,jpj) ::   zptb   ! workspace 
     186      !!---------------------------------------------------------------------- 
     187      ! 
     188      IF( ln_timing )   CALL timing_start('tra_bbl_dif') 
    192189      ! 
    193190      DO jn = 1, kjpt                                     ! tracer loop 
    … …  
    214211      END DO                                                ! end tracer 
    215212      !                                                     ! =========== 
    216       CALL wrk_dealloc( jpi, jpj, zptb ) 
    217       ! 
    218       IF( nn_timing == 1 )  CALL timing_stop('tra_bbl_dif') 
     213      ! 
     214      IF( ln_timing )   CALL timing_stop('tra_bbl_dif') 
    219215      ! 
    220216   END SUBROUTINE tra_bbl_dif 
    … …  
    247243      !!---------------------------------------------------------------------- 
    248244      ! 
    249       IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl_adv') 
     245      IF( ln_timing )   CALL timing_start( 'tra_bbl_adv') 
    250246      !                                                          ! =========== 
    251247      DO jn = 1, kjpt                                            ! tracer loop 
    … …  
    303299      !                                                     ! =========== 
    304300      ! 
    305       IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl_adv') 
     301      IF( ln_timing )   CALL timing_stop( 'tra_bbl_adv') 
    306302      ! 
    307303   END SUBROUTINE tra_bbl_adv 
    … …  
    348344      !!---------------------------------------------------------------------- 
    349345      ! 
    350       IF( nn_timing == 1 )  CALL timing_start( 'bbl') 
     346      IF( ln_timing )   CALL timing_start( 'bbl') 
    351347      ! 
    352348      IF( kt == kit000 )  THEN 
    … …  
    479475      ENDIF 
    480476      ! 
    481       IF( nn_timing == 1 )  CALL timing_stop( 'bbl') 
     477      IF( ln_timing )   CALL timing_stop( 'bbl') 
    482478      ! 
    483479   END SUBROUTINE bbl 
    … …  
    493489      !!              called by nemo_init at the first timestep (kit000) 
    494490      !!---------------------------------------------------------------------- 
    495       INTEGER ::   ji, jj               ! dummy loop indices 
    496       INTEGER ::   ii0, ii1, ij0, ij1   ! local integer 
    497       INTEGER ::   ios                  !   -      - 
    498       REAL(wp), POINTER, DIMENSION(:,:) :: zmbk 
     491      INTEGER ::   ji, jj                      ! dummy loop indices 
     492      INTEGER ::   ii0, ii1, ij0, ij1, ios     ! local integer 
     493      REAL(wp), DIMENSION(jpi,jpj) ::   zmbk   ! workspace 
    499494      !! 
    500495      NAMELIST/nambbl/ ln_trabbl, nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl 
    501496      !!---------------------------------------------------------------------- 
    502497      ! 
    503       IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl_init') 
     498      IF( ln_timing )   CALL timing_start( 'tra_bbl_init') 
    504499      ! 
    505500      REWIND( numnam_ref )              ! Namelist nambbl in reference namelist : Bottom boundary layer scheme 
    … …  
    544539      END DO 
    545540      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
    546       CALL wrk_alloc( jpi, jpj, zmbk ) 
    547541      zmbk(:,:) = REAL( mbku_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'U',1.)   ;   mbku_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
    548542      zmbk(:,:) = REAL( mbkv_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
    549       CALL wrk_dealloc( jpi, jpj, zmbk ) 
    550543      ! 
    551544      !                                 !* sign of grad(H) at u- and v-points 
    … …  
    570563      ahv_bbl_0(:,:) = rn_ahtbbl * e1_e2v(:,:) * e3v_bbl_0(:,:) * vmask(:,:,1) 
    571564      ! 
    572       IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl_init') 
     565      IF( ln_timing )   CALL timing_stop( 'tra_bbl_init') 
    573566      ! 
    574567   END SUBROUTINE tra_bbl_init 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90

    r7753 r8568  
    3333   ! 
    3434   USE in_out_manager ! I/O manager 
     35   USE iom            ! XIOS 
    3536   USE lib_mpp        ! MPP library 
    3637   USE prtctl         ! Print control 
    37    USE wrk_nemo       ! Memory allocation 
    3838   USE timing         ! Timing 
    39    USE iom 
    4039 
    4140   IMPLICIT NONE 
    … …  
    9493      ! 
    9594      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
    96       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zts_dta, ztrdts 
    97       !!---------------------------------------------------------------------- 
    98       ! 
    99       IF( nn_timing == 1 )   CALL timing_start('tra_dmp') 
    100       ! 
    101       CALL wrk_alloc( jpi,jpj,jpk,jpts,   zts_dta ) 
     95      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts)     ::  zts_dta 
     96      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  ztrdts 
     97      !!---------------------------------------------------------------------- 
     98      ! 
     99      IF( ln_timing )   CALL timing_start('tra_dmp') 
     100      ! 
    102101      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    103          CALL wrk_alloc( jpi,jpj,jpk,jpts,   ztrdts )  
     102         ALLOCATE( ztrdts(jpi,jpj,jpk,jpts) )  
    104103         ztrdts(:,:,:,:) = tsa(:,:,:,:)  
    105104      ENDIF 
    … …  
    154153         CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) ) 
    155154         CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) ) 
    156          CALL wrk_dealloc( jpi,jpj,jpk,jpts,  ztrdts )  
     155         DEALLOCATE( ztrdts )  
    157156      ENDIF 
    158157      !                           ! Control print 
    … …  
    160159         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    161160      ! 
    162       CALL wrk_dealloc( jpi,jpj,jpk,jpts,   zts_dta ) 
    163       ! 
    164       IF( nn_timing == 1 )   CALL timing_stop('tra_dmp') 
     161      IF( ln_timing )   CALL timing_stop('tra_dmp') 
    165162      ! 
    166163   END SUBROUTINE tra_dmp 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90

    r7765 r8568  
    3030   USE lib_mpp        ! distribued memory computing library 
    3131   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    32    USE wrk_nemo       ! Memory allocation 
    3332   USE timing         ! Timing 
    3433 
    … …  
    5857      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    5958      !! 
    60       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    61       !!---------------------------------------------------------------------- 
    62       ! 
    63       IF( nn_timing == 1 )   CALL timing_start('tra_ldf') 
     59      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds 
     60      !!---------------------------------------------------------------------- 
     61      ! 
     62      IF( ln_timing )   CALL timing_start('tra_ldf') 
    6463      ! 
    6564      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    66          CALL wrk_alloc( jpi,jpj,jpk,   ztrdt, ztrds )  
     65         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )  
    6766         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)  
    6867         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    … …  
    8584         CALL trd_tra( kt, 'TRA', jp_tem, jptra_ldf, ztrdt ) 
    8685         CALL trd_tra( kt, 'TRA', jp_sal, jptra_ldf, ztrds ) 
    87          CALL wrk_dealloc( jpi,jpj,jpk,  ztrdt, ztrds )  
     86         DEALLOCATE( ztrdt, ztrds )  
    8887      ENDIF 
    8988      !                                        !* print mean trends (used for debugging) 
    … …  
    9190         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    9291      ! 
    93       IF( nn_timing == 1 )   CALL timing_stop('tra_ldf') 
     92      IF( ln_timing )   CALL timing_stop('tra_ldf') 
    9493      ! 
    9594   END SUBROUTINE tra_ldf 
    … …  
    107106      !!---------------------------------------------------------------------- 
    108107      ! 
    109       IF(lwp) THEN                     ! Namelist print 
     108      IF(lwp) THEN                     !==  Namelist print  ==! 
    110109         WRITE(numout,*) 
    111110         WRITE(numout,*) 'tra_ldf_init : lateral tracer diffusive operator' 
    … …  
    114113         WRITE(numout,*) '      see ldf_tra_init report for lateral mixing parameters' 
    115114      ENDIF 
    116       !                                   ! use of lateral operator or not 
     115      !                                !==  use of lateral operator or not  ==! 
    117116      nldf   = np_ERROR 
    118117      ioptio = 0 
    119       IF( ln_traldf_lap )   ioptio = ioptio + 1 
    120       IF( ln_traldf_blp )   ioptio = ioptio + 1 
    121       IF( ioptio >  1   )   CALL ctl_stop( 'tra_ldf_init: use ONE or NONE of the 2 lap/bilap operator type on tracer' ) 
    122       IF( ioptio == 0   )   nldf = np_no_ldf     ! No lateral diffusion 
    123       ! 
    124       IF( nldf /= np_no_ldf ) THEN        ! direction ==>> type of operator   
     118      IF( ln_traldf_NONE ) THEN   ;   nldf = np_no_ldf   ;   ioptio = ioptio + 1   ;   ENDIF 
     119      IF( ln_traldf_lap  ) THEN   ;                          ioptio = ioptio + 1   ;   ENDIF 
     120      IF( ln_traldf_blp  ) THEN   ;                          ioptio = ioptio + 1   ;   ENDIF 
     121      IF( ioptio /=  1   )   CALL ctl_stop( 'tra_ldf_init: use ONE of the 3 operator options (NONE/lap/blp)' ) 
     122      ! 
     123      IF( .NOT.ln_traldf_NONE ) THEN   !==  direction ==>> type of operator  ==! 
    125124         ioptio = 0 
    126125         IF( ln_traldf_lev )   ioptio = ioptio + 1 
    127126         IF( ln_traldf_hor )   ioptio = ioptio + 1 
    128127         IF( ln_traldf_iso )   ioptio = ioptio + 1 
    129          IF( ioptio >  1 )   CALL ctl_stop( 'tra_ldf_init: use only ONE direction (level/hor/iso)' ) 
     128         IF( ioptio /=  1  )   CALL ctl_stop( 'tra_ldf_init: use ONE direction (level/hor/iso)' ) 
    130129         ! 
    131130         !                                ! defined the type of lateral diffusion from ln_traldf_... logicals 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r7753 r8568  
    3030   USE phycst         ! physical constants 
    3131   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    32    USE wrk_nemo       ! Memory Allocation 
    3332   USE timing         ! Timing 
    3433 
    … …  
    111110      REAL(wp) ::  zmskv, zahv_w, zabe2, zcof2, zcoef4   !   -      - 
    112111      REAL(wp) ::  zcoef0, ze3w_2, zsign, z2dt, z1_2dt   !   -      - 
    113       REAL(wp), POINTER, DIMENSION(:,:)   ::   zdkt, zdk1t, z2d 
    114       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdit, zdjt, zftu, zftv, ztfw  
    115       !!---------------------------------------------------------------------- 
    116       ! 
    117       IF( nn_timing == 1 )  CALL timing_start('tra_ldf_iso') 
    118       ! 
    119       CALL wrk_alloc( jpi,jpj,       zdkt, zdk1t, z2d )  
    120       CALL wrk_alloc( jpi,jpj,jpk,   zdit, zdjt , zftu, zftv, ztfw  )  
     112      REAL(wp), DIMENSION(jpi,jpj)     ::   zdkt, zdk1t, z2d 
     113      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdit, zdjt, zftu, zftv, ztfw  
     114      !!---------------------------------------------------------------------- 
     115      ! 
     116      IF( ln_timing )   CALL timing_start('tra_ldf_iso') 
    121117      ! 
    122118      IF( kt == kit000 )  THEN 
    … …  
    386382         !                                                        ! =============== 
    387383      END DO                                                      ! end tracer loop 
    388       !                                                           ! =============== 
    389       ! 
    390       CALL wrk_dealloc( jpi, jpj,      zdkt, zdk1t, z2d )  
    391       CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt , zftu, zftv, ztfw  )  
    392       ! 
    393       IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_iso') 
     384      ! 
     385      IF( ln_timing )   CALL timing_stop('tra_ldf_iso') 
    394386      ! 
    395387   END SUBROUTINE tra_ldf_iso 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_blp.F90

    r7646 r8568  
    2222   ! 
    2323   USE in_out_manager ! I/O manager 
     24   USE iom            ! I/O library 
    2425   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    2526   USE lib_mpp        ! distribued memory computing library 
    2627   USE timing         ! Timing 
    27    USE wrk_nemo       ! Memory allocation 
    28    USE iom 
    2928 
    3029   IMPLICIT NONE 
    … …  
    8786      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    8887      REAL(wp) ::   zsign            ! local scalars 
    89       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztu, ztv, zaheeu, zaheev 
    90       !!---------------------------------------------------------------------- 
    91       ! 
    92       IF( nn_timing == 1 )   CALL timing_start('tra_ldf_lap') 
     88      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztu, ztv, zaheeu, zaheev 
     89      !!---------------------------------------------------------------------- 
     90      ! 
     91      IF( ln_timing )   CALL timing_start('tra_ldf_lap') 
    9392      ! 
    9493      IF( kt == nit000 .AND. lwp )  THEN 
    … …  
    9796         WRITE(numout,*) '~~~~~~~~~~~ ' 
    9897      ENDIF 
    99       ! 
    100       CALL wrk_alloc( jpi,jpj,jpk,   ztu, ztv, zaheeu, zaheev )  
    10198      ! 
    10299      l_hst = .FALSE. 
    … …  
    169166      !                             ! ================== 
    170167      ! 
    171       CALL wrk_dealloc( jpi,jpj,jpk,   ztu, ztv, zaheeu, zaheev )  
    172       ! 
    173       IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_lap') 
     168      IF( ln_timing )   CALL timing_stop('tra_ldf_lap') 
    174169      ! 
    175170   END SUBROUTINE tra_ldf_lap 
    … …  
    203198      ! 
    204199      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
    205       REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zlap         ! laplacian at t-point 
    206       REAL(wp), POINTER, DIMENSION(:,:,:)  :: zglu, zglv   ! bottom GRADh of the laplacian (u- and v-points) 
    207       REAL(wp), POINTER, DIMENSION(:,:,:)  :: zgui, zgvi   ! top    GRADh of the laplacian (u- and v-points) 
     200      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt) :: zlap         ! laplacian at t-point 
     201      REAL(wp), DIMENSION(jpi,jpj,    kjpt) :: zglu, zglv   ! bottom GRADh of the laplacian (u- and v-points) 
     202      REAL(wp), DIMENSION(jpi,jpj,    kjpt) :: zgui, zgvi   ! top    GRADh of the laplacian (u- and v-points) 
    208203      !!--------------------------------------------------------------------- 
    209204      ! 
    210       IF( nn_timing == 1 )  CALL timing_start('tra_ldf_blp') 
    211       ! 
    212       CALL wrk_alloc( jpi,jpj,jpk,kjpt,   zlap )  
    213       CALL wrk_alloc( jpi,jpj,    kjpt,   zglu, zglv, zgui, zgvi )  
     205      IF( ln_timing )   CALL timing_start('tra_ldf_blp') 
    214206      ! 
    215207      IF( kt == kit000 .AND. lwp )  THEN 
    … …  
    253245      END SELECT 
    254246      ! 
    255       CALL wrk_dealloc( jpi,jpj,jpk,kjpt,   zlap )  
    256       CALL wrk_dealloc( jpi,jpj    ,kjpt,   zglu, zglv, zgui, zgvi )  
    257       ! 
    258       IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_blp') 
     247      IF( ln_timing )   CALL timing_stop('tra_ldf_blp') 
    259248      ! 
    260249   END SUBROUTINE tra_ldf_blp 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90

    r7646 r8568  
    2727   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    2828   USE lib_mpp        ! MPP library 
    29    USE wrk_nemo       ! Memory Allocation 
    3029   USE timing         ! Timing 
    3130 
    … …  
    9493      REAL(wp) ::   ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt 
    9594      REAL(wp) ::   zah, zah_slp, zaei_slp 
    96       REAL(wp), POINTER, DIMENSION(:,:  ) :: z2d                                            ! 2D workspace 
    97       REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw   ! 3D     - 
     95      REAL(wp), DIMENSION(jpi,jpj    ) ::   z2d                                              ! 2D workspace 
     96      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw   ! 3D     - 
    9897      !!---------------------------------------------------------------------- 
    9998      ! 
    100       IF( nn_timing == 1 )  CALL timing_start('tra_ldf_triad') 
    101       ! 
    102       CALL wrk_alloc( jpi,jpj,       z2d )  
    103       CALL wrk_alloc( jpi,jpj,jpk,   zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw  )  
     99      IF( ln_timing )   CALL timing_start('tra_ldf_triad') 
    104100      ! 
    105101      IF( .NOT.ALLOCATED(zdkt3d) )  THEN 
    … …  
    434430      END DO                                                      ! end tracer loop 
    435431      !                                                           ! =============== 
    436       ! 
    437       CALL wrk_dealloc( jpi,jpj,       z2d )  
    438       CALL wrk_dealloc( jpi,jpj,jpk,   zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw  )  
    439       ! 
    440       IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_triad') 
     432      IF( ln_timing )   CALL timing_stop('tra_ldf_triad') 
    441433      ! 
    442434   END SUBROUTINE tra_ldf_triad 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90

    r6140 r8568  
    2626   USE in_out_manager ! I/O manager 
    2727   USE lib_mpp        ! MPP library 
    28    USE wrk_nemo       ! Memory Allocation 
    2928   USE timing         ! Timing 
    3029 
    … …  
    6766      REAL(wp) ::   zta, zalfa, zsum_temp, zsum_alfa, zaw, zdz, zsum_z 
    6867      REAL(wp) ::   zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw, z1_r2dt 
    69       REAL(wp), PARAMETER :: zn2_zero = 1.e-14_wp       ! acceptance criteria for neutrality (N2==0) 
    70       REAL(wp), POINTER, DIMENSION(:)       ::   zvn2   ! vertical profile of N2 at 1 given point... 
    71       REAL(wp), POINTER, DIMENSION(:,:)     ::   zvts   ! vertical profile of T and S at 1 given point... 
    72       REAL(wp), POINTER, DIMENSION(:,:)     ::   zvab   ! vertical profile of alpha and beta 
    73       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zn2    ! N^2  
    74       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zab    ! alpha and beta 
    75       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   ztrdt, ztrds   ! 3D workspace 
     68      REAL(wp), PARAMETER ::   zn2_zero = 1.e-14_wp      ! acceptance criteria for neutrality (N2==0) 
     69      REAL(wp), DIMENSION(        jpk     ) ::   zvn2         ! vertical profile of N2 at 1 given point... 
     70      REAL(wp), DIMENSION(        jpk,jpts) ::   zvts, zvab   ! vertical profile of T & S , and  alpha & betaat 1 given point 
     71      REAL(wp), DIMENSION(jpi,jpj,jpk     ) ::   zn2          ! N^2  
     72      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) ::   zab          ! alpha and beta 
     73      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds   ! 3D workspace 
    7674      ! 
    7775      LOGICAL, PARAMETER :: l_LB_debug = .FALSE. ! set to true if you want to follow what is 
    … …  
    8078      !!---------------------------------------------------------------------- 
    8179      ! 
    82       IF( nn_timing == 1 )  CALL timing_start('tra_npc') 
     80      IF( ln_timing )   CALL timing_start('tra_npc') 
    8381      ! 
    8482      IF( MOD( kt, nn_npc ) == 0 ) THEN 
    8583         ! 
    86          CALL wrk_alloc( jpi, jpj, jpk, zn2 )    ! N2 
    87          CALL wrk_alloc( jpi, jpj, jpk, 2, zab ) ! Alpha and Beta 
    88          CALL wrk_alloc( jpk, 2, zvts, zvab )    ! 1D column vector at point ji,jj 
    89          CALL wrk_alloc( jpk, zvn2 )             ! 1D column vector at point ji,jj 
    90  
    9184         IF( l_trdtra )   THEN                    !* Save initial after fields 
    92             CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     85            ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
    9386            ztrdt(:,:,:) = tsa(:,:,:,jp_tem)  
    9487            ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    9588         ENDIF 
    96  
     89         ! 
    9790         IF( l_LB_debug ) THEN 
    9891            ! Location of 1 known convection site to follow what's happening in the water column 
    … …  
    10194            klc1 =  mbkt(ilc1,jlc1) ! bottom of the ocean for debug point...           
    10295         ENDIF 
    103           
     96         ! 
    10497         CALL eos_rab( tsa, zab )         ! after alpha and beta (given on T-points) 
    10598         CALL bn2    ( tsa, zab, zn2 )    ! after Brunt-Vaisala  (given on W-points) 
    106          
     99         ! 
    107100         inpcc = 0 
    108  
     101         ! 
    109102         DO jj = 2, jpjm1                 ! interior column only 
    110103            DO ji = fs_2, fs_jpim1 
    … …  
    313306            CALL trd_tra( kt, 'TRA', jp_tem, jptra_npc, ztrdt ) 
    314307            CALL trd_tra( kt, 'TRA', jp_sal, jptra_npc, ztrds ) 
    315             CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     308            DEALLOCATE( ztrdt, ztrds ) 
    316309         ENDIF 
    317310         ! 
    … …  
    323316         ENDIF 
    324317         ! 
    325          CALL wrk_dealloc(jpi, jpj, jpk, zn2 ) 
    326          CALL wrk_dealloc(jpi, jpj, jpk, 2, zab ) 
    327          CALL wrk_dealloc(jpk, zvn2 ) 
    328          CALL wrk_dealloc(jpk, 2, zvts, zvab ) 
    329          ! 
    330318      ENDIF   ! IF( MOD( kt, nn_npc ) == 0 ) THEN 
    331319      ! 
    332       IF( nn_timing == 1 )  CALL timing_stop('tra_npc') 
     320      IF( ln_timing )   CALL timing_stop('tra_npc') 
    333321      ! 
    334322   END SUBROUTINE tra_npc 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r7753 r8568  
    3535   USE traqsr          ! penetrative solar radiation (needed for nksr) 
    3636   USE phycst          ! physical constant 
    37    USE ldftra          ! lateral physics on tracers 
    38    USE ldfslp 
    39    USE bdy_oce   , ONLY: ln_bdy 
     37   USE ldftra          ! lateral physics : tracers 
     38   USE ldfslp          ! lateral physics : slopes 
     39   USE bdy_oce  , ONLY : ln_bdy 
    4040   USE bdytra          ! open boundary condition (bdy_tra routine) 
    4141   ! 
    … …  
    4343   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    4444   USE prtctl          ! Print control 
    45    USE wrk_nemo        ! Memory allocation 
    4645   USE timing          ! Timing 
    4746#if defined key_agrif 
    … …  
    9190      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    9291      REAL(wp) ::   zfact            ! local scalars 
    93       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    94       !!---------------------------------------------------------------------- 
    95       ! 
    96       IF( nn_timing == 1 )  CALL timing_start( 'tra_nxt') 
     92      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds 
     93      !!---------------------------------------------------------------------- 
     94      ! 
     95      IF( ln_timing )   CALL timing_start( 'tra_nxt') 
    9796      ! 
    9897      IF( kt == nit000 ) THEN 
    … …  
    120119      ! trends computation initialisation 
    121120      IF( l_trdtra )   THEN                     
    122          CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     121         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
    123122         ztrdt(:,:,jk) = 0._wp 
    124123         ztrds(:,:,jk) = 0._wp 
    … …  
    170169         CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt ) 
    171170         CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds ) 
    172          CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     171         DEALLOCATE( ztrdt , ztrds ) 
    173172      END IF 
    174173      ! 
    … …  
    177176         &                       tab3d_2=tsn(:,:,:,jp_sal), clinfo2=       ' Sn: ', mask2=tmask ) 
    178177      ! 
    179       IF( nn_timing == 1 )   CALL timing_stop('tra_nxt') 
     178      IF( ln_timing )   CALL timing_stop('tra_nxt') 
    180179      ! 
    181180   END SUBROUTINE tra_nxt 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r7753 r8568  
    2929   USE in_out_manager ! I/O manager 
    3030   USE prtctl         ! Print control 
    31    USE iom            ! I/O manager 
     31   USE iom            ! I/O library 
    3232   USE fldread        ! read input fields 
    3333   USE restart        ! ocean restart 
    3434   USE lib_mpp        ! MPP library 
    3535   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    36    USE wrk_nemo       ! Memory Allocation 
    3736   USE timing         ! Timing 
    3837 
    … …  
    113112      REAL(wp) ::   zCb, zCmax, zze, zpsi, zpsimax, zdelpsi, zCtot, zCze 
    114113      REAL(wp) ::   zlogc, zlogc2, zlogc3  
    115       REAL(wp), POINTER, DIMENSION(:,:)   :: zekb, zekg, zekr 
    116       REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt 
    117       REAL(wp), POINTER, DIMENSION(:,:,:) :: zetot, zchl3d 
    118       !!---------------------------------------------------------------------- 
    119       ! 
    120       IF( nn_timing == 1 )  CALL timing_start('tra_qsr') 
     114      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   :: zekb, zekg, zekr 
     115      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt 
     116      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zetot, zchl3d 
     117      !!---------------------------------------------------------------------- 
     118      ! 
     119      IF( ln_timing )   CALL timing_start('tra_qsr') 
    121120      ! 
    122121      IF( kt == nit000 ) THEN 
    … …  
    127126      ! 
    128127      IF( l_trdtra ) THEN      ! trends diagnostic: save the input temperature trend 
    129          CALL wrk_alloc( jpi,jpj,jpk,   ztrdt )  
     128         ALLOCATE( ztrdt(jpi,jpj,jpk) )  
    130129         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    131130      ENDIF 
    … …  
    161160      CASE( np_RGB , np_RGBc )         !==  R-G-B fluxes  ==! 
    162161         ! 
    163          CALL wrk_alloc( jpi,jpj,       zekb, zekg, zekr        )  
    164          CALL wrk_alloc( jpi,jpj,jpk,   ze0, ze1, ze2, ze3, zea, zchl3d )  
     162         ALLOCATE( zekb(jpi,jpj)     , zekg(jpi,jpj)     , zekr  (jpi,jpj)     , & 
     163            &      ze0 (jpi,jpj,jpk) , ze1 (jpi,jpj,jpk) , ze2   (jpi,jpj,jpk) , & 
     164            &      ze3 (jpi,jpj,jpk) , zea (jpi,jpj,jpk) , zchl3d(jpi,jpj,jpk)   )  
    165165         ! 
    166166         IF( nqsr == np_RGBc ) THEN          !*  Variable Chlorophyll 
    … …  
    240240         END DO 
    241241         ! 
    242          CALL wrk_dealloc( jpi,jpj,        zekb, zekg, zekr        )  
    243          CALL wrk_dealloc( jpi,jpj,jpk,   ze0, ze1, ze2, ze3, zea, zchl3d )  
     242         DEALLOCATE( zekb , zekg , zekr , ze0 , ze1 , ze2 , ze3 , zea , zchl3d )  
    244243         ! 
    245244      CASE( np_2BD  )            !==  2-bands fluxes  ==! 
    … …  
    282281      ! 
    283282      IF( iom_use('qsr3d') ) THEN      ! output the shortwave Radiation distribution 
    284          CALL wrk_alloc( jpi,jpj,jpk,   zetot ) 
    285          ! 
     283         ALLOCATE( zetot(jpi,jpj,jpk) ) 
    286284         zetot(:,:,nksr+1:jpk) = 0._wp     ! below ~400m set to zero 
    287285         DO jk = nksr, 1, -1 
    288             zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) / r1_rau0_rcp 
     286            zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) * rau0_rcp 
    289287         END DO          
    290288         CALL iom_put( 'qsr3d', zetot )   ! 3D distribution of shortwave Radiation 
    291          ! 
    292          CALL wrk_dealloc( jpi,jpj,jpk,   zetot )  
     289         DEALLOCATE( zetot )  
    293290      ENDIF 
    294291      ! 
    … …  
    301298         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    302299         CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt ) 
    303          CALL wrk_dealloc( jpi,jpj,jpk,  ztrdt )  
     300         DEALLOCATE( ztrdt )  
    304301      ENDIF 
    305302      !                       ! print mean trends (used for debugging) 
    306303      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 
    307304      ! 
    308       IF( nn_timing == 1 )  CALL timing_stop('tra_qsr') 
     305      IF( ln_timing )   CALL timing_stop('tra_qsr') 
    309306      ! 
    310307   END SUBROUTINE tra_qsr 
    … …  
    340337      !!---------------------------------------------------------------------- 
    341338      ! 
    342       IF( nn_timing == 1 )   CALL timing_start('tra_qsr_init') 
     339      IF( ln_timing )   CALL timing_start('tra_qsr_init') 
    343340      ! 
    344341      REWIND( numnam_ref )              ! Namelist namtra_qsr in reference     namelist 
    … …  
    435432      ENDIF 
    436433      ! 
    437       IF( nn_timing == 1 )   CALL timing_stop('tra_qsr_init') 
     434      IF( ln_timing )   CALL timing_stop('tra_qsr_init') 
    438435      ! 
    439436   END SUBROUTINE tra_qsr_init 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r7788 r8568  
    3232   USE iom            ! xIOS server 
    3333   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    34    USE wrk_nemo       ! Memory Allocation 
    3534   USE timing         ! Timing 
    3635 
    … …  
    7574      INTEGER  ::   ikt, ikb              ! local integers 
    7675      REAL(wp) ::   zfact, z1_e3t, zdep   ! local scalar 
    77       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds 
     76      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    7877      !!---------------------------------------------------------------------- 
    7978      ! 
    80       IF( nn_timing == 1 )  CALL timing_start('tra_sbc') 
     79      IF( ln_timing )   CALL timing_start('tra_sbc') 
    8180      ! 
    8281      IF( kt == nit000 ) THEN 
    … …  
    8786      ! 
    8887      IF( l_trdtra ) THEN                    !* Save ta and sa trends 
    89          CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )  
     88         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )  
    9089         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    9190         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    … …  
    232231         CALL trd_tra( kt, 'TRA', jp_tem, jptra_nsr, ztrdt ) 
    233232         CALL trd_tra( kt, 'TRA', jp_sal, jptra_nsr, ztrds ) 
    234          CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )  
     233         DEALLOCATE( ztrdt , ztrds )  
    235234      ENDIF 
    236235      ! 
    … …  
    238237         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    239238      ! 
    240       IF( nn_timing == 1 )  CALL timing_stop('tra_sbc') 
     239      IF( ln_timing )   CALL timing_stop('tra_sbc') 
    241240      ! 
    242241   END SUBROUTINE tra_sbc 

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

    r8215 r8568  
    5656      !!--------------------------------------------------------------------- 
    5757      ! 
    58       IF( nn_timing == 1 )  CALL timing_start('tra_zdf') 
     58      IF( ln_timing )   CALL timing_start('tra_zdf') 
    5959      ! 
    6060      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000 
    … …  
    9797         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    9898      ! 
    99       IF( nn_timing == 1 )  CALL timing_stop('tra_zdf') 
     99      IF( ln_timing )   CALL timing_stop('tra_zdf') 
    100100      ! 
    101101   END SUBROUTINE tra_zdf 
    … …  
    135135      !!--------------------------------------------------------------------- 
    136136      ! 
    137       IF( nn_timing == 1 )  CALL timing_start('tra_zdf_imp') 
     137      IF( ln_timing )   CALL timing_start('tra_zdf_imp') 
    138138      ! 
    139139      IF( kt == kit000 )  THEN 
    … …  
    255255      !                                               ! ================= ! 
    256256      ! 
    257       IF( nn_timing == 1 )  CALL timing_stop('tra_zdf_imp') 
     257      IF( ln_timing )   CALL timing_stop('tra_zdf_imp') 
    258258      ! 
    259259   END SUBROUTINE tra_zdf_imp 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90

    r7753 r8568  
    2222   USE lbclnk          ! lateral boundary conditions (or mpp link) 
    2323   USE lib_mpp         ! MPP library 
    24    USE wrk_nemo        ! Memory allocation 
    2524   USE timing          ! Timing 
    2625 
    … …  
    9998      !!---------------------------------------------------------------------- 
    10099      ! 
    101       IF( nn_timing == 1 )   CALL timing_start( 'zps_hde') 
    102       ! 
    103       pgtu(:,:,:)=0._wp   ;   zti (:,:,:)=0._wp   ;   zhi (:,:  )=0._wp 
    104       pgtv(:,:,:)=0._wp   ;   ztj (:,:,:)=0._wp   ;   zhj (:,:  )=0._wp 
     100      IF( ln_timing )   CALL timing_start( 'zps_hde') 
     101      ! 
     102      pgtu(:,:,:) = 0._wp   ;   zti (:,:,:) = 0._wp   ;   zhi (:,:) = 0._wp 
     103      pgtv(:,:,:) = 0._wp   ;   ztj (:,:,:) = 0._wp   ;   zhj (:,:) = 0._wp 
    105104      ! 
    106105      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==! 
    … …  
    188187      END IF 
    189188      ! 
    190       IF( nn_timing == 1 )   CALL timing_stop( 'zps_hde') 
     189      IF( ln_timing )   CALL timing_stop( 'zps_hde') 
    191190      ! 
    192191   END SUBROUTINE zps_hde 
    193    ! 
     192 
     193 
    194194   SUBROUTINE zps_hde_isf( kt, kjpt, pta, pgtu, pgtv, pgtui, pgtvi,  & 
    195195      &                          prd, pgru, pgrv, pgrui, pgrvi ) 
    … …  
    256256      !!---------------------------------------------------------------------- 
    257257      ! 
    258       IF( nn_timing == 1 )  CALL timing_start( 'zps_hde_isf') 
     258      IF( ln_timing )   CALL timing_start( 'zps_hde_isf') 
    259259      ! 
    260260      pgtu (:,:,:) = 0._wp   ;   pgtv (:,:,:) =0._wp 
    … …  
    453453      END IF   
    454454      ! 
    455       IF( nn_timing == 1 )   CALL timing_stop( 'zps_hde_isf') 
     455      IF( ln_timing )   CALL timing_stop( 'zps_hde_isf') 
    456456      ! 
    457457   END SUBROUTINE zps_hde_isf 
     458 
    458459   !!====================================================================== 
    459460END MODULE zpshde 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90

    r8215 r8568  
    8383      !!---------------------------------------------------------------------- 
    8484      ! 
    85       IF( nn_timing == 1 )   CALL timing_start('zdf_ddm') 
     85      IF( ln_timing )   CALL timing_start('zdf_ddm') 
    8686      ! 
    8787      !                                                ! =============== 
    … …  
    170170      ENDIF 
    171171      ! 
    172       IF( nn_timing == 1 )  CALL timing_stop('zdf_ddm') 
     172      IF( ln_timing )   CALL timing_stop('zdf_ddm') 
    173173      ! 
    174174   END SUBROUTINE zdf_ddm 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfdrg.F90

    r8215 r8568  
    2020   !!---------------------------------------------------------------------- 
    2121   USE oce            ! ocean dynamics and tracers variables 
    22    USE phycst   , ONLY: vkarmn 
     22   USE phycst  , ONLY : vkarmn 
    2323   USE dom_oce        ! ocean space and time domain variables 
    2424   USE zdf_oce        ! ocean vertical physics variables 
    … …  
    109109      !!---------------------------------------------------------------------- 
    110110      ! 
    111       IF( nn_timing == 1 )  CALL timing_start('zdf_drg') 
     111      IF( ln_timing )   CALL timing_start('zdf_drg') 
    112112      ! 
    113113      ! 
    … …  
    140140      IF(ln_ctl)   CALL prt_ctl( tab2d_1=pCdU, clinfo1=' Cd*U ') 
    141141      ! 
    142       IF( nn_timing == 1 )  CALL timing_stop('zdf_drg') 
     142      IF( ln_timing )   CALL timing_stop('zdf_drg') 
    143143      ! 
    144144   END SUBROUTINE zdf_drg 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90

    r8215 r8568  
    6262      !!---------------------------------------------------------------------- 
    6363      ! 
    64       IF( nn_timing == 1 )  CALL timing_start('zdf_evd') 
     64      IF( ln_timing )   CALL timing_start('zdf_evd') 
    6565      ! 
    6666      IF( kt == nit000 ) THEN 
    … …  
    121121      IF( l_trdtra ) CALL trd_tra( kt, 'TRA', jp_tem, jptra_evd, zavt_evd ) 
    122122      ! 
    123       IF( nn_timing == 1 )  CALL timing_stop('zdf_evd') 
     123      IF( ln_timing )   CALL timing_stop('zdf_evd') 
    124124      ! 
    125125   END SUBROUTINE zdf_evd 

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

    r8215 r8568  
    159159      !!-------------------------------------------------------------------- 
    160160      ! 
    161       IF( nn_timing == 1 )   CALL timing_start('zdf_gls') 
     161      IF( ln_timing )   CALL timing_start('zdf_gls') 
    162162      ! 
    163163      ! Preliminary computing 
    … …  
    822822      ENDIF 
    823823      ! 
    824       IF( nn_timing == 1 )   CALL timing_stop('zdf_gls') 
     824      IF( ln_timing )   CALL timing_stop('zdf_gls') 
    825825      ! 
    826826   END SUBROUTINE zdf_gls 
    … …  
    852852      !!---------------------------------------------------------- 
    853853      ! 
    854       IF( nn_timing == 1 )  CALL timing_start('zdf_gls_init') 
     854      IF( ln_timing )   CALL timing_start('zdf_gls_init') 
    855855      ! 
    856856      REWIND( numnam_ref )              ! Namelist namzdf_gls in reference namelist : Vertical eddy diffivity and viscosity using gls turbulent closure scheme 
    … …  
    10771077         rl_sf = vkarmn 
    10781078      ELSE 
    1079          rl_sf = rc0 * SQRT(rc0/rcm_sf) * SQRT( ( (1._wp + 4._wp*rmm + 8._wp*rmm**2_wp)*rsc_tke          & 
    1080                  &                                       + 12._wp * rsc_psi0*rpsi2 - (1._wp + 4._wp*rmm) & 
    1081                  &                                                *SQRT(rsc_tke*(rsc_tke                 & 
    1082                  &                                                   + 24._wp*rsc_psi0*rpsi2)) )         & 
    1083                  &                                         /(12._wp*rnn**2.)                             & 
    1084                  &                                       ) 
     1079         rl_sf = rc0 * SQRT(rc0/rcm_sf) * SQRT( ( (1._wp + 4._wp*rmm + 8._wp*rmm**2_wp) * rsc_tke        & 
     1080            &                                            + 12._wp*rsc_psi0*rpsi2 - (1._wp + 4._wp*rmm)   & 
     1081            &                                                     *SQRT(rsc_tke*(rsc_tke                 & 
     1082            &                                                        + 24._wp*rsc_psi0*rpsi2)) )         & 
     1083            &                                              /(12._wp*rnn**2.)                             ) 
    10851084      ENDIF 
    10861085 
    … …  
    11301129      CALL gls_rst( nit000, 'READ' )      ! (en, avt_k, avm_k, hmxl_n) 
    11311130      ! 
    1132       IF( nn_timing == 1 )  CALL timing_stop('zdf_gls_init') 
     1131      IF( ln_timing )   CALL timing_stop('zdf_gls_init') 
    11331132      ! 
    11341133   END SUBROUTINE zdf_gls_init 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfiwm.F90

    r8215 r8568  
    141141      !!---------------------------------------------------------------------- 
    142142      ! 
    143       IF( nn_timing == 1 )   CALL timing_start('zdf_iwm') 
     143      IF( ln_timing )   CALL timing_start('zdf_iwm') 
    144144      ! 
    145145      !                      ! ----------------------------- ! 
    … …  
    366366      IF(ln_ctl)   CALL prt_ctl(tab3d_1=zav_wave , clinfo1=' iwm - av_wave: ', tab3d_2=avt, clinfo2=' avt: ', ovlap=1, kdim=jpk) 
    367367      ! 
    368       IF( nn_timing == 1 )   CALL timing_stop('zdf_iwm') 
     368      IF( ln_timing )   CALL timing_stop('zdf_iwm') 
    369369      ! 
    370370   END SUBROUTINE zdf_iwm 
    … …  
    405405      !!---------------------------------------------------------------------- 
    406406      ! 
    407       IF( nn_timing == 1 )  CALL timing_start('zdf_iwm_init') 
     407      IF( ln_timing )   CALL timing_start('zdf_iwm_init') 
    408408      ! 
    409409      REWIND( numnam_ref )              ! Namelist namzdf_iwm in reference namelist : Wave-driven mixing 
    … …  
    483483      ENDIF 
    484484      ! 
    485       IF( nn_timing == 1 )  CALL timing_stop('zdf_iwm_init') 
     485      IF( ln_timing )   CALL timing_stop('zdf_iwm_init') 
    486486      ! 
    487487   END SUBROUTINE zdf_iwm_init 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90

    r8215 r8568  
    8282      !!---------------------------------------------------------------------- 
    8383      ! 
    84       IF( nn_timing == 1 )  CALL timing_start('zdf_mxl') 
     84      IF( ln_timing )   CALL timing_start('zdf_mxl') 
    8585      ! 
    8686      IF( kt == nit000 ) THEN 
    … …  
    141141      IF(ln_ctl)   CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ', ovlap=1 ) 
    142142      ! 
    143       IF( nn_timing == 1 )  CALL timing_stop('zdf_mxl') 
     143      IF( ln_timing )   CALL timing_stop('zdf_mxl') 
    144144      ! 
    145145   END SUBROUTINE zdf_mxl 

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

    r8215 r8568  
    3232   USE lbclnk         ! lateral boundary conditions 
    3333   USE lib_mpp        ! distribued memory computing 
     34   USE timing         ! Timing 
    3435 
    3536   IMPLICIT NONE 
    … …  
    7576         &             rn_avm0, rn_avt0, nn_avb, nn_havtb                  ! coefficients 
    7677      !!---------------------------------------------------------------------- 
     78      ! 
     79      IF( ln_timing )   CALL timing_start('zdf_phy_init') 
    7780      ! 
    7881      !                           !==  Namelist  ==! 
    … …  
    193196      !!gm move it here ? 
    194197      ! 
     198      IF( ln_timing )   CALL timing_stop('zdf_phy_init') 
     199      ! 
    195200   END SUBROUTINE zdf_phy_init 
    196201 
    … …  
    213218      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zsh2   ! shear production 
    214219      !! --------------------------------------------------------------------- 
     220      ! 
     221      IF( ln_timing )   CALL timing_start('zdf_phy') 
    215222      ! 
    216223      IF( l_zdfdrg ) THEN     !==  update top/bottom drag  ==!   (non-linear cases) 
    … …  
    289296      ENDIF 
    290297      ! 
     298      IF( ln_timing )   CALL timing_stop('zdf_phy') 
     299      ! 
    291300   END SUBROUTINE zdf_phy 
    292301 

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

    r8215 r8568  
    158158      !!---------------------------------------------------------------------- 
    159159      ! 
    160       IF( nn_timing == 1 )   CALL timing_start('zdf_ric') 
     160      IF( ln_timing )   CALL timing_start('zdf_ric') 
    161161      ! 
    162162      !                       !==  avm and avt = F(Richardson number)  ==! 
    … …  
    197197      ENDIF 
    198198      ! 
    199       IF( nn_timing == 1 )   CALL timing_stop('zdf_ric') 
     199      IF( ln_timing )   CALL timing_stop('zdf_ric') 
    200200      ! 
    201201   END SUBROUTINE zdf_ric 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfsh2.F90

    r8215 r8568  
    5656      !!-------------------------------------------------------------------- 
    5757      ! 
    58       IF( nn_timing == 1 )  CALL timing_start('zdf_sh2') 
     58      IF( ln_timing )   CALL timing_start('zdf_sh2') 
    5959      ! 
    6060      DO jk = 2, jpkm1 
    … …  
    7777      END DO  
    7878      ! 
    79       IF( nn_timing == 1 )  CALL timing_stop('zdf_sh2')      
     79      IF( ln_timing )   CALL timing_stop('zdf_sh2')      
    8080      ! 
    8181   END SUBROUTINE zdf_sh2 

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

    r8215 r8568  
    159159      !!              Bruchard OM 2002 
    160160      !!---------------------------------------------------------------------- 
    161       INTEGER                    , INTENT(in   ) ::   kt             ! ocean time step 
     161      INTEGER                   , INTENT(in   ) ::   kt             ! ocean time step 
    162162      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   p_sh2          ! shear production term 
    163       REAL(wp), DIMENSION(:,:,:) , INTENT(inout) ::   p_avm, p_avt   !  momentum and tracer Kz (w-points) 
     163      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   p_avm, p_avt   !  momentum and tracer Kz (w-points) 
    164164      !!---------------------------------------------------------------------- 
    165165      ! 
    … …  
    194194      !!                a tridiagonal linear system by a "methode de chasse" 
    195195      !!              - increase TKE due to surface and internal wave breaking 
     196      !!             NB: when sea-ice is present, both LC parameterization  
     197      !!                 and TKE penetration are turned off when the ice fraction  
     198      !!                 is smaller than 0.25  
    196199      !! 
    197200      !! ** Action  : - en : now turbulent kinetic energy) 
    … …  
    217220      !!-------------------------------------------------------------------- 
    218221      ! 
    219       IF( nn_timing == 1 )  CALL timing_start('tke_tke') 
     222      IF( ln_timing )   CALL timing_start('tke_tke') 
    220223      ! 
    221224      zbbrau = rn_ebb / rau0       ! Local constant initialisation 
    … …  
    312315                  zwlc = zind * rn_lc * zus * SIN( rpi * pdepw(ji,jj,jk) / zhlc(ji,jj) ) 
    313316                  !                                           ! TKE Langmuir circulation source term 
    314                   en(ji,jj,jk) = en(ji,jj,jk) + rdt * MAX(0.,1._wp - 2.*fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc )   & 
     317                  en(ji,jj,jk) = en(ji,jj,jk) + rdt * MAX(0.,1._wp - 4.*fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc )   & 
    315318                     &                              / zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    316319               END DO 
    … …  
    415418               DO ji = fs_2, fs_jpim1   ! vector opt. 
    416419                  en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   & 
    417                      &                                 * MAX(0.,1._wp - 2.*fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     420                     &                                 * MAX(0.,1._wp - 4.*fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    418421               END DO 
    419422            END DO 
    … …  
    424427               jk = nmln(ji,jj) 
    425428               en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   & 
    426                   &                                 * MAX(0.,1._wp - 2.*fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     429                  &                                 * MAX(0.,1._wp - 4.*fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    427430            END DO 
    428431         END DO 
    … …  
    437440                  zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add )  ! apply some modifications... 
    438441                  en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   & 
    439                      &                        * MAX(0.,1._wp - 2.*fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    440                END DO 
    441             END DO 
    442          END DO 
    443       ENDIF 
    444       ! 
    445       IF( nn_timing == 1 )  CALL timing_stop('tke_tke') 
     442                     &                        * MAX(0.,1._wp - 4.*fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     443               END DO 
     444            END DO 
     445         END DO 
     446      ENDIF 
     447      ! 
     448      IF( ln_timing )   CALL timing_stop('tke_tke') 
    446449      ! 
    447450   END SUBROUTINE tke_tke 
    … …  
    493496      !!-------------------------------------------------------------------- 
    494497      ! 
    495       IF( nn_timing == 1 )  CALL timing_start('tke_avn') 
     498      IF( ln_timing )   CALL timing_start('tke_avn') 
    496499 
    497500      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    … …  
    636639      ENDIF 
    637640      ! 
    638       IF( nn_timing == 1 )  CALL timing_stop('tke_avn') 
     641      IF( ln_timing )   CALL timing_stop('tke_avn') 
    639642      ! 
    640643   END SUBROUTINE tke_avn 

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

    r8215 r8568  
    206206#if defined key_agrif 
    207207      IF( .NOT. Agrif_Root() ) THEN 
    208                          CALL Agrif_ParentGrid_To_ChildGrid() 
    209          IF( ln_diaobs ) CALL dia_obs_wri 
    210          IF( nn_timing == 1 )   CALL timing_finalize 
    211                                 CALL Agrif_ChildGrid_To_ParentGrid() 
    212       ENDIF 
    213 #endif 
    214       IF( nn_timing == 1 )   CALL timing_finalize 
     208                           CALL Agrif_ParentGrid_To_ChildGrid() 
     209         IF( ln_diaobs )   CALL dia_obs_wri 
     210         IF( ln_timing )   CALL timing_finalize 
     211                           CALL Agrif_ChildGrid_To_ParentGrid() 
     212      ENDIF 
     213#endif 
     214      IF( ln_timing    )   CALL timing_finalize 
    215215      ! 
    216216      CALL nemo_closefile 
    … …  
    242242      NAMELIST/namctl/ ln_ctl   , nn_print, nn_ictls, nn_ictle,   & 
    243243         &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,   & 
    244          &             nn_timing, nn_diacfl 
     244         &             ln_timing, ln_diacfl 
    245245      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
    246246      !!---------------------------------------------------------------------- 
    … …  
    416416      ENDIF 
    417417      ! 
    418       IF( nn_timing == 1 )  CALL timing_init 
     418      IF( ln_timing    )   CALL timing_init 
    419419      ! 
    420420      !                                      ! General initialization 
    421                             CALL     phy_cst    ! Physical constants 
    422                             CALL     eos_init   ! Equation of state 
    423       IF( lk_c1d        )   CALL     c1d_init   ! 1D column configuration 
    424                             CALL     wad_init   ! Wetting and drying options 
    425                             CALL     dom_init   ! Domain 
    426       IF( ln_crs        )   CALL     crs_init   ! coarsened grid: domain initialization  
    427       IF( ln_nnogather )    CALL nemo_northcomms! northfold neighbour lists (must be done after the masks are defined) 
    428       IF( ln_ctl        )   CALL prt_ctl_init   ! Print control 
     421                           CALL     phy_cst    ! Physical constants 
     422                           CALL     eos_init   ! Equation of state 
     423      IF( lk_c1d       )   CALL     c1d_init   ! 1D column configuration 
     424                           CALL     wad_init   ! Wetting and drying options 
     425                           CALL     dom_init   ! Domain 
     426      IF( ln_crs       )   CALL     crs_init   ! coarsened grid: domain initialization  
     427      IF( ln_nnogather )   CALL nemo_northcomms! northfold neighbour lists (must be done after the masks are defined) 
     428      IF( ln_ctl       )   CALL prt_ctl_init   ! Print control 
    429429       
    430430      CALL diurnal_sst_bulk_init             ! diurnal sst 
    … …  
    432432       
    433433      ! IF ln_diurnal_only, then we only want a subset of the initialisation routines 
    434       IF ( ln_diurnal_only ) THEN 
     434      IF( ln_diurnal_only ) THEN 
    435435         CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
    436436         CALL     sbc_init   ! Forcings : surface module 
    437437         CALL tra_qsr_init   ! penetrative solar radiation qsr 
    438          IF( ln_diaobs     ) THEN                  ! Observation & model comparison 
    439             CALL dia_obs_init            ! Initialize observational data 
    440             CALL dia_obs( nit000 - 1 )   ! Observation operator for restart 
     438         IF( ln_diaobs ) THEN                   ! Observation & model comparison 
     439            CALL dia_obs_init                      ! Initialize observational data 
     440            CALL dia_obs( nit000 - 1 )             ! Observation operator for restart 
    441441         ENDIF      
    442442         !                                     ! Assimilation increments 
    443          IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments 
     443         IF( lk_asminc )   CALL asm_inc_init   ! Initialize assimilation increments 
    444444                  
    445445         IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 
    … …  
    447447      ENDIF 
    448448       
    449                             CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
     449                           CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
    450450 
    451451      !                                      ! external forcing  
    452452!!gm to be added : creation and call of sbc_apr_init 
    453                             CALL    tide_init   ! tidal harmonics 
    454                             CALL     sbc_init   ! surface boundary conditions (including sea-ice) 
    455                             CALL     bdy_init   ! Open boundaries initialisation 
     453                           CALL    tide_init   ! tidal harmonics 
     454                           CALL     sbc_init   ! surface boundary conditions (including sea-ice) 
     455                           CALL     bdy_init   ! Open boundaries initialisation 
    456456 
    457457      !                                      ! Ocean physics 
    458                             CALL zdf_phy_init   ! Vertical physics 
     458                           CALL zdf_phy_init    ! Vertical physics 
    459459                                      
    460460      !                                         ! Lateral physics 
    461                             CALL ldf_tra_init      ! Lateral ocean tracer physics 
    462                             CALL ldf_eiv_init      ! eddy induced velocity param. 
    463                             CALL ldf_dyn_init      ! Lateral ocean momentum physics 
     461                           CALL ldf_tra_init      ! Lateral ocean tracer physics 
     462                           CALL ldf_eiv_init      ! eddy induced velocity param. 
     463                           CALL ldf_dyn_init      ! Lateral ocean momentum physics 
    464464 
    465465      !                                      ! Active tracers 
    466                             CALL tra_qsr_init      ! penetrative solar radiation qsr 
    467                             CALL tra_bbc_init      ! bottom heat flux 
    468       IF( ln_trabbl     )   CALL tra_bbl_init      ! advective (and/or diffusive) bottom boundary layer scheme 
    469                             CALL tra_dmp_init      ! internal tracer damping 
    470                             CALL tra_adv_init      ! horizontal & vertical advection 
    471                             CALL tra_ldf_init      ! lateral mixing 
     466                           CALL tra_qsr_init      ! penetrative solar radiation qsr 
     467                           CALL tra_bbc_init      ! bottom heat flux 
     468      IF( ln_trabbl    )   CALL tra_bbl_init      ! advective (and/or diffusive) bottom boundary layer scheme 
     469                           CALL tra_dmp_init      ! internal tracer damping 
     470                           CALL tra_adv_init      ! horizontal & vertical advection 
     471                           CALL tra_ldf_init      ! lateral mixing 
    472472 
    473473      !                                      ! Dynamics 
    474       IF( lk_c1d        )   CALL dyn_dmp_init      ! internal momentum damping 
    475                             CALL dyn_adv_init      ! advection (vector or flux form) 
    476                             CALL dyn_vor_init      ! vorticity term including Coriolis 
    477                             CALL dyn_ldf_init      ! lateral mixing 
    478                             CALL dyn_hpg_init      ! horizontal gradient of Hydrostatic pressure 
    479                             CALL dyn_spg_init      ! surface pressure gradient 
     474      IF( lk_c1d       )   CALL dyn_dmp_init      ! internal momentum damping 
     475                           CALL dyn_adv_init      ! advection (vector or flux form) 
     476                           CALL dyn_vor_init      ! vorticity term including Coriolis 
     477                           CALL dyn_ldf_init      ! lateral mixing 
     478                           CALL dyn_hpg_init      ! horizontal gradient of Hydrostatic pressure 
     479                           CALL dyn_spg_init      ! surface pressure gradient 
    480480 
    481481#if defined key_top 
    482482      !                                      ! Passive tracers 
    483                             CALL     trc_init 
    484 #endif 
    485       IF( l_ldfslp      )   CALL ldf_slp_init   ! slope of lateral mixing 
     483                           CALL     trc_init 
     484#endif 
     485      IF( l_ldfslp     )   CALL ldf_slp_init    ! slope of lateral mixing 
    486486 
    487487      !                                      ! Icebergs 
    488                             CALL icb_init( rdt, nit000)   ! initialise icebergs instance 
     488                           CALL icb_init( rdt, nit000)   ! initialise icebergs instance 
    489489 
    490490      !                                      ! Misc. options 
    491                             CALL sto_par_init   ! Stochastic parametrization 
    492       IF( ln_sto_eos     )  CALL sto_pts_init   ! RRandom T/S fluctuations 
     491                           CALL sto_par_init    ! Stochastic parametrization 
     492      IF( ln_sto_eos   )   CALL sto_pts_init    ! RRandom T/S fluctuations 
    493493      
    494494      !                                      ! Diagnostics 
    495       IF( lk_floats     )   CALL     flo_init   ! drifting Floats 
    496                             CALL dia_cfl_init   ! Initialise CFL diagnostics 
    497                             CALL dia_ptr_init   ! Poleward TRansports initialization 
    498       IF( lk_diadct     )   CALL dia_dct_init   ! Sections tranports 
    499                             CALL dia_hsb_init   ! heat content, salt content and volume budgets 
    500                             CALL     trd_init   ! Mixed-layer/Vorticity/Integral constraints trends 
    501                             CALL dia_obs_init            ! Initialize observational data 
    502       IF( ln_diaobs     )   CALL dia_obs( nit000 - 1 )   ! Observation operator for restart 
     495      IF( lk_floats    )   CALL     flo_init    ! drifting Floats 
     496      IF( ln_diacfl    )   CALL dia_cfl_init    ! Initialise CFL diagnostics 
     497                           CALL dia_ptr_init    ! Poleward TRansports initialization 
     498      IF( lk_diadct    )   CALL dia_dct_init    ! Sections tranports 
     499                           CALL dia_hsb_init    ! heat content, salt content and volume budgets 
     500                           CALL     trd_init    ! Mixed-layer/Vorticity/Integral constraints trends 
     501                           CALL dia_obs_init    ! Initialize observational data 
     502      IF( ln_diaobs    )   CALL dia_obs( nit000 - 1 )   ! Observation operator for restart 
    503503 
    504504      !                                      ! Assimilation increments 
    505       IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments 
     505      IF( lk_asminc    )   CALL asm_inc_init    ! Initialize assimilation increments 
    506506      IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 
    507                             CALL dia_tmb_init  ! TMB outputs 
    508                             CALL dia_25h_init  ! 25h mean  outputs 
     507                           CALL dia_tmb_init    ! TMB outputs 
     508                           CALL dia_25h_init    ! 25h mean  outputs 
    509509      ! 
    510510   END SUBROUTINE nemo_init 
    … …  
    533533         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    534534         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    535          WRITE(numout,*) '      timing activated    (0/1)       nn_timing  = ', nn_timing 
     535         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing 
     536         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl 
    536537      ENDIF 
    537538      ! 
    … …  
    543544      isplt     = nn_isplt 
    544545      jsplt     = nn_jsplt 
     546!!gm to be remove at the end of the 2017 merge party 
     547      if( ln_timing ) then  ;  nn_timing = 1 
     548      else                  ;  nn_timing = 0 
     549      endif 
     550!!gm end 
     551       
    545552 
    546553      IF(lwp) THEN                  ! control print 

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

    r8215 r8568  
    208208      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    209209      IF( lk_floats  )   CALL flo_stp( kstp )         ! drifting Floats 
    210       IF( nn_diacfl == 1 )   CALL dia_cfl( kstp )         ! Courant number diagnostics 
     210      IF( ln_diacfl )   CALL dia_cfl( kstp )         ! Courant number diagnostics 
    211211      IF( lk_diahth  )   CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth) 
    212212      IF( lk_diadct  )   CALL dia_dct( kstp )         ! Transports 
    … …  
    324324#endif 
    325325      ! 
    326       IF( nn_timing == 1 .AND.  kstp == nit000  )   CALL timing_reset 
     326      IF( ln_timing .AND.  kstp == nit000  )   CALL timing_reset 
    327327      ! 
    328328   END SUBROUTINE stp 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/stpctl.F90

    r8215 r8568  
    9696         IF( lk_mpp ) THEN 
    9797            CALL mpp_maxloc( ABS(sshn)        , tmask(:,:,1), zzz, iih, ijh ) 
    98             CALL mpp_maxloc( ABS(un)          , umask       , zzz, iiu, iju, iku ) 
     98            CALL mpp_maxloc( ABS(un)          , umask(:,:,:), zzz, iiu, iju, iku ) 
    9999            CALL mpp_minloc( tsn(:,:,1,jp_sal), tmask(:,:,1), zzz, iis, ijs ) 
    100100         ELSE 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DIA/diacfl.F90

    r7753 r8568  
    11MODULE diacfl 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                       ***  MODULE  diacfl  *** 
    44   !! Output CFL diagnostics to ascii file 
    5    !!============================================================================== 
    6    !! History :  1.0  !  2010-03  (E. Blockley)  Original code 
    7    !!                 !  2014-06  (T Graham) Removed CPP key & Updated to vn3.6 
    8    !!  
     5   !!====================================================================== 
     6   !! History :  3.4  !  2010-03  (E. Blockley)  Original code 
     7   !!            3.6  !  2014-06  (T. Graham) Removed CPP key & Updated to vn3.6 
     8   !!            4.0  !  2017-09  (G. Madec)  style + comments 
    99   !!---------------------------------------------------------------------- 
    1010   !!   dia_cfl        : Compute and output Courant numbers at each timestep 
    … …  
    1212   USE oce             ! ocean dynamics and active tracers 
    1313   USE dom_oce         ! ocean space and time domain 
     14   USE domvvl          !  
     15   ! 
    1416   USE lib_mpp         ! distribued memory computing 
    1517   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    1618   USE in_out_manager  ! I/O manager 
    17    USE domvvl      
    1819   USE timing          ! Performance output 
    1920 
    … …  
    2122   PRIVATE 
    2223 
    23    REAL(wp) :: cu_max, cv_max, cw_max                      ! Run max U Courant number  
    24    INTEGER, DIMENSION(3) :: cu_loc, cv_loc, cw_loc         ! Run max locations 
    25    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zcu_cfl           ! Courant number arrays 
    26    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zcv_cfl           ! Courant number arrays 
    27    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zcw_cfl           ! Courant number arrays 
     24   CHARACTER(LEN=50) :: clname="cfl_diagnostics.ascii"    ! ascii filename 
     25   INTEGER           :: numcfl                            ! outfile unit 
     26   ! 
     27   INTEGER, DIMENSION(3) ::   nCu_loc, nCv_loc, nCw_loc   ! U, V, and W run max locations in the global domain 
     28   REAL(wp)              ::   rCu_max, rCv_max, rCw_max   ! associated run max Courant number  
    2829 
    29    INTEGER  :: numcfl                                       ! outfile unit 
    30    CHARACTER(LEN=50) :: clname="cfl_diagnostics.ascii"      ! ascii filename 
     30!!gm CAUTION: need to declare these arrays here, otherwise the calculation fails in multi-proc ! 
     31!!gm          8 don't understand why. 
     32   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zCu_cfl, zCv_cfl, zCw_cfl         ! workspace 
     33!!gm end 
    3134 
    3235   PUBLIC   dia_cfl       ! routine called by step.F90 
    … …  
    4043   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4144   !!---------------------------------------------------------------------- 
    42  
    43  
    4445CONTAINS 
    45  
    4646 
    4747   SUBROUTINE dia_cfl ( kt ) 
    … …  
    5252      !!               and output to ascii file 'cfl_diagnostics.ascii' 
    5353      !!---------------------------------------------------------------------- 
     54      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     55      ! 
     56      INTEGER :: ji, jj, jk   ! dummy loop indices 
     57      REAL(wp)::   z2dt, zCu_max, zCv_max, zCw_max       ! local scalars 
     58      INTEGER , DIMENSION(3)           ::   iloc_u , iloc_v , iloc_w , iloc   ! workspace 
     59!!gm this does not work      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zCu_cfl, zCv_cfl, zCw_cfl         ! workspace 
     60      !!---------------------------------------------------------------------- 
     61      ! 
     62      IF( nn_timing == 1 )   CALL timing_start('dia_cfl') 
     63      ! 
     64      !                       ! setup timestep multiplier to account for initial Eulerian timestep 
     65      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;    z2dt = rdt 
     66      ELSE                                        ;    z2dt = rdt * 2._wp 
     67      ENDIF 
     68      ! 
     69      !                 
     70      DO jk = 1, jpk       ! calculate Courant numbers 
     71         DO jj = 1, jpj 
     72            DO ji = 1, fs_jpim1   ! vector opt. 
     73               zCu_cfl(ji,jj,jk) = ABS( un(ji,jj,jk) ) * z2dt / e1u  (ji,jj)      ! for i-direction 
     74               zCv_cfl(ji,jj,jk) = ABS( vn(ji,jj,jk) ) * z2dt / e2v  (ji,jj)      ! for j-direction 
     75               zCw_cfl(ji,jj,jk) = ABS( wn(ji,jj,jk) ) * z2dt / e3w_n(ji,jj,jk)   ! for k-direction 
     76            END DO 
     77         END DO          
     78      END DO 
     79      ! 
     80      !                    ! calculate maximum values and locations 
     81      IF( lk_mpp ) THEN 
     82         CALL mpp_maxloc( zCu_cfl, umask, zCu_max, iloc_u(1), iloc_u(2), iloc_u(3) ) 
     83         CALL mpp_maxloc( zCv_cfl, vmask, zCv_max, iloc_v(1), iloc_v(2), iloc_v(3) ) 
     84         CALL mpp_maxloc( zCw_cfl, wmask, zCw_max, iloc_w(1), iloc_w(2), iloc_w(3) ) 
     85      ELSE 
     86         iloc = MAXLOC( ABS( zcu_cfl(:,:,:) ) ) 
     87         iloc_u(1) = iloc(1) + nimpp - 1 
     88         iloc_u(2) = iloc(2) + njmpp - 1 
     89         iloc_u(3) = iloc(3) 
     90         zCu_max = zCu_cfl(iloc(1),iloc(2),iloc(3)) 
     91         ! 
     92         iloc = MAXLOC( ABS( zcv_cfl(:,:,:) ) ) 
     93         iloc_v(1) = iloc(1) + nimpp - 1 
     94         iloc_v(2) = iloc(2) + njmpp - 1 
     95         iloc_v(3) = iloc(3) 
     96         zCv_max = zCv_cfl(iloc(1),iloc(2),iloc(3)) 
     97         ! 
     98         iloc = MAXLOC( ABS( zcw_cfl(:,:,:) ) ) 
     99         iloc_w(1) = iloc(1) + nimpp - 1 
     100         iloc_w(2) = iloc(2) + njmpp - 1 
     101         iloc_w(3) = iloc(3) 
     102         zCw_max = zCw_cfl(iloc(1),iloc(2),iloc(3)) 
     103      ENDIF 
     104      ! 
     105      !                    ! write out to file 
     106      IF( lwp ) THEN 
     107         WRITE(numcfl,FMT='(2x,i4,5x,a6,5x,f6.4,1x,i4,1x,i4,1x,i4)') kt, 'Max Cu', zCu_max, iloc_u(1), iloc_u(2), iloc_u(3) 
     108         WRITE(numcfl,FMT='(11x,     a6,5x,f6.4,1x,i4,1x,i4,1x,i4)')     'Max Cv', zCv_max, iloc_v(1), iloc_v(2), iloc_v(3) 
     109         WRITE(numcfl,FMT='(11x,     a6,5x,f6.4,1x,i4,1x,i4,1x,i4)')     'Max Cw', zCw_max, iloc_w(1), iloc_w(2), iloc_w(3) 
     110      ENDIF 
     111      ! 
     112      !                    ! update maximum Courant numbers from whole run if applicable 
     113      IF( zCu_max > rCu_max ) THEN   ;   rCu_max = zCu_max   ;   nCu_loc(:) = iloc_u(:)   ;   ENDIF 
     114      IF( zCv_max > rCv_max ) THEN   ;   rCv_max = zCv_max   ;   nCv_loc(:) = iloc_v(:)   ;   ENDIF 
     115      IF( zCw_max > rCw_max ) THEN   ;   rCw_max = zCw_max   ;   nCw_loc(:) = iloc_w(:)   ;   ENDIF 
    54116 
    55       INTEGER, INTENT(in) ::  kt                            ! ocean time-step index 
     117      !                    ! at end of run output max Cu and Cv and close ascii file 
     118      IF( kt == nitend .AND. lwp ) THEN 
     119         ! to ascii file 
     120         WRITE(numcfl,*) '******************************************' 
     121         WRITE(numcfl,FMT='(3x,a12,7x,f6.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cu', rCu_max, nCu_loc(1), nCu_loc(2), nCu_loc(3) 
     122         WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', z2dt/rCu_max 
     123         WRITE(numcfl,*) '******************************************' 
     124         WRITE(numcfl,FMT='(3x,a12,7x,f6.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cv', rCv_max, nCv_loc(1), nCv_loc(2), nCv_loc(3) 
     125         WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', z2dt/rCv_max 
     126         WRITE(numcfl,*) '******************************************' 
     127         WRITE(numcfl,FMT='(3x,a12,7x,f6.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cw', rCw_max, nCw_loc(1), nCw_loc(2), nCw_loc(3) 
     128         WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', z2dt/rCw_max 
     129         CLOSE( numcfl )  
     130         ! 
     131         ! to ocean output 
     132         WRITE(numout,*) 
     133         WRITE(numout,*) 'dia_cfl : Maximum Courant number information for the run ' 
     134         WRITE(numout,*) '~~~~~~~' 
     135         WRITE(numout,*) '   Max Cu = ', rCu_max, ' at (i,j,k) = (',nCu_loc(1),nCu_loc(2),nCu_loc(3),') => dt/C = ', z2dt/rCu_max 
     136         WRITE(numout,*) '   Max Cv = ', rCv_max, ' at (i,j,k) = (',nCv_loc(1),nCv_loc(2),nCv_loc(3),') => dt/C = ', z2dt/rCv_max 
     137         WRITE(numout,*) '   Max Cw = ', rCw_max, ' at (i,j,k) = (',nCw_loc(1),nCw_loc(2),nCw_loc(3),') => dt/C = ', z2dt/rCw_max 
     138      ENDIF 
     139      ! 
     140      IF( nn_timing == 1 )   CALL timing_stop('dia_cfl') 
     141      ! 
     142   END SUBROUTINE dia_cfl 
    56143 
    57       REAL(wp) :: zcu_max, zcv_max, zcw_max                 ! max Courant numbers per timestep 
    58       INTEGER, DIMENSION(3) :: zcu_loc, zcv_loc, zcw_loc    ! max Courant number locations 
    59  
    60       REAL(wp) :: dt                                        ! temporary scalars 
    61       INTEGER, DIMENSION(3) :: zlocu, zlocv, zlocw          ! temporary arrays  
    62       INTEGER  :: ji, jj, jk                                ! dummy loop indices 
    63  
    64        
    65       IF( nn_diacfl == 1) THEN 
    66          IF( nn_timing == 1 )   CALL timing_start('dia_cfl') 
    67          ! setup timestep multiplier to account for initial Eulerian timestep 
    68          IF( neuler == 0 .AND. kt == nit000 ) THEN   ;    dt = rdt 
    69          ELSE                                        ;    dt = rdt * 2.0 
    70          ENDIF 
    71  
    72              ! calculate Courant numbers 
    73          DO jk = 1, jpk 
    74             DO jj = 1, jpj 
    75                DO ji = 1, fs_jpim1   ! vector opt. 
    76  
    77                   ! Courant number for x-direction (zonal current) 
    78                   zcu_cfl(ji,jj,jk) = ABS(un(ji,jj,jk))*dt/e1u(ji,jj) 
    79  
    80                   ! Courant number for y-direction (meridional current) 
    81                   zcv_cfl(ji,jj,jk) = ABS(vn(ji,jj,jk))*dt/e2v(ji,jj) 
    82  
    83                   ! Courant number for z-direction (vertical current) 
    84                   zcw_cfl(ji,jj,jk) = ABS(wn(ji,jj,jk))*dt/e3w_n(ji,jj,jk) 
    85                END DO 
    86             END DO          
    87          END DO 
    88  
    89          ! calculate maximum values and locations 
    90          IF( lk_mpp ) THEN 
    91             CALL mpp_maxloc(zcu_cfl,umask,zcu_max, zcu_loc(1), zcu_loc(2), zcu_loc(3)) 
    92             CALL mpp_maxloc(zcv_cfl,vmask,zcv_max, zcv_loc(1), zcv_loc(2), zcv_loc(3)) 
    93             CALL mpp_maxloc(zcw_cfl,tmask,zcw_max, zcw_loc(1), zcw_loc(2), zcw_loc(3)) 
    94          ELSE 
    95             zlocu = MAXLOC( ABS( zcu_cfl(:,:,:) ) ) 
    96             zcu_loc(1) = zlocu(1) + nimpp - 1 
    97             zcu_loc(2) = zlocu(2) + njmpp - 1 
    98             zcu_loc(3) = zlocu(3) 
    99             zcu_max = zcu_cfl(zcu_loc(1),zcu_loc(2),zcu_loc(3)) 
    100  
    101             zlocv = MAXLOC( ABS( zcv_cfl(:,:,:) ) ) 
    102             zcv_loc(1) = zlocv(1) + nimpp - 1 
    103             zcv_loc(2) = zlocv(2) + njmpp - 1 
    104             zcv_loc(3) = zlocv(3) 
    105             zcv_max = zcv_cfl(zcv_loc(1),zcv_loc(2),zcv_loc(3)) 
    106  
    107             zlocw = MAXLOC( ABS( zcw_cfl(:,:,:) ) ) 
    108             zcw_loc(1) = zlocw(1) + nimpp - 1 
    109             zcw_loc(2) = zlocw(2) + njmpp - 1 
    110             zcw_loc(3) = zlocw(3) 
    111             zcw_max = zcw_cfl(zcw_loc(1),zcw_loc(2),zcw_loc(3)) 
    112          ENDIF 
    113        
    114          ! write out to file 
    115          IF( lwp ) THEN 
    116             WRITE(numcfl,FMT='(2x,i4,5x,a6,5x,f6.4,1x,i4,1x,i4,1x,i4)') kt, 'Max Cu', zcu_max, zcu_loc(1), zcu_loc(2), zcu_loc(3) 
    117             WRITE(numcfl,FMT='(11x,a6,5x,f6.4,1x,i4,1x,i4,1x,i4)') 'Max Cv', zcv_max, zcv_loc(1), zcv_loc(2), zcv_loc(3) 
    118             WRITE(numcfl,FMT='(11x,a6,5x,f6.4,1x,i4,1x,i4,1x,i4)') 'Max Cw', zcw_max, zcw_loc(1), zcw_loc(2), zcw_loc(3) 
    119          ENDIF 
    120  
    121          ! update maximum Courant numbers from whole run if applicable 
    122          IF( zcu_max > cu_max ) THEN 
    123             cu_max = zcu_max 
    124             cu_loc = zcu_loc 
    125          ENDIF 
    126          IF( zcv_max > cv_max ) THEN 
    127             cv_max = zcv_max 
    128             cv_loc = zcv_loc 
    129          ENDIF 
    130          IF( zcw_max > cw_max ) THEN 
    131             cw_max = zcw_max 
    132             cw_loc = zcw_loc 
    133          ENDIF 
    134  
    135          ! at end of run output max Cu and Cv and close ascii file 
    136          IF( kt == nitend .AND. lwp ) THEN 
    137             ! to ascii file 
    138             WRITE(numcfl,*) '******************************************' 
    139             WRITE(numcfl,FMT='(3x,a12,7x,f6.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cu', cu_max, cu_loc(1), cu_loc(2), cu_loc(3) 
    140             WRITE(numcfl,FMT='(3x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cu_max) 
    141             WRITE(numcfl,*) '******************************************' 
    142             WRITE(numcfl,FMT='(3x,a12,7x,f6.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cv', cv_max, cv_loc(1), cv_loc(2), cv_loc(3) 
    143             WRITE(numcfl,FMT='(3x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cv_max) 
    144             WRITE(numcfl,*) '******************************************' 
    145             WRITE(numcfl,FMT='(3x,a12,7x,f6.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cw', cw_max, cw_loc(1), cw_loc(2), cw_loc(3) 
    146             WRITE(numcfl,FMT='(3x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cw_max) 
    147             CLOSE( numcfl )  
    148  
    149             ! to ocean output 
    150             WRITE(numout,*) 
    151             WRITE(numout,*) 'dia_cfl     : Maximum Courant number information for the run:' 
    152             WRITE(numout,*) '~~~~~~~~~~~~' 
    153             WRITE(numout,FMT='(12x,a12,7x,f6.4,5x,a16,i4,1x,i4,1x,i4,a1)') 'Run Max Cu', cu_max, 'at (i, j, k) = (', cu_loc(1), cu_loc(2), cu_loc(3), ')' 
    154             WRITE(numout,FMT='(12x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cu_max) 
    155             WRITE(numout,FMT='(12x,a12,7x,f6.4,5x,a16,i4,1x,i4,1x,i4,a1)') 'Run Max Cv', cv_max, 'at (i, j, k) = (', cv_loc(1), cv_loc(2), cv_loc(3), ')' 
    156             WRITE(numout,FMT='(12x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cv_max) 
    157             WRITE(numout,FMT='(12x,a12,7x,f6.4,5x,a16,i4,1x,i4,1x,i4,a1)') 'Run Max Cw', cw_max, 'at (i, j, k) = (', cw_loc(1), cw_loc(2), cw_loc(3), ')' 
    158             WRITE(numout,FMT='(12x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cw_max) 
    159  
    160          ENDIF 
    161  
    162          IF( nn_timing == 1 )   CALL timing_stop('dia_cfl') 
    163       ENDIF 
    164  
    165    END SUBROUTINE dia_cfl 
    166144 
    167145   SUBROUTINE dia_cfl_init 
    … …  
    171149      !! ** Purpose :   create output file, initialise arrays 
    172150      !!---------------------------------------------------------------------- 
    173  
    174  
    175       IF( nn_diacfl == 1 ) THEN 
    176          IF( nn_timing == 1 )   CALL timing_start('dia_cfl_init') 
    177  
    178          cu_max=0.0 
    179          cv_max=0.0 
    180          cw_max=0.0 
    181  
    182          ALLOCATE( zcu_cfl(jpi, jpj, jpk), zcv_cfl(jpi, jpj, jpk), zcw_cfl(jpi, jpj, jpk) ) 
    183  
    184          zcu_cfl(:,:,:)=0.0 
    185          zcv_cfl(:,:,:)=0.0 
    186          zcw_cfl(:,:,:)=0.0 
    187  
    188          IF( lwp ) THEN 
    189             WRITE(numout,*) 
    190             WRITE(numout,*) 'dia_cfl     : Outputting CFL diagnostics to '//TRIM(clname) 
    191             WRITE(numout,*) '~~~~~~~~~~~~' 
    192             WRITE(numout,*) 
    193  
    194             ! create output ascii file 
    195             CALL ctl_opn( numcfl, clname, 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 ) 
    196             WRITE(numcfl,*) 'Timestep  Direction  Max C     i    j    k' 
    197             WRITE(numcfl,*) '******************************************' 
    198          ENDIF 
    199  
    200          IF( nn_timing == 1 )   CALL timing_stop('dia_cfl_init') 
    201  
     151      ! 
     152      IF(lwp) THEN 
     153         WRITE(numout,*) 
     154         WRITE(numout,*) 'dia_cfl : Outputting CFL diagnostics to ',TRIM(clname), ' file' 
     155         WRITE(numout,*) '~~~~~~~' 
     156         WRITE(numout,*) 
     157         ! 
     158         ! create output ascii file 
     159         CALL ctl_opn( numcfl, clname, 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 ) 
     160         WRITE(numcfl,*) 'Timestep  Direction  Max C     i    j    k' 
     161         WRITE(numcfl,*) '******************************************' 
    202162      ENDIF 
    203  
     163      ! 
     164      rCu_max = 0._wp 
     165      rCv_max = 0._wp 
     166      rCw_max = 0._wp 
     167      ! 
     168!!gm required to work 
     169      ALLOCATE ( zCu_cfl(jpi,jpj,jpk), zCv_cfl(jpi,jpj,jpk), zCw_cfl(jpi,jpj,jpk) ) 
     170!!gm end 
     171      !       
    204172   END SUBROUTINE dia_cfl_init 
    205173 
     174   !!====================================================================== 
    206175END MODULE diacfl 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DOM/daymod.F90

    r7646 r8568  
    222222      !!---------------------------------------------------------------------- 
    223223      ! 
    224       IF( nn_timing == 1 )  CALL timing_start('day') 
     224      IF( ln_timing )   CALL timing_start('day') 
    225225      ! 
    226226      zprec = 0.1 / rday 
    … …  
    276276      IF( lrst_oce         ) CALL day_rst( kt, 'WRITE' )      ! write day restart information 
    277277      ! 
    278       IF( nn_timing == 1 )  CALL timing_stop('day') 
     278      IF( ln_timing )   CALL timing_stop('day') 
    279279      ! 
    280280   END SUBROUTINE day 
    … …  
    402402         CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj            )   ! number of elapsed days since 
    403403         !                                                                     ! the begining of the run [s] 
    404     CALL iom_rstput( kt, nitrst, numrow, 'ntime'  , REAL( nn_time0, wp) ) ! time 
     404         CALL iom_rstput( kt, nitrst, numrow, 'ntime'  , REAL( nn_time0, wp) ) ! time 
    405405      ENDIF 
    406406      ! 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DOM/depth_e3.F90

    r7753 r8568  
    2020   USE lbclnk            ! ocean lateral boundary conditions (or mpp link) 
    2121   USE lib_mpp           ! distributed memory computing library 
    22    USE wrk_nemo          ! Memory allocation 
    2322   USE timing            ! Timing 
    2423 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DOM/domain.F90

    r7822 r8568  
    4545   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
    4646   USE lib_mpp        ! distributed memory computing library 
    47    USE wrk_nemo       ! Memory Allocation 
    4847   USE timing         ! Timing 
    4948 
    … …  
    8382      !!---------------------------------------------------------------------- 
    8483      ! 
    85       IF( nn_timing == 1 )   CALL timing_start('dom_init') 
     84      IF( ln_timing )   CALL timing_start('dom_init') 
    8685      ! 
    8786      IF(lwp) THEN         ! Ocean domain Parameters (control print) 
    … …  
    199198      IF( ln_write_cfg )   CALL cfg_write         ! create the configuration file 
    200199      ! 
    201       IF( nn_timing == 1 )   CALL timing_stop('dom_init') 
     200      IF( ln_timing )   CALL timing_stop('dom_init') 
    202201      ! 
    203202   END SUBROUTINE dom_init 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DOM/domhgr.F90

    r7753 r8568  
    7979      !!---------------------------------------------------------------------- 
    8080      ! 
    81       IF( nn_timing == 1 )  CALL timing_start('dom_hgr') 
     81      IF( ln_timing )   CALL timing_start('dom_hgr') 
    8282      ! 
    8383      IF(lwp) THEN 
    … …  
    152152      ! 
    153153      ! 
    154       IF( nn_timing == 1 )  CALL timing_stop('dom_hgr') 
     154      IF( ln_timing )   CALL timing_stop('dom_hgr') 
    155155      ! 
    156156   END SUBROUTINE dom_hgr 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DOM/dommsk.F90

    r7753 r8568  
    3030   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    3131   USE lib_mpp        ! Massively Parallel Processing library 
    32    USE wrk_nemo       ! Memory allocation 
    3332   USE timing         ! Timing 
    3433 
    … …  
    9291      INTEGER  ::   iktop, ikbot   !   -       - 
    9392      INTEGER  ::   ios, inum 
    94       REAL(wp), POINTER, DIMENSION(:,:) ::   zwf   ! 2D workspace 
     93      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zwf   ! 2D workspace 
    9594      !! 
    9695      NAMELIST/namlbc/ rn_shlat, ln_vorlat 
    … …  
    104103      !!--------------------------------------------------------------------- 
    105104      ! 
    106       IF( nn_timing == 1 )  CALL timing_start('dom_msk') 
     105      IF( ln_timing )   CALL timing_start('dom_msk') 
    107106      ! 
    108107      REWIND( numnam_ref )              ! Namelist namlbc in reference namelist : Lateral momentum boundary condition 
    … …  
    248247      IF( rn_shlat /= 0 ) THEN      ! Not free-slip lateral boundary condition 
    249248         ! 
    250          CALL wrk_alloc( jpi,jpj,   zwf ) 
     249         ALLOCATE( zwf(jpi,jpj) ) 
    251250         ! 
    252251         DO jk = 1, jpk 
    … …  
    278277         END DO 
    279278         ! 
    280          CALL wrk_dealloc( jpi,jpj,  zwf ) 
     279         DEALLOCATE( zwf ) 
    281280         ! 
    282281         CALL lbc_lnk( fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask 
    … …  
    292291      ! 
    293292      ! 
    294       IF( nn_timing == 1 )  CALL timing_stop('dom_msk') 
     293      IF( ln_timing )   CALL timing_stop('dom_msk') 
    295294      ! 
    296295   END SUBROUTINE dom_msk 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DOM/domngb.F90

    r7646 r8568  
    1111   !!---------------------------------------------------------------------- 
    1212   USE dom_oce        ! ocean space and time domain 
     13   ! 
    1314   USE in_out_manager ! I/O manager 
    1415   USE lib_mpp        ! for mppsum 
    15    USE wrk_nemo       ! Memory allocation 
    1616   USE timing         ! Timing 
    1717 
    … …  
    4545      INTEGER , DIMENSION(2) ::   iloc 
    4646      REAL(wp)               ::   zlon, zmini 
    47       REAL(wp), POINTER, DIMENSION(:,:) ::  zglam, zgphi, zmask, zdist 
     47      REAL(wp), DIMENSION(jpi,jpj) ::   zglam, zgphi, zmask, zdist 
    4848      !!-------------------------------------------------------------------- 
    4949      ! 
    50       IF( nn_timing == 1 )  CALL timing_start('dom_ngb') 
    51       ! 
    52       CALL wrk_alloc( jpi,jpj,   zglam, zgphi, zmask, zdist ) 
     50      IF( ln_timing )   CALL timing_start('dom_ngb') 
    5351      ! 
    5452      zmask(:,:) = 0._wp 
    … …  
    7977      ENDIF 
    8078      ! 
    81       CALL wrk_dealloc( jpi,jpj,   zglam, zgphi, zmask, zdist ) 
    82       ! 
    83       IF( nn_timing == 1 )  CALL timing_stop('dom_ngb') 
     79      IF( ln_timing )   CALL timing_stop('dom_ngb') 
    8480      ! 
    8581   END SUBROUTINE dom_ngb 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DOM/domvvl.F90

    r7753 r8568  
    66   !! History :  2.0  !  2006-06  (B. Levier, L. Marie)  original code 
    77   !!            3.1  !  2009-02  (G. Madec, M. Leclair, R. Benshila)  pure z* coordinate 
    8    !!            3.3  !  2011-10  (M. Leclair) totally rewrote domvvl: 
    9    !!                                          vvl option includes z_star and z_tilde coordinates 
     8   !!            3.3  !  2011-10  (M. Leclair) totally rewrote domvvl: vvl option includes z_star and z_tilde coordinates 
    109   !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability 
    1110   !!---------------------------------------------------------------------- 
    … …  
    3130   USE lib_mpp         ! distributed memory computing library 
    3231   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    33    USE wrk_nemo        ! Memory allocation 
    3432   USE timing          ! Timing 
    3533 
    … …  
    122120      !!---------------------------------------------------------------------- 
    123121      ! 
    124       IF( nn_timing == 1 )   CALL timing_start('dom_vvl_init') 
     122      IF( ln_timing )   CALL timing_start('dom_vvl_init') 
    125123      ! 
    126124      IF(lwp) WRITE(numout,*) 
    … …  
    242240      ENDIF 
    243241      ! 
    244       IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_init') 
     242      IF( ln_timing )   CALL timing_stop('dom_vvl_init') 
    245243      ! 
    246244   END SUBROUTINE dom_vvl_init 
    … …  
    276274      REAL(wp)               ::   z2dt, z_tmin, z_tmax  ! local scalars 
    277275      LOGICAL                ::   ll_do_bclinic         ! local logical 
    278       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze3t 
    279       REAL(wp), POINTER, DIMENSION(:,:  ) ::   zht, z_scale, zwu, zwv, zhdiv 
     276      REAL(wp), DIMENSION(jpi,jpj)     ::   zht, z_scale, zwu, zwv, zhdiv 
     277      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3t 
    280278      !!---------------------------------------------------------------------- 
    281279      ! 
    282280      IF( ln_linssh )   RETURN      ! No calculation in linear free surface 
    283281      ! 
    284       IF( nn_timing == 1 )   CALL timing_start('dom_vvl_sf_nxt') 
    285       ! 
    286       CALL wrk_alloc( jpi,jpj,zht,   z_scale, zwu, zwv, zhdiv ) 
    287       CALL wrk_alloc( jpi,jpj,jpk,   ze3t ) 
    288  
     282      IF( ln_timing )   CALL timing_start('dom_vvl_sf_nxt') 
     283      ! 
    289284      IF( kt == nit000 ) THEN 
    290285         IF(lwp) WRITE(numout,*) 
    … …  
    543538      r1_hv_a(:,:) = ssvmask(:,:) / ( hv_a(:,:) + 1._wp - ssvmask(:,:) ) 
    544539      ! 
    545       CALL wrk_dealloc( jpi,jpj,       zht, z_scale, zwu, zwv, zhdiv ) 
    546       CALL wrk_dealloc( jpi,jpj,jpk,   ze3t ) 
    547       ! 
    548       IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_sf_nxt') 
     540      IF( ln_timing )   CALL timing_stop('dom_vvl_sf_nxt') 
    549541      ! 
    550542   END SUBROUTINE dom_vvl_sf_nxt 
    … …  
    583575      IF( ln_linssh )   RETURN      ! No calculation in linear free surface 
    584576      ! 
    585       IF( nn_timing == 1 )  CALL timing_start('dom_vvl_sf_swp') 
     577      IF( ln_timing )   CALL timing_start('dom_vvl_sf_swp') 
    586578      ! 
    587579      IF( kt == nit000 )   THEN 
    … …  
    657649      ! write restart file 
    658650      ! ================== 
    659       IF( lrst_oce )   CALL dom_vvl_rst( kt, 'WRITE' ) 
    660       ! 
    661       IF( nn_timing == 1 )   CALL timing_stop('dom_vvl_sf_swp') 
     651      IF( lrst_oce  )   CALL dom_vvl_rst( kt, 'WRITE' ) 
     652      ! 
     653      IF( ln_timing )   CALL timing_stop('dom_vvl_sf_swp') 
    662654      ! 
    663655   END SUBROUTINE dom_vvl_sf_swp 
    … …  
    683675      !!---------------------------------------------------------------------- 
    684676      ! 
    685       IF( nn_timing == 1 )   CALL timing_start('dom_vvl_interpol') 
     677      IF( ln_timing )   CALL timing_start('dom_vvl_interpol') 
    686678      ! 
    687679      IF(ln_wd) THEN 
    … …  
    770762      END SELECT 
    771763      ! 
    772       IF( nn_timing == 1 )   CALL timing_stop('dom_vvl_interpol') 
     764      IF( ln_timing )   CALL timing_stop('dom_vvl_interpol') 
    773765      ! 
    774766   END SUBROUTINE dom_vvl_interpol 
    … …  
    794786      !!---------------------------------------------------------------------- 
    795787      ! 
    796       IF( nn_timing == 1 )  CALL timing_start('dom_vvl_rst') 
     788      IF( ln_timing )   CALL timing_start('dom_vvl_rst') 
     789      ! 
    797790      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise  
    798791         !                                   ! =============== 
    … …  
    947940      ENDIF 
    948941      ! 
    949       IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_rst') 
     942      IF( ln_timing )   CALL timing_stop('dom_vvl_rst') 
    950943      ! 
    951944   END SUBROUTINE dom_vvl_rst 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DOM/domwri.F90

    r7646 r8568  
    2424   USE lbclnk          ! lateral boundary conditions - mpp exchanges 
    2525   USE lib_mpp         ! MPP library 
    26    USE wrk_nemo        ! Memory allocation 
    2726   USE timing          ! Timing 
    2827 
    … …  
    7574      INTEGER           ::   izco, izps, isco, icav 
    7675      !                                
    77       REAL(wp), POINTER, DIMENSION(:,:)   ::   zprt, zprw     ! 2D workspace 
    78       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdepu, zdepv   ! 3D workspace 
    79       !!---------------------------------------------------------------------- 
    80       ! 
    81       IF( nn_timing == 1 )  CALL timing_start('dom_wri') 
    82       ! 
    83       CALL wrk_alloc( jpi,jpj,       zprt , zprw  ) 
    84       CALL wrk_alloc( jpi,jpj,jpk,   zdepu, zdepv ) 
     76      REAL(wp), DIMENSION(jpi,jpj)     ::   zprt, zprw     ! 2D workspace 
     77      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdepu, zdepv   ! 3D workspace 
     78      !!---------------------------------------------------------------------- 
     79      ! 
     80      IF( ln_timing )   CALL timing_start('dom_wri') 
    8581      ! 
    8682      IF(lwp) WRITE(numout,*) 
    … …  
    206202      !                                     ! ============================ 
    207203      ! 
    208       CALL wrk_dealloc( jpi, jpj, zprt, zprw ) 
    209       CALL wrk_dealloc( jpi, jpj, jpk, zdepu, zdepv ) 
    210       ! 
    211       IF( nn_timing == 1 )  CALL timing_stop('dom_wri') 
     204      IF( ln_timing )   CALL timing_stop('dom_wri') 
    212205      ! 
    213206   END SUBROUTINE dom_wri 
    … …  
    229222      INTEGER  ::  ji       ! dummy loop indices 
    230223      LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) ::  lldbl  ! store whether each point is unique or not 
    231       REAL(wp), POINTER, DIMENSION(:,:) :: ztstref 
    232       !!---------------------------------------------------------------------- 
    233       ! 
    234       IF( nn_timing == 1 )  CALL timing_start('dom_uniq') 
    235       ! 
    236       CALL wrk_alloc( jpi, jpj, ztstref ) 
     224      REAL(wp), DIMENSION(jpi,jpj) ::   ztstref 
     225      !!---------------------------------------------------------------------- 
     226      ! 
     227      IF( ln_timing )   CALL timing_start('dom_uniq') 
    237228      ! 
    238229      ! build an array with different values for each element  
    … …  
    250241      puniq(nldi:nlei,nldj:nlej) = REAL( COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ) , wp ) 
    251242      ! 
    252       CALL wrk_dealloc( jpi, jpj, ztstref ) 
    253       ! 
    254       IF( nn_timing == 1 )  CALL timing_stop('dom_uniq') 
     243      IF( ln_timing )   CALL timing_stop('dom_uniq') 
    255244      ! 
    256245   END SUBROUTINE dom_uniq 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DOM/domzgr.F90

    r7753 r8568  
    3636   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    3737   USE lib_mpp        ! distributed memory computing library 
    38    USE wrk_nemo       ! Memory allocation 
    3938   USE timing         ! Timing 
    4039 
    … …  
    7776      !!---------------------------------------------------------------------- 
    7877      ! 
    79       IF( nn_timing == 1 )   CALL timing_start('dom_zgr') 
     78      IF( ln_timing )   CALL timing_start('dom_zgr') 
    8079      ! 
    8180      IF(lwp) THEN                     ! Control print 
    … …  
    164163      ENDIF 
    165164      ! 
    166       IF( nn_timing == 1 )  CALL timing_stop('dom_zgr') 
     165      IF( ln_timing )   CALL timing_stop('dom_zgr') 
    167166      ! 
    168167   END SUBROUTINE dom_zgr 
    … …  
    284283      ! 
    285284      INTEGER ::   ji, jj   ! dummy loop indices 
    286       REAL(wp), POINTER, DIMENSION(:,:) ::  zk 
    287       !!---------------------------------------------------------------------- 
    288       ! 
    289       IF( nn_timing == 1 )  CALL timing_start('zgr_top_bot') 
    290       ! 
    291       CALL wrk_alloc( jpi,jpj,   zk ) 
     285      REAL(wp), DIMENSION(jpi,jpj) ::   zk   ! workspace 
     286      !!---------------------------------------------------------------------- 
     287      ! 
     288      IF( ln_timing )   CALL timing_start('zgr_top_bot') 
    292289      ! 
    293290      IF(lwp) WRITE(numout,*) 
    … …  
    319316      zk(:,:) = REAL( mbkv(:,:), wp )   ;   CALL lbc_lnk( zk, 'V', 1. )   ;   mbkv(:,:) = MAX( INT( zk(:,:) ), 1 ) 
    320317      ! 
    321       CALL wrk_dealloc( jpi,jpj,   zk ) 
    322       ! 
    323       IF( nn_timing == 1 )  CALL timing_stop('zgr_top_bot') 
     318      IF( ln_timing )   CALL timing_stop('zgr_top_bot') 
    324319      ! 
    325320   END SUBROUTINE zgr_top_bot 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DOM/dtatsd.F90

    r7753 r8568  
    1616   !!---------------------------------------------------------------------- 
    1717   USE oce             ! ocean dynamics and tracers 
     18   USE phycst          ! physical constants 
    1819   USE dom_oce         ! ocean space and time domain 
    1920   USE fldread         ! read input fields 
     21   ! 
    2022   USE in_out_manager  ! I/O manager 
    21    USE phycst          ! physical constants 
    2223   USE lib_mpp         ! MPP library 
    23    USE wrk_nemo        ! Memory allocation 
    2424   USE timing          ! Timing 
    2525 
    … …  
    6262      !!---------------------------------------------------------------------- 
    6363      ! 
    64       IF( nn_timing == 1 )  CALL timing_start('dta_tsd_init') 
     64      IF( ln_timing )   CALL timing_start('dta_tsd_init') 
    6565      ! 
    6666      !  Initialisation 
    … …  
    120120      ENDIF 
    121121      ! 
    122       IF( nn_timing == 1 )  CALL timing_stop('dta_tsd_init') 
     122      IF( ln_timing )   CALL timing_stop('dta_tsd_init') 
    123123      ! 
    124124   END SUBROUTINE dta_tsd_init 
    … …  
    145145      INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies 
    146146      INTEGER ::   ik, il0, il1, ii0, ii1, ij0, ij1   ! local integers 
    147       REAL(wp)::   zl, zi 
    148       REAL(wp), POINTER, DIMENSION(:) ::  ztp, zsp   ! 1D workspace 
    149       !!---------------------------------------------------------------------- 
    150       ! 
    151       IF( nn_timing == 1 )  CALL timing_start('dta_tsd') 
     147      REAL(wp)::   zl, zi                             ! local scalars 
     148      REAL(wp), DIMENSION(jpk) ::  ztp, zsp   ! 1D workspace 
     149      !!---------------------------------------------------------------------- 
     150      ! 
     151      IF( ln_timing )   CALL timing_start('dta_tsd') 
    152152      ! 
    153153      CALL fld_read( kt, 1, sf_tsd )      !==   read T & S data at kt time step   ==! 
    … …  
    185185      ! 
    186186      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==! 
    187          ! 
    188          CALL wrk_alloc( jpk, ztp, zsp ) 
    189187         ! 
    190188         IF( kt == nit000 .AND. lwp )THEN 
    … …  
    222220         END DO 
    223221         !  
    224          CALL wrk_dealloc( jpk, ztp, zsp ) 
    225          !  
    226222      ELSE                                !==   z- or zps- coordinate   ==! 
    227223         !                              
    … …  
    260256      ENDIF 
    261257      ! 
    262       IF( nn_timing == 1 )  CALL timing_stop('dta_tsd') 
     258      IF( ln_timing )   CALL timing_stop('dta_tsd') 
    263259      ! 
    264260   END SUBROUTINE dta_tsd 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DOM/iscplhsb.F90

    r7646 r8568  
    1313   !!   iscpl_div      : correction of divergence to keep volume conservation 
    1414   !!---------------------------------------------------------------------- 
     15   USE oce             ! global tra/dyn variable 
    1516   USE dom_oce         ! ocean space and time domain 
    1617   USE domwri          ! ocean space and time domain 
     18   USE domngb          !  
    1719   USE phycst          ! physical constants 
    1820   USE sbc_oce         ! surface boundary condition variables 
    19    USE oce             ! global tra/dyn variable 
     21   USE iscplini        !  
     22   ! 
    2023   USE in_out_manager  ! I/O manager 
    2124   USE lib_mpp         ! MPP library 
    2225   USE lib_fortran     ! MPP library 
    23    USE wrk_nemo        ! Memory allocation 
    2426   USE lbclnk          ! 
    25    USE domngb          ! 
    26    USE iscplini 
    2727 
    2828   IMPLICIT NONE 
    … …  
    5656      REAL(wp), DIMENSION(:,:,:  ), INTENT(out) :: pvol_flx    !! corrective flux to have volume conservation 
    5757      REAL(wp),                     INTENT(in ) :: prdt_iscpl  !! coupling period  
    58       !! 
    59       INTEGER :: ji, jj, jk                                    !! loop index 
    60       INTEGER :: jip1, jim1, jjp1, jjm1 
    61       !! 
    62       REAL(wp):: summsk, zsum, zsum1, zarea, zsumn, zsumb 
    63       REAL(wp):: r1_rdtiscpl 
    64       REAL(wp):: zjip1_ratio  , zjim1_ratio  , zjjp1_ratio  , zjjm1_ratio 
    65       !! 
    66       REAL(wp):: zde3t, zdtem, zdsal 
    67       REAL(wp), DIMENSION(:,:), POINTER :: zdssh 
    68       !! 
    69       REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon, zlat 
    70       REAL(wp), DIMENSION(:), ALLOCATABLE :: zcorr_vol, zcorr_tem, zcorr_sal 
    71       INTEGER , DIMENSION(:), ALLOCATABLE :: ixpts, iypts, izpts, inpts 
     58      ! 
     59      INTEGER  ::   ji  , jj  , jk           ! loop index 
     60      INTEGER  ::   jip1, jim1, jjp1, jjm1 
     61      REAL(wp) ::   summsk, zsum , zsumn, zjip1_ratio  , zjim1_ratio, zdtem, zde3t, z1_rdtiscpl 
     62      REAL(wp) ::   zarea , zsum1, zsumb, zjjp1_ratio  , zjjm1_ratio, zdsal 
     63      REAL(wp), DIMENSION(jpi,jpj)        ::   zdssh   ! workspace 
     64      REAL(wp), DIMENSION(:), ALLOCATABLE ::   zlon, zlat 
     65      REAL(wp), DIMENSION(:), ALLOCATABLE ::   zcorr_vol, zcorr_tem, zcorr_sal 
     66      INTEGER , DIMENSION(:), ALLOCATABLE ::   ixpts, iypts, izpts, inpts 
    7267      INTEGER :: jpts, npts 
    73  
    74       CALL wrk_alloc(jpi,jpj, zdssh ) 
     68      !!---------------------------------------------------------------------- 
    7569 
    7670      ! get imbalance (volume heat and salt) 
    7771      ! initialisation difference 
    78       zde3t = 0.0_wp; zdsal = 0.0_wp ; zdtem = 0.0_wp 
     72      zde3t = 0._wp   ;   zdsal = 0._wp   ;   zdtem = 0._wp 
    7973 
    8074      ! initialisation correction term 
    81       pvol_flx(:,:,:  ) = 0.0_wp 
    82       pts_flx (:,:,:,:) = 0.0_wp 
     75      pvol_flx(:,:,:  ) = 0._wp 
     76      pts_flx (:,:,:,:) = 0._wp 
    8377       
    84       r1_rdtiscpl = 1._wp / prdt_iscpl  
     78      z1_rdtiscpl = 1._wp / prdt_iscpl  
    8579 
    8680      ! mask tsn and tsb  
    87       tsb(:,:,:,jp_tem)=tsb(:,:,:,jp_tem)*ptmask_b(:,:,:); tsn(:,:,:,jp_tem)=tsn(:,:,:,jp_tem)*tmask(:,:,:); 
    88       tsb(:,:,:,jp_sal)=tsb(:,:,:,jp_sal)*ptmask_b(:,:,:); tsn(:,:,:,jp_sal)=tsn(:,:,:,jp_sal)*tmask(:,:,:); 
     81      tsb(:,:,:,jp_tem) = tsb(:,:,:,jp_tem) * ptmask_b(:,:,:) 
     82      tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) *  tmask  (:,:,:) 
     83      tsb(:,:,:,jp_sal) = tsb(:,:,:,jp_sal) * ptmask_b(:,:,:) 
     84      tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) *  tmask  (:,:,:) 
    8985 
    9086      !============================================================================== 
    … …  
    118114 
    119115                  ! volume, heat and salt differences in each cell  
    120                   pvol_flx(ji,jj,jk)       =   pvol_flx(ji,jj,jk)        + zde3t * r1_rdtiscpl 
    121                   pts_flx (ji,jj,jk,jp_sal)=   pts_flx (ji,jj,jk,jp_sal) + zdsal * r1_rdtiscpl  
    122                   pts_flx (ji,jj,jk,jp_tem)=   pts_flx (ji,jj,jk,jp_tem) + zdtem * r1_rdtiscpl 
     116                  pvol_flx(ji,jj,jk)       =   pvol_flx(ji,jj,jk)        + zde3t * z1_rdtiscpl 
     117                  pts_flx (ji,jj,jk,jp_sal)=   pts_flx (ji,jj,jk,jp_sal) + zdsal * z1_rdtiscpl  
     118                  pts_flx (ji,jj,jk,jp_tem)=   pts_flx (ji,jj,jk,jp_tem) + zdtem * z1_rdtiscpl 
    123119 
    124120                  ! case where we close a cell: check if the neighbour cells are wet  
    … …  
    190186      ! if no neighbour wet cell in case of 2close a cell", need to find the nearest wet point  
    191187      ! allocation and initialisation of the list of problematic point 
    192       ALLOCATE(inpts(jpnij)) 
    193       inpts(:)=0 
     188      ALLOCATE( inpts(jpnij) ) 
     189      inpts(:) = 0 
    194190 
    195191      ! fill narea location with the number of problematic point 
    … …  
    287283      CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1._wp) 
    288284      CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1._wp) 
    289  
    290       ! deallocate variables 
    291       CALL wrk_dealloc(jpi,jpj, zdssh )  
    292  
     285      ! 
    293286   END SUBROUTINE iscpl_cons 
     287 
    294288 
    295289   SUBROUTINE iscpl_div( phdivn ) 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DOM/iscplini.F90

    r7646 r8568  
    1111   !!   iscpl_alloc    : allocation of correction variables 
    1212   !!---------------------------------------------------------------------- 
     13   USE oce             ! global tra/dyn variable 
    1314   USE dom_oce         ! ocean space and time domain 
    14    USE oce             ! global tra/dyn variable 
     15   ! 
    1516   USE lib_mpp         ! MPP library 
    1617   USE lib_fortran     ! MPP library 
    … …  
    4748   END FUNCTION iscpl_alloc 
    4849 
     50 
    4951   SUBROUTINE iscpl_init() 
     52      !!---------------------------------------------------------------------- 
    5053      INTEGER ::   ios           ! Local integer output status for namelist read 
    51       NAMELIST/namsbc_iscpl/nn_fiscpl,ln_hsb,nn_drown 
     54      NAMELIST/namsbc_iscpl/ nn_fiscpl, ln_hsb, nn_drown 
    5255      !!---------------------------------------------------------------------- 
    53       !                                   ! ============ 
    54       !                                   !   Namelist 
    55       !                                   ! ============ 
    5656      ! 
    5757      nn_fiscpl = 0 
    … …  
    7979         WRITE(numout,*) ' coupling time step                       = ', rdt_iscpl 
    8080         WRITE(numout,*) ' number of call of the extrapolation loop = ', nn_drown 
    81       END IF 
    82  
     81      ENDIF 
     82      ! 
    8383   END SUBROUTINE iscpl_init 
    8484 
     85   !!====================================================================== 
    8586END MODULE iscplini 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DOM/iscplrst.F90

    r7646 r8568  
    1111   !!   iscpl_rst_interpol : restart interpolation in case of coupling with ice sheet 
    1212   !!---------------------------------------------------------------------- 
     13   USE oce             ! global tra/dyn variable 
    1314   USE dom_oce         ! ocean space and time domain 
    1415   USE domwri          ! ocean space and time domain 
    15    USE domvvl, ONLY : dom_vvl_interpol 
     16   USE domvvl   , ONLY : dom_vvl_interpol 
    1617   USE phycst          ! physical constants 
    1718   USE sbc_oce         ! surface boundary condition variables 
    18    USE oce             ! global tra/dyn variable 
     19   USE iscplini        ! ice sheet coupling: initialisation 
     20   USE iscplhsb        ! ice sheet coupling: conservation 
     21   ! 
    1922   USE in_out_manager  ! I/O manager 
    2023   USE iom             ! I/O module 
    2124   USE lib_mpp         ! MPP library 
    2225   USE lib_fortran     ! MPP library 
    23    USE wrk_nemo        ! Memory allocation 
    2426   USE lbclnk          ! communication 
    25    USE iscplini        ! ice sheet coupling: initialisation 
    26    USE iscplhsb        ! ice sheet coupling: conservation 
    2727 
    2828   IMPLICIT NONE 
    … …  
    5050      !!---------------------------------------------------------------------- 
    5151      INTEGER  ::   inum0 
    52       REAL(wp), DIMENSION(:,:  ), POINTER ::   zsmask_b 
    53       REAL(wp), DIMENSION(:,:,:), POINTER ::   ztmask_b, zumask_b, zvmask_b 
    54       REAL(wp), DIMENSION(:,:,:), POINTER ::   ze3t_b  , ze3u_b  , ze3v_b   
    55       REAL(wp), DIMENSION(:,:,:), POINTER ::   zdepw_b 
     52      REAL(wp), DIMENSION(jpi,jpj)    ::   zsmask_b 
     53      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztmask_b, zumask_b, zvmask_b 
     54      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3t_b  , ze3u_b  , ze3v_b   
     55      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdepw_b 
    5656      CHARACTER(20) :: cfile 
    5757      !!---------------------------------------------------------------------- 
    58  
    59       CALL wrk_alloc(jpi,jpj,jpk,   ztmask_b, zumask_b, zvmask_b) ! mask before 
    60       CALL wrk_alloc(jpi,jpj,jpk,   ze3t_b  , ze3u_b  , ze3v_b  ) ! e3   before 
    61       CALL wrk_alloc(jpi,jpj,jpk,   zdepw_b ) 
    62       CALL wrk_alloc(jpi,jpj,       zsmask_b                    ) 
    63  
    64  
    65       !! get restart variable 
     58      ! 
     59      !                       ! get restart variable 
    6660      CALL iom_get( numror, jpdom_autoglo, 'tmask'  , ztmask_b   ) ! need to extrapolate T/S 
    6761      CALL iom_get( numror, jpdom_autoglo, 'umask'  , zumask_b   ) ! need to correct barotropic velocity 
    … …  
    7266      CALL iom_get( numror, jpdom_autoglo, 'e3v_n'  , ze3v_b(:,:,:) )  ! need to correct barotropic velocity 
    7367      CALL iom_get( numror, jpdom_autoglo, 'gdepw_n', zdepw_b(:,:,:) ) ! need to interpol vertical profile (vvl) 
    74  
    75       !! read namelist 
    76       CALL iscpl_init() 
    77  
    78       !!  ! Extrapolation/interpolation of modify cell and new cells ... (maybe do it later after domvvl) 
     68      ! 
     69      CALL iscpl_init()       ! read namelist 
     70      !                       ! Extrapolation/interpolation of modify cell and new cells ... (maybe do it later after domvvl) 
    7971      CALL iscpl_rst_interpol( ztmask_b, zumask_b, zvmask_b, zsmask_b, ze3t_b, ze3u_b, ze3v_b, zdepw_b ) 
    80  
    81       !! compute correction if conservation needed 
    82       IF ( ln_hsb ) THEN 
     72      ! 
     73      IF ( ln_hsb ) THEN      ! compute correction if conservation needed 
    8374         IF( iscpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'rst_iscpl : unable to allocate rst_iscpl arrays' ) 
    8475         CALL iscpl_cons(ztmask_b, zsmask_b, ze3t_b, htsc_iscpl, hdiv_iscpl, rdt_iscpl) 
    8576      END IF 
    8677          
    87       !! print mesh/mask 
    88       IF( nn_msh /= 0 .AND. ln_iscpl )   CALL dom_wri      ! Create a domain file 
    89  
     78      !                       ! create  a domain file 
     79      IF( nn_msh /= 0 .AND. ln_iscpl )   CALL dom_wri 
     80      ! 
    9081      IF ( ln_hsb ) THEN 
    9182         cfile='correction' 
    … …  
    9788         CALL iom_close ( inum0 ) 
    9889      END IF 
    99  
    100       CALL wrk_dealloc(jpi,jpj,jpk,   ztmask_b,zumask_b,zvmask_b )   
    101       CALL wrk_dealloc(jpi,jpj,jpk,   ze3t_b  ,ze3u_b  ,ze3v_b   )   
    102       CALL wrk_dealloc(jpi,jpj,jpk,   zdepw_b                    ) 
    103       CALL wrk_dealloc(jpi,jpj,       zsmask_b                   ) 
    104  
    105       !! next step is an euler time step 
    106       neuler = 0 
    107  
    108       !! set _b and _n variables equal 
     90      ! 
     91      neuler = 0              ! next step is an euler time step 
     92      ! 
     93      !                       ! set _b and _n variables equal 
    10994      tsb (:,:,:,:) = tsn (:,:,:,:) 
    11095      ub  (:,:,:)   = un  (:,:,:) 
    11196      vb  (:,:,:)   = vn  (:,:,:) 
    11297      sshb(:,:)     = sshn(:,:) 
    113  
    114       !! set _b and _n vertical scale factor equal 
     98      ! 
     99      !                       ! set _b and _n vertical scale factor equal 
    115100      e3t_b (:,:,:) = e3t_n (:,:,:) 
    116101      e3u_b (:,:,:) = e3u_n (:,:,:) 
    117102      e3v_b (:,:,:) = e3v_n (:,:,:) 
    118  
     103      ! 
    119104      e3uw_b (:,:,:) = e3uw_n (:,:,:) 
    120105      e3vw_b (:,:,:) = e3vw_n (:,:,:) 
    … …  
    150135      REAL(wp):: zdz, zdzm1, zdzp1 
    151136      !! 
    152       REAL(wp), DIMENSION(:,:    ), POINTER :: zdmask , zdsmask, zvcorr, zucorr, zde3t 
    153       REAL(wp), DIMENSION(:,:    ), POINTER :: zbub   , zbvb   , zbun  , zbvn 
    154       REAL(wp), DIMENSION(:,:    ), POINTER :: zssh0  , zssh1, zhu1, zhv1 
    155       REAL(wp), DIMENSION(:,:    ), POINTER :: zsmask0, zsmask1 
    156       REAL(wp), DIMENSION(:,:,:  ), POINTER :: ztmask0, ztmask1, ztrp 
    157       REAL(wp), DIMENSION(:,:,:  ), POINTER :: zwmaskn, zwmaskb, ztmp3d 
    158       REAL(wp), DIMENSION(:,:,:,:), POINTER :: zts0 
     137      REAL(wp), DIMENSION(jpi,jpj)          :: zdmask , zsmask0, zucorr, zbub, zbun, zssh0, zhu1, zde3t 
     138      REAL(wp), DIMENSION(jpi,jpj)          :: zdsmask, zsmask1, zvcorr, zbvb, zbvn, zssh1, zhv1 
     139      REAL(wp), DIMENSION(jpi,jpj,jpk)      :: ztmask0, zwmaskn, ztrp 
     140      REAL(wp), DIMENSION(jpi,jpj,jpk)      :: ztmask1, zwmaskb, ztmp3d 
     141      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts0 
    159142      !!---------------------------------------------------------------------- 
    160  
    161       !! allocate variables 
    162       CALL wrk_alloc(jpi,jpj,jpk,2, zts0                                   ) 
    163       CALL wrk_alloc(jpi,jpj,jpk,   ztmask0, ztmask1 , ztrp, ztmp3d        )  
    164       CALL wrk_alloc(jpi,jpj,jpk,   zwmaskn, zwmaskb                       )  
    165       CALL wrk_alloc(jpi,jpj,       zsmask0, zsmask1                       )  
    166       CALL wrk_alloc(jpi,jpj,       zdmask , zdsmask, zvcorr, zucorr, zde3t)  
    167       CALL wrk_alloc(jpi,jpj,       zbub   , zbvb    , zbun , zbvn         )  
    168       CALL wrk_alloc(jpi,jpj,       zssh0  , zssh1, zhu1, zhv1             )  
    169  
    170       !! mask value to be sure 
     143      ! 
     144      !                 ! mask value to be sure 
    171145      tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * ptmask_b(:,:,:) 
    172146      tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * ptmask_b(:,:,:) 
    173        
    174       ! compute wmask 
     147      ! 
     148      !                 ! compute wmask 
    175149      zwmaskn(:,:,1) = tmask   (:,:,1) 
    176150      zwmaskb(:,:,1) = ptmask_b(:,:,1) 
    … …  
    179153         zwmaskb(:,:,jk) = ptmask_b(:,:,jk) * ptmask_b(:,:,jk-1) 
    180154      END DO 
    181             
    182       ! compute new ssh if we open a full water column (average of the closest neigbourgs)   
     155      !     
     156      !                 ! compute new ssh if we open a full water column (average of the closest neigbourgs)   
    183157      sshb (:,:)=sshn(:,:) 
    184158      zssh0(:,:)=sshn(:,:) 
    185159      zsmask0(:,:) = psmask_b(:,:) 
    186160      zsmask1(:,:) = psmask_b(:,:) 
    187       DO iz = 1,10    ! need to be tuned (configuration dependent) (OK for ISOMIP+) 
     161      DO iz = 1, 10                 ! need to be tuned (configuration dependent) (OK for ISOMIP+) 
    188162         zdsmask(:,:) = ssmask(:,:)-zsmask0(:,:) 
    189163         DO jj = 2,jpj-1 
    … …  
    198172                  &           + zssh0(ji,jjm1)*zsmask0(ji,jjm1))/summsk 
    199173                  zsmask1(ji,jj)=1._wp 
    200                END IF 
     174               ENDIF 
    201175            END DO 
    202176         END DO 
    203          CALL lbc_lnk(sshn,'T',1._wp) 
    204          CALL lbc_lnk(zsmask1,'T',1._wp) 
     177         CALL lbc_lnk( sshn   , 'T', 1._wp ) 
     178         CALL lbc_lnk( zsmask1, 'T', 1._wp ) 
    205179         zssh0   = sshn 
    206180         zsmask0 = zsmask1 
    … …  
    210184!============================================================================= 
    211185!PM: Is this needed since introduction of VVL by default? 
    212       IF (.NOT.ln_linssh) THEN 
     186      IF ( .NOT.ln_linssh ) THEN 
    213187      ! Reconstruction of all vertical scale factors at now time steps 
    214188      ! ============================================================================= 
    … …  
    224198            END DO 
    225199         END DO 
    226  
     200         ! 
    227201         CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' ) 
    228202         CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 
    229203         CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' ) 
    230204 
    231       ! Vertical scale factor interpolations 
    232       ! ------------------------------------ 
     205         ! Vertical scale factor interpolations 
     206         ! ------------------------------------ 
    233207         CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  ) 
    234208         CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' ) 
    235209         CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) 
    236  
    237       ! t- and w- points depth 
    238       ! ---------------------- 
     210          
     211         ! t- and w- points depth 
     212         ! ---------------------- 
    239213         gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 
    240214         gdepw_n(:,:,1) = 0.0_wp 
    … …  
    429403      ! nothing to do 
    430404      !  
    431       ! deallocation tmp arrays 
    432       CALL wrk_dealloc(jpi,jpj,jpk,2, zts0                                   ) 
    433       CALL wrk_dealloc(jpi,jpj,jpk,   ztmask0, ztmask1 , ztrp                )  
    434       CALL wrk_dealloc(jpi,jpj,jpk,   zwmaskn, zwmaskb , ztmp3d              )  
    435       CALL wrk_dealloc(jpi,jpj,       zsmask0, zsmask1                       )  
    436       CALL wrk_dealloc(jpi,jpj,       zdmask , zdsmask, zvcorr, zucorr, zde3t)  
    437       CALL wrk_dealloc(jpi,jpj,       zbub   , zbvb    , zbun  , zbvn        )  
    438       CALL wrk_dealloc(jpi,jpj,       zssh0  , zssh1  , zhu1 , zhv1          )  
    439       ! 
    440405   END SUBROUTINE iscpl_rst_interpol 
    441406 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DOM/istate.F90

    r7753 r8568  
    3636   USE lib_mpp         ! MPP library 
    3737   USE restart         ! restart 
    38    USE wrk_nemo        ! Memory allocation 
    3938   USE timing          ! Timing 
    4039 
    … …  
    6059      !!---------------------------------------------------------------------- 
    6160      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    62       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zuvd    ! U & V data workspace 
     61!!gm see comment further down 
     62      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   zuvd    ! U & V data workspace 
     63!!gm end 
    6364      !!---------------------------------------------------------------------- 
    6465      ! 
    65       IF( nn_timing == 1 )   CALL timing_start('istate_init') 
     66      IF( ln_timing )   CALL timing_start('istate_init') 
    6667      ! 
    6768      IF(lwp) WRITE(numout,*) 
    … …  
    121122!!gm to be moved in usrdef of C1D case 
    122123!         IF ( ln_uvd_init .AND. lk_c1d ) THEN ! read 3D U and V data at nit000 
    123 !            CALL wrk_alloc( jpi,jpj,jpk,2,   zuvd ) 
     124!            ALLOCATE( zuvd(jpi,jpj,jpk,2) ) 
    124125!            CALL dta_uvd( nit000, zuvd ) 
    125126!            ub(:,:,:) = zuvd(:,:,:,1) ;  un(:,:,:) = ub(:,:,:) 
    126127!            vb(:,:,:) = zuvd(:,:,:,2) ;  vn(:,:,:) = vb(:,:,:) 
    127 !            CALL wrk_dealloc( jpi,jpj,jpk,2,  zuvd ) 
     128!            DEALLOCATE( zuvd ) 
    128129!         ENDIF 
    129130         ! 
    … …  
    164165      vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:) 
    165166      ! 
    166       IF( nn_timing == 1 )   CALL timing_stop('istate_init') 
     167      IF( ln_timing )   CALL timing_stop('istate_init') 
    167168      ! 
    168169   END SUBROUTINE istate_init 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DYN/divhor.F90

    r7753 r8568  
    2929   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    3030   USE lib_mpp         ! MPP library 
    31    USE wrk_nemo        ! Memory Allocation 
    3231   USE timing          ! Timing 
    3332 
    … …  
    4039#  include "vectopt_loop_substitute.h90" 
    4140   !!---------------------------------------------------------------------- 
    42    !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
     41   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    4342   !! $Id$  
    4443   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    6463      !!---------------------------------------------------------------------- 
    6564      ! 
    66       IF( nn_timing == 1 )   CALL timing_start('div_hor') 
     65      IF( ln_timing )   CALL timing_start('div_hor') 
    6766      ! 
    6867      IF( kt == nit000 ) THEN 
    … …  
    7574         DO jj = 2, jpjm1 
    7675            DO ji = fs_2, fs_jpim1   ! vector opt. 
    77                hdivn(ji,jj,jk) = (  e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) * un(ji  ,jj,jk)        & 
    78                   &               - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * un(ji-1,jj,jk)        & 
    79                   &               + e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * vn(ji,jj  ,jk)        & 
    80                   &               - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vn(ji,jj-1,jk)   )    & 
    81                   &            / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
     76               hdivn(ji,jj,jk) = (  e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) * un(ji  ,jj,jk)      & 
     77                  &               - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * un(ji-1,jj,jk)      & 
     78                  &               + e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * vn(ji,jj  ,jk)      & 
     79                  &               - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vn(ji,jj-1,jk)  )   & 
     80                  &            * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    8281            END DO   
    8382         END DO   
    … …  
    9089      END DO 
    9190      ! 
    92       IF( ln_rnf )   CALL sbc_rnf_div( hdivn )      !==  runoffs    ==!   (update hdivn field) 
     91      IF( ln_rnf )   CALL sbc_rnf_div( hdivn )              !==  runoffs    ==!   (update hdivn field) 
    9392      ! 
    94       IF( ln_isf )   CALL sbc_isf_div( hdivn )      !==  ice shelf  ==!   (update hdivn field) 
     93      IF( ln_isf )   CALL sbc_isf_div( hdivn )              !==  ice shelf  ==!   (update hdivn field) 
    9594      ! 
    96       IF( ln_iscpl .AND. ln_hsb ) CALL iscpl_div( hdivn ) !==  ice sheet  ==!   (update hdivn field) 
     95      IF( ln_iscpl .AND. ln_hsb )   CALL iscpl_div( hdivn ) !==  ice sheet  ==!   (update hdivn field) 
    9796      ! 
    98       CALL lbc_lnk( hdivn, 'T', 1. )                !==  lateral boundary cond.  ==!   (no sign change) 
     97      CALL lbc_lnk( hdivn, 'T', 1. )   !   (no sign change) 
    9998      ! 
    100       IF( nn_timing == 1 )  CALL timing_stop('div_hor') 
     99      IF( ln_timing )   CALL timing_stop('div_hor') 
    101100      ! 
    102101   END SUBROUTINE div_hor 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DYN/dynadv.F90

    r7646 r8568  
    77   !!            3.3  !  2010-10  (C. Ethe, G. Madec)  reorganisation of initialisation phase 
    88   !!            3.6  !  2015-05  (N. Ducousso, G. Madec)  add Hollingsworth scheme as an option  
     9   !!            4.0  !  2017-07  (G. Madec)  add a linear dynamics option 
    910   !!---------------------------------------------------------------------- 
    1011 
    … …  
    3031  
    3132   !                                    !* namdyn_adv namelist * 
    32    LOGICAL, PUBLIC ::   ln_dynadv_vec   !: vector form flag 
    33    INTEGER, PUBLIC ::   nn_dynkeg       !: scheme of kinetic energy gradient: =0 C2 ; =1 Hollingsworth 
     33   LOGICAL, PUBLIC ::   ln_dynadv_NONE  !: linear dynamics (no momentum advection) 
     34   LOGICAL, PUBLIC ::   ln_dynadv_vec   !: vector form 
     35   INTEGER, PUBLIC ::      nn_dynkeg       !: scheme of grad(KE): =0 C2 ; =1 Hollingsworth 
    3436   LOGICAL, PUBLIC ::   ln_dynadv_cen2  !: flux form - 2nd order centered scheme flag 
    3537   LOGICAL, PUBLIC ::   ln_dynadv_ubs   !: flux form - 3rd order UBS scheme flag 
    36    LOGICAL, PUBLIC ::   ln_dynzad_zts   !: vertical advection with sub-timestepping (requires vector form) 
    3738    
    38    INTEGER ::   nadv   ! choice of the formulation and scheme for the advection 
     39   INTEGER, PUBLIC ::   n_dynadv   !: choice of the formulation and scheme for momentum advection 
     40   !                               !  associated indices: 
     41   INTEGER, PUBLIC, PARAMETER ::   np_LIN_dyn = 0   ! no advection: linear dynamics 
     42   INTEGER, PUBLIC, PARAMETER ::   np_VEC_c2  = 1   ! vector form : 2nd order centered scheme 
     43   INTEGER, PUBLIC, PARAMETER ::   np_FLX_c2  = 2   ! flux   form : 2nd order centered scheme 
     44   INTEGER, PUBLIC, PARAMETER ::   np_FLX_ubs = 3   ! flux   form : 3rd order Upstream Biased Scheme 
    3945 
    4046   !! * Substitutions 
    4147#  include "vectopt_loop_substitute.h90" 
    4248   !!---------------------------------------------------------------------- 
    43    !! NEMO/OPA 3.6 , NEMO Consortium (2015) 
     49   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    4450   !! $Id$ 
    4551   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    5359      !! ** Purpose :   compute the ocean momentum advection trend. 
    5460      !! 
    55       !! ** Method  : - Update (ua,va) with the advection term following nadv 
     61      !! ** Method  : - Update (ua,va) with the advection term following n_dynadv 
     62      !! 
    5663      !!      NB: in flux form advection (ln_dynadv_cen2 or ln_dynadv_ubs=T)  
    5764      !!      a metric term is add to the coriolis term while in vector form  
    … …  
    6269      !!---------------------------------------------------------------------- 
    6370      ! 
    64       IF( nn_timing == 1 )  CALL timing_start('dyn_adv') 
     71      IF( ln_timing )   CALL timing_start( 'dyn_adv' ) 
    6572      ! 
    66       SELECT CASE ( nadv )                  ! compute advection trend and add it to general trend 
    67       CASE ( 0 )      
    68                       CALL dyn_keg     ( kt, nn_dynkeg )    ! vector form : horizontal gradient of kinetic energy 
    69                       CALL dyn_zad     ( kt )               ! vector form : vertical advection 
    70       CASE ( 1 )      
    71                       CALL dyn_keg     ( kt, nn_dynkeg )    ! vector form : horizontal gradient of kinetic energy 
    72                       CALL dyn_zad_zts ( kt )               ! vector form : vertical advection with sub-timestepping 
    73       CASE ( 2 )  
    74                       CALL dyn_adv_cen2( kt )               ! 2nd order centered scheme 
    75       CASE ( 3 )    
    76                       CALL dyn_adv_ubs ( kt )               ! 3rd order UBS      scheme 
     73      SELECT CASE( n_dynadv )    !==  compute advection trend and add it to general trend  ==! 
     74      CASE( np_VEC_c2  )      
     75         CALL dyn_keg     ( kt, nn_dynkeg )    ! vector form : horizontal gradient of kinetic energy 
     76         CALL dyn_zad     ( kt )               ! vector form : vertical advection 
     77      CASE( np_FLX_c2  )  
     78         CALL dyn_adv_cen2( kt )               ! 2nd order centered scheme 
     79      CASE( np_FLX_ubs )    
     80         CALL dyn_adv_ubs ( kt )               ! 3rd order UBS      scheme (UP3) 
    7781      END SELECT 
    7882      ! 
    79       IF( nn_timing == 1 )  CALL timing_stop('dyn_adv') 
     83      IF( ln_timing )   CALL timing_stop( 'dyn_adv' ) 
    8084      ! 
    8185   END SUBROUTINE dyn_adv 
    … …  
    8791      !!                 
    8892      !! ** Purpose :   Control the consistency between namelist options for  
    89       !!              momentum advection formulation & scheme and set nadv 
     93      !!              momentum advection formulation & scheme and set n_dynadv 
    9094      !!---------------------------------------------------------------------- 
    9195      INTEGER ::   ioptio, ios   ! Local integer 
    9296      ! 
    93       NAMELIST/namdyn_adv/ ln_dynadv_vec, nn_dynkeg, ln_dynadv_cen2 , ln_dynadv_ubs, ln_dynzad_zts 
     97      NAMELIST/namdyn_adv/ ln_dynadv_NONE, ln_dynadv_vec, nn_dynkeg, ln_dynadv_cen2, ln_dynadv_ubs 
    9498      !!---------------------------------------------------------------------- 
    9599      ! 
    … …  
    108112         WRITE(numout,*) '~~~~~~~~~~~~' 
    109113         WRITE(numout,*) '   Namelist namdyn_adv : chose a advection formulation & scheme for momentum' 
    110          WRITE(numout,*) '      Vector/flux form (T/F)                           ln_dynadv_vec  = ', ln_dynadv_vec 
    111          WRITE(numout,*) '      = 0 standard scheme  ; =1 Hollingsworth scheme   nn_dynkeg      = ', nn_dynkeg 
    112          WRITE(numout,*) '      2nd order centred advection scheme               ln_dynadv_cen2 = ', ln_dynadv_cen2 
    113          WRITE(numout,*) '      3rd order UBS advection scheme                   ln_dynadv_ubs  = ', ln_dynadv_ubs 
    114          WRITE(numout,*) '      Sub timestepping of vertical advection           ln_dynzad_zts  = ', ln_dynzad_zts 
     114         WRITE(numout,*) '      linear dynamics : no momentum advection          ln_dynadv_NONE = ', ln_dynadv_NONE 
     115         WRITE(numout,*) '      Vector form: 2nd order centered scheme           ln_dynadv_vec  = ', ln_dynadv_vec 
     116         WRITE(numout,*) '         with Hollingsworth scheme (=1) or not (=0)       nn_dynkeg   = ', nn_dynkeg 
     117         WRITE(numout,*) '      flux form: 2nd order centred scheme              ln_dynadv_cen2 = ', ln_dynadv_cen2 
     118         WRITE(numout,*) '                 3rd order UBS scheme                  ln_dynadv_ubs  = ', ln_dynadv_ubs 
    115119      ENDIF 
    116120 
    117       ioptio = 0                      ! Parameter control 
    118       IF( ln_dynadv_vec  )   ioptio = ioptio + 1 
    119       IF( ln_dynadv_cen2 )   ioptio = ioptio + 1 
    120       IF( ln_dynadv_ubs  )   ioptio = ioptio + 1 
     121      ioptio = 0                      ! parameter control and set n_dynadv 
     122      IF( ln_dynadv_NONE ) THEN   ;   ioptio = ioptio + 1   ;   n_dynadv = np_LIN_dyn   ;   ENDIF 
     123      IF( ln_dynadv_vec  ) THEN   ;   ioptio = ioptio + 1   ;   n_dynadv = np_VEC_c2    ;   ENDIF 
     124      IF( ln_dynadv_cen2 ) THEN   ;   ioptio = ioptio + 1   ;   n_dynadv = np_FLX_c2    ;   ENDIF 
     125      IF( ln_dynadv_ubs  ) THEN   ;   ioptio = ioptio + 1   ;   n_dynadv = np_FLX_ubs   ;   ENDIF 
    121126 
    122       IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namdyn_adv' ) 
    123       IF( ln_dynzad_zts .AND. .NOT. ln_dynadv_vec )   & 
    124          CALL ctl_stop( 'Sub timestepping of vertical advection requires vector form; set ln_dynadv_vec = .TRUE.' ) 
    125       IF( nn_dynkeg /= nkeg_C2 .AND. nn_dynkeg /= nkeg_HW )   &   
    126          CALL ctl_stop( 'KEG scheme wrong value of nn_dynkeg' ) 
     127      IF( ioptio /= 1 )   CALL ctl_stop( 'choose ONE and only ONE advection scheme' ) 
     128      IF( nn_dynkeg /= nkeg_C2 .AND. nn_dynkeg /= nkeg_HW )   CALL ctl_stop( 'KEG scheme wrong value of nn_dynkeg' ) 
    127129 
    128       !                               ! Set nadv 
    129       IF( ln_dynadv_vec  )   nadv =  0  
    130       IF( ln_dynzad_zts  )   nadv =  1 
    131       IF( ln_dynadv_cen2 )   nadv =  2 
    132       IF( ln_dynadv_ubs  )   nadv =  3 
    133130 
    134131      IF(lwp) THEN                    ! Print the choice 
    135132         WRITE(numout,*) 
    136          IF( nadv ==  0 )   WRITE(numout,*) '      ===>>   vector form : keg + zad + vor is used'  
    137          IF( nadv ==  1 )   WRITE(numout,*) '      ===>>   vector form : keg + zad_zts + vor is used' 
    138          IF( nadv ==  0 .OR. nadv ==  1 ) THEN 
     133         SELECT CASE( n_dynadv ) 
     134         CASE( np_LIN_dyn )   ;   WRITE(numout,*) '      ===>>   linear dynamics : no momentum advection used' 
     135         CASE( np_VEC_c2  )   ;   WRITE(numout,*) '      ===>>   vector form : keg + zad + vor is used'  
    139136            IF( nn_dynkeg == nkeg_C2  )   WRITE(numout,*) '              with Centered standard keg scheme' 
    140137            IF( nn_dynkeg == nkeg_HW  )   WRITE(numout,*) '              with Hollingsworth keg scheme' 
    141          ENDIF 
    142          IF( nadv ==  2 )   WRITE(numout,*) '      ===>>   flux form   : 2nd order scheme is used' 
    143          IF( nadv ==  3 )   WRITE(numout,*) '      ===>>   flux form   : UBS       scheme is used' 
     138         CASE( np_FLX_c2  )   ;   WRITE(numout,*) '      ===>>   flux form   : 2nd order scheme is used' 
     139         CASE( np_FLX_ubs )   ;   WRITE(numout,*) '      ===>>   flux form   : UBS      scheme is used' 
     140         END SELECT 
    144141      ENDIF 
    145142      ! 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DYN/dynadv_cen2.F90

    r6750 r8568  
    2020   USE lib_mpp        ! MPP library 
    2121   USE prtctl         ! Print control 
    22    USE wrk_nemo       ! Memory Allocation 
    2322   USE timing         ! Timing 
    2423 
    … …  
    3130#  include "vectopt_loop_substitute.h90" 
    3231   !!---------------------------------------------------------------------- 
    33    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     32   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    3433   !! $Id$ 
    3534   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    5150      ! 
    5251      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    53       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfw 
    54       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zfu, zfv 
     52      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zfu_t, zfu_f, zfu_uw, zfu 
     53      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zfv_t, zfv_f, zfv_vw, zfv, zfw 
    5554      !!---------------------------------------------------------------------- 
    5655      ! 
    57       IF( nn_timing == 1 )  CALL timing_start('dyn_adv_cen2') 
    58       ! 
    59       CALL wrk_alloc( jpi,jpj,jpk,   zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw ) 
     56      IF( ln_timing )   CALL timing_start('dyn_adv_cen2') 
    6057      ! 
    6158      IF( kt == nit000 .AND. lwp ) THEN 
    … …  
    148145         &                       tab3d_2=va, clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    149146      ! 
    150       CALL wrk_dealloc( jpi, jpj, jpk, zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw ) 
    151       ! 
    152       IF( nn_timing == 1 )  CALL timing_stop('dyn_adv_cen2') 
     147      IF( ln_timing )   CALL timing_stop('dyn_adv_cen2') 
    153148      ! 
    154149   END SUBROUTINE dyn_adv_cen2 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DYN/dynadv_ubs.F90

    r6750 r8568  
    2323   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    2424   USE lib_mpp        ! MPP library 
    25    USE wrk_nemo       ! Memory Allocation 
    2625   USE timing         ! Timing 
    2726 
    … …  
    3736#  include "vectopt_loop_substitute.h90" 
    3837   !!---------------------------------------------------------------------- 
    39    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     38   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    4039   !! $Id$ 
    4140   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    7473      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    7574      REAL(wp) ::   zui, zvj, zfuj, zfvi, zl_u, zl_v   ! local scalars 
    76       REAL(wp), POINTER, DIMENSION(:,:,:  ) ::  zfu, zfv 
    77       REAL(wp), POINTER, DIMENSION(:,:,:  ) ::  zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfw 
    78       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zlu_uu, zlv_vv, zlu_uv, zlv_vu 
     75      REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zfu_t, zfu_f, zfu_uw, zfu 
     76      REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zfv_t, zfv_f, zfv_vw, zfv, zfw 
     77      REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   zlu_uu, zlu_uv 
     78      REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   zlv_vv, zlv_vu 
    7979      !!---------------------------------------------------------------------- 
    8080      ! 
    81       IF( nn_timing == 1 )  CALL timing_start('dyn_adv_ubs') 
    82       ! 
    83       CALL wrk_alloc( jpi,jpj,jpk,        zfu_t , zfv_t , zfu_f , zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw ) 
    84       CALL wrk_alloc( jpi,jpj,jpk,jpts,   zlu_uu, zlv_vv, zlu_uv, zlv_vu                               ) 
     81      IF( ln_timing )   CALL timing_start('dyn_adv_ubs') 
    8582      ! 
    8683      IF( kt == nit000 ) THEN 
    … …  
    241238         &                       tab3d_2=va, clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    242239      ! 
    243       CALL wrk_dealloc( jpi,jpj,jpk,        zfu_t , zfv_t , zfu_f , zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw ) 
    244       CALL wrk_dealloc( jpi,jpj,jpk,jpts,   zlu_uu, zlv_vv, zlu_uv, zlv_vu                               ) 
    245       ! 
    246       IF( nn_timing == 1 )  CALL timing_stop('dyn_adv_ubs') 
     240      IF( ln_timing )   CALL timing_stop('dyn_adv_ubs') 
    247241      ! 
    248242   END SUBROUTINE dyn_adv_ubs 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DYN/dynbfr.F90

    r8367 r8568  
    5757      !!--------------------------------------------------------------------- 
    5858      ! 
    59       IF( nn_timing == 1 )  CALL timing_start('dyn_bfr') 
     59      IF( ln_timing )   CALL timing_start('dyn_bfr') 
    6060      ! 
    6161!!gm bug : time step is only rdt (not 2 rdt if euler start !) 
    … …  
    109109         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    110110      ! 
    111       IF( nn_timing == 1 )  CALL timing_stop('dyn_bfr') 
     111      IF( ln_timing )   CALL timing_stop('dyn_bfr') 
    112112      ! 
    113113   END SUBROUTINE dyn_bfr 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DYN/dynhpg.F90

    r8367 r8568  
    4444   USE lib_mpp         ! MPP library 
    4545   USE eosbn2          ! compute density 
    46    USE wrk_nemo        ! Memory Allocation 
    4746   USE timing          ! Timing 
    4847   USE iom 
    … …  
    8483      !!---------------------------------------------------------------------- 
    8584      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    86       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
    87       !!---------------------------------------------------------------------- 
    88       ! 
    89       IF( nn_timing == 1 )  CALL timing_start('dyn_hpg') 
     85      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv 
     86      !!---------------------------------------------------------------------- 
     87      ! 
     88      IF( ln_timing )   CALL timing_start('dyn_hpg') 
    9089      ! 
    9190      IF( l_trddyn ) THEN                    ! Temporary saving of ua and va trends (l_trddyn) 
    92          CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
     91         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 
    9392         ztrdu(:,:,:) = ua(:,:,:) 
    9493         ztrdv(:,:,:) = va(:,:,:) 
    … …  
    108107         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    109108         CALL trd_dyn( ztrdu, ztrdv, jpdyn_hpg, kt ) 
    110          CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
     109         DEALLOCATE( ztrdu , ztrdv ) 
    111110      ENDIF 
    112111      ! 
    … …  
    114113         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    115114      ! 
    116       IF( nn_timing == 1 )  CALL timing_stop('dyn_hpg') 
     115      IF( ln_timing )   CALL timing_stop('dyn_hpg') 
    117116      ! 
    118117   END SUBROUTINE dyn_hpg 
    … …  
    134133      INTEGER  ::   ji, jj, jk, ikt    ! dummy loop indices      ISF 
    135134      REAL(wp) ::   znad 
    136       REAL(wp), POINTER, DIMENSION(:,:,:)   ::  ztstop, zrhd ! hypothesys on isf density 
    137       REAL(wp), POINTER, DIMENSION(:,:)     ::  zrhdtop_isf  ! density at bottom of ISF 
    138       REAL(wp), POINTER, DIMENSION(:,:)     ::  ziceload     ! density at bottom of ISF 
     135      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  zts_top, zrhd  ! hypothesys on isf density 
     136      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::  zrhdtop_isf    ! density at bottom of ISF 
     137      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::  ziceload       ! density at bottom of ISF 
    139138      !! 
    140139      NAMELIST/namdyn_hpg/ ln_hpg_zco, ln_hpg_zps, ln_hpg_sco,     & 
    … …  
    165164      ! 
    166165      IF( ln_hpg_djc )   & 
    167          &   CALL ctl_stop('dyn_hpg_init : Density Jacobian: Cubic polynominal method & 
    168                            & currently disabled (bugs under investigation). Please select & 
    169                            & either  ln_hpg_sco or  ln_hpg_prj instead') 
    170       ! 
    171       IF( .NOT.ln_linssh .AND. .NOT.(ln_hpg_sco.OR.ln_hpg_prj.OR.ln_hpg_isf) )        & 
    172          &   CALL ctl_stop('dyn_hpg_init : non-linear free surface requires either ', & 
    173          &                 '   the standard jacobian formulation hpg_sco    or '    , & 
    174          &                 '   the pressure jacobian formulation hpg_prj'            ) 
    175  
    176       IF(       ln_hpg_isf .AND. .NOT. ln_isfcav )   & 
    177          &   CALL ctl_stop( ' hpg_isf not available if ln_isfcav = false ' ) 
    178       IF( .NOT. ln_hpg_isf .AND.       ln_isfcav )   & 
    179          &   CALL ctl_stop( 'Only hpg_isf has been corrected to work with ice shelf cavity.' ) 
     166         &   CALL ctl_stop('dyn_hpg_init : Density Jacobian: Cubic polynominal method',   & 
     167         &                 '   currently disabled (bugs under investigation).'        ,   & 
     168         &                 '   Please select either  ln_hpg_sco or  ln_hpg_prj instead' ) 
     169         ! 
     170      IF( .NOT.ln_linssh .AND. .NOT.(ln_hpg_sco.OR.ln_hpg_prj.OR.ln_hpg_isf) )          & 
     171         &   CALL ctl_stop('dyn_hpg_init : non-linear free surface requires either ',   & 
     172         &                 '   the standard jacobian formulation hpg_sco    or '    ,   & 
     173         &                 '   the pressure jacobian formulation hpg_prj'             ) 
     174         ! 
     175      IF( ln_hpg_isf ) THEN 
     176         IF( .NOT. ln_isfcav )   CALL ctl_stop( ' hpg_isf not available if ln_isfcav = false ' ) 
     177       ELSE 
     178         IF(       ln_isfcav )   CALL ctl_stop( 'Only hpg_isf has been corrected to work with ice shelf cavity.' ) 
     179      ENDIF 
    180180      ! 
    181181      !                               ! Set nhpg from ln_hpg_... flags 
    … …  
    197197      IF( ioptio /= 1 )   CALL ctl_stop( 'NO or several hydrostatic pressure gradient options used' ) 
    198198      !  
    199       ! initialisation of ice shelf load 
    200       IF ( .NOT. ln_isfcav ) riceload(:,:)=0.0 
    201       IF (       ln_isfcav ) THEN 
    202          CALL wrk_alloc( jpi,jpj, 2,  ztstop)  
    203          CALL wrk_alloc( jpi,jpj,jpk, zrhd  ) 
    204          CALL wrk_alloc( jpi,jpj,     zrhdtop_isf, ziceload)  
     199      !                           
     200      IF ( .NOT. ln_isfcav ) THEN     !--- no ice shelf load 
     201         riceload(:,:) = 0._wp 
     202         ! 
     203      ELSE                            !--- set an ice shelf load 
    205204         ! 
    206205         IF(lwp) WRITE(numout,*) 
    207          IF(lwp) WRITE(numout,*) 'dyn:hpg_isf : hydrostatic pressure gradient trend for ice shelf' 
    208          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'   
    209  
    210          ! To use density and not density anomaly 
    211          znad=1._wp 
    212           
    213          ! assume water displaced by the ice shelf is at T=-1.9 and S=34.4 (rude) 
    214          ztstop(:,:,1)=-1.9_wp ; ztstop(:,:,2)=34.4_wp 
    215  
    216          ! compute density of the water displaced by the ice shelf  
    217          DO jk = 1, jpk 
    218             CALL eos(ztstop(:,:,:),gdept_n(:,:,jk),zrhd(:,:,jk)) 
    219          END DO 
    220        
    221          ! compute rhd at the ice/oce interface (ice shelf side) 
    222          CALL eos(ztstop,risfdep,zrhdtop_isf) 
    223  
    224          ! Surface value + ice shelf gradient 
    225          ! compute pressure due to ice shelf load (used to compute hpgi/j for all the level from 1 to miku/v) 
    226          ! divided by 2 later 
    227          ziceload = 0._wp 
    228          DO jj = 1, jpj 
    229             DO ji = 1, jpi 
    230                ikt=mikt(ji,jj) 
     206         IF(lwp) WRITE(numout,*) '   ice shelf case: set the ice-shelf load' 
     207         ALLOCATE( zts_top(jpi,jpj,jpts) , zrhd(jpi,jpj,jpk) , zrhdtop_isf(jpi,jpj) , ziceload(jpi,jpj) )  
     208         ! 
     209         znad = 1._wp                     !- To use density and not density anomaly 
     210         ! 
     211         !                                !- assume water displaced by the ice shelf is at T=-1.9 and S=34.4 (rude) 
     212         zts_top(:,:,jp_tem) = -1.9_wp   ;   zts_top(:,:,jp_sal) = 34.4_wp 
     213         ! 
     214         DO jk = 1, jpk                   !- compute density of the water displaced by the ice shelf  
     215            CALL eos( zts_top(:,:,:), gdept_n(:,:,jk), zrhd(:,:,jk) ) 
     216         END DO 
     217         ! 
     218         !                                !- compute rhd at the ice/oce interface (ice shelf side) 
     219         CALL eos( zts_top , risfdep, zrhdtop_isf ) 
     220         ! 
     221         !                                !- Surface value + ice shelf gradient 
     222         ziceload = 0._wp                       ! compute pressure due to ice shelf load  
     223         DO jj = 1, jpj                         ! (used to compute hpgi/j for all the level from 1 to miku/v) 
     224            DO ji = 1, jpi                      ! divided by 2 later 
     225               ikt = mikt(ji,jj) 
    231226               ziceload(ji,jj) = ziceload(ji,jj) + (znad + zrhd(ji,jj,1) ) * e3w_n(ji,jj,1) * (1._wp - tmask(ji,jj,1)) 
    232                DO jk=2,ikt-1 
     227               DO jk = 2, ikt-1 
    233228                  ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhd(ji,jj,jk-1) + zrhd(ji,jj,jk)) * e3w_n(ji,jj,jk) & 
    234229                     &                              * (1._wp - tmask(ji,jj,jk)) 
    235230               END DO 
    236231               IF (ikt  >=  2) ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhdtop_isf(ji,jj) + zrhd(ji,jj,ikt-1)) & 
    237                                   &                              * ( risfdep(ji,jj) - gdept_1d(ikt-1) ) 
    238             END DO 
    239          END DO 
    240          riceload(:,:)=ziceload(:,:)  ! need to be saved for diaar5 
    241  
    242          CALL wrk_dealloc( jpi,jpj, 2,  ztstop)  
    243          CALL wrk_dealloc( jpi,jpj,jpk, zrhd  ) 
    244          CALL wrk_dealloc( jpi,jpj,     zrhdtop_isf, ziceload)  
    245       END IF 
     232                  &                                              * ( risfdep(ji,jj) - gdept_1d(ikt-1) ) 
     233            END DO 
     234         END DO 
     235         riceload(:,:) = ziceload(:,:)  ! need to be saved for diaar5 
     236         ! 
     237         DEALLOCATE( zts_top , zrhd , zrhdtop_isf , ziceload )  
     238      ENDIF 
    246239      ! 
    247240   END SUBROUTINE dyn_hpg_init 
    … …  
    268261      INTEGER  ::   ji, jj, jk       ! dummy loop indices 
    269262      REAL(wp) ::   zcoef0, zcoef1   ! temporary scalars 
    270       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj 
    271       !!---------------------------------------------------------------------- 
    272       ! 
    273       CALL wrk_alloc( jpi,jpj,jpk,   zhpi, zhpj ) 
     263      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zhpi, zhpj 
     264      !!---------------------------------------------------------------------- 
    274265      ! 
    275266      IF( kt == nit000 ) THEN 
    … …  
    315306      END DO 
    316307      ! 
    317       CALL wrk_dealloc( jpi,jpj,jpk,   zhpi, zhpj ) 
    318       ! 
    319308   END SUBROUTINE hpg_zco 
    320309 
    … …  
    333322      INTEGER  ::   iku, ikv                         ! temporary integers 
    334323      REAL(wp) ::   zcoef0, zcoef1, zcoef2, zcoef3   ! temporary scalars 
    335       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj 
    336       !!---------------------------------------------------------------------- 
    337       ! 
    338       CALL wrk_alloc( jpi,jpj,jpk,   zhpi, zhpj ) 
     324      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zhpi, zhpj 
     325      !!---------------------------------------------------------------------- 
    339326      ! 
    340327      IF( kt == nit000 ) THEN 
    … …  
    405392      END DO 
    406393      ! 
    407       CALL wrk_dealloc( jpi,jpj,jpk,   zhpi, zhpj ) 
    408       ! 
    409394   END SUBROUTINE hpg_zps 
    410395 
    … …  
    433418      REAL(wp) ::   zcoef0, zuap, zvap, znad, ztmp       ! temporary scalars 
    434419      LOGICAL  ::   ll_tmp1, ll_tmp2                     ! local logical variables 
    435       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj 
    436       REAL(wp), POINTER, DIMENSION(:,:)   ::  zcpx, zcpy !W/D pressure filter 
    437       !!---------------------------------------------------------------------- 
    438       ! 
    439       CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj ) 
    440       IF( ln_wd ) CALL wrk_alloc( jpi,jpj, zcpx, zcpy ) 
     420      REAL(wp), DIMENSION(jpi,jpj,jpk)      ::   zhpi, zhpj 
     421      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zcpx, zcpy   !W/D pressure filter 
     422      !!---------------------------------------------------------------------- 
    441423      ! 
    442424      IF( kt == nit000 ) THEN 
    … …  
    452434      ! 
    453435      IF( ln_wd ) THEN 
    454         DO jj = 2, jpjm1 
    455            DO ji = 2, jpim1  
    456              ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                & 
     436         ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 
     437         DO jj = 2, jpjm1 
     438            DO ji = 2, jpim1  
     439               ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                & 
    457440                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) .AND.            & 
    458441                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji+1,jj) + ht_wd(ji+1,jj) ) & 
    459442                  &                                                         > rn_wdmin1 + rn_wdmin2 
    460              ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji+1,jj) ) > 1.E-12 ) .AND. (             & 
     443               ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji+1,jj) ) > 1.E-12 ) .AND. (             & 
    461444                  &    MAX(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                & 
    462445                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 ) 
    463446 
    464              IF(ll_tmp1) THEN 
    465                zcpx(ji,jj) = 1.0_wp 
    466              ELSE IF(ll_tmp2) THEN 
    467                ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here 
    468                zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) & 
    469                            &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) ) 
    470              ELSE 
    471                zcpx(ji,jj) = 0._wp 
    472              END IF 
    473        
    474              ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                & 
     447               IF(ll_tmp1) THEN 
     448                  zcpx(ji,jj) = 1.0_wp 
     449               ELSE IF(ll_tmp2) THEN 
     450                  ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here 
     451                  zcpx(ji,jj) = ABS(   ( sshn(ji+1,jj)+ht_wd(ji+1,jj) - sshn(ji,jj)-ht_wd(ji,jj) )  & 
     452                     &                / ( sshn(ji+1,jj)                - sshn(ji,jj)              )  ) 
     453               ELSE 
     454                  zcpx(ji,jj) = 0._wp 
     455               ENDIF 
     456               ! 
     457               ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                & 
    475458                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) .AND.            & 
    476459                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji,jj+1) + ht_wd(ji,jj+1) ) & 
    477460                  &                                                         > rn_wdmin1 + rn_wdmin2 
    478              ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji,jj+1) ) > 1.E-12 ) .AND. (             & 
     461               ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji,jj+1) ) > 1.E-12 ) .AND. (             & 
    479462                  &    MAX(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                & 
    480463                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 ) 
    481  
    482              IF(ll_tmp1) THEN 
    483                zcpy(ji,jj) = 1.0_wp 
    484              ELSE IF(ll_tmp2) THEN 
    485                ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here 
    486                zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) & 
    487                            &    / (sshn(ji,jj+1) -  sshn(ji,jj  )) ) 
    488              ELSE 
    489                zcpy(ji,jj) = 0._wp 
    490              END IF 
    491            END DO 
    492         END DO 
    493         CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp ) 
    494       END IF 
     464                  ! 
     465               IF(ll_tmp1) THEN 
     466                  zcpy(ji,jj) = 1.0_wp 
     467               ELSE IF(ll_tmp2) THEN 
     468                  ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here 
     469                  zcpy(ji,jj) = ABS(   ( sshn(ji,jj+1)+ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj) )  & 
     470                     &               / ( sshn(ji,jj+1)                - sshn(ji,jj)                )  ) 
     471               ELSE 
     472                  zcpy(ji,jj) = 0._wp 
     473               ENDIF 
     474            END DO 
     475         END DO 
     476         CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp ) 
     477      ENDIF 
    495478 
    496479      ! Surface value 
    … …  
    507490            zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) + 2._wp * znad )   & 
    508491               &           * ( gde3w_n(ji,jj+1,1) - gde3w_n(ji,jj,1) ) * r1_e2v(ji,jj) 
    509  
    510  
     492            ! 
    511493            IF( ln_wd ) THEN 
    512  
    513               zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj) 
    514               zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj)  
    515               zuap = zuap * zcpx(ji,jj) 
    516               zvap = zvap * zcpy(ji,jj) 
     494               zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj) 
     495               zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj)  
     496               zuap = zuap * zcpx(ji,jj) 
     497               zvap = zvap * zcpy(ji,jj) 
    517498            ENDIF 
    518  
     499            ! 
    519500            ! add to the general momentum trend 
    520501            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap 
    … …  
    539520               zvap = -zcoef0 * ( rhd    (ji  ,jj+1,jk) + rhd    (ji,jj,jk) + 2._wp * znad )   & 
    540521                  &           * ( gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk) ) * r1_e2v(ji,jj) 
    541  
     522               ! 
    542523               IF( ln_wd ) THEN 
    543                  zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj) 
    544                  zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj)  
    545                  zuap = zuap * zcpx(ji,jj) 
    546                  zvap = zvap * zcpy(ji,jj) 
    547                ENDIF 
    548  
     524                  zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj) 
     525                  zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj)  
     526                  zuap = zuap * zcpx(ji,jj) 
     527                  zvap = zvap * zcpy(ji,jj) 
     528               ENDIF 
     529               ! 
    549530               ! add to the general momentum trend 
    550531               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) + zuap 
    … …  
    554535      END DO 
    555536      ! 
    556       CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj ) 
    557       IF( ln_wd ) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy ) 
     537      IF( ln_wd )   DEALLOCATE( zcpx , zcpy ) 
    558538      ! 
    559539   END SUBROUTINE hpg_sco 
    … …  
    583563      INTEGER  ::   ji, jj, jk, ikt, iktp1i, iktp1j   ! dummy loop indices 
    584564      REAL(wp) ::   zcoef0, zuap, zvap, znad          ! temporary scalars 
    585       REAL(wp), POINTER, DIMENSION(:,:,:)   ::  zhpi, zhpj 
    586       REAL(wp), POINTER, DIMENSION(:,:,:)   ::  ztstop 
    587       REAL(wp), POINTER, DIMENSION(:,:)     ::  zrhdtop_oce 
    588       !!---------------------------------------------------------------------- 
    589       ! 
    590       CALL wrk_alloc( jpi,jpj,  2, ztstop)  
    591       CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj) 
    592       CALL wrk_alloc( jpi,jpj,     zrhdtop_oce ) 
    593       ! 
    594       ! Local constant initialization 
    595       zcoef0 = - grav * 0.5_wp 
    596    
    597       ! To use density and not density anomaly 
    598       znad=1._wp 
    599  
    600       ! iniitialised to 0. zhpi zhpi  
    601       zhpi(:,:,:)=0._wp ; zhpj(:,:,:)=0._wp 
     565      REAL(wp), DIMENSION(jpi,jpj,jpk ) ::  zhpi, zhpj 
     566      REAL(wp), DIMENSION(jpi,jpj,jpts) ::  zts_top 
     567      REAL(wp), DIMENSION(jpi,jpj)      ::  zrhdtop_oce 
     568      !!---------------------------------------------------------------------- 
     569      ! 
     570      zcoef0 = - grav * 0.5_wp   ! Local constant initialization 
     571      ! 
     572      znad=1._wp                 ! To use density and not density anomaly 
     573      ! 
     574      !                          ! iniitialised to 0. zhpi zhpi  
     575      zhpi(:,:,:) = 0._wp   ;   zhpj(:,:,:) = 0._wp 
    602576 
    603577      ! compute rhd at the ice/oce interface (ocean side) 
    604578      ! usefull to reduce residual current in the test case ISOMIP with no melting 
    605       DO ji=1,jpi 
    606         DO jj=1,jpj 
    607           ikt=mikt(ji,jj) 
    608           ztstop(ji,jj,1)=tsn(ji,jj,ikt,1) 
    609           ztstop(ji,jj,2)=tsn(ji,jj,ikt,2) 
     579      DO ji = 1, jpi 
     580        DO jj = 1, jpj 
     581          ikt = mikt(ji,jj) 
     582          zts_top(ji,jj,1) = tsn(ji,jj,ikt,1) 
     583          zts_top(ji,jj,2) = tsn(ji,jj,ikt,2) 
    610584        END DO 
    611585      END DO 
    612       CALL eos( ztstop, risfdep, zrhdtop_oce ) 
     586      CALL eos( zts_top, risfdep, zrhdtop_oce ) 
    613587 
    614588!==================================================================================      
    … …  
    667641         END DO 
    668642      END DO 
    669      ! 
    670       CALL wrk_dealloc( jpi,jpj,2  , ztstop) 
    671       CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj) 
    672       CALL wrk_dealloc( jpi,jpj    , zrhdtop_oce ) 
    673643      ! 
    674644   END SUBROUTINE hpg_isf 
    … …  
    690660      REAL(wp) ::   z1_12, cffv, cffy   !    "         " 
    691661      LOGICAL  ::   ll_tmp1, ll_tmp2    ! local logical variables 
    692       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj 
    693       REAL(wp), POINTER, DIMENSION(:,:,:) ::  dzx, dzy, dzz, dzu, dzv, dzw 
    694       REAL(wp), POINTER, DIMENSION(:,:,:) ::  drhox, drhoy, drhoz, drhou, drhov, drhow 
    695       REAL(wp), POINTER, DIMENSION(:,:,:) ::  rho_i, rho_j, rho_k 
    696       REAL(wp), POINTER, DIMENSION(:,:)   ::  zcpx, zcpy    !W/D pressure filter 
    697       !!---------------------------------------------------------------------- 
    698       ! 
    699       CALL wrk_alloc( jpi, jpj, jpk, dzx  , dzy  , dzz  , dzu  , dzv  , dzw   ) 
    700       CALL wrk_alloc( jpi, jpj, jpk, drhox, drhoy, drhoz, drhou, drhov, drhow ) 
    701       CALL wrk_alloc( jpi, jpj, jpk, rho_i, rho_j, rho_k,  zhpi,  zhpj        ) 
    702       IF( ln_wd ) CALL wrk_alloc( jpi,jpj, zcpx, zcpy ) 
    703       ! 
     662      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zhpi, zhpj 
     663      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   dzx, dzy, dzz, dzu, dzv, dzw 
     664      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   drhox, drhoy, drhoz, drhou, drhov, drhow 
     665      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   rho_i, rho_j, rho_k 
     666      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zcpx, zcpy   !W/D pressure filter 
     667      !!---------------------------------------------------------------------- 
    704668      ! 
    705669      IF( ln_wd ) THEN 
    706         DO jj = 2, jpjm1 
    707            DO ji = 2, jpim1  
    708              ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                & 
     670         ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 
     671         DO jj = 2, jpjm1 
     672            DO ji = 2, jpim1  
     673               ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                & 
    709674                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) .AND.            & 
    710675                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji+1,jj) + ht_wd(ji+1,jj) ) & 
    711676                  &                                                         > rn_wdmin1 + rn_wdmin2 
    712              ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji+1,jj) ) > 1.E-12 ) .AND. (             & 
     677               ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji+1,jj) ) > 1.E-12 ) .AND. (             & 
    713678                  &    MAX(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                & 
    714679                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 ) 
    715680 
    716              IF(ll_tmp1) THEN 
    717                zcpx(ji,jj) = 1.0_wp 
    718              ELSE IF(ll_tmp2) THEN 
    719                ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here 
    720                zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) & 
    721                            &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) ) 
    722              ELSE 
    723                zcpx(ji,jj) = 0._wp 
    724              END IF 
     681               IF(ll_tmp1) THEN 
     682                  zcpx(ji,jj) = 1.0_wp 
     683               ELSE IF(ll_tmp2) THEN 
     684                  ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here 
     685                  zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) & 
     686                              &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) ) 
     687               ELSE 
     688                  zcpx(ji,jj) = 0._wp 
     689               ENDIF 
    725690       
    726              ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                & 
     691               ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                & 
    727692                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) .AND.            & 
    728693                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji,jj+1) + ht_wd(ji,jj+1) ) & 
    729694                  &                                                         > rn_wdmin1 + rn_wdmin2 
    730              ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji,jj+1) ) > 1.E-12 ) .AND. (             & 
     695               ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji,jj+1) ) > 1.E-12 ) .AND. (             & 
    731696                  &    MAX(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                & 
    732697                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 ) 
    733698 
    734              IF(ll_tmp1) THEN 
    735                zcpy(ji,jj) = 1.0_wp 
    736              ELSE IF(ll_tmp2) THEN 
    737                ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here 
    738                zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) & 
    739                            &    / (sshn(ji,jj+1) -  sshn(ji,jj  )) ) 
    740              ELSE 
    741                zcpy(ji,jj) = 0._wp 
    742              END IF 
    743            END DO 
    744         END DO 
    745         CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp ) 
    746       END IF 
     699               IF(ll_tmp1) THEN 
     700                  zcpy(ji,jj) = 1.0_wp 
     701               ELSE IF(ll_tmp2) THEN 
     702                  ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here 
     703                  zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) & 
     704                              &    / (sshn(ji,jj+1) -  sshn(ji,jj  )) ) 
     705               ELSE 
     706                  zcpy(ji,jj) = 0._wp 
     707               ENDIF 
     708            END DO 
     709         END DO 
     710         CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp ) 
     711      ENDIF 
    747712 
    748713      IF( kt == nit000 ) THEN 
    … …  
    903868         END DO 
    904869      END DO 
    905       CALL lbc_lnk(rho_k,'W',1.) 
    906       CALL lbc_lnk(rho_i,'U',1.) 
    907       CALL lbc_lnk(rho_j,'V',1.) 
     870      CALL lbc_lnk( rho_k, 'W', 1. ) 
     871      CALL lbc_lnk( rho_i, 'U', 1. ) 
     872      CALL lbc_lnk( rho_j, 'V', 1. ) 
    908873 
    909874 
    … …  
    949914      END DO 
    950915      ! 
    951       CALL wrk_dealloc( jpi, jpj, jpk, dzx  , dzy  , dzz  , dzu  , dzv  , dzw   ) 
    952       CALL wrk_dealloc( jpi, jpj, jpk, drhox, drhoy, drhoz, drhou, drhov, drhow ) 
    953       CALL wrk_dealloc( jpi, jpj, jpk, rho_i, rho_j, rho_k,  zhpi,  zhpj        ) 
    954       IF( ln_wd ) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy ) 
     916      IF( ln_wd )   DEALLOCATE( zcpx, zcpy ) 
    955917      ! 
    956918   END SUBROUTINE hpg_djc 
    … …  
    980942      REAL(wp) :: zrhdt1 
    981943      REAL(wp) :: zdpdx1, zdpdx2, zdpdy1, zdpdy2 
    982       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdept, zrhh 
    983       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp 
    984       REAL(wp), POINTER, DIMENSION(:,:)   ::   zsshu_n, zsshv_n 
    985       REAL(wp), POINTER, DIMENSION(:,:)   ::  zcpx, zcpy    !W/D pressure filter 
    986       !!---------------------------------------------------------------------- 
    987       ! 
    988       CALL wrk_alloc( jpi,jpj,jpk,   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp ) 
    989       CALL wrk_alloc( jpi,jpj,jpk,   zdept, zrhh ) 
    990       CALL wrk_alloc( jpi,jpj,       zsshu_n, zsshv_n ) 
    991       IF( ln_wd ) CALL wrk_alloc( jpi,jpj, zcpx, zcpy ) 
     944      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdept, zrhh 
     945      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp 
     946      REAL(wp), DIMENSION(jpi,jpj)   ::   zsshu_n, zsshv_n 
     947      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zcpx, zcpy   !W/D pressure filter 
     948      !!---------------------------------------------------------------------- 
    992949      ! 
    993950      IF( kt == nit000 ) THEN 
    … …  
    1003960 
    1004961      IF( ln_wd ) THEN 
    1005         DO jj = 2, jpjm1 
    1006            DO ji = 2, jpim1  
    1007              ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                & 
     962         ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 
     963         DO jj = 2, jpjm1 
     964            DO ji = 2, jpim1  
     965               ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                & 
    1008966                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) .AND.            & 
    1009967                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji+1,jj) + ht_wd(ji+1,jj) ) & 
    1010968                  &                                                         > rn_wdmin1 + rn_wdmin2 
    1011              ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji+1,jj) ) > 1.E-12 ) .AND. (             & 
     969               ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji+1,jj) ) > 1.E-12 ) .AND. (             & 
    1012970                  &    MAX(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                & 
    1013971                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 ) 
    1014972 
    1015              IF(ll_tmp1) THEN 
    1016                zcpx(ji,jj) = 1.0_wp 
    1017              ELSE IF(ll_tmp2) THEN 
    1018                ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here 
    1019                zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) & 
    1020                            &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) ) 
    1021              ELSE 
    1022                zcpx(ji,jj) = 0._wp 
    1023              END IF 
     973               IF(ll_tmp1) THEN 
     974                  zcpx(ji,jj) = 1.0_wp 
     975               ELSE IF(ll_tmp2) THEN 
     976                  ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here 
     977                  zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) & 
     978                             &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) ) 
     979               ELSE 
     980                  zcpx(ji,jj) = 0._wp 
     981               ENDIF 
    1024982       
    1025              ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                & 
     983               ll_tmp1 = MIN(   sshn(ji,jj)             ,   sshn(ji,jj+1) ) >                & 
    1026984                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) .AND.            & 
    1027985                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji,jj+1) + ht_wd(ji,jj+1) ) & 
    1028986                  &                                                         > rn_wdmin1 + rn_wdmin2 
    1029              ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji,jj+1) ) > 1.E-12 ) .AND. (             & 
     987               ll_tmp2 = ( ABS( sshn(ji,jj)             -   sshn(ji,jj+1) ) > 1.E-12 ) .AND. (             & 
    1030988                  &    MAX(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                & 
    1031989                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 ) 
    1032990 
    1033              IF(ll_tmp1) THEN 
    1034                zcpy(ji,jj) = 1.0_wp 
    1035              ELSE IF(ll_tmp2) THEN 
    1036                ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here 
    1037                zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) & 
     991               IF(ll_tmp1) THEN 
     992                  zcpy(ji,jj) = 1.0_wp 
     993               ELSE IF(ll_tmp2) THEN 
     994                  ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here 
     995                  zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) & 
    1038996                           &    / (sshn(ji,jj+1) -  sshn(ji,jj  )) ) 
    1039              ELSE 
    1040                zcpy(ji,jj) = 0._wp 
    1041              END IF 
    1042            END DO 
    1043         END DO 
    1044         CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp ) 
    1045       END IF 
     997               ELSE 
     998                  zcpy(ji,jj) = 0._wp 
     999               ENDIF 
     1000            END DO 
     1001         END DO 
     1002         CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp ) 
     1003      ENDIF 
    10461004 
    10471005      ! Clean 3-D work arrays 
    … …  
    12981256      END DO 
    12991257      ! 
    1300       CALL wrk_dealloc( jpi,jpj,jpk,   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp ) 
    1301       CALL wrk_dealloc( jpi,jpj,jpk,   zdept, zrhh ) 
    1302       CALL wrk_dealloc( jpi,jpj,       zsshu_n, zsshv_n ) 
    1303       IF( ln_wd ) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy ) 
     1258      IF( ln_wd )   DEALLOCATE( zcpx, zcpy ) 
    13041259      ! 
    13051260   END SUBROUTINE hpg_prj 
    … …  
    13531308           !!Simply geometric average 
    13541309               DO jk = 2, jpkm1-1 
    1355                   zdf1 = (fsp(ji,jj,jk) - fsp(ji,jj,jk-1)) / (xsp(ji,jj,jk) - xsp(ji,jj,jk-1)) 
    1356                   zdf2 = (fsp(ji,jj,jk+1) - fsp(ji,jj,jk)) / (xsp(ji,jj,jk+1) - xsp(ji,jj,jk)) 
     1310                  zdf1 = (fsp(ji,jj,jk  ) - fsp(ji,jj,jk-1)) / (xsp(ji,jj,jk  ) - xsp(ji,jj,jk-1)) 
     1311                  zdf2 = (fsp(ji,jj,jk+1) - fsp(ji,jj,jk  )) / (xsp(ji,jj,jk+1) - xsp(ji,jj,jk  )) 
    13571312 
    13581313                  IF(zdf1 * zdf2 <= 0._wp) THEN 
    … …  
    14031358            END DO 
    14041359         END DO 
    1405  
     1360         ! 
    14061361      ELSE 
    1407            CALL ctl_stop( 'invalid polynomial type in cspline' ) 
    1408       ENDIF 
    1409  
     1362         CALL ctl_stop( 'invalid polynomial type in cspline' ) 
     1363      ENDIF 
     1364      ! 
    14101365   END SUBROUTINE cspline 
    14111366 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DYN/dynkeg.F90

    r7753 r8568  
    2222   USE lib_mpp         ! MPP library 
    2323   USE prtctl          ! Print control 
    24    USE wrk_nemo        ! Memory Allocation 
    2524   USE timing          ! Timing 
    2625   USE bdy_oce         ! ocean open boundary conditions 
    … …  
    3938#  include "vectopt_loop_substitute.h90" 
    4039   !!---------------------------------------------------------------------- 
    41    !! NEMO/OPA 3.6 , NEMO Consortium (2015) 
     40   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    4241   !! $Id$  
    4342   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    7574      INTEGER, INTENT( in ) ::   kscheme   ! =0/1   type of KEG scheme  
    7675      ! 
    77       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    78       REAL(wp) ::   zu, zv       ! temporary scalars 
    79       REAL(wp), POINTER, DIMENSION(:,:,:) :: zhke 
    80       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv  
    81       INTEGER  ::   jb                 ! dummy loop indices 
    82       INTEGER  ::   ii, ij, igrd, ib_bdy   ! local integers 
    83       INTEGER  ::   fu, fv 
     76      INTEGER  ::   ji, jj, jk, jb    ! dummy loop indices 
     77      INTEGER  ::   ii, ifu, ib_bdy   ! local integers 
     78      INTEGER  ::   ij, ifv, igrd     !   -       - 
     79      REAL(wp) ::   zu, zv            ! local scalars 
     80      REAL(wp), DIMENSION(jpi,jpj,jpk)        ::   zhke 
     81      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv  
    8482      !!---------------------------------------------------------------------- 
    8583      ! 
    86       IF( nn_timing == 1 )   CALL timing_start('dyn_keg') 
    87       ! 
    88       CALL wrk_alloc( jpi,jpj,jpk,   zhke ) 
     84      IF( ln_timing )   CALL timing_start('dyn_keg') 
    8985      ! 
    9086      IF( kt == nit000 ) THEN 
    … …  
    9490      ENDIF 
    9591 
    96       IF( l_trddyn ) THEN           ! Save ua and va trends 
    97          CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
     92      IF( l_trddyn ) THEN           ! Save the input trends 
     93         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 
    9894         ztrdu(:,:,:) = ua(:,:,:)  
    9995         ztrdv(:,:,:) = va(:,:,:)  
    … …  
    112108                     ii   = idx_bdy(ib_bdy)%nbi(jb,igrd) 
    113109                     ij   = idx_bdy(ib_bdy)%nbj(jb,igrd) 
    114                      fu   = NINT( idx_bdy(ib_bdy)%flagu(jb,igrd) ) 
    115                      un(ii-fu,ij,jk) = un(ii,ij,jk) * umask(ii,ij,jk) 
     110                     ifu   = NINT( idx_bdy(ib_bdy)%flagu(jb,igrd) ) 
     111                     un(ii-ifu,ij,jk) = un(ii,ij,jk) * umask(ii,ij,jk) 
    116112                  END DO 
    117113               END DO 
    … …  
    122118                     ii   = idx_bdy(ib_bdy)%nbi(jb,igrd) 
    123119                     ij   = idx_bdy(ib_bdy)%nbj(jb,igrd) 
    124                      fv   = NINT( idx_bdy(ib_bdy)%flagv(jb,igrd) ) 
    125                      vn(ii,ij-fv,jk) = vn(ii,ij,jk) * vmask(ii,ij,jk) 
     120                     ifv   = NINT( idx_bdy(ib_bdy)%flagv(jb,igrd) ) 
     121                     vn(ii,ij-ifv,jk) = vn(ii,ij,jk) * vmask(ii,ij,jk) 
    126122                  END DO 
    127123               END DO 
    … …  
    172168      ENDIF       
    173169 
    174  
    175170      ! 
    176171      DO jk = 1, jpkm1                    !==  grad( KE ) added to the general momentum trends  ==! 
    … …  
    187182         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    188183         CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt ) 
    189          CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
     184         DEALLOCATE( ztrdu , ztrdv ) 
    190185      ENDIF 
    191186      ! 
    … …  
    193188         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    194189      ! 
    195       CALL wrk_dealloc( jpi,jpj,jpk,   zhke ) 
    196       ! 
    197       IF( nn_timing == 1 )   CALL timing_stop('dyn_keg') 
     190      IF( ln_timing )   CALL timing_stop('dyn_keg') 
    198191      ! 
    199192   END SUBROUTINE dyn_keg 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DYN/dynldf.F90

    r8367 r8568  
    2727   USE lib_mpp        ! distribued memory computing library 
    2828   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    29    USE wrk_nemo       ! Memory Allocation 
    3029   USE timing         ! Timing 
    3130 
    … …  
    4847#  include "vectopt_loop_substitute.h90" 
    4948   !!---------------------------------------------------------------------- 
    50    !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
     49   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    5150   !! $Id$ 
    5251   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    6261      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    6362      ! 
    64       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
     63      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv 
    6564      !!---------------------------------------------------------------------- 
    6665      ! 
    67       IF( nn_timing == 1 )  CALL timing_start('dyn_ldf') 
     66      IF( ln_timing )   CALL timing_start('dyn_ldf') 
    6867      ! 
    6968      IF( l_trddyn )   THEN                      ! temporary save of momentum trends 
    70          CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
     69         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 
    7170         ztrdu(:,:,:) = ua(:,:,:)  
    7271         ztrdv(:,:,:) = va(:,:,:)  
    … …  
    8584         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    8685         CALL trd_dyn( ztrdu, ztrdv, jpdyn_ldf, kt ) 
    87          CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
     86         DEALLOCATE ( ztrdu , ztrdv ) 
    8887      ENDIF 
    8988      !                                          ! print sum trends (used for debugging) 
    … …  
    9190         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    9291      ! 
    93       IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf') 
     92      IF( ln_timing )   CALL timing_stop('dyn_ldf') 
    9493      ! 
    9594   END SUBROUTINE dyn_ldf 
    … …  
    102101      !! ** Purpose :   initializations of the horizontal ocean dynamics physics 
    103102      !!---------------------------------------------------------------------- 
    104       INTEGER ::   ioptio, ierr         ! temporary integers  
     103      INTEGER ::   ioptio, ierr   ! temporary integers  
    105104      !!---------------------------------------------------------------------- 
    106105      ! 
    107       !                                   ! Namelist nam_dynldf: already read in ldfdyn module 
     106      !                                !==  Namelist nam_dynldf  ==!  already read in ldfdyn module 
    108107      ! 
    109       IF(lwp) THEN                        ! Namelist print 
     108      IF(lwp) THEN                     !== Namelist print  ==! 
    110109         WRITE(numout,*) 
    111110         WRITE(numout,*) 'dyn_ldf_init : Choice of the lateral diffusive operator on dynamics' 
    112111         WRITE(numout,*) '~~~~~~~~~~~~' 
    113112         WRITE(numout,*) '   Namelist nam_dynldf : set lateral mixing parameters (type, direction, coefficients)' 
    114          WRITE(numout,*) '      laplacian operator          ln_dynldf_lap = ', ln_dynldf_lap 
    115          WRITE(numout,*) '      bilaplacian operator        ln_dynldf_blp = ', ln_dynldf_blp 
    116          WRITE(numout,*) '      iso-level                   ln_dynldf_lev = ', ln_dynldf_lev 
    117          WRITE(numout,*) '      horizontal (geopotential)   ln_dynldf_hor = ', ln_dynldf_hor 
    118          WRITE(numout,*) '      iso-neutral                 ln_dynldf_iso = ', ln_dynldf_iso 
     113         WRITE(numout,*) '      Type of operator' 
     114         WRITE(numout,*) '         no explicit diffusion       ln_dynldf_NONE = ', ln_dynldf_NONE 
     115         WRITE(numout,*) '         laplacian operator          ln_dynldf_lap  = ', ln_dynldf_lap 
     116         WRITE(numout,*) '         bilaplacian operator        ln_dynldf_blp  = ', ln_dynldf_blp 
     117         WRITE(numout,*) '      Direction of action' 
     118         WRITE(numout,*) '         iso-level                   ln_dynldf_lev  = ', ln_dynldf_lev 
     119         WRITE(numout,*) '         horizontal (geopotential)   ln_dynldf_hor  = ', ln_dynldf_hor 
     120         WRITE(numout,*) '         iso-neutral                 ln_dynldf_iso  = ', ln_dynldf_iso 
    119121      ENDIF 
    120       !                                   ! use of lateral operator or not 
     122      !                                !==  use of lateral operator or not  ==! 
    121123      nldf = np_ERROR 
    122124      ioptio = 0 
    123       IF( ln_dynldf_lap )   ioptio = ioptio + 1 
    124       IF( ln_dynldf_blp )   ioptio = ioptio + 1 
    125       IF( ioptio >  1   )   CALL ctl_stop( 'dyn_ldf_init: use ONE or NONE of the 2 lap/bilap operator type on momentum' ) 
    126       IF( ioptio == 0   )   nldf = np_no_ldf     ! No lateral mixing operator 
     125      IF( ln_dynldf_NONE ) THEN   ;   nldf = np_no_ldf   ;   ioptio = ioptio + 1   ;   ENDIF 
     126      IF( ln_dynldf_lap  ) THEN   ;                          ioptio = ioptio + 1   ;   ENDIF 
     127      IF( ln_dynldf_blp  ) THEN   ;                          ioptio = ioptio + 1   ;   ENDIF 
     128      IF( ioptio /= 1    )   CALL ctl_stop( 'dyn_ldf_init: use ONE of the 3 operator options (NONE/lap/blp)' ) 
    127129      ! 
    128       IF( nldf /= np_no_ldf ) THEN        ! direction ==>> type of operator   
     130      IF(.NOT.ln_dynldf_NONE ) THEN    !==  direction ==>> type of operator  ==! 
    129131         ioptio = 0 
    130132         IF( ln_dynldf_lev )   ioptio = ioptio + 1 
    131133         IF( ln_dynldf_hor )   ioptio = ioptio + 1 
    132134         IF( ln_dynldf_iso )   ioptio = ioptio + 1 
    133          IF( ioptio >  1   )   CALL ctl_stop( '          use only ONE direction (level/hor/iso)' ) 
    134          IF( ioptio == 0   )   CALL ctl_stop( '          use at least ONE direction (level/hor/iso)' ) 
     135         IF( ioptio /= 1   )   CALL ctl_stop( 'dyn_ldf_init: use ONE of the 3 direction options (level/hor/iso)' ) 
    135136         ! 
    136          !                                   ! Set nldf, the type of lateral diffusion, from ln_dynldf_... logicals 
     137         !                             ! Set nldf, the type of lateral diffusion, from ln_dynldf_... logicals 
    137138         ierr = 0 
    138          IF ( ln_dynldf_lap ) THEN      ! laplacian operator 
    139             IF ( ln_zco ) THEN                ! z-coordinate 
     139         IF( ln_dynldf_lap ) THEN         ! laplacian operator 
     140            IF( ln_zco ) THEN                ! z-coordinate 
    140141               IF ( ln_dynldf_lev )   nldf = np_lap     ! iso-level = horizontal (no rotation) 
    141142               IF ( ln_dynldf_hor )   nldf = np_lap     ! iso-level = horizontal (no rotation) 
    142143               IF ( ln_dynldf_iso )   nldf = np_lap_i   ! iso-neutral            (   rotation) 
    143144            ENDIF 
    144             IF ( ln_zps ) THEN             ! z-coordinate with partial step 
     145            IF( ln_zps ) THEN                ! z-coordinate with partial step 
    145146               IF ( ln_dynldf_lev )   nldf = np_lap     ! iso-level              (no rotation) 
    146147               IF ( ln_dynldf_hor )   nldf = np_lap     ! iso-level              (no rotation) 
    147148               IF ( ln_dynldf_iso )   nldf = np_lap_i   ! iso-neutral            (   rotation) 
    148149            ENDIF 
    149             IF ( ln_sco ) THEN             ! s-coordinate 
     150            IF( ln_sco ) THEN                ! s-coordinate 
    150151               IF ( ln_dynldf_lev )   nldf = np_lap     ! iso-level = horizontal (no rotation) 
    151152               IF ( ln_dynldf_hor )   nldf = np_lap_i   ! horizontal             (   rotation) 
    … …  
    154155         ENDIF 
    155156         ! 
    156          IF( ln_dynldf_blp ) THEN          ! bilaplacian operator 
    157             IF ( ln_zco ) THEN                ! z-coordinate 
    158                IF ( ln_dynldf_lev )   nldf = np_blp     ! iso-level = horizontal (no rotation) 
    159                IF ( ln_dynldf_hor )   nldf = np_blp     ! iso-level = horizontal (no rotation) 
    160                IF ( ln_dynldf_iso )   ierr = 2          ! iso-neutral            (   rotation) 
     157         IF( ln_dynldf_blp ) THEN         ! bilaplacian operator 
     158            IF( ln_zco ) THEN                ! z-coordinate 
     159               IF( ln_dynldf_lev )   nldf = np_blp     ! iso-level = horizontal (no rotation) 
     160               IF( ln_dynldf_hor )   nldf = np_blp     ! iso-level = horizontal (no rotation) 
     161               IF( ln_dynldf_iso )   ierr = 2          ! iso-neutral            (   rotation) 
    161162            ENDIF 
    162             IF ( ln_zps ) THEN             ! z-coordinate with partial step 
    163                IF ( ln_dynldf_lev )   nldf = np_blp     ! iso-level              (no rotation) 
    164                IF ( ln_dynldf_hor )   nldf = np_blp     ! iso-level              (no rotation) 
    165                IF ( ln_dynldf_iso )   ierr = 2          ! iso-neutral            (   rotation) 
     163            IF( ln_zps ) THEN                ! z-coordinate with partial step 
     164               IF( ln_dynldf_lev )   nldf = np_blp     ! iso-level              (no rotation) 
     165               IF( ln_dynldf_hor )   nldf = np_blp     ! iso-level              (no rotation) 
     166               IF( ln_dynldf_iso )   ierr = 2          ! iso-neutral            (   rotation) 
    166167            ENDIF 
    167             IF ( ln_sco ) THEN             ! s-coordinate 
    168                IF ( ln_dynldf_lev )   nldf = np_blp     ! iso-level              (no rotation) 
    169                IF ( ln_dynldf_hor )   ierr = 2          ! horizontal             (   rotation) 
    170                IF ( ln_dynldf_iso )   ierr = 2          ! iso-neutral            (   rotation) 
     168            IF( ln_sco ) THEN                ! s-coordinate 
     169               IF( ln_dynldf_lev )   nldf = np_blp     ! iso-level              (no rotation) 
     170               IF( ln_dynldf_hor )   ierr = 2          ! horizontal             (   rotation) 
     171               IF( ln_dynldf_iso )   ierr = 2          ! iso-neutral            (   rotation) 
    171172            ENDIF 
    172173         ENDIF 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DYN/dynldf_iso.F90

    r8367 r8568  
    2828   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2929   USE prtctl          ! Print control 
    30    USE wrk_nemo        ! Memory Allocation 
    3130   USE timing          ! Timing 
    3231 
    … …  
    4544#  include "vectopt_loop_substitute.h90" 
    4645   !!---------------------------------------------------------------------- 
    47    !! NEMO/OPA 3.3 , NEMO Consortium (2011) 
     46   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    4847   !! $Id$ 
    4948   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    108107      ! 
    109108      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    110       REAL(wp) ::   zabe1, zabe2, zcof1, zcof2                       ! local scalars 
    111       REAL(wp) ::   zmskt, zmskf                                     !   -      - 
    112       REAL(wp) ::   zcoef0, zcoef3, zcoef4, zmkt, zmkf               !   -      - 
    113       REAL(wp) ::   zuav, zvav, zuwslpi, zuwslpj, zvwslpi, zvwslpj   !   -      - 
    114       ! 
    115       REAL(wp), POINTER, DIMENSION(:,:) :: ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v 
     109      REAL(wp) ::   zabe1, zmskt, zmkt, zuav, zuwslpi, zuwslpj   ! local scalars 
     110      REAL(wp) ::   zabe2, zmskf, zmkf, zvav, zvwslpi, zvwslpj   !   -      - 
     111      REAL(wp) ::   zcof0, zcof1, zcof2, zcof3, zcof4            !   -      - 
     112      REAL(wp), DIMENSION(jpi,jpj) ::   ziut, zivf, zdku, zdk1u  ! 2D workspace 
     113      REAL(wp), DIMENSION(jpi,jpj) ::   zjuf, zjvt, zdkv, zdk1v  !  -      - 
    116114      !!---------------------------------------------------------------------- 
    117115      ! 
    118       IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_iso') 
    119       ! 
    120       CALL wrk_alloc( jpi, jpj, ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v )  
     116      IF( ln_timing )   CALL timing_start('dyn_ldf_iso') 
    121117      ! 
    122118      IF( kt == nit000 ) THEN 
    … …  
    343339         DO jk = 2, jpkm1 
    344340            DO ji = 2, jpim1 
    345                zcoef0= 0.5 * rn_aht_0 * umask(ji,jj,jk) 
     341               zcof0 = 0.5_wp * rn_aht_0 * umask(ji,jj,jk) 
    346342               ! 
    347                zuwslpi = zcoef0 * ( wslpi(ji+1,jj,jk) + wslpi(ji,jj,jk) ) 
    348                zuwslpj = zcoef0 * ( wslpj(ji+1,jj,jk) + wslpj(ji,jj,jk) ) 
     343               zuwslpi = zcof0 * ( wslpi(ji+1,jj,jk) + wslpi(ji,jj,jk) ) 
     344               zuwslpj = zcof0 * ( wslpj(ji+1,jj,jk) + wslpj(ji,jj,jk) ) 
    349345               ! 
    350                zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji+1,jj,jk-1)   & 
    351                              + tmask(ji,jj,jk  )+tmask(ji+1,jj,jk  ), 1. ) 
    352                zmkf = 1./MAX(  fmask(ji,jj-1,jk-1) + fmask(ji,jj,jk-1)   & 
    353                              + fmask(ji,jj-1,jk  ) + fmask(ji,jj,jk  ), 1. ) 
    354  
    355                zcoef3 = - e2u(ji,jj) * zmkt * zuwslpi 
    356                zcoef4 = - e1u(ji,jj) * zmkf * zuwslpj 
     346               zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji+1,jj,jk-1)      & 
     347                             + tmask(ji,jj,jk  )+tmask(ji+1,jj,jk  ) , 1. ) 
     348               zmkf = 1./MAX(  fmask(ji,jj-1,jk-1) + fmask(ji,jj,jk-1)      & 
     349                             + fmask(ji,jj-1,jk  ) + fmask(ji,jj,jk  ) , 1. ) 
     350 
     351               zcof3 = - e2u(ji,jj) * zmkt * zuwslpi 
     352               zcof4 = - e1u(ji,jj) * zmkf * zuwslpj 
    357353               ! vertical flux on u field 
    358                zfuw(ji,jk) = zcoef3 * ( zdiu (ji,jk-1) + zdiu (ji+1,jk-1)     & 
    359                                        +zdiu (ji,jk  ) + zdiu (ji+1,jk  ) )   & 
    360                            + zcoef4 * ( zdj1u(ji,jk-1) + zdju (ji  ,jk-1)     & 
    361                                        +zdj1u(ji,jk  ) + zdju (ji  ,jk  ) ) 
     354               zfuw(ji,jk) = zcof3 * (  zdiu (ji,jk-1) + zdiu (ji+1,jk-1)      & 
     355                  &                   + zdiu (ji,jk  ) + zdiu (ji+1,jk  ) )   & 
     356                  &        + zcof4 * (  zdj1u(ji,jk-1) + zdju (ji  ,jk-1)      & 
     357                  &                   + zdj1u(ji,jk  ) + zdju (ji  ,jk  ) ) 
    362358               ! vertical mixing coefficient (akzu) 
    363                ! Note: zcoef0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0 
     359               ! Note: zcof0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0 
    364360               akzu(ji,jj,jk) = ( zuwslpi * zuwslpi + zuwslpj * zuwslpj ) / rn_aht_0 
    365361            END DO 
    … …  
    369365         DO jk = 2, jpkm1 
    370366            DO ji = 2, jpim1 
    371                zcoef0 = 0.5 * rn_aht_0 * vmask(ji,jj,jk) 
    372  
    373                zvwslpi = zcoef0 * ( wslpi(ji,jj+1,jk) + wslpi(ji,jj,jk) ) 
    374                zvwslpj = zcoef0 * ( wslpj(ji,jj+1,jk) + wslpj(ji,jj,jk) ) 
    375  
    376                zmkf = 1./MAX(  fmask(ji-1,jj,jk-1)+fmask(ji,jj,jk-1)   & 
    377                              + fmask(ji-1,jj,jk  )+fmask(ji,jj,jk  ), 1. ) 
    378                zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji,jj+1,jk-1)   & 
    379                              + tmask(ji,jj,jk  )+tmask(ji,jj+1,jk  ), 1. ) 
    380  
    381                zcoef3 = - e2v(ji,jj) * zmkf * zvwslpi 
    382                zcoef4 = - e1v(ji,jj) * zmkt * zvwslpj 
     367               zcof0 = 0.5_wp * rn_aht_0 * vmask(ji,jj,jk) 
     368               ! 
     369               zvwslpi = zcof0 * ( wslpi(ji,jj+1,jk) + wslpi(ji,jj,jk) ) 
     370               zvwslpj = zcof0 * ( wslpj(ji,jj+1,jk) + wslpj(ji,jj,jk) ) 
     371               ! 
     372               zmkf = 1./MAX(  fmask(ji-1,jj,jk-1)+fmask(ji,jj,jk-1)      & 
     373                  &          + fmask(ji-1,jj,jk  )+fmask(ji,jj,jk  ) , 1. ) 
     374               zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji,jj+1,jk-1)      & 
     375                  &          + tmask(ji,jj,jk  )+tmask(ji,jj+1,jk  ) , 1. ) 
     376 
     377               zcof3 = - e2v(ji,jj) * zmkf * zvwslpi 
     378               zcof4 = - e1v(ji,jj) * zmkt * zvwslpj 
    383379               ! vertical flux on v field 
    384                zfvw(ji,jk) = zcoef3 * ( zdiv (ji,jk-1) + zdiv (ji-1,jk-1)     & 
    385                   &                    +zdiv (ji,jk  ) + zdiv (ji-1,jk  ) )   & 
    386                   &        + zcoef4 * ( zdjv (ji,jk-1) + zdj1v(ji  ,jk-1)     & 
    387                   &                    +zdjv (ji,jk  ) + zdj1v(ji  ,jk  ) ) 
     380               zfvw(ji,jk) = zcof3 * (  zdiv (ji,jk-1) + zdiv (ji-1,jk-1)      & 
     381                  &                   + zdiv (ji,jk  ) + zdiv (ji-1,jk  ) )   & 
     382                  &        + zcof4 * (  zdjv (ji,jk-1) + zdj1v(ji  ,jk-1)      & 
     383                  &                   + zdjv (ji,jk  ) + zdj1v(ji  ,jk  ) ) 
    388384               ! vertical mixing coefficient (akzv) 
    389                ! Note: zcoef0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0 
     385               ! Note: zcof0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0 
    390386               akzv(ji,jj,jk) = ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) / rn_aht_0 
    391387            END DO 
    … …  
    404400      END DO                                           !   End of slab 
    405401      !                                                ! =============== 
    406       CALL wrk_dealloc( jpi, jpj, ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v )  
    407402      ! 
    408       IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_iso') 
     403      IF( ln_timing )   CALL timing_stop('dyn_ldf_iso') 
    409404      ! 
    410405   END SUBROUTINE dyn_ldf_iso 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DYN/dynldf_lap_blp.F90

    r7753 r8568  
    1919   USE in_out_manager ! I/O manager 
    2020   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    21    USE wrk_nemo       ! Memory Allocation 
    2221   USE timing         ! Timing 
    2322 
    … …  
    3130#  include "vectopt_loop_substitute.h90" 
    3231   !!---------------------------------------------------------------------- 
    33    !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
     32   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    3433   !! $Id$  
    3534   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    5756      REAL(wp) ::   zsign        ! local scalars 
    5857      REAL(wp) ::   zua, zva     ! local scalars 
    59       REAL(wp), POINTER, DIMENSION(:,:) ::  zcur, zdiv 
     58      REAL(wp), DIMENSION(jpi,jpj) ::   zcur, zdiv 
    6059      !!---------------------------------------------------------------------- 
    6160      ! 
    … …  
    6665      ENDIF 
    6766      ! 
    68       IF( nn_timing == 1 )   CALL timing_start('dyn_ldf_lap') 
    69       ! 
    70       CALL wrk_alloc( jpi, jpj, zcur, zdiv )  
     67      IF( ln_timing )   CALL timing_start('dyn_ldf_lap') 
    7168      ! 
    7269      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign 
    … …  
    107104      END DO                                           !   End of slab 
    108105      !                                                ! =============== 
    109       CALL wrk_dealloc( jpi, jpj, zcur, zdiv )  
    110106      ! 
    111       IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_lap') 
     107      IF( ln_timing )   CALL timing_stop('dyn_ldf_lap') 
    112108      ! 
    113109   END SUBROUTINE dyn_ldf_lap 
    … …  
    131127      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva   ! momentum trend 
    132128      ! 
    133       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zulap, zvlap   ! laplacian at u- and v-point 
     129      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zulap, zvlap   ! laplacian at u- and v-point 
    134130      !!---------------------------------------------------------------------- 
    135131      ! 
    136       IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_blp') 
    137       ! 
    138       CALL wrk_alloc( jpi, jpj, jpk, zulap, zvlap )  
     132      IF( ln_timing )   CALL timing_start('dyn_ldf_blp') 
    139133      ! 
    140134      IF( kt == nit000 )  THEN 
    … …  
    154148      CALL dyn_ldf_lap( kt, zulap, zvlap, pua, pva, 2 )   ! rotated laplacian applied to zlap (output in pta) 
    155149      ! 
    156       CALL wrk_dealloc( jpi, jpj, jpk, zulap, zvlap )  
    157       ! 
    158       IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_blp') 
     150      IF( ln_timing )   CALL timing_stop('dyn_ldf_blp') 
    159151      ! 
    160152   END SUBROUTINE dyn_ldf_blp 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DYN/dynnxt.F90

    r7753 r8568  
    4444   USE lbclnk         ! lateral boundary condition (or mpp link) 
    4545   USE lib_mpp        ! MPP library 
    46    USE wrk_nemo       ! Memory Allocation 
    4746   USE prtctl         ! Print control 
    4847   USE timing         ! Timing 
    … …  
    5756 
    5857   !!---------------------------------------------------------------------- 
    59    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     58   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    6059   !! $Id$  
    6160   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    9796      REAL(wp) ::   zue3a, zue3n, zue3b, zuf, zcoef    ! local scalars 
    9897      REAL(wp) ::   zve3a, zve3n, zve3b, zvf, z1_2dt   !   -      - 
    99       REAL(wp), POINTER, DIMENSION(:,:)   ::  zue, zve 
    100       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ze3u_f, ze3v_f, zua, zva  
     98      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zue, zve 
     99      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ze3u_f, ze3v_f, zua, zva  
    101100      !!---------------------------------------------------------------------- 
    102101      ! 
    103       IF( nn_timing == 1 )   CALL timing_start('dyn_nxt') 
    104       ! 
    105       IF( ln_dynspg_ts       )   CALL wrk_alloc( jpi,jpj,       zue, zve) 
    106       IF( l_trddyn           )   CALL wrk_alloc( jpi,jpj,jpk,   zua, zva) 
     102      IF( ln_timing    )   CALL timing_start('dyn_nxt') 
     103      IF( ln_dynspg_ts )   ALLOCATE( zue(jpi,jpj)     , zve(jpi,jpj)     ) 
     104      IF( l_trddyn     )   ALLOCATE( zua(jpi,jpj,jpk) , zva(jpi,jpj,jpk) ) 
    107105      ! 
    108106      IF( kt == nit000 ) THEN 
    … …  
    253251            ELSE                          ! Asselin filter applied on thickness weighted velocity 
    254252               ! 
    255                CALL wrk_alloc( jpi,jpj,jpk,   ze3u_f, ze3v_f ) 
     253               ALLOCATE( ze3u_f(jpi,jpj,jpk) , ze3v_f(jpi,jpj,jpk) ) 
    256254               ! Before filtered scale factor at (u/v)-points stored in ze3u_f, ze3v_f 
    257255               CALL dom_vvl_interpol( e3t_b(:,:,:), ze3u_f, 'U' ) 
    … …  
    280278               e3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1) 
    281279               ! 
    282                CALL wrk_dealloc( jpi,jpj,jpk,   ze3u_f, ze3v_f ) 
     280               DEALLOCATE( ze3u_f , ze3v_f ) 
    283281            ENDIF 
    284282            ! 
    … …  
    346344         &                       tab3d_2=vn, clinfo2=' Vn: '       , mask2=vmask ) 
    347345      !  
    348       IF( ln_dynspg_ts )   CALL wrk_dealloc( jpi,jpj,       zue, zve ) 
    349       IF( l_trddyn     )   CALL wrk_dealloc( jpi,jpj,jpk,   zua, zva ) 
    350       ! 
    351       IF( nn_timing == 1 )  CALL timing_stop('dyn_nxt') 
     346      IF( ln_dynspg_ts )   DEALLOCATE( zue, zve ) 
     347      IF( l_trddyn     )   DEALLOCATE( zua, zva ) 
     348      IF( ln_timing    )   CALL timing_stop('dyn_nxt') 
    352349      ! 
    353350   END SUBROUTINE dyn_nxt 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DYN/dynspg.F90

    r7753 r8568  
    2828   USE in_out_manager ! I/O manager 
    2929   USE lib_mpp        ! MPP library 
    30    USE wrk_nemo       ! Memory Allocation 
    3130   USE timing         ! Timing 
    3231 
    … …  
    4746#  include "vectopt_loop_substitute.h90" 
    4847   !!---------------------------------------------------------------------- 
    49    !! NEMO/OPA 3.2 , LODYC-IPSL  (2009) 
     48   !! NEMO/OPA 4.0 , LODYC-IPSL  (2017) 
    5049   !! $Id$  
    5150   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    7170      !!             period is used to prevent the divergence of odd and even time step. 
    7271      !!---------------------------------------------------------------------- 
    73       INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
    74       ! 
    75       INTEGER  ::   ji, jj, jk                             ! dummy loop indices 
    76       REAL(wp) ::   z2dt, zg_2, zintp, zgrau0r             ! temporary scalar 
    77       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
    78       REAL(wp), POINTER, DIMENSION(:,:)   ::  zpice 
    79       !!---------------------------------------------------------------------- 
    80       ! 
    81       IF( nn_timing == 1 )  CALL timing_start('dyn_spg') 
     72      INTEGER, INTENT(in   ) ::   kt   ! ocean time-step index 
     73      ! 
     74      INTEGER  ::   ji, jj, jk                   ! dummy loop indices 
     75      REAL(wp) ::   z2dt, zg_2, zintp, zgrau0r   ! local scalars 
     76      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zpice 
     77      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv 
     78      !!---------------------------------------------------------------------- 
     79      ! 
     80      IF( ln_timing )   CALL timing_start('dyn_spg') 
    8281      ! 
    8382      IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends 
    84          CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv )  
     83         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) )  
    8584         ztrdu(:,:,:) = ua(:,:,:) 
    8685         ztrdv(:,:,:) = va(:,:,:) 
    … …  
    124123         ! 
    125124         IF( nn_ice_embd == 2 ) THEN          !== embedded sea ice: Pressure gradient due to snow-ice mass ==! 
    126             CALL wrk_alloc( jpi,jpj,   zpice ) 
    127             !                                             
     125            ALLOCATE( zpice(jpi,jpj) ) 
    128126            zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc ) 
    129127            zgrau0r     = - grav * r1_rau0 
    … …  
    135133               END DO 
    136134            END DO 
    137             ! 
    138             CALL wrk_dealloc( jpi,jpj,   zpice )          
     135            DEALLOCATE( zpice )          
    139136         ENDIF 
    140137         ! 
    … …  
    161158         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    162159         CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt ) 
    163          CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv )  
     160         DEALLOCATE( ztrdu , ztrdv )  
    164161      ENDIF 
    165162      !                                      ! print mean trends (used for debugging) 
    … …  
    167164         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    168165      ! 
    169       IF( nn_timing == 1 )  CALL timing_stop('dyn_spg') 
     166      IF( ln_timing )   CALL timing_stop('dyn_spg') 
    170167      ! 
    171168   END SUBROUTINE dyn_spg 
    … …  
    186183      !!---------------------------------------------------------------------- 
    187184      ! 
    188       IF( nn_timing == 1 )  CALL timing_start('dyn_spg_init') 
     185      IF( ln_timing )   CALL timing_start('dyn_spg_init') 
    189186      ! 
    190187      REWIND( numnam_ref )              ! Namelist namdyn_spg in reference namelist : Free surface 
    … …  
    227224      ENDIF 
    228225      ! 
    229       IF( nn_timing == 1 )  CALL timing_stop('dyn_spg_init') 
     226      IF( ln_timing )   CALL timing_stop('dyn_spg_init') 
    230227      ! 
    231228   END SUBROUTINE dyn_spg_init 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DYN/dynspg_exp.F90

    r6140 r8568  
    6161      !!---------------------------------------------------------------------- 
    6262      ! 
    63       IF( nn_timing == 1 )  CALL timing_start('dyn_spg_exp') 
     63      IF( ln_timing )   CALL timing_start('dyn_spg_exp') 
    6464      ! 
    6565      IF( kt == nit000 ) THEN 
    … …  
    9393      ENDIF 
    9494      ! 
    95       IF( nn_timing == 1 )  CALL timing_stop('dyn_spg_exp') 
     95      IF( ln_timing )   CALL timing_stop('dyn_spg_exp') 
    9696      ! 
    9797   END SUBROUTINE dyn_spg_exp 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DYN/dynspg_ts.F90

    r8367 r8568  
    162162      !!---------------------------------------------------------------------- 
    163163      ! 
    164       IF( nn_timing == 1 )   CALL timing_start('dyn_spg_ts') 
     164      IF( ln_timing )   CALL timing_start('dyn_spg_ts') 
    165165      ! 
    166166      IF( ln_wd ) ALLOCATE( zcpx(jpi,jpj), zcpy(jpi,jpj) ) 
    … …  
    11251125      IF( ln_wd )   DEALLOCATE( zcpx, zcpy ) 
    11261126      ! 
    1127       IF ( ln_diatmb ) THEN 
     1127      IF( ln_diatmb ) THEN 
    11281128         CALL iom_put( "baro_u" , un_b*umask(:,:,1)+zmdi*(1-umask(:,:,1 ) ) )  ! Barotropic  U Velocity 
    11291129         CALL iom_put( "baro_v" , vn_b*vmask(:,:,1)+zmdi*(1-vmask(:,:,1 ) ) )  ! Barotropic  V Velocity 
    11301130      ENDIF 
    1131       IF( nn_timing == 1 )  CALL timing_stop('dyn_spg_ts') 
     1131      IF( ln_timing )   CALL timing_stop('dyn_spg_ts') 
    11321132      ! 
    11331133   END SUBROUTINE dyn_spg_ts 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DYN/dynvor.F90

    r7753 r8568  
    1414   !!            2.0  ! 2006-11  (G. Madec)  flux form advection: add metric term 
    1515   !!            3.2  ! 2009-04  (R. Benshila)  vvl: correction of een scheme 
    16    !!            3.3  ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    17    !!            3.7  ! 2014-04  (G. Madec) trend simplification: suppress jpdyn_trd_dat vorticity  
    18    !!             -   ! 2014-06  (G. Madec) suppression of velocity curl from in-core memory 
     16   !!            3.3  ! 2010-10  (C. Ethe, G. Madec)  reorganisation of initialisation phase 
     17   !!            3.7  ! 2014-04  (G. Madec)  trend simplification: suppress jpdyn_trd_dat vorticity  
     18   !!             -   ! 2014-06  (G. Madec)  suppression of velocity curl from in-core memory 
    1919   !!             -   ! 2016-12  (G. Madec, E. Clementi) add Stokes-Coriolis trends (ln_stcor=T) 
     20   !!            4.0  ! 2017-07  (G. Madec)  linear dynamics + trends diag. with Stokes-Coriolis 
    2021   !!---------------------------------------------------------------------- 
    2122 
    2223   !!---------------------------------------------------------------------- 
    23    !!   dyn_vor      : Update the momentum trend with the vorticity trend 
    24    !!       vor_ens  : enstrophy conserving scheme       (ln_dynvor_ens=T) 
    25    !!       vor_ene  : energy conserving scheme          (ln_dynvor_ene=T) 
    26    !!       vor_een  : energy and enstrophy conserving   (ln_dynvor_een=T) 
    27    !!   dyn_vor_init : set and control of the different vorticity option 
     24   !!   dyn_vor       : Update the momentum trend with the vorticity trend 
     25   !!       vor_ens   : enstrophy conserving scheme       (ln_dynvor_ens=T) 
     26   !!       vor_ene   : energy conserving scheme          (ln_dynvor_ene=T) 
     27   !!       vor_een   : energy and enstrophy conserving   (ln_dynvor_een=T) 
     28   !!   dyn_vor_init  : set and control of the different vorticity option 
    2829   !!---------------------------------------------------------------------- 
    2930   USE oce            ! ocean dynamics and tracers 
    3031   USE dom_oce        ! ocean space and time domain 
    3132   USE dommsk         ! ocean mask 
    32    USE dynadv         ! momentum advection (use ln_dynadv_vec value) 
     33   USE dynadv         ! momentum advection 
    3334   USE trd_oce        ! trends: ocean variables 
    3435   USE trddyn         ! trend manager: dynamics 
    … …  
    4041   USE in_out_manager ! I/O manager 
    4142   USE lib_mpp        ! MPP library 
    42    USE wrk_nemo       ! Memory Allocation 
    4343   USE timing         ! Timing 
    44  
    4544 
    4645   IMPLICIT NONE 
    … …  
    8079#  include "vectopt_loop_substitute.h90" 
    8180   !!---------------------------------------------------------------------- 
    82    !! NEMO/OPA 3.7 , NEMO Consortium (2016) 
     81   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    8382   !! $Id$ 
    8483   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    9897      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    9998      ! 
    100       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
    101       !!---------------------------------------------------------------------- 
    102       ! 
    103       IF( nn_timing == 1 )  CALL timing_start('dyn_vor') 
    104       ! 
    105       IF( l_trddyn )   CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
    106       ! 
    107       SELECT CASE ( nvor_scheme )               !==  vorticity trend added to the general trend  ==! 
    108       ! 
    109       CASE ( np_ENE )                                 !* energy conserving scheme 
    110          IF( l_trddyn ) THEN                                ! trend diagnostics: split the trend in two 
     99      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
     100      !!---------------------------------------------------------------------- 
     101      ! 
     102      IF( ln_timing )   CALL timing_start('dyn_vor') 
     103      ! 
     104      IF( l_trddyn ) THEN     !==  trend diagnostics case : split the added trend in two parts  ==! 
     105         ! 
     106         ALLOCATE( ztrdu(jpi,jpj,jpk), ztrdv(jpi,jpj,jpk) ) 
     107         ! 
     108         ztrdu(:,:,:) = ua(:,:,:)            !* planetary vorticity trend (including Stokes-Coriolis force) 
     109         ztrdv(:,:,:) = va(:,:,:) 
     110         SELECT CASE( nvor_scheme ) 
     111         CASE( np_ENE, np_MIX )   ;   CALL vor_ene( kt, ncor, un , vn , ua, va )   ! energy conserving scheme 
     112            IF( ln_stcor )            CALL vor_ene( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend 
     113         CASE( np_ENS )           ;   CALL vor_ens( kt, ncor, un , vn , ua, va )   ! enstrophy conserving scheme 
     114            IF( ln_stcor )            CALL vor_ens( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend 
     115         CASE( np_EEN )           ;   CALL vor_een( kt, ncor, un , vn , ua, va )   ! energy & enstrophy scheme 
     116            IF( ln_stcor )            CALL vor_een( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend 
     117         END SELECT 
     118         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
     119         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     120         CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
     121         ! 
     122         IF( n_dynadv /= np_LIN_dyn ) THEN   !* relative vorticity or metric trend (only in non-linear case) 
    111123            ztrdu(:,:,:) = ua(:,:,:) 
    112124            ztrdv(:,:,:) = va(:,:,:) 
    113             CALL vor_ene( kt, nrvm, un , vn , ua, va )                    ! relative vorticity or metric trend 
     125            SELECT CASE( nvor_scheme ) 
     126            CASE( np_ENE )           ;   CALL vor_ene( kt, nrvm, un , vn , ua, va )  ! energy conserving scheme 
     127            CASE( np_ENS, np_MIX )   ;   CALL vor_ens( kt, nrvm, un , vn , ua, va )  ! enstrophy conserving scheme 
     128            CASE( np_EEN )           ;   CALL vor_een( kt, nrvm, un , vn , ua, va )  ! energy & enstrophy scheme 
     129            END SELECT 
    114130            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    115131            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    116132            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 
    117             ztrdu(:,:,:) = ua(:,:,:) 
    118             ztrdv(:,:,:) = va(:,:,:) 
    119             CALL vor_ene( kt, ncor, un , vn , ua, va )                    ! planetary vorticity trend 
    120             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    121             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    122             CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
    123          ELSE                                               ! total vorticity trend 
     133         ENDIF 
     134         ! 
     135         DEALLOCATE( ztrdu, ztrdv ) 
     136         ! 
     137      ELSE              !==  total vorticity trend added to the general trend  ==! 
     138         ! 
     139         SELECT CASE ( nvor_scheme )      !==  vorticity trend added to the general trend  ==! 
     140         CASE( np_ENE )                        !* energy conserving scheme 
    124141                             CALL vor_ene( kt, ntot, un , vn , ua, va )   ! total vorticity trend 
    125142            IF( ln_stcor )   CALL vor_ene( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend 
    126          ENDIF 
    127          ! 
    128       CASE ( np_ENS )                                 !* enstrophy conserving scheme 
    129          IF( l_trddyn ) THEN                                ! trend diagnostics: splitthe trend in two     
    130             ztrdu(:,:,:) = ua(:,:,:) 
    131             ztrdv(:,:,:) = va(:,:,:) 
    132             CALL vor_ens( kt, nrvm, un , vn , ua, va )            ! relative vorticity or metric trend 
    133             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    134             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    135             CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 
    136             ztrdu(:,:,:) = ua(:,:,:) 
    137             ztrdv(:,:,:) = va(:,:,:) 
    138             CALL vor_ens( kt, ncor, un , vn , ua, va )            ! planetary vorticity trend 
    139             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    140             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    141             CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
    142          ELSE                                               ! total vorticity trend 
     143         CASE( np_ENS )                        !* enstrophy conserving scheme 
    143144                             CALL vor_ens( kt, ntot, un , vn , ua, va )  ! total vorticity trend 
    144145            IF( ln_stcor )   CALL vor_ens( kt, ncor, usd, vsd, ua, va )  ! add the Stokes-Coriolis trend 
    145          ENDIF 
    146          ! 
    147       CASE ( np_MIX )                                 !* mixed ene-ens scheme 
    148          IF( l_trddyn ) THEN                                ! trend diagnostics: split the trend in two 
    149             ztrdu(:,:,:) = ua(:,:,:) 
    150             ztrdv(:,:,:) = va(:,:,:) 
    151             CALL vor_ens( kt, nrvm, un , vn , ua, va )            ! relative vorticity or metric trend (ens) 
    152             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    153             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    154             CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 
    155             ztrdu(:,:,:) = ua(:,:,:) 
    156             ztrdv(:,:,:) = va(:,:,:) 
    157             CALL vor_ene( kt, ncor, un , vn , ua, va )            ! planetary vorticity trend (ene) 
    158             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    159             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    160             CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
    161          ELSE                                               ! total vorticity trend 
     146         CASE( np_MIX )                        !* mixed ene-ens scheme 
    162147                             CALL vor_ens( kt, nrvm, un , vn , ua, va )   ! relative vorticity or metric trend (ens) 
    163148                             CALL vor_ene( kt, ncor, un , vn , ua, va )   ! planetary vorticity trend (ene) 
    164149            IF( ln_stcor )   CALL vor_ene( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend 
    165         ENDIF 
    166          ! 
    167       CASE ( np_EEN )                                 !* energy and enstrophy conserving scheme 
    168          IF( l_trddyn ) THEN                                ! trend diagnostics: split the trend in two 
    169             ztrdu(:,:,:) = ua(:,:,:) 
    170             ztrdv(:,:,:) = va(:,:,:) 
    171             CALL vor_een( kt, nrvm, un , vn , ua, va )            ! relative vorticity or metric trend 
    172             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    173             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    174             CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 
    175             ztrdu(:,:,:) = ua(:,:,:) 
    176             ztrdv(:,:,:) = va(:,:,:) 
    177             CALL vor_een( kt, ncor, un , vn , ua, va )            ! planetary vorticity trend 
    178             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    179             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    180             CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
    181          ELSE                                               ! total vorticity trend 
     150         CASE( np_EEN )                        !* energy and enstrophy conserving scheme 
    182151                             CALL vor_een( kt, ntot, un , vn , ua, va )   ! total vorticity trend 
    183152            IF( ln_stcor )   CALL vor_ene( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend 
    184          ENDIF 
    185          ! 
    186       END SELECT 
     153         END SELECT 
     154         ! 
     155      ENDIF 
    187156      ! 
    188157      !                       ! print sum trends (used for debugging) 
    … …  
    190159         &                     tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    191160      ! 
    192       IF( l_trddyn )   CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
    193       ! 
    194       IF( nn_timing == 1 )  CALL timing_stop('dyn_vor') 
     161      IF( ln_timing )   CALL timing_stop('dyn_vor') 
    195162      ! 
    196163   END SUBROUTINE dyn_vor 
    … …  
    217184      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
    218185      !!---------------------------------------------------------------------- 
    219       INTEGER , INTENT(in   )                         ::   kt          ! ocean time-step index 
    220       INTEGER , INTENT(in   )                         ::   kvor        ! =ncor (planetary) ; =ntot (total) ; 
    221       !                                                                ! =nrvm (relative vorticity or metric) 
    222       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pun, pvn    ! now velocities 
    223       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua, pva    ! total v-trend 
     186      INTEGER                          , INTENT(in   )::   kt          ! ocean time-step index 
     187      INTEGER                          , INTENT(in   )::   kvor        ! total, planetary, relative, or metric 
     188      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun, pvn    ! now velocities 
     189      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva    ! total v-trend 
    224190      ! 
    225191      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    226192      REAL(wp) ::   zx1, zy1, zx2, zy2   ! local scalars 
    227       REAL(wp), POINTER, DIMENSION(:,:) ::   zwx, zwy, zwz   ! 2D workspace 
    228       !!---------------------------------------------------------------------- 
    229       ! 
    230       IF( nn_timing == 1 )  CALL timing_start('vor_ene') 
    231       ! 
    232       CALL wrk_alloc( jpi,jpj,   zwx, zwy, zwz )  
     193      REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz   ! 2D workspace 
     194      !!---------------------------------------------------------------------- 
     195      ! 
     196      IF( ln_timing )  CALL timing_start('vor_ene') 
    233197      ! 
    234198      IF( kt == nit000 ) THEN 
    … …  
    264228               DO ji = 1, fs_jpim1   ! vector opt. 
    265229                  zwz(ji,jj) = ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pvn(ji+1,jj  ,jk) - e2v(ji,jj) * pvn(ji,jj,jk)    & 
    266                      &                      - e1u(ji  ,jj+1) * pun(ji  ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) & 
     230                     &                      - e1u(ji  ,jj+1) * pun(ji  ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  )   & 
    267231                     &                   * r1_e1e2f(ji,jj) 
    268232               END DO 
    … …  
    311275      END DO                                           !   End of slab 
    312276      !                                                ! =============== 
    313       CALL wrk_dealloc( jpi, jpj, zwx, zwy, zwz )  
    314       ! 
    315       IF( nn_timing == 1 )  CALL timing_stop('vor_ene') 
     277      ! 
     278      IF( ln_timing )  CALL timing_stop('vor_ene') 
    316279      ! 
    317280   END SUBROUTINE vor_ene 
    … …  
    338301      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
    339302      !!---------------------------------------------------------------------- 
    340       INTEGER , INTENT(in   )                         ::   kt          ! ocean time-step index 
    341       INTEGER , INTENT(in   )                         ::   kvor        ! =ncor (planetary) ; =ntot (total) ; 
    342          !                                                             ! =nrvm (relative vorticity or metric) 
    343       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pun, pvn    ! now velocities 
    344       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua, pva    ! total v-trend 
     303      INTEGER                          , INTENT(in   )::   kt          ! ocean time-step index 
     304      INTEGER                          , INTENT(in   )::   kvor        ! total, planetary, relative, or metric 
     305      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun, pvn    ! now velocities 
     306      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva    ! total v-trend 
    345307      ! 
    346308      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    347309      REAL(wp) ::   zuav, zvau   ! local scalars 
    348       REAL(wp), POINTER, DIMENSION(:,:) ::   zwx, zwy, zwz, zww   ! 2D workspace 
    349       !!---------------------------------------------------------------------- 
    350       ! 
    351       IF( nn_timing == 1 )  CALL timing_start('vor_ens') 
    352       ! 
    353       CALL wrk_alloc( jpi,jpj,   zwx, zwy, zwz )  
     310      REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz, zww   ! 2D workspace 
     311      !!---------------------------------------------------------------------- 
     312      ! 
     313      IF( ln_timing )   CALL timing_start('vor_ens') 
    354314      ! 
    355315      IF( kt == nit000 ) THEN 
    … …  
    431391      END DO                                           !   End of slab 
    432392      !                                                ! =============== 
    433       CALL wrk_dealloc( jpi, jpj, zwx, zwy, zwz )  
    434       ! 
    435       IF( nn_timing == 1 )  CALL timing_stop('vor_ens') 
     393      ! 
     394      IF( ln_timing )   CALL timing_stop('vor_ens') 
    436395      ! 
    437396   END SUBROUTINE vor_ens 
    … …  
    455414      !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36 
    456415      !!---------------------------------------------------------------------- 
    457       INTEGER , INTENT(in   )                         ::   kt          ! ocean time-step index 
    458       INTEGER , INTENT(in   )                         ::   kvor        ! =ncor (planetary) ; =ntot (total) ; 
    459          !                                                             ! =nrvm (relative vorticity or metric) 
    460       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pun, pvn    ! now velocities 
    461       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua, pva    ! total v-trend 
     416      INTEGER                          , INTENT(in   )::   kt          ! ocean time-step index 
     417      INTEGER                          , INTENT(in   )::   kvor        ! total, planetary, relative, or metric 
     418      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun, pvn    ! now velocities 
     419      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva    ! total v-trend 
    462420      ! 
    463421      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    465423      REAL(wp) ::   zua, zva     ! local scalars 
    466424      REAL(wp) ::   zmsk, ze3    ! local scalars 
    467       ! 
    468       REAL(wp), POINTER, DIMENSION(:,:)   :: zwx, zwy, zwz, z1_e3f 
    469       REAL(wp), POINTER, DIMENSION(:,:)   :: ztnw, ztne, ztsw, ztse 
    470       !!---------------------------------------------------------------------- 
    471       ! 
    472       IF( nn_timing == 1 )  CALL timing_start('vor_een') 
    473       ! 
    474       CALL wrk_alloc( jpi,jpj,   zwx , zwy , zwz , z1_e3f )  
    475       CALL wrk_alloc( jpi,jpj,   ztnw, ztne, ztsw, ztse   )  
     425      REAL(wp), DIMENSION(jpi,jpj)   :: zwx , zwy , zwz , z1_e3f 
     426      REAL(wp), DIMENSION(jpi,jpj)   :: ztnw, ztne, ztsw, ztse 
     427      !!---------------------------------------------------------------------- 
     428      ! 
     429      IF( ln_timing )   CALL timing_start('vor_een') 
    476430      ! 
    477431      IF( kt == nit000 ) THEN 
    … …  
    599553      !                                                ! =============== 
    600554      ! 
    601       CALL wrk_dealloc( jpi,jpj,   zwx , zwy , zwz , z1_e3f )  
    602       CALL wrk_dealloc( jpi,jpj,   ztnw, ztne, ztsw, ztse   )  
    603       ! 
    604       IF( nn_timing == 1 )  CALL timing_stop('vor_een') 
     555      IF( ln_timing )   CALL timing_stop('vor_een') 
    605556      ! 
    606557   END SUBROUTINE vor_een 
    … …  
    618569      INTEGER ::   ios             ! Local integer output status for namelist read 
    619570      !! 
    620       NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix, ln_dynvor_een, nn_een_e3f, ln_dynvor_msk 
     571      NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix,   & 
     572         &                 ln_dynvor_een, nn_een_e3f   , ln_dynvor_msk 
    621573      !!---------------------------------------------------------------------- 
    622574 
    … …  
    672624      !                       
    673625      IF(lwp) WRITE(numout,*)        ! type of calculated vorticity (set ncor, nrvm, ntot) 
    674       ncor = np_COR 
    675       IF( ln_dynadv_vec ) THEN      
    676          IF(lwp) WRITE(numout,*) '      ===>>   Vector form advection : vorticity = Coriolis + relative vorticity' 
     626      ncor = np_COR                       ! planetary vorticity 
     627      SELECT CASE( n_dynadv ) 
     628      CASE( np_LIN_dyn ) 
     629         IF(lwp) WRITE(numout,*) '      ===>>   linear dynamics : total vorticity = Coriolis' 
     630         nrvm = np_COR        ! planetary vorticity 
     631         ntot = np_COR        !     -         - 
     632      CASE( np_VEC_c2  ) 
     633         IF(lwp) WRITE(numout,*) '      ===>>   vector form dynamics : total vorticity = Coriolis + relative vorticity'  
    677634         nrvm = np_RVO        ! relative vorticity 
    678          ntot = np_CRV        ! relative + planetary vorticity 
    679       ELSE                         
    680          IF(lwp) WRITE(numout,*) '      ===>>   Flux form advection   : vorticity = Coriolis + metric term' 
     635         ntot = np_CRV        ! relative + planetary vorticity          
     636      CASE( np_FLX_c2 , np_FLX_ubs  ) 
     637         IF(lwp) WRITE(numout,*) '      ===>>   flux form dynamics : total vorticity = Coriolis + metric term' 
    681638         nrvm = np_MET        ! metric term 
    682639         ntot = np_CME        ! Coriolis + metric term 
    683       ENDIF 
     640      END SELECT 
    684641       
    685642      IF(lwp) THEN                   ! Print the choice 
    686643         WRITE(numout,*) 
    687          IF( nvor_scheme ==  np_ENE )   WRITE(numout,*) '      ===>>   energy conserving scheme' 
    688          IF( nvor_scheme ==  np_ENS )   WRITE(numout,*) '      ===>>   enstrophy conserving scheme' 
    689          IF( nvor_scheme ==  np_MIX )   WRITE(numout,*) '      ===>>   mixed enstrophy/energy conserving scheme' 
    690          IF( nvor_scheme ==  np_EEN )   WRITE(numout,*) '      ===>>   energy and enstrophy conserving scheme' 
     644         SELECT CASE( nvor_scheme ) 
     645         CASE( np_ENE )   ;   WRITE(numout,*) '      ===>>   energy conserving scheme' 
     646         CASE( np_ENS )   ;   WRITE(numout,*) '      ===>>   enstrophy conserving scheme' 
     647         CASE( np_MIX )   ;   WRITE(numout,*) '      ===>>   mixed enstrophy/energy conserving scheme' 
     648         CASE( np_EEN )   ;   WRITE(numout,*) '      ===>>   energy and enstrophy conserving scheme' 
     649         END SELECT          
    691650      ENDIF 
    692651      ! 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DYN/dynzad.F90

    r7753 r8568  
    55   !!====================================================================== 
    66   !! History :  OPA  ! 1991-01  (G. Madec) Original code 
    7    !!            7.0  ! 1991-11  (G. Madec) 
    8    !!            7.5  ! 1996-01  (G. Madec) statement function for e3 
    97   !!   NEMO     0.5  ! 2002-07  (G. Madec) Free form, F90 
    108   !!---------------------------------------------------------------------- 
    … …  
    2220   USE lib_mpp        ! MPP library 
    2321   USE prtctl         ! Print control 
    24    USE wrk_nemo       ! Memory Allocation 
    2522   USE timing         ! Timing 
    2623 
    … …  
    2926    
    3027   PUBLIC   dyn_zad       ! routine called by dynadv.F90 
    31    PUBLIC   dyn_zad_zts   ! routine called by dynadv.F90 
    3228 
    3329   !! * Substitutions 
    3430#  include "vectopt_loop_substitute.h90" 
    3531   !!---------------------------------------------------------------------- 
    36    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     32   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    3733   !! $Id$ 
    3834   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    5854      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx 
    5955      ! 
    60       INTEGER  ::   ji, jj, jk      ! dummy loop indices 
    61       REAL(wp) ::   zua, zva        ! temporary scalars 
    62       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwuw , zwvw 
    63       REAL(wp), POINTER, DIMENSION(:,:  ) ::  zww 
    64       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
     56      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     57      REAL(wp) ::   zua, zva     ! local scalars 
     58      REAL(wp), DIMENSION(jpi,jpj)     ::   zww 
     59      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwuw, zwvw 
     60      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdu, ztrdv 
    6561      !!---------------------------------------------------------------------- 
    6662      ! 
    67       IF( nn_timing == 1 )  CALL timing_start('dyn_zad') 
    68       ! 
    69       CALL wrk_alloc( jpi,jpj, zww )  
    70       CALL wrk_alloc( jpi,jpj,jpk, zwuw , zwvw )  
     63      IF( ln_timing )   CALL timing_start('dyn_zad') 
    7164      ! 
    7265      IF( kt == nit000 ) THEN 
    73          IF(lwp)WRITE(numout,*) 
    74          IF(lwp)WRITE(numout,*) 'dyn_zad : arakawa advection scheme' 
     66         IF(lwp) WRITE(numout,*) 
     67         IF(lwp) WRITE(numout,*) 'dyn_zad : 2nd order vertical advection scheme' 
    7568      ENDIF 
    7669 
    7770      IF( l_trddyn )   THEN         ! Save ua and va trends 
    78          CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv )  
     71         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) )  
    7972         ztrdu(:,:,:) = ua(:,:,:)  
    8073         ztrdv(:,:,:) = va(:,:,:)  
    … …  
    9689      ! 
    9790      ! Surface and bottom advective fluxes set to zero 
    98       IF ( ln_isfcav ) THEN 
     91      IF( ln_isfcav ) THEN 
    9992         DO jj = 2, jpjm1 
    10093            DO ji = fs_2, fs_jpim1           ! vector opt. 
    … …  
    119112         DO jj = 2, jpjm1 
    120113            DO ji = fs_2, fs_jpim1       ! vector opt. 
    121                !                         ! vertical momentum advective trends 
    122                zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 
    123                zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 
    124                !                         ! add the trends to the general momentum trends 
    125                ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
    126                va(ji,jj,jk) = va(ji,jj,jk) + zva 
     114               ua(ji,jj,jk) = ua(ji,jj,jk) - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 
     115               va(ji,jj,jk) = va(ji,jj,jk) - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 
    127116            END DO   
    128117         END DO   
    … …  
    133122         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    134123         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt ) 
    135          CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )  
     124         DEALLOCATE( ztrdu, ztrdv )  
    136125      ENDIF 
    137126      !                             ! Control print 
    … …  
    139128         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    140129      ! 
    141       CALL wrk_dealloc( jpi,jpj, zww )  
    142       CALL wrk_dealloc( jpi,jpj,jpk, zwuw , zwvw )  
    143       ! 
    144       IF( nn_timing == 1 )  CALL timing_stop('dyn_zad') 
     130      IF( ln_timing )   CALL timing_stop('dyn_zad') 
    145131      ! 
    146132   END SUBROUTINE dyn_zad 
    147133 
    148  
    149    SUBROUTINE dyn_zad_zts ( kt ) 
    150       !!---------------------------------------------------------------------- 
    151       !!                  ***  ROUTINE dynzad_zts  *** 
    152       !!  
    153       !! ** Purpose :   Compute the now vertical momentum advection trend and  
    154       !!      add it to the general trend of momentum equation. This version 
    155       !!      uses sub-timesteps for improved numerical stability with small 
    156       !!      vertical grid sizes. This is especially relevant when using  
    157       !!      embedded ice with thin surface boxes. 
    158       !! 
    159       !! ** Method  :   The now vertical advection of momentum is given by: 
    160       !!         w dz(u) = ua + 1/(e1u*e2u*e3u) mk+1[ mi(e1t*e2t*wn) dk(un) ] 
    161       !!         w dz(v) = va + 1/(e1v*e2v*e3v) mk+1[ mj(e1t*e2t*wn) dk(vn) ] 
    162       !!      Add this trend to the general trend (ua,va): 
    163       !!         (ua,va) = (ua,va) + w dz(u,v) 
    164       !! 
    165       !! ** Action  : - Update (ua,va) with the vert. momentum adv. trends 
    166       !!              - Save the trends in (ztrdu,ztrdv) ('key_trddyn') 
    167       !!---------------------------------------------------------------------- 
    168       INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx 
    169       ! 
    170       INTEGER  ::   ji, jj, jk, jl  ! dummy loop indices 
    171       INTEGER  ::   jnzts = 5       ! number of sub-timesteps for vertical advection 
    172       INTEGER  ::   jtb, jtn, jta   ! sub timestep pointers for leap-frog/euler forward steps 
    173       REAL(wp) ::   zua, zva        ! temporary scalars 
    174       REAL(wp) ::   zr_rdt          ! temporary scalar 
    175       REAL(wp) ::   z2dtzts         ! length of Euler forward sub-timestep for vertical advection 
    176       REAL(wp) ::   zts             ! length of sub-timestep for vertical advection 
    177       REAL(wp), POINTER, DIMENSION(:,:,:)   ::  zwuw , zwvw, zww 
    178       REAL(wp), POINTER, DIMENSION(:,:,:)   ::  ztrdu, ztrdv 
    179       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zus , zvs 
    180       !!---------------------------------------------------------------------- 
    181       ! 
    182       IF( nn_timing == 1 )  CALL timing_start('dyn_zad_zts') 
    183       ! 
    184       CALL wrk_alloc( jpi,jpj,jpk,     zwuw, zwvw, zww )  
    185       CALL wrk_alloc( jpi,jpj,jpk,3,   zus , zvs )  
    186       ! 
    187       IF( kt == nit000 ) THEN 
    188          IF(lwp)WRITE(numout,*) 
    189          IF(lwp)WRITE(numout,*) 'dyn_zad_zts : arakawa advection scheme with sub-timesteps' 
    190       ENDIF 
    191  
    192       IF( l_trddyn )   THEN         ! Save ua and va trends 
    193          CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv )  
    194          ztrdu(:,:,:) = ua(:,:,:)  
    195          ztrdv(:,:,:) = va(:,:,:)  
    196       ENDIF 
    197        
    198       IF( neuler == 0 .AND. kt == nit000 ) THEN 
    199           z2dtzts =         rdt / REAL( jnzts, wp )   ! = rdt (restart with Euler time stepping) 
    200       ELSE 
    201           z2dtzts = 2._wp * rdt / REAL( jnzts, wp )   ! = 2 rdt (leapfrog) 
    202       ENDIF 
    203        
    204       DO jk = 2, jpkm1                    ! Calculate and store vertical fluxes 
    205          DO jj = 2, jpj                    
    206             DO ji = fs_2, jpi             ! vector opt. 
    207                zww(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk) 
    208             END DO 
    209          END DO 
    210       END DO 
    211  
    212       DO jj = 2, jpjm1                    ! Surface and bottom advective fluxes set to zero 
    213          DO ji = fs_2, fs_jpim1           ! vector opt. 
    214  !!gm missing ISF boundary condition 
    215             zwuw(ji,jj, 1 ) = 0._wp 
    216             zwvw(ji,jj, 1 ) = 0._wp 
    217             zwuw(ji,jj,jpk) = 0._wp 
    218             zwvw(ji,jj,jpk) = 0._wp 
    219          END DO   
    220       END DO 
    221  
    222 ! Start with before values and use sub timestepping to reach after values 
    223  
    224       zus(:,:,:,1) = ub(:,:,:) 
    225       zvs(:,:,:,1) = vb(:,:,:) 
    226  
    227       DO jl = 1, jnzts                   ! Start of sub timestepping loop 
    228  
    229          IF( jl == 1 ) THEN              ! Euler forward to kick things off 
    230            jtb = 1   ;   jtn = 1   ;   jta = 2 
    231            zts = z2dtzts 
    232          ELSEIF( jl == 2 ) THEN          ! First leapfrog step 
    233            jtb = 1   ;   jtn = 2   ;   jta = 3 
    234            zts = 2._wp * z2dtzts 
    235          ELSE                            ! Shuffle pointers for subsequent leapfrog steps 
    236            jtb = MOD(jtb,3) + 1 
    237            jtn = MOD(jtn,3) + 1 
    238            jta = MOD(jta,3) + 1 
    239          ENDIF 
    240  
    241          DO jk = 2, jpkm1           ! Vertical momentum advection at level w and u- and v- vertical 
    242             DO jj = 2, jpjm1                 ! vertical momentum advection at w-point 
    243                DO ji = fs_2, fs_jpim1        ! vector opt. 
    244                   zwuw(ji,jj,jk) = ( zww(ji+1,jj  ,jk) + zww(ji,jj,jk) ) * ( zus(ji,jj,jk-1,jtn)-zus(ji,jj,jk,jtn) ) !* wumask(ji,jj,jk) 
    245                   zwvw(ji,jj,jk) = ( zww(ji  ,jj+1,jk) + zww(ji,jj,jk) ) * ( zvs(ji,jj,jk-1,jtn)-zvs(ji,jj,jk,jtn) ) !* wvmask(ji,jj,jk) 
    246                END DO   
    247             END DO    
    248          END DO 
    249          DO jk = 1, jpkm1           ! Vertical momentum advection at u- and v-points 
    250             DO jj = 2, jpjm1 
    251                DO ji = fs_2, fs_jpim1       ! vector opt. 
    252                   !                         ! vertical momentum advective trends 
    253                   zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 
    254                   zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 
    255                   zus(ji,jj,jk,jta) = zus(ji,jj,jk,jtb) + zua * zts 
    256                   zvs(ji,jj,jk,jta) = zvs(ji,jj,jk,jtb) + zva * zts 
    257                END DO   
    258             END DO   
    259          END DO 
    260  
    261       END DO      ! End of sub timestepping loop 
    262  
    263       zr_rdt = 1._wp / ( REAL( jnzts, wp ) * z2dtzts ) 
    264       DO jk = 1, jpkm1              ! Recover trends over the outer timestep 
    265          DO jj = 2, jpjm1 
    266             DO ji = fs_2, fs_jpim1       ! vector opt. 
    267                !                         ! vertical momentum advective trends 
    268                !                         ! add the trends to the general momentum trends 
    269                ua(ji,jj,jk) = ua(ji,jj,jk) + ( zus(ji,jj,jk,jta) - ub(ji,jj,jk)) * zr_rdt 
    270                va(ji,jj,jk) = va(ji,jj,jk) + ( zvs(ji,jj,jk,jta) - vb(ji,jj,jk)) * zr_rdt 
    271             END DO   
    272          END DO   
    273       END DO 
    274  
    275       IF( l_trddyn ) THEN           ! save the vertical advection trends for diagnostic 
    276          ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    277          ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    278          CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt ) 
    279          CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )  
    280       ENDIF 
    281       !                             ! Control print 
    282       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' zad  - Ua: ', mask1=umask,   & 
    283          &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    284       ! 
    285       CALL wrk_dealloc( jpi,jpj,jpk,     zwuw, zwvw, zww )  
    286       CALL wrk_dealloc( jpi,jpj,jpk,3,   zus , zvs )  
    287       ! 
    288       IF( nn_timing == 1 )  CALL timing_stop('dyn_zad_zts') 
    289       ! 
    290    END SUBROUTINE dyn_zad_zts 
    291  
    292134   !!====================================================================== 
    293135END MODULE dynzad 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DYN/dynzdf.F90

    r8367 r8568  
    7676      !!--------------------------------------------------------------------- 
    7777      ! 
    78       IF( nn_timing == 1 )   CALL timing_start('dyn_zdf') 
     78      IF( ln_timing )   CALL timing_start('dyn_zdf') 
    7979      ! 
    8080      IF( kt == nit000 ) THEN       !* initialization 
    … …  
    392392         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    393393         ! 
    394       IF( nn_timing == 1 )   CALL timing_stop('dyn_zdf') 
     394      IF( ln_timing )   CALL timing_stop('dyn_zdf') 
    395395      ! 
    396396   END SUBROUTINE dyn_zdf 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DYN/sshwzv.F90

    r7753 r8568  
    2222   USE divhor         ! horizontal divergence 
    2323   USE phycst         ! physical constants 
    24    USE bdy_oce   , ONLY: ln_bdy, bdytmask 
     24   USE bdy_oce , ONLY : ln_bdy, bdytmask   ! Open BounDarY 
    2525   USE bdydyn2d       ! bdy_ssh routine 
    2626#if defined key_agrif 
    … …  
    3636   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
    3737   USE lib_mpp        ! MPP library 
    38    USE wrk_nemo       ! Memory Allocation 
    3938   USE timing         ! Timing 
    40    USE wet_dry         ! Wetting/Drying flux limting 
     39   USE wet_dry        ! Wetting/Drying flux limting 
    4140 
    4241   IMPLICIT NONE 
    … …  
    7473      INTEGER  ::   jk            ! dummy loop indice 
    7574      REAL(wp) ::   z2dt, zcoef   ! local scalars 
    76       REAL(wp), POINTER, DIMENSION(:,:  ) ::   zhdiv   ! 2D workspace 
    77       !!---------------------------------------------------------------------- 
    78       ! 
    79       IF( nn_timing == 1 )   CALL timing_start('ssh_nxt') 
    80       ! 
    81       CALL wrk_alloc( jpi,jpj,   zhdiv )  
     75      REAL(wp), DIMENSION(jpi,jpj) ::   zhdiv   ! 2D workspace 
     76      !!---------------------------------------------------------------------- 
     77      ! 
     78      IF( ln_timing )   CALL timing_start('ssh_nxt') 
    8279      ! 
    8380      IF( kt == nit000 ) THEN 
    … …  
    134131      IF(ln_ctl)   CALL prt_ctl( tab2d_1=ssha, clinfo1=' ssha  - : ', mask1=tmask, ovlap=1 ) 
    135132      ! 
    136       CALL wrk_dealloc( jpi, jpj, zhdiv )  
    137       ! 
    138       IF( nn_timing == 1 )  CALL timing_stop('ssh_nxt') 
     133      IF( ln_timing )   CALL timing_stop('ssh_nxt') 
    139134      ! 
    140135   END SUBROUTINE ssh_nxt 
    … …  
    160155      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    161156      REAL(wp) ::   z1_2dt       ! local scalars 
    162       REAL(wp), POINTER, DIMENSION(:,:  ) ::  z2d 
    163       REAL(wp), POINTER, DIMENSION(:,:,:) ::  z3d, zhdiv 
    164       !!---------------------------------------------------------------------- 
    165       ! 
    166       IF( nn_timing == 1 )   CALL timing_start('wzv') 
     157      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zhdiv 
     158      !!---------------------------------------------------------------------- 
     159      ! 
     160      IF( ln_timing )   CALL timing_start('wzv') 
    167161      ! 
    168162      IF( kt == nit000 ) THEN 
    … …  
    180174      ! 
    181175      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN      ! z_tilde and layer cases 
    182          CALL wrk_alloc( jpi, jpj, jpk, zhdiv )  
     176         ALLOCATE( zhdiv(jpi,jpj,jpk) )  
    183177         ! 
    184178         DO jk = 1, jpkm1 
    … …  
    200194         END DO 
    201195         !          IF( ln_vvl_layer ) wn(:,:,:) = 0.e0 
    202          CALL wrk_dealloc( jpi, jpj, jpk, zhdiv )  
     196         DEALLOCATE( zhdiv )  
    203197      ELSE   ! z_star and linear free surface cases 
    204198         DO jk = jpkm1, 1, -1                       ! integrate from the bottom the hor. divergence 
    … …  
    215209      ENDIF 
    216210      ! 
    217       IF( nn_timing == 1 )  CALL timing_stop('wzv') 
     211      IF( ln_timing )   CALL timing_stop('wzv') 
    218212      ! 
    219213   END SUBROUTINE wzv 
    … …  
    244238      !!---------------------------------------------------------------------- 
    245239      ! 
    246       IF( nn_timing == 1 )  CALL timing_start('ssh_swp') 
     240      IF( ln_timing )  CALL timing_start('ssh_swp') 
    247241      ! 
    248242      IF( kt == nit000 ) THEN 
    … …  
    271265      IF(ln_ctl)   CALL prt_ctl( tab2d_1=sshb, clinfo1=' sshb  - : ', mask1=tmask, ovlap=1 ) 
    272266      ! 
    273       IF( nn_timing == 1 )   CALL timing_stop('ssh_swp') 
     267      IF( ln_timing )   CALL timing_stop('ssh_swp') 
    274268      ! 
    275269   END SUBROUTINE ssh_swp 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DYN/wet_dry.F90

    r7646 r8568  
    1111 
    1212   !!---------------------------------------------------------------------- 
    13    !!   wad_lmt    : Compute the horizontal flux limiter and the limited velocity 
    14    !!                when wetting and drying happens  
    15    !!---------------------------------------------------------------------- 
    16    USE oce             ! ocean dynamics and tracers 
    17    USE dom_oce         ! ocean space and time domain 
    18    USE sbc_oce, ONLY : ln_rnf   ! surface boundary condition: ocean 
    19    USE sbcrnf          ! river runoff  
    20    USE in_out_manager  ! I/O manager 
    21    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    22    USE lib_mpp         ! MPP library 
    23    USE wrk_nemo        ! Memory Allocation 
    24    USE timing          ! Timing 
     13   !!   wad_init      : initialisation of wetting and drying 
     14   !!   wad_lmt       : horizontal flux limiter and limited velocity when wetting and drying happens 
     15   !!   wad_lmt_bt    : same as wad_lmt for the barotropic stepping (dynspg_ts) 
     16   !!---------------------------------------------------------------------- 
     17   USE oce            ! ocean dynamics and tracers 
     18   USE dom_oce        ! ocean space and time domain 
     19   USE sbc_oce  , ONLY: ln_rnf   ! surface boundary condition: ocean 
     20   USE sbcrnf         ! river runoff  
     21   ! 
     22   USE in_out_manager ! I/O manager 
     23   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     24   USE lib_mpp        ! MPP library 
     25   USE timing         ! Timing 
    2526 
    2627   IMPLICIT NONE 
    … …  
    3132   !! --------------------------------------------------------------------- 
    3233 
    33    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   wdmask         !: u- and v- limiter  
    34    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   ht_wd          !: wetting and drying t-pt depths 
    35                                                                      !  (can include negative depths) 
     34   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   wdmask   !: u- and v- limiter  
     35   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   ht_wd    !: wetting and drying t-pt depths 
     36   !                                                           !  (can include negative depths) 
    3637 
    3738   LOGICAL,  PUBLIC  ::   ln_wd       !: Wetting/drying activation switch (T:on,F:off) 
    3839   REAL(wp), PUBLIC  ::   rn_wdmin1   !: minimum water depth on dried cells 
    3940   REAL(wp), PUBLIC  ::   rn_wdmin2   !: tolerrance of minimum water depth on dried cells 
    40    REAL(wp), PUBLIC  ::   rn_wdld     !: land elevation below which wetting/drying  
    41                                            !: will be considered 
     41   REAL(wp), PUBLIC  ::   rn_wdld     !: land elevation below which wetting/drying will be considered 
    4242   INTEGER , PUBLIC  ::   nn_wdit     !: maximum number of iteration for W/D limiter 
    4343 
    … …  
    4848   !! * Substitutions 
    4949#  include "vectopt_loop_substitute.h90" 
     50   !!---------------------------------------------------------------------- 
    5051CONTAINS 
    5152 
    … …  
    5859      !! ** input   : - namwad namelist 
    5960      !!---------------------------------------------------------------------- 
     61      INTEGER  ::   ios, ierr   ! Local integer 
     62      !! 
    6063      NAMELIST/namwad/ ln_wd, rn_wdmin1, rn_wdmin2, rn_wdld, nn_wdit 
    61       INTEGER  ::   ios                 ! Local integer output status for namelist read 
    62       INTEGER  ::   ierr                ! Local integer status array allocation  
    63       !!---------------------------------------------------------------------- 
    64  
    65       REWIND( numnam_ref )              ! Namelist namwad in reference namelist  
    66                                         ! : Parameters for Wetting/Drying 
     64      !!---------------------------------------------------------------------- 
     65      ! 
     66      REWIND( numnam_ref )              ! Namelist namwad in reference namelist : Parameters for Wetting/Drying 
    6767      READ  ( numnam_ref, namwad, IOSTAT = ios, ERR = 905) 
    6868905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namwad in reference namelist', .TRUE.)  
    69       REWIND( numnam_cfg )              ! Namelist namwad in configuration namelist  
    70                                         ! : Parameters for Wetting/Drying 
     69      REWIND( numnam_cfg )              ! Namelist namwad in configuration namelist : Parameters for Wetting/Drying 
    7170      READ  ( numnam_cfg, namwad, IOSTAT = ios, ERR = 906) 
    7271906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namwad in configuration namelist', .TRUE. ) 
    7372      IF(lwm) WRITE ( numond, namwad ) 
    74  
     73      ! 
    7574      IF(lwp) THEN                  ! control print 
    7675         WRITE(numout,*) 
    … …  
    103102      !! ** Action  : - calculate flux limiter and W/D flag 
    104103      !!---------------------------------------------------------------------- 
    105       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   sshb1 
    106       REAL(wp), DIMENSION(:,:), INTENT(in)    ::   sshemp 
    107       REAL(wp), INTENT(in) :: z2dt 
     104      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   sshb1        !!gm DOCTOR names: should start with p ! 
     105      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   sshemp 
     106      REAL(wp)                , INTENT(in   ) ::  z2dt 
    108107      ! 
    109108      INTEGER  ::   ji, jj, jk, jk1     ! dummy loop indices 
    … …  
    113112      REAL(wp) ::   zdepwd              ! local scalar, always wet cell depth 
    114113      REAL(wp) ::   ztmp                ! local scalars 
    115       REAL(wp), POINTER,  DIMENSION(:,:) ::   zwdlmtu, zwdlmtv         !: W/D flux limiters 
    116       REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxp,  zflxn            ! local 2D workspace 
    117       REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxu,  zflxv            ! local 2D workspace 
    118       REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxu1, zflxv1           ! local 2D workspace 
    119       !!---------------------------------------------------------------------- 
    120       ! 
    121  
    122       IF( nn_timing == 1 )  CALL timing_start('wad_lmt') 
    123  
    124       IF(ln_wd) THEN 
    125  
    126         CALL wrk_alloc( jpi, jpj, zflxp, zflxn, zflxu, zflxv, zflxu1, zflxv1 ) 
    127         CALL wrk_alloc( jpi, jpj, zwdlmtu, zwdlmtv) 
    128         ! 
    129         
    130         !IF(lwp) WRITE(numout,*) 
    131         !IF(lwp) WRITE(numout,*) 'wad_lmt : wetting/drying limiters and velocity limiting' 
    132         
    133         jflag  = 0 
    134         zdepwd = 50._wp   !maximum depth on which that W/D could possibly happen 
    135  
    136         
    137         zflxp(:,:)   = 0._wp 
    138         zflxn(:,:)   = 0._wp 
    139         zflxu(:,:)   = 0._wp 
    140         zflxv(:,:)   = 0._wp 
    141  
    142         zwdlmtu(:,:)  = 1._wp 
    143         zwdlmtv(:,:)  = 1._wp 
    144         
    145         ! Horizontal Flux in u and v direction 
    146         DO jk = 1, jpkm1   
    147            DO jj = 1, jpj 
    148               DO ji = 1, jpi 
    149                  zflxu(ji,jj) = zflxu(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 
    150                  zflxv(ji,jj) = zflxv(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 
    151               END DO   
    152            END DO   
    153         END DO 
    154         
    155         zflxu(:,:) = zflxu(:,:) * e2u(:,:) 
    156         zflxv(:,:) = zflxv(:,:) * e1v(:,:) 
    157         
    158         wdmask(:,:) = 1 
    159         DO jj = 2, jpj 
    160            DO ji = 2, jpi  
    161  
    162              IF( tmask(ji, jj, 1) < 0.5_wp ) CYCLE   ! we don't care about land cells 
    163              IF( ht_wd(ji,jj) > zdepwd )      CYCLE   ! and cells which are unlikely to dry 
    164  
    165               zflxp(ji,jj) = max(zflxu(ji,jj), 0._wp) - min(zflxu(ji-1,jj),   0._wp) + & 
    166                            & max(zflxv(ji,jj), 0._wp) - min(zflxv(ji,  jj-1), 0._wp)  
    167               zflxn(ji,jj) = min(zflxu(ji,jj), 0._wp) - max(zflxu(ji-1,jj),   0._wp) + & 
    168                            & min(zflxv(ji,jj), 0._wp) - max(zflxv(ji,  jj-1), 0._wp)  
    169  
    170               zdep2 = ht_wd(ji,jj) + sshb1(ji,jj) - rn_wdmin1 
    171               IF(zdep2 .le. 0._wp) THEN  !add more safty, but not necessary 
    172                 sshb1(ji,jj) = rn_wdmin1 - ht_wd(ji,jj) 
    173                 IF(zflxu(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = 0._wp 
    174                 IF(zflxu(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = 0._wp 
    175                 IF(zflxv(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = 0._wp 
    176                 IF(zflxv(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = 0._wp  
    177                 wdmask(ji,jj) = 0._wp 
    178               END IF 
    179            ENDDO 
    180         END DO 
    181  
    182        
    183         !! start limiter iterations  
    184         DO jk1 = 1, nn_wdit + 1 
    185         
    186            
    187            zflxu1(:,:) = zflxu(:,:) * zwdlmtu(:,:) 
    188            zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:) 
    189            jflag = 0     ! flag indicating if any further iterations are needed 
    190            
    191            DO jj = 2, jpj 
    192               DO ji = 2, jpi  
    193          
    194                  IF( tmask(ji, jj, 1) < 0.5_wp ) CYCLE  
    195                  IF( ht_wd(ji,jj) > zdepwd )      CYCLE 
    196          
    197                  ztmp = e1e2t(ji,jj) 
    198  
    199                  zzflxp = max(zflxu1(ji,jj), 0._wp) - min(zflxu1(ji-1,jj),   0._wp) + & 
    200                         & max(zflxv1(ji,jj), 0._wp) - min(zflxv1(ji,  jj-1), 0._wp)  
    201                  zzflxn = min(zflxu1(ji,jj), 0._wp) - max(zflxu1(ji-1,jj),   0._wp) + & 
    202                         & min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji,  jj-1), 0._wp)  
    203            
    204                  zdep1 = (zzflxp + zzflxn) * z2dt / ztmp 
    205                  zdep2 = ht_wd(ji,jj) + sshb1(ji,jj) - rn_wdmin1 - z2dt * sshemp(ji,jj) 
    206            
    207                  IF( zdep1 > zdep2 ) THEN 
    208                    wdmask(ji, jj) = 0 
    209                    zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt ) 
    210                    !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt ) 
    211                    ! flag if the limiter has been used but stop flagging if the only 
    212                    ! changes have zeroed the coefficient since further iterations will 
    213                    ! not change anything 
    214                    IF( zcoef > 0._wp ) THEN 
    215                       jflag = 1  
    216                    ELSE 
    217                       zcoef = 0._wp 
    218                    ENDIF 
    219                    IF(jk1 > nn_wdit) zcoef = 0._wp 
    220                    IF(zflxu1(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = zcoef 
    221                    IF(zflxu1(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = zcoef 
    222                    IF(zflxv1(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = zcoef 
    223                    IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = zcoef 
    224                  END IF 
    225               END DO ! ji loop 
    226            END DO  ! jj loop 
    227  
    228            CALL lbc_lnk( zwdlmtu, 'U', 1. ) 
    229            CALL lbc_lnk( zwdlmtv, 'V', 1. ) 
    230  
    231            IF(lk_mpp) CALL mpp_max(jflag)   !max over the global domain 
    232  
    233            IF(jflag == 0) EXIT 
    234            
    235         END DO  ! jk1 loop 
    236         
    237         DO jk = 1, jpkm1 
    238           un(:,:,jk) = un(:,:,jk) * zwdlmtu(:, :)  
    239           vn(:,:,jk) = vn(:,:,jk) * zwdlmtv(:, :)  
    240         END DO 
    241  
    242         CALL lbc_lnk( un, 'U', -1. ) 
    243         CALL lbc_lnk( vn, 'V', -1. ) 
    244       ! 
    245         un_b(:,:) = un_b(:,:) * zwdlmtu(:, :) 
    246         vn_b(:,:) = vn_b(:,:) * zwdlmtv(:, :) 
    247         CALL lbc_lnk( un_b, 'U', -1. ) 
    248         CALL lbc_lnk( vn_b, 'V', -1. ) 
    249         
    250         IF(jflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt!!!' 
    251         
    252         !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field) 
    253         !IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field) 
    254         ! 
    255         ! 
    256         CALL wrk_dealloc( jpi, jpj, zflxp, zflxn, zflxu, zflxv, zflxu1, zflxv1 ) 
    257         CALL wrk_dealloc( jpi, jpj, zwdlmtu, zwdlmtv) 
    258         ! 
    259       ENDIF 
    260       ! 
    261       IF( nn_timing == 1 )  CALL timing_stop('wad_lmt') 
     114      REAL(wp),  DIMENSION(jpi,jpj) ::   zwdlmtu, zwdlmtv   ! W/D flux limiters 
     115      REAL(wp),  DIMENSION(jpi,jpj) ::   zflxp  ,  zflxn    ! local 2D workspace 
     116      REAL(wp),  DIMENSION(jpi,jpj) ::   zflxu  ,  zflxv    ! local 2D workspace 
     117      REAL(wp),  DIMENSION(jpi,jpj) ::   zflxu1 , zflxv1    ! local 2D workspace 
     118      !!---------------------------------------------------------------------- 
     119      ! 
     120      IF( ln_timing )   CALL timing_start('wad_lmt') 
     121      ! 
     122      !IF(lwp) WRITE(numout,*) 
     123      !IF(lwp) WRITE(numout,*) 'wad_lmt : wetting/drying limiters and velocity limiting' 
     124      ! 
     125      jflag  = 0 
     126      zdepwd = 50._wp   !maximum depth on which that W/D could possibly happen 
     127      !  
     128      zflxp(:,:)   = 0._wp 
     129      zflxn(:,:)   = 0._wp 
     130      zflxu(:,:)   = 0._wp 
     131      zflxv(:,:)   = 0._wp 
     132      ! 
     133      zwdlmtu(:,:) = 1._wp 
     134      zwdlmtv(:,:) = 1._wp 
     135      !  
     136      ! Horizontal Flux in u and v direction 
     137      DO jk = 1, jpkm1   
     138         DO jj = 1, jpj 
     139            DO ji = 1, jpi 
     140               zflxu(ji,jj) = zflxu(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 
     141               zflxv(ji,jj) = zflxv(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 
     142            END DO   
     143         END DO   
     144      END DO 
     145      ! 
     146      zflxu(:,:) = zflxu(:,:) * e2u(:,:) 
     147      zflxv(:,:) = zflxv(:,:) * e1v(:,:) 
     148      !  
     149      wdmask(:,:) = 1 
     150      DO jj = 2, jpj 
     151         DO ji = 2, jpi  
     152            ! 
     153            IF( tmask(ji, jj, 1) < 0.5_wp )   CYCLE   ! we don't care about land cells 
     154            IF( ht_wd(ji,jj)     > zdepwd )   CYCLE   ! and cells which are unlikely to dry 
     155            ! 
     156            zflxp(ji,jj) = MAX( zflxu(ji,jj) , 0._wp ) - MIN( zflxu(ji-1,jj) , 0._wp )   & 
     157               &         + MAX( zflxv(ji,jj) , 0._wp ) - MIN( zflxv(ji,jj-1) , 0._wp )  
     158            zflxn(ji,jj) = MIN( zflxu(ji,jj) , 0._wp ) - MAX( zflxu(ji-1,jj) , 0._wp )   & 
     159               &         + MIN( zflxv(ji,jj) , 0._wp ) - MAX( zflxv(ji,jj-1) , 0._wp )  
     160            ! 
     161            zdep2 = ht_wd(ji,jj) + sshb1(ji,jj) - rn_wdmin1 
     162            IF( zdep2 .le. 0._wp) THEN  !add more safty, but not necessary 
     163               sshb1(ji,jj) = rn_wdmin1 - ht_wd(ji,jj) 
     164               IF( zflxu(ji,  jj) > 0._wp )   zwdlmtu(ji  ,jj) = 0._wp 
     165               IF( zflxu(ji-1,jj) < 0._wp )   zwdlmtu(ji-1,jj) = 0._wp 
     166               IF( zflxv(ji,  jj) > 0._wp )   zwdlmtv(ji  ,jj) = 0._wp 
     167               IF( zflxv(ji,jj-1) < 0._wp )   zwdlmtv(ji,jj-1) = 0._wp  
     168               wdmask(ji,jj) = 0._wp 
     169            ENDIF 
     170         END DO 
     171      END DO 
     172      !! 
     173      !! start limiter iterations  
     174      DO jk1 = 1, nn_wdit + 1 
     175         !  
     176         zflxu1(:,:) = zflxu(:,:) * zwdlmtu(:,:) 
     177         zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:) 
     178         jflag = 0     ! flag indicating if any further iterations are needed 
     179         !  
     180         DO jj = 2, jpj 
     181            DO ji = 2, jpi  
     182               ! 
     183               IF( tmask(ji,jj,1) < 0.5_wp )   CYCLE  
     184               IF( ht_wd(ji,jj)   > zdepwd )   CYCLE 
     185               ! 
     186               ztmp = e1e2t(ji,jj) 
     187               ! 
     188               zzflxp = MAX( zflxu1(ji,jj) , 0._wp ) - MIN( zflxu1(ji-1,jj) , 0._wp )   & 
     189                  &   + MAX( zflxv1(ji,jj) , 0._wp ) - MIN( zflxv1(ji,jj-1) , 0._wp )  
     190               zzflxn = MIN( zflxu1(ji,jj) , 0._wp ) - MAX( zflxu1(ji-1,jj) , 0._wp )   & 
     191                  &   + MIN( zflxv1(ji,jj) , 0._wp ) - MAX( zflxv1(ji,jj-1) , 0._wp )  
     192               ! 
     193               zdep1 = (zzflxp + zzflxn) * z2dt / ztmp 
     194               zdep2 = ht_wd(ji,jj) + sshb1(ji,jj) - rn_wdmin1 - z2dt * sshemp(ji,jj) 
     195               ! 
     196               IF( zdep1 > zdep2 ) THEN 
     197                  wdmask(ji, jj) = 0 
     198                  zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt ) 
     199                  !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt ) 
     200                  ! flag if the limiter has been used but stop flagging if the only 
     201                  ! changes have zeroed the coefficient since further iterations will 
     202                  ! not change anything 
     203                  IF( zcoef > 0._wp ) THEN   ;   jflag = 1  
     204                  ELSE                       ;   zcoef = 0._wp 
     205                  ENDIF 
     206                  IF( jk1 > nn_wdit )   zcoef = 0._wp 
     207                  IF( zflxu1(ji,  jj) > 0._wp )   zwdlmtu(ji  ,jj) = zcoef 
     208                  IF( zflxu1(ji-1,jj) < 0._wp )   zwdlmtu(ji-1,jj) = zcoef 
     209                  IF( zflxv1(ji,  jj) > 0._wp )   zwdlmtv(ji  ,jj) = zcoef 
     210                  IF( zflxv1(ji,jj-1) < 0._wp )   zwdlmtv(ji,jj-1) = zcoef 
     211               ENDIF 
     212            END DO ! ji loop 
     213         END DO  ! jj loop 
     214         ! 
     215         CALL lbc_lnk( zwdlmtu, 'U', 1. ) 
     216         CALL lbc_lnk( zwdlmtv, 'V', 1. ) 
     217         ! 
     218         IF(lk_mpp)   CALL mpp_max(jflag)   !max over the global domain 
     219         ! 
     220         IF(jflag == 0)   EXIT 
     221         !  
     222      END DO  ! jk1 loop 
     223        
     224      DO jk = 1, jpkm1 
     225         un(:,:,jk) = un(:,:,jk) * zwdlmtu(:,:)  
     226         vn(:,:,jk) = vn(:,:,jk) * zwdlmtv(:,:)  
     227      END DO 
     228 
     229!!gm ==> Andrew  : the lbclnk below is useless since above lbclnk is applied on zwdlmtu/v 
     230!!                                             and un, vn always with lbclnk 
     231      CALL lbc_lnk( un, 'U', -1. ) 
     232      CALL lbc_lnk( vn, 'V', -1. ) 
     233!!gm end 
     234      ! 
     235      un_b(:,:) = un_b(:,:) * zwdlmtu(:,:) 
     236      vn_b(:,:) = vn_b(:,:) * zwdlmtv(:,:) 
     237!!gm ==> Andrew   : probably same as above 
     238      CALL lbc_lnk( un_b, 'U', -1. ) 
     239      CALL lbc_lnk( vn_b, 'V', -1. ) 
     240!!gm end 
     241        
     242      IF(jflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt!!!' 
     243        
     244      !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field) 
     245      !IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field) 
     246      ! 
     247      ! 
     248      ! 
     249      IF( ln_timing )   CALL timing_stop('wad_lmt') 
    262250      ! 
    263251   END SUBROUTINE wad_lmt 
    … …  
    284272      REAL(wp) ::   zdepwd              ! local scalar, always wet cell depth 
    285273      REAL(wp) ::   ztmp                ! local scalars 
    286       REAL(wp), POINTER,  DIMENSION(:,:) ::   zwdlmtu, zwdlmtv         !: W/D flux limiters 
    287       REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxp,  zflxn            ! local 2D workspace 
    288       REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxu1, zflxv1           ! local 2D workspace 
    289       !!---------------------------------------------------------------------- 
    290       ! 
    291       IF( nn_timing == 1 )  CALL timing_start('wad_lmt_bt') 
    292  
    293       IF(ln_wd) THEN 
    294  
    295         CALL wrk_alloc( jpi, jpj, zflxp, zflxn, zflxu1, zflxv1 ) 
    296         CALL wrk_alloc( jpi, jpj, zwdlmtu, zwdlmtv) 
    297         ! 
    298         
    299         !IF(lwp) WRITE(numout,*) 
    300         !IF(lwp) WRITE(numout,*) 'wad_lmt_bt : wetting/drying limiters and velocity limiting' 
    301         
    302         jflag  = 0 
    303         zdepwd = 50._wp   !maximum depth that ocean cells can have W/D processes 
    304  
    305         z2dt = rdtbt    
    306         
    307         zflxp(:,:)   = 0._wp 
    308         zflxn(:,:)   = 0._wp 
    309  
    310         zwdlmtu(:,:)  = 1._wp 
    311         zwdlmtv(:,:)  = 1._wp 
    312         
    313         ! Horizontal Flux in u and v direction 
    314         
    315         DO jj = 2, jpj 
    316            DO ji = 2, jpi  
    317  
    318              IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE   ! we don't care about land cells 
    319              IF( ht_wd(ji,jj) > zdepwd )      CYCLE   ! and cells which are unlikely to dry 
    320  
    321               zflxp(ji,jj) = max(zflxu(ji,jj), 0._wp) - min(zflxu(ji-1,jj),   0._wp) + & 
    322                            & max(zflxv(ji,jj), 0._wp) - min(zflxv(ji,  jj-1), 0._wp)  
    323               zflxn(ji,jj) = min(zflxu(ji,jj), 0._wp) - max(zflxu(ji-1,jj),   0._wp) + & 
    324                            & min(zflxv(ji,jj), 0._wp) - max(zflxv(ji,  jj-1), 0._wp)  
    325  
    326               zdep2 = ht_wd(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 
    327               IF(zdep2 .le. 0._wp) THEN  !add more safety, but not necessary 
    328                 sshn_e(ji,jj) = rn_wdmin1 - ht_wd(ji,jj) 
    329                 IF(zflxu(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = 0._wp 
    330                 IF(zflxu(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = 0._wp 
    331                 IF(zflxv(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = 0._wp 
    332                 IF(zflxv(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = 0._wp  
    333               END IF 
    334            ENDDO 
    335         END DO 
     274      REAL(wp), DIMENSION(jpi,jpj) ::   zwdlmtu, zwdlmtv         !: W/D flux limiters 
     275      REAL(wp), DIMENSION(jpi,jpj) ::   zflxp,  zflxn            ! local 2D workspace 
     276      REAL(wp), DIMENSION(jpi,jpj) ::   zflxu1, zflxv1           ! local 2D workspace 
     277      !!---------------------------------------------------------------------- 
     278      ! 
     279      IF( ln_timing )  CALL timing_start('wad_lmt_bt') 
     280      !        
     281      !IF(lwp) WRITE(numout,*) 
     282      !IF(lwp) WRITE(numout,*) 'wad_lmt_bt : wetting/drying limiters and velocity limiting' 
     283        
     284      jflag  = 0 
     285      zdepwd = 50._wp   !maximum depth that ocean cells can have W/D processes 
     286 
     287      z2dt = rdtbt    
     288        
     289      zflxp(:,:)   = 0._wp 
     290      zflxn(:,:)   = 0._wp 
     291 
     292      zwdlmtu(:,:) = 1._wp 
     293      zwdlmtv(:,:) = 1._wp 
     294        
     295      ! Horizontal Flux in u and v direction 
     296        
     297      DO jj = 2, jpj 
     298         DO ji = 2, jpi  
     299            ! 
     300            IF( tmask(ji,jj,1) < 0.5_wp )   CYCLE   ! we don't care about land cells 
     301            IF( ht_wd(ji,jj)   > zdepwd )   CYCLE   ! and cells which are unlikely to dry 
     302            ! 
     303            zflxp(ji,jj) = MAX( zflxu(ji,jj) , 0._wp ) - MIN( zflxu(ji-1,jj) , 0._wp )   & 
     304               &         + MAX( zflxv(ji,jj) , 0._wp ) - MIN( zflxv(ji,jj-1) , 0._wp )  
     305            zflxn(ji,jj) = MIN( zflxu(ji,jj) , 0._wp ) - MAX( zflxu(ji-1,jj) , 0._wp )   & 
     306               &         + MIN( zflxv(ji,jj) , 0._wp ) - MAX( zflxv(ji,jj-1) , 0._wp )  
     307 
     308            zdep2 = ht_wd(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 
     309            IF(zdep2 .le. 0._wp) THEN  !add more safety, but not necessary 
     310               sshn_e(ji,jj) = rn_wdmin1 - ht_wd(ji,jj) 
     311               IF( zflxu(ji,  jj) > 0._wp )   zwdlmtu(ji  ,jj) = 0._wp 
     312               IF( zflxu(ji-1,jj) < 0._wp )   zwdlmtu(ji-1,jj) = 0._wp 
     313               IF( zflxv(ji,  jj) > 0._wp )   zwdlmtv(ji  ,jj) = 0._wp 
     314               IF( zflxv(ji,jj-1) < 0._wp )   zwdlmtv(ji,jj-1) = 0._wp  
     315            ENDIF 
     316         END DO 
     317      END DO 
    336318 
    337319       
    338         !! start limiter iterations  
    339         DO jk1 = 1, nn_wdit + 1 
    340         
     320      !! start limiter iterations  
     321      DO jk1 = 1, nn_wdit + 1 
     322         !  
     323         zflxu1(:,:) = zflxu(:,:) * zwdlmtu(:,:) 
     324         zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:) 
     325         jflag = 0     ! flag indicating if any further iterations are needed 
     326         ! 
     327         DO jj = 2, jpj 
     328            DO ji = 2, jpi  
     329               ! 
     330               IF( tmask(ji,jj, 1 ) < 0.5_wp  )   CYCLE  
     331               IF( ht_wd(ji,jj)      > zdepwd )   CYCLE 
     332               ! 
     333               ztmp = e1e2t(ji,jj) 
     334               ! 
     335               zzflxp = MAX( zflxu1(ji,jj) , 0._wp ) - MIN( zflxu1(ji-1,jj) , 0._wp )   & 
     336                  &   + MAX( zflxv1(ji,jj) , 0._wp ) - MIN( zflxv1(ji,jj-1) , 0._wp )  
     337               zzflxn = MIN( zflxu1(ji,jj) , 0._wp ) - MAX( zflxu1(ji-1,jj) , 0._wp )   & 
     338                  &   + MIN( zflxv1(ji,jj) , 0._wp ) - MAX( zflxv1(ji,jj-1) , 0._wp )  
    341339           
    342            zflxu1(:,:) = zflxu(:,:) * zwdlmtu(:,:) 
    343            zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:) 
    344            jflag = 0     ! flag indicating if any further iterations are needed 
     340               zdep1 = (zzflxp + zzflxn) * z2dt / ztmp 
     341               zdep2 = ht_wd(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 - z2dt * zssh_frc(ji,jj) 
    345342           
    346            DO jj = 2, jpj 
    347               DO ji = 2, jpi  
    348          
    349                  IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE  
    350                  IF( ht_wd(ji,jj) > zdepwd )      CYCLE 
    351          
    352                  ztmp = e1e2t(ji,jj) 
    353  
    354                  zzflxp = max(zflxu1(ji,jj), 0._wp) - min(zflxu1(ji-1,jj),   0._wp) + & 
    355                         & max(zflxv1(ji,jj), 0._wp) - min(zflxv1(ji,  jj-1), 0._wp)  
    356                  zzflxn = min(zflxu1(ji,jj), 0._wp) - max(zflxu1(ji-1,jj),   0._wp) + & 
    357                         & min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji,  jj-1), 0._wp)  
    358            
    359                  zdep1 = (zzflxp + zzflxn) * z2dt / ztmp 
    360                  zdep2 = ht_wd(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 - z2dt * zssh_frc(ji,jj) 
    361            
    362                  IF(zdep1 > zdep2) THEN 
    363                    zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt ) 
    364                    !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt ) 
    365                    ! flag if the limiter has been used but stop flagging if the only 
    366                    ! changes have zeroed the coefficient since further iterations will 
    367                    ! not change anything 
    368                    IF( zcoef > 0._wp ) THEN 
     343               IF(zdep1 > zdep2) THEN 
     344                  zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt ) 
     345                  !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt ) 
     346                  ! flag if the limiter has been used but stop flagging if the only 
     347                  ! changes have zeroed the coefficient since further iterations will 
     348                  ! not change anything 
     349                  IF( zcoef > 0._wp ) THEN 
    369350                      jflag = 1  
    370                    ELSE 
     351                  ELSE 
    371352                      zcoef = 0._wp 
    372                    ENDIF 
    373                    IF(jk1 > nn_wdit) zcoef = 0._wp 
    374                    IF(zflxu1(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = zcoef 
    375                    IF(zflxu1(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = zcoef 
    376                    IF(zflxv1(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = zcoef 
    377                    IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = zcoef 
    378                  END IF 
    379               END DO ! ji loop 
    380            END DO  ! jj loop 
    381  
    382            CALL lbc_lnk( zwdlmtu, 'U', 1. ) 
    383            CALL lbc_lnk( zwdlmtv, 'V', 1. ) 
    384  
    385            IF(lk_mpp) CALL mpp_max(jflag)   !max over the global domain 
    386  
    387            IF(jflag == 0) EXIT 
    388            
    389         END DO  ! jk1 loop 
    390         
    391         zflxu(:,:) = zflxu(:,:) * zwdlmtu(:, :)  
    392         zflxv(:,:) = zflxv(:,:) * zwdlmtv(:, :)  
    393  
    394         CALL lbc_lnk( zflxu, 'U', -1. ) 
    395         CALL lbc_lnk( zflxv, 'V', -1. ) 
    396         
    397         IF(jflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt_bt!!!' 
    398         
    399         !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field) 
    400         !IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field) 
    401         ! 
    402         ! 
    403         CALL wrk_dealloc( jpi, jpj, zflxp, zflxn, zflxu1, zflxv1 ) 
    404         CALL wrk_dealloc( jpi, jpj, zwdlmtu, zwdlmtv) 
    405         ! 
    406       END IF 
    407  
    408       IF( nn_timing == 1 )  CALL timing_stop('wad_lmt') 
     353                  ENDIF 
     354                  IF( jk1 > nn_wdit )   zcoef = 0._wp 
     355                  IF( zflxu1(ji,  jj) > 0._wp )   zwdlmtu(ji  ,jj) = zcoef 
     356                  IF( zflxu1(ji-1,jj) < 0._wp )   zwdlmtu(ji-1,jj) = zcoef 
     357                  IF( zflxv1(ji,  jj) > 0._wp )   zwdlmtv(ji  ,jj) = zcoef 
     358                  IF( zflxv1(ji,jj-1) < 0._wp )   zwdlmtv(ji,jj-1) = zcoef 
     359               ENDIF 
     360            END DO ! ji loop 
     361         END DO  ! jj loop 
     362         ! 
     363         CALL lbc_lnk( zwdlmtu, 'U', 1. ) 
     364         CALL lbc_lnk( zwdlmtv, 'V', 1. ) 
     365         ! 
     366         IF(lk_mpp)   CALL mpp_max(jflag)   !max over the global domain 
     367         ! 
     368         IF( jflag == 0 )   EXIT 
     369         !     
     370      END DO  ! jk1 loop 
     371      !  
     372      zflxu(:,:) = zflxu(:,:) * zwdlmtu(:, :)  
     373      zflxv(:,:) = zflxv(:,:) * zwdlmtv(:, :)  
     374      ! 
     375      CALL lbc_lnk( zflxu, 'U', -1. ) 
     376      CALL lbc_lnk( zflxv, 'V', -1. ) 
     377      ! 
     378      IF(jflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt_bt!!!' 
     379        
     380      !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field) 
     381      !IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field) 
     382      ! 
     383      IF( ln_timing )  CALL timing_stop('wad_lmt') 
     384      ! 
    409385   END SUBROUTINE wad_lmt_bt 
    410386 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/IOM/in_out_manager.F90

    r8367 r8568  
    9696   !!---------------------------------------------------------------------- 
    9797   LOGICAL ::   ln_ctl           !: run control for debugging 
     98   LOGICAL ::   ln_timing        !: run control for timing 
     99!!gm to be removed at the end of the 2017 merge party 
    98100   INTEGER ::   nn_timing        !: run control for timing 
    99    INTEGER ::   nn_diacfl        !: flag whether to create CFL diagnostics 
     101!!gm end 
     102   LOGICAL ::   ln_diacfl        !: flag whether to create CFL diagnostics 
    100103   INTEGER ::   nn_print         !: level of print (0 no print) 
    101104   INTEGER ::   nn_ictls         !: Start i indice for the SUM control 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/LBC/lib_mpp.F90

    r8367 r8568  
    23502350      zain(2,:) = ki + 10000.*kj + 100000000.*kk 
    23512351      ! 
    2352       CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror) 
     2352      CALL MPI_ALLREDUCE( zain, zaout, 1, MPI_2DOUBLE_PRECISION, MPI_MAXLOC, MPI_COMM_OPA, ierror ) 
    23532353      ! 
    23542354      pmax = zaout(1,1) 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/LDF/ldfdyn.F90

    r7753 r8568  
    2424   USE lib_mpp         ! distribued memory computing library 
    2525   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    26    USE wrk_nemo        ! Memory Allocation 
    2726 
    2827   IMPLICIT NONE 
    … …  
    3332 
    3433   !                                                !!* Namelist namdyn_ldf : lateral mixing on momentum * 
     34   LOGICAL , PUBLIC ::   ln_dynldf_NONE  !: No operator (i.e. no explicit diffusion) 
    3535   LOGICAL , PUBLIC ::   ln_dynldf_lap   !: laplacian operator 
    3636   LOGICAL , PUBLIC ::   ln_dynldf_blp   !: bilaplacian operator 
    … …  
    9696      REAL(wp) ::   zah0              ! local scalar 
    9797      ! 
    98       NAMELIST/namdyn_ldf/ ln_dynldf_lap, ln_dynldf_blp,                  & 
    99          &                 ln_dynldf_lev, ln_dynldf_hor, ln_dynldf_iso,   & 
    100          &                 nn_ahm_ijk_t , rn_ahm_0, rn_ahm_b, rn_bhm_0,   & 
    101          &                 rn_csmc      , rn_minfac, rn_maxfac 
     98      NAMELIST/namdyn_ldf/ ln_dynldf_NONE, ln_dynldf_lap, ln_dynldf_blp,   &   ! type of operator 
     99         &                 ln_dynldf_lev, ln_dynldf_hor, ln_dynldf_iso ,   &   ! acting direction of the operator 
     100         &                 nn_ahm_ijk_t , rn_ahm_0, rn_ahm_b, rn_bhm_0 ,   &   ! lateral eddy coefficient 
     101         &                 rn_csmc      , rn_minfac, rn_maxfac                 ! Smagorinsky settings 
    102102      !!---------------------------------------------------------------------- 
    103103      ! 
    … …  
    118118         ! 
    119119         WRITE(numout,*) '      type :' 
     120         WRITE(numout,*) '         no explicit diffusion                ln_dynldf_NONE= ', ln_dynldf_NONE 
    120121         WRITE(numout,*) '         laplacian operator                   ln_dynldf_lap = ', ln_dynldf_lap 
    121122         WRITE(numout,*) '         bilaplacian operator                 ln_dynldf_blp = ', ln_dynldf_blp 
    … …  
    131132         WRITE(numout,*) '         background viscosity (iso case)      rn_ahm_b      = ', rn_ahm_b, ' m2/s' 
    132133         WRITE(numout,*) '         lateral bilaplacian eddy viscosity   rn_bhm_0      = ', rn_bhm_0, ' m4/s' 
    133          WRITE(numout,*) '      smagorinsky settings (nn_ahm_ijk_t  = 32) :' 
     134         WRITE(numout,*) '      Smagorinsky settings (nn_ahm_ijk_t  = 32) :' 
    134135         WRITE(numout,*) '         Smagorinsky coefficient              rn_csmc       = ', rn_csmc 
    135136         WRITE(numout,*) '         factor multiplier for theorectical lower limit for ' 
    … …  
    140141 
    141142      !                                ! Parameter control 
    142       IF( .NOT.ln_dynldf_lap .AND. .NOT.ln_dynldf_blp ) THEN 
     143      IF( ln_dynldf_NONE ) THEN 
    143144         IF(lwp) WRITE(numout,*) '   No viscous operator selected. ahmt and ahmf are not allocated' 
    144145         l_ldfdyn_time = .FALSE. 
    … …  
    284285      !!---------------------------------------------------------------------- 
    285286      ! 
    286       IF( nn_timing == 1 )  CALL timing_start('ldf_dyn') 
     287      IF( ln_timing )   CALL timing_start('ldf_dyn') 
    287288      ! 
    288289      SELECT CASE(  nn_ahm_ijk_t  )       !== Eddy vicosity coefficients ==! 
    … …  
    411412      CALL iom_put( "ahmf_3d", ahmf(:,:,:) )   ! 3D      v-eddy diffusivity coeff. 
    412413      ! 
    413       IF( nn_timing == 1 )  CALL timing_stop('ldf_dyn') 
     414      IF( ln_timing )   CALL timing_stop('ldf_dyn') 
    414415      ! 
    415416   END SUBROUTINE ldf_dyn 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/LDF/ldfslp.F90

    r7753 r8568  
    3232   USE lib_mpp        ! distribued memory computing library 
    3333   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    34    USE wrk_nemo       ! work arrays 
    3534   USE timing         ! Timing 
    3635 
    … …  
    118117      REAL(wp) ::   zck, zfk,      zbw             !   -      - 
    119118      REAL(wp) ::   zdepu, zdepv                   !   -      - 
    120       REAL(wp), POINTER, DIMENSION(:,:  ) ::  zslpml_hmlpu, zslpml_hmlpv 
    121       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwz, zww 
    122       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdzr 
    123       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zgru, zgrv 
    124       !!---------------------------------------------------------------------- 
    125       ! 
    126       IF( nn_timing == 1 )  CALL timing_start('ldf_slp') 
    127       ! 
    128       CALL wrk_alloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 
    129       CALL wrk_alloc( jpi,jpj, zslpml_hmlpu, zslpml_hmlpv ) 
    130  
     119      REAL(wp), DIMENSION(jpi,jpj)     ::  zslpml_hmlpu, zslpml_hmlpv 
     120      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zgru, zwz, zdzr 
     121      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zgrv, zww 
     122      !!---------------------------------------------------------------------- 
     123      ! 
     124      IF( ln_timing )   CALL timing_start('ldf_slp') 
     125      ! 
    131126      zeps   =  1.e-20_wp        !==   Local constant initialization   ==! 
    132127      z1_16  =  1.0_wp / 16._wp 
    … …  
    157152         DO jj = 1, jpjm1 
    158153            DO ji = 1, jpim1 
    159                IF ( miku(ji,jj) > 1 ) zgru(ji,jj,miku(ji,jj)) = grui(ji,jj)  
    160                IF ( mikv(ji,jj) > 1 ) zgrv(ji,jj,mikv(ji,jj)) = grvi(ji,jj) 
     154               IF( miku(ji,jj) > 1 )  zgru(ji,jj,miku(ji,jj)) = grui(ji,jj)  
     155               IF( mikv(ji,jj) > 1 )  zgrv(ji,jj,mikv(ji,jj)) = grvi(ji,jj) 
    161156            END DO 
    162157         END DO 
    … …  
    375370      ENDIF 
    376371      ! 
    377       CALL wrk_dealloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 
    378       CALL wrk_dealloc( jpi,jpj, zslpml_hmlpu, zslpml_hmlpv ) 
    379       ! 
    380       IF( nn_timing == 1 )  CALL timing_stop('ldf_slp') 
     372      IF( ln_timing )   CALL timing_stop('ldf_slp') 
    381373      ! 
    382374   END SUBROUTINE ldf_slp 
    … …  
    409401      REAL(wp) ::   zdzrho_raw 
    410402      REAL(wp) ::   zbeta0, ze3_e1, ze3_e2 
    411       REAL(wp), POINTER, DIMENSION(:,:)     ::   z1_mlbw 
    412       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalbet 
    413       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zdxrho , zdyrho, zdzrho     ! Horizontal and vertical density gradients 
    414       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zti_mlb, ztj_mlb            ! for Griffies operator only 
    415       !!---------------------------------------------------------------------- 
    416       ! 
    417       IF( nn_timing == 1 )  CALL timing_start('ldf_slp_triad') 
    418       ! 
    419       CALL wrk_alloc( jpi,jpj, z1_mlbw ) 
    420       CALL wrk_alloc( jpi,jpj,jpk, zalbet ) 
    421       CALL wrk_alloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  ) 
    422       CALL wrk_alloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  ) 
     403      REAL(wp), DIMENSION(jpi,jpj)     ::   z1_mlbw 
     404      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zalbet 
     405      REAL(wp), DIMENSION(jpi,jpj,jpk,0:1) ::   zdxrho , zdyrho, zdzrho     ! Horizontal and vertical density gradients 
     406      REAL(wp), DIMENSION(jpi,jpj,0:1,0:1) ::   zti_mlb, ztj_mlb            ! for Griffies operator only 
     407      !!---------------------------------------------------------------------- 
     408      ! 
     409      IF( ln_timing )   CALL timing_start('ldf_slp_triad') 
     410      ! 
    423411      ! 
    424412      !--------------------------------! 
    … …  
    624612      CALL lbc_lnk( wslp2, 'W', 1. )      ! lateral boundary confition on wslp2 only   ==>>> gm : necessary ? to be checked 
    625613      ! 
    626       CALL wrk_dealloc( jpi,jpj, z1_mlbw ) 
    627       CALL wrk_dealloc( jpi,jpj,jpk, zalbet ) 
    628       CALL wrk_dealloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  ) 
    629       CALL wrk_dealloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  ) 
    630       ! 
    631       IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_triad') 
     614      IF( ln_timing )   CALL timing_stop('ldf_slp_triad') 
    632615      ! 
    633616   END SUBROUTINE ldf_slp_triad 
    … …  
    663646      !!---------------------------------------------------------------------- 
    664647      ! 
    665       IF( nn_timing == 1 )  CALL timing_start('ldf_slp_mxl') 
     648      IF( ln_timing )   CALL timing_start('ldf_slp_mxl') 
    666649      ! 
    667650      zeps   =  1.e-20_wp        !==   Local constant initialization   ==! 
    … …  
    746729      CALL lbc_lnk( wslpiml, 'W', -1. )   ;   CALL lbc_lnk( wslpjml, 'W', -1. )   ! lateral boundary conditions 
    747730      ! 
    748       IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_mxl') 
     731      IF( ln_timing )   CALL timing_stop('ldf_slp_mxl') 
    749732      ! 
    750733   END SUBROUTINE ldf_slp_mxl 
    … …  
    763746      !!---------------------------------------------------------------------- 
    764747      ! 
    765       IF( nn_timing == 1 )  CALL timing_start('ldf_slp_init') 
     748      IF( ln_timing )   CALL timing_start('ldf_slp_init') 
    766749      ! 
    767750      IF(lwp) THEN 
    … …  
    821804      ENDIF 
    822805      ! 
    823       IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_init') 
     806      IF( ln_timing )   CALL timing_stop('ldf_slp_init') 
    824807      ! 
    825808   END SUBROUTINE ldf_slp_init 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/LDF/ldftra.F90

    r7753 r8568  
    3030   USE lib_mpp         ! distribued memory computing library 
    3131   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    32    USE wrk_nemo        ! work arrays 
    3332   USE timing          ! timing 
    3433 
    … …  
    4544   !                                   !!* Namelist namtra_ldf : lateral mixing on tracers *  
    4645   !                                    != Operator type =! 
     46   LOGICAL , PUBLIC ::   ln_traldf_NONE      !: no operator: No explicit diffusion 
    4747   LOGICAL , PUBLIC ::   ln_traldf_lap       !: laplacian operator 
    4848   LOGICAL , PUBLIC ::   ln_traldf_blp       !: bilaplacian operator 
    … …  
    119119      INTEGER  ::   ierr, inum, ios   ! local integer 
    120120      REAL(wp) ::   zah0              ! local scalar 
    121       ! 
    122       NAMELIST/namtra_ldf/ ln_traldf_lap, ln_traldf_blp  ,                   &   ! type of operator 
    123          &                 ln_traldf_lev, ln_traldf_hor  , ln_traldf_triad,  &   ! acting direction of the operator 
    124          &                 ln_traldf_iso, ln_traldf_msc  ,  rn_slpmax     ,  &   ! option for iso-neutral operator 
    125          &                 ln_triad_iso , ln_botmix_triad, rn_sw_triad    ,  &   ! option for triad operator 
    126          &                 rn_aht_0     , rn_bht_0       , nn_aht_ijk_t          ! lateral eddy coefficient 
     121      !! 
     122      NAMELIST/namtra_ldf/ ln_traldf_NONE, ln_traldf_lap  , ln_traldf_blp  ,  &   ! type of operator 
     123         &                 ln_traldf_lev , ln_traldf_hor  , ln_traldf_triad,  &   ! acting direction of the operator 
     124         &                 ln_traldf_iso , ln_traldf_msc  ,  rn_slpmax     ,  &   ! option for iso-neutral operator 
     125         &                 ln_triad_iso  , ln_botmix_triad, rn_sw_triad    ,  &   ! option for triad operator 
     126         &                 rn_aht_0      , rn_bht_0       , nn_aht_ijk_t          ! lateral eddy coefficient 
    127127      !!---------------------------------------------------------------------- 
    128128      ! 
    … …  
    144144         WRITE(numout,*) '~~~~~~~~~~~~ ' 
    145145         WRITE(numout,*) '   Namelist namtra_ldf : lateral mixing parameters (type, direction, coefficients)' 
    146          ! 
    147146         WRITE(numout,*) '      type :' 
     147         WRITE(numout,*) '         no explicit diffusion                   ln_traldf_NONE  = ', ln_traldf_NONE 
    148148         WRITE(numout,*) '         laplacian operator                      ln_traldf_lap   = ', ln_traldf_lap 
    149149         WRITE(numout,*) '         bilaplacian operator                    ln_traldf_blp   = ', ln_traldf_blp 
    150          ! 
    151150         WRITE(numout,*) '      direction of action :' 
    152151         WRITE(numout,*) '         iso-level                               ln_traldf_lev   = ', ln_traldf_lev 
    … …  
    159158         WRITE(numout,*) '            switching triad or not               rn_sw_triad     = ', rn_sw_triad 
    160159         WRITE(numout,*) '            lateral mixing on bottom             ln_botmix_triad = ', ln_botmix_triad 
    161          ! 
    162160         WRITE(numout,*) '      coefficients :' 
    163161         WRITE(numout,*) '         lateral eddy diffusivity   (lap case)   rn_aht_0        = ', rn_aht_0 
    … …  
    168166      !                                ! Parameter control 
    169167      ! 
    170       IF( .NOT.ln_traldf_lap .AND. .NOT.ln_traldf_blp ) THEN 
     168      IF( ln_traldf_NONE ) THEN 
    171169         IF(lwp) WRITE(numout,*) '   No diffusive operator selected. ahtu and ahtv are not allocated' 
    172170         l_ldftra_time = .FALSE. 
    … …  
    490488      ! 
    491489      INTEGER  ::   ji, jj, jk    ! dummy loop indices 
    492       REAL(wp) ::   zfw, ze3w, zn2, z1_f20, zaht, zaht_min, zzaei   ! local scalars 
    493       REAL(wp), DIMENSION(:,:), POINTER ::   zn, zah, zhw, zross, zaeiw   ! 2D workspace 
    494       !!---------------------------------------------------------------------- 
    495       ! 
    496       IF( nn_timing == 1 )   CALL timing_start('ldf_eiv') 
    497       ! 
    498       CALL wrk_alloc( jpi,jpj,   zn, zah, zhw, zross, zaeiw ) 
    499       !       
     490      REAL(wp) ::   zfw, ze3w, zn2, z1_f20, zaht, zaht_min, zzaei    ! local scalars 
     491      REAL(wp), DIMENSION(jpi,jpj) ::   zn, zah, zhw, zross, zaeiw   ! 2D workspace 
     492      !!---------------------------------------------------------------------- 
     493      ! 
     494      IF( ln_timing )   CALL timing_start('ldf_eiv') 
     495      ! 
    500496      zn   (:,:) = 0._wp      ! Local initialization 
    501497      zhw  (:,:) = 5._wp 
    … …  
    575571      END DO 
    576572      !   
    577       CALL wrk_dealloc( jpi,jpj,   zn, zah, zhw, zross, zaeiw ) 
    578       ! 
    579       IF( nn_timing == 1 )   CALL timing_stop('ldf_eiv') 
     573      IF( ln_timing )   CALL timing_stop('ldf_eiv') 
    580574      ! 
    581575   END SUBROUTINE ldf_eiv 
    … …  
    610604      REAL(wp) ::   zuwk, zuwk1, zuwi, zuwi1   ! local scalars 
    611605      REAL(wp) ::   zvwk, zvwk1, zvwj, zvwj1   !   -      - 
    612       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zpsi_uw, zpsi_vw 
    613       !!---------------------------------------------------------------------- 
    614       ! 
    615       IF( nn_timing == 1 )   CALL timing_start( 'ldf_eiv_trp') 
    616       ! 
    617       CALL wrk_alloc( jpi,jpj,jpk,   zpsi_uw, zpsi_vw ) 
    618  
     606      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zpsi_uw, zpsi_vw 
     607      !!---------------------------------------------------------------------- 
     608      ! 
     609      IF( ln_timing )   CALL timing_start( 'ldf_eiv_trp') 
     610      ! 
    619611      IF( kt == kit000 )  THEN 
    620612         IF(lwp) WRITE(numout,*) 
    … …  
    658650      IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' )   CALL ldf_eiv_dia( zpsi_uw, zpsi_vw ) 
    659651      ! 
    660       CALL wrk_dealloc( jpi,jpj,jpk,   zpsi_uw, zpsi_vw ) 
    661       ! 
    662       IF( nn_timing == 1 )   CALL timing_stop( 'ldf_eiv_trp') 
     652      IF( ln_timing )   CALL timing_stop( 'ldf_eiv_trp') 
    663653      ! 
    664654    END SUBROUTINE ldf_eiv_trp 
    … …  
    679669      INTEGER  ::   ji, jj, jk    ! dummy loop indices 
    680670      REAL(wp) ::   zztmp   ! local scalar 
    681       REAL(wp), DIMENSION(:,:)  , POINTER ::   zw2d   ! 2D workspace 
    682       REAL(wp), DIMENSION(:,:,:), POINTER ::   zw3d   ! 3D workspace 
    683       !!---------------------------------------------------------------------- 
    684       ! 
    685       IF( nn_timing == 1 )  CALL timing_start( 'ldf_eiv_dia') 
     671      REAL(wp), DIMENSION(jpi,jpj)     ::   zw2d   ! 2D workspace 
     672      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d   ! 3D workspace 
     673      !!---------------------------------------------------------------------- 
     674      ! 
     675!!gm I don't like this routine....   Crazy  way of doing things, not optimal at all... 
     676!!gm     to be redesigned....    
     677      IF( ln_timing )   CALL timing_start( 'ldf_eiv_dia') 
    686678      ! 
    687679      !                                                  !==  eiv stream function: output  ==! 
    … …  
    693685      ! 
    694686      !                                                  !==  eiv velocities: calculate and output  ==! 
    695       CALL wrk_alloc( jpi,jpj,jpk,   zw3d ) 
    696687      ! 
    697688      zw3d(:,:,jpk) = 0._wp                                    ! bottom value always 0 
    … …  
    718709      CALL iom_put( "woce_eiv", zw3d ) 
    719710      ! 
    720       !       
    721       ! 
    722       CALL wrk_alloc( jpi,jpj,   zw2d ) 
    723711      ! 
    724712      zztmp = 0.5_wp * rau0 * rcp  
    … …  
    792780      IF( ln_diaptr ) CALL dia_ptr_hst( jp_sal, 'eiv', 0.5 * zw3d ) 
    793781      ! 
    794       CALL wrk_dealloc( jpi,jpj,   zw2d ) 
    795       CALL wrk_dealloc( jpi,jpj,jpk,   zw3d ) 
    796       ! 
    797       IF( nn_timing == 1 )  CALL timing_stop( 'ldf_eiv_dia')       
     782      ! 
     783      IF( ln_timing )   CALL timing_stop( 'ldf_eiv_dia')       
    798784      ! 
    799785   END SUBROUTINE ldf_eiv_dia 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/TRA/eosbn2.F90

    r8367 r8568  
    4646   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    4747   USE prtctl         ! Print control 
    48    USE wrk_nemo       ! Memory Allocation 
    4948   USE lbclnk         ! ocean lateral boundary conditions 
    5049   USE timing         ! Timing 
    … …  
    231230      !!---------------------------------------------------------------------- 
    232231      ! 
    233       IF( nn_timing == 1 )   CALL timing_start('eos-insitu') 
     232      IF( ln_timing )   CALL timing_start('eos-insitu') 
    234233      ! 
    235234      SELECT CASE( neos ) 
    … …  
    298297      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu  : ', ovlap=1, kdim=jpk ) 
    299298      ! 
    300       IF( nn_timing == 1 )   CALL timing_stop('eos-insitu') 
     299      IF( ln_timing )   CALL timing_stop('eos-insitu') 
    301300      ! 
    302301   END SUBROUTINE eos_insitu 
    … …  
    329328      !!---------------------------------------------------------------------- 
    330329      ! 
    331       IF( nn_timing == 1 )   CALL timing_start('eos-pot') 
     330      IF( ln_timing )   CALL timing_start('eos-pot') 
    332331      ! 
    333332      SELECT CASE ( neos ) 
    … …  
    465464      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk ) 
    466465      ! 
    467       IF( nn_timing == 1 )   CALL timing_stop('eos-pot') 
     466      IF( ln_timing )   CALL timing_stop('eos-pot') 
    468467      ! 
    469468   END SUBROUTINE eos_insitu_pot 
    … …  
    491490      !!---------------------------------------------------------------------- 
    492491      ! 
    493       IF( nn_timing == 1 )   CALL timing_start('eos2d') 
     492      IF( ln_timing )   CALL timing_start('eos2d') 
    494493      ! 
    495494      prd(:,:) = 0._wp 
    … …  
    560559      IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' ) 
    561560      ! 
    562       IF( nn_timing == 1 )   CALL timing_stop('eos2d') 
     561      IF( ln_timing )   CALL timing_stop('eos2d') 
    563562      ! 
    564563   END SUBROUTINE eos_insitu_2d 
    … …  
    583582      !!---------------------------------------------------------------------- 
    584583      ! 
    585       IF( nn_timing == 1 )   CALL timing_start('rab_3d') 
     584      IF( ln_timing )   CALL timing_start('rab_3d') 
    586585      ! 
    587586      SELECT CASE ( neos ) 
    … …  
    674673         &                       tab3d_2=pab(:,:,:,jp_sal), clinfo2=' rab_3d_s : ', ovlap=1, kdim=jpk ) 
    675674      ! 
    676       IF( nn_timing == 1 )   CALL timing_stop('rab_3d') 
     675      IF( ln_timing )   CALL timing_stop('rab_3d') 
    677676      ! 
    678677   END SUBROUTINE rab_3d 
    … …  
    696695      !!---------------------------------------------------------------------- 
    697696      ! 
    698       IF( nn_timing == 1 ) CALL timing_start('rab_2d') 
     697      IF( ln_timing )  CALL timing_start('rab_2d') 
    699698      ! 
    700699      pab(:,:,:) = 0._wp 
    … …  
    791790         &                       tab2d_2=pab(:,:,jp_sal), clinfo2=' rab_2d_s : ' ) 
    792791      ! 
    793       IF( nn_timing == 1 )   CALL timing_stop('rab_2d') 
     792      IF( ln_timing )   CALL timing_stop('rab_2d') 
    794793      ! 
    795794   END SUBROUTINE rab_2d 
    … …  
    812811      !!---------------------------------------------------------------------- 
    813812      ! 
    814       IF( nn_timing == 1 ) CALL timing_start('rab_2d') 
     813      IF( ln_timing )  CALL timing_start('rab_2d') 
    815814      ! 
    816815      pab(:) = 0._wp 
    … …  
    888887      END SELECT 
    889888      ! 
    890       IF( nn_timing == 1 )   CALL timing_stop('rab_2d') 
     889      IF( ln_timing )   CALL timing_stop('rab_2d') 
    891890      ! 
    892891   END SUBROUTINE rab_0d 
    … …  
    915914      !!---------------------------------------------------------------------- 
    916915      ! 
    917       IF( nn_timing == 1 ) CALL timing_start('bn2') 
     916      IF( ln_timing )  CALL timing_start('bn2') 
    918917      ! 
    919918      DO jk = 2, jpkm1           ! interior points only (2=< jk =< jpkm1 ) 
    … …  
    935934      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2  : ', ovlap=1, kdim=jpk ) 
    936935      ! 
    937       IF( nn_timing == 1 )   CALL timing_stop('bn2') 
     936      IF( ln_timing )   CALL timing_stop('bn2') 
    938937      ! 
    939938   END SUBROUTINE bn2 
    … …  
    963962      !!---------------------------------------------------------------------- 
    964963      ! 
    965       IF ( nn_timing == 1 )   CALL timing_start('eos_pt_from_ct') 
     964      IF( ln_timing )   CALL timing_start('eos_pt_from_ct') 
    966965      ! 
    967966      zdeltaS = 5._wp 
    … …  
    994993      END DO 
    995994      ! 
    996       IF( nn_timing == 1 )   CALL timing_stop('eos_pt_from_ct') 
     995      IF( ln_timing )   CALL timing_stop('eos_pt_from_ct') 
    997996      ! 
    998997   END FUNCTION eos_pt_from_ct 
    … …  
    11281127      !!---------------------------------------------------------------------- 
    11291128      ! 
    1130       IF( nn_timing == 1 )   CALL timing_start('eos_pen') 
     1129      IF( ln_timing )   CALL timing_start('eos_pen') 
    11311130      ! 
    11321131      SELECT CASE ( neos ) 
    … …  
    12221221      END SELECT 
    12231222      ! 
    1224       IF( nn_timing == 1 )   CALL timing_stop('eos_pen') 
     1223      IF( ln_timing )   CALL timing_stop('eos_pen') 
    12251224      ! 
    12261225   END SUBROUTINE eos_pen 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/TRA/traadv.F90

    r7753 r8568  
    1414   !!---------------------------------------------------------------------- 
    1515   !!   tra_adv       : compute ocean tracer advection trend 
    16    !!   tra_adv_ctl   : control the different options of advection scheme 
     16   !!   tra_adv_init  : control the different options of advection scheme 
    1717   !!---------------------------------------------------------------------- 
    1818   USE oce            ! ocean dynamics and active tracers 
    1919   USE dom_oce        ! ocean space and time domain 
    2020   USE domvvl         ! variable vertical scale factors 
     21   USE sbcwave        ! wave module 
     22   USE sbc_oce        ! surface boundary condition: ocean 
    2123   USE traadv_cen     ! centered scheme           (tra_adv_cen  routine) 
    2224   USE traadv_fct     ! FCT      scheme           (tra_adv_fct  routine) 
    … …  
    2729   USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff. 
    2830   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces 
    29    USE trd_oce         ! trends: ocean variables 
    30    USE trdtra          ! trends manager: tracers  
     31   USE trd_oce        ! trends: ocean variables 
     32   USE trdtra         ! trends manager: tracers  
     33   USE diaptr         ! Poleward heat transport  
    3134   ! 
    3235   USE in_out_manager ! I/O manager 
    … …  
    3437   USE prtctl         ! Print control 
    3538   USE lib_mpp        ! MPP library 
    36    USE wrk_nemo       ! Memory Allocation 
    3739   USE timing         ! Timing 
    38    USE sbcwave        ! wave module 
    39    USE sbc_oce        ! surface boundary condition: ocean 
    40    USE diaptr         ! Poleward heat transport  
    4140 
    4241   IMPLICIT NONE 
    4342   PRIVATE 
    4443 
    45    PUBLIC   tra_adv        ! routine called by step module 
    46    PUBLIC   tra_adv_init   ! routine called by opa module 
     44   PUBLIC   tra_adv        ! called by step.F90 
     45   PUBLIC   tra_adv_init   ! called by nemogcm.F90 
    4746 
    4847   !                            !!* Namelist namtra_adv * 
     48   LOGICAL ::   ln_traadv_NONE   ! no advection on T and S 
    4949   LOGICAL ::   ln_traadv_cen    ! centered scheme flag 
    5050   INTEGER ::      nn_cen_h, nn_cen_v   ! =2/4 : horizontal and vertical choices of the order of CEN scheme 
    5151   LOGICAL ::   ln_traadv_fct    ! FCT scheme flag 
    5252   INTEGER ::      nn_fct_h, nn_fct_v   ! =2/4 : horizontal and vertical choices of the order of FCT scheme 
    53    INTEGER ::      nn_fct_zts           ! >=1 : 2nd order FCT with vertical sub-timestepping 
    5453   LOGICAL ::   ln_traadv_mus    ! MUSCL scheme flag 
    5554   LOGICAL ::      ln_mus_ups           ! use upstream scheme in vivcinity of river mouths 
    … …  
    5857   LOGICAL ::   ln_traadv_qck    ! QUICKEST scheme flag 
    5958 
    60    INTEGER ::              nadv             ! choice of the type of advection scheme 
    61    ! 
    62    !                                        ! associated indices: 
     59   INTEGER ::   nadv             ! choice of the type of advection scheme 
     60   !                             ! associated indices: 
    6361   INTEGER, PARAMETER ::   np_NO_adv  = 0   ! no T-S advection 
    6462   INTEGER, PARAMETER ::   np_CEN     = 1   ! 2nd/4th order centered scheme 
    6563   INTEGER, PARAMETER ::   np_FCT     = 2   ! 2nd/4th order Flux Corrected Transport scheme 
    66    INTEGER, PARAMETER ::   np_FCT_zts = 3   ! 2nd order FCT scheme with vertical sub-timestepping 
    67    INTEGER, PARAMETER ::   np_MUS     = 4   ! MUSCL scheme 
    68    INTEGER, PARAMETER ::   np_UBS     = 5   ! 3rd order Upstream Biased Scheme 
    69    INTEGER, PARAMETER ::   np_QCK     = 6   ! QUICK scheme 
     64   INTEGER, PARAMETER ::   np_MUS     = 3   ! MUSCL scheme 
     65   INTEGER, PARAMETER ::   np_UBS     = 4   ! 3rd order Upstream Biased Scheme 
     66   INTEGER, PARAMETER ::   np_QCK     = 5   ! QUICK scheme 
    7067    
    7168   !! * Substitutions 
    7269#  include "vectopt_loop_substitute.h90" 
    7370   !!---------------------------------------------------------------------- 
    74    !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
     71   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    7572   !! $Id$ 
    7673   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    8683      !! ** Method  : - Update (ua,va) with the advection term following nadv 
    8784      !!---------------------------------------------------------------------- 
    88       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     85      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    8986      ! 
    9087      INTEGER ::   jk   ! dummy loop index 
    91       REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn 
    92       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt, ztrds   ! 3D workspace 
    93       !!---------------------------------------------------------------------- 
    94       ! 
    95       IF( nn_timing == 1 )  CALL timing_start('tra_adv') 
    96       ! 
    97       CALL wrk_alloc( jpi,jpj,jpk,   zun, zvn, zwn ) 
     88      REAL(wp), DIMENSION(jpi,jpj,jpk)        :: zun, zvn, zwn   ! 3D workspace 
     89      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds 
     90      !!---------------------------------------------------------------------- 
     91      ! 
     92      IF( ln_timing )   CALL timing_start('tra_adv') 
    9893      ! 
    9994      !                                          ! set time step 
    100       zun(:,:,:) = 0.0 
    101       zvn(:,:,:) = 0.0 
    102       zwn(:,:,:) = 0.0 
    103       !     
    104       IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000 
    105          r2dt = rdt                                 ! = rdt (restarting with Euler time stepping) 
    106       ELSEIF( kt <= nit000 + 1) THEN                ! at nit000 or nit000+1 
    107          r2dt = 2._wp * rdt                         ! = 2 rdt (leapfrog) 
     95      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dt =        rdt   ! at nit000             (Euler) 
     96      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dt = 2._wp* rdt   ! at nit000 or nit000+1 (Leapfrog) 
    10897      ENDIF 
    10998      ! 
    11099      !                                         !==  effective transport  ==! 
     100      zun(:,:,jpk) = 0._wp 
     101      zvn(:,:,jpk) = 0._wp 
     102      zwn(:,:,jpk) = 0._wp 
    111103      IF( ln_wave .AND. ln_sdw )  THEN 
    112104         DO jk = 1, jpkm1                                                       ! eulerian transport + Stokes Drift 
    … …  
    146138      ! 
    147139      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    148          CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     140         ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 
    149141         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    150142         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    … …  
    153145      SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==! 
    154146      ! 
    155       CASE ( np_CEN )                                    ! Centered scheme : 2nd / 4th order 
     147      CASE ( np_CEN )                                 ! Centered scheme : 2nd / 4th order 
    156148         CALL tra_adv_cen    ( kt, nit000, 'TRA',         zun, zvn, zwn     , tsn, tsa, jpts, nn_cen_h, nn_cen_v ) 
    157       CASE ( np_FCT )                                    ! FCT scheme      : 2nd / 4th order 
     149      CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order 
    158150         CALL tra_adv_fct    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts, nn_fct_h, nn_fct_v ) 
    159       CASE ( np_FCT_zts )                                ! 2nd order FCT with vertical time-splitting 
    160          CALL tra_adv_fct_zts( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts        , nn_fct_zts ) 
    161       CASE ( np_MUS )                                    ! MUSCL 
     151      CASE ( np_MUS )                                 ! MUSCL 
    162152         CALL tra_adv_mus    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb,      tsa, jpts        , ln_mus_ups )  
    163       CASE ( np_UBS )                                    ! UBS 
     153      CASE ( np_UBS )                                 ! UBS 
    164154         CALL tra_adv_ubs    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts        , nn_ubs_v   ) 
    165       CASE ( np_QCK )                                    ! QUICKEST 
     155      CASE ( np_QCK )                                 ! QUICKEST 
    166156         CALL tra_adv_qck    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts                     ) 
    167157      ! 
    … …  
    175165         CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt ) 
    176166         CALL trd_tra( kt, 'TRA', jp_sal, jptra_totad, ztrds ) 
    177          CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     167         DEALLOCATE( ztrdt, ztrds ) 
    178168      ENDIF 
    179169      !                                              ! print mean trends (used for debugging) 
    … …  
    181171         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    182172      ! 
    183       IF( nn_timing == 1 )  CALL timing_stop( 'tra_adv' ) 
    184       ! 
    185       CALL wrk_dealloc( jpi,jpj,jpk,   zun, zvn, zwn ) 
    186       !                                           
     173      IF( ln_timing )   CALL timing_stop( 'tra_adv' ) 
     174      ! 
    187175   END SUBROUTINE tra_adv 
    188176 
    … …  
    197185      INTEGER ::   ioptio, ios   ! Local integers 
    198186      ! 
    199       NAMELIST/namtra_adv/ ln_traadv_cen, nn_cen_h, nn_cen_v,               &   ! CEN 
    200          &                 ln_traadv_fct, nn_fct_h, nn_fct_v, nn_fct_zts,   &   ! FCT 
    201          &                 ln_traadv_mus,                     ln_mus_ups,   &   ! MUSCL 
    202          &                 ln_traadv_ubs,           nn_ubs_v,               &   ! UBS 
    203          &                 ln_traadv_qck                                        ! QCK 
     187      NAMELIST/namtra_adv/ ln_traadv_NONE,                       &   ! No advection 
     188         &                 ln_traadv_cen , nn_cen_h, nn_cen_v,   &   ! CEN 
     189         &                 ln_traadv_fct , nn_fct_h, nn_fct_v,   &   ! FCT 
     190         &                 ln_traadv_mus , ln_mus_ups,           &   ! MUSCL 
     191         &                 ln_traadv_ubs ,           nn_ubs_v,   &   ! UBS 
     192         &                 ln_traadv_qck                             ! QCK 
    204193      !!---------------------------------------------------------------------- 
    205194      ! 
    … …  
    217206         WRITE(numout,*) 
    218207         WRITE(numout,*) 'tra_adv_init : choice/control of the tracer advection scheme' 
    219          WRITE(numout,*) '~~~~~~~~~~~' 
     208         WRITE(numout,*) '~~~~~~~~~~~~' 
    220209         WRITE(numout,*) '   Namelist namtra_adv : chose a advection scheme for tracers' 
     210         WRITE(numout,*) '      No advection on T & S                     ln_traadv_NONE= ', ln_traadv_NONE 
    221211         WRITE(numout,*) '      centered scheme                           ln_traadv_cen = ', ln_traadv_cen 
    222212         WRITE(numout,*) '            horizontal 2nd/4th order               nn_cen_h   = ', nn_fct_h 
    … …  
    225215         WRITE(numout,*) '            horizontal 2nd/4th order               nn_fct_h   = ', nn_fct_h 
    226216         WRITE(numout,*) '            vertical   2nd/4th order               nn_fct_v   = ', nn_fct_v 
    227          WRITE(numout,*) '            2nd order + vertical sub-timestepping  nn_fct_zts = ', nn_fct_zts 
    228217         WRITE(numout,*) '      MUSCL scheme                              ln_traadv_mus = ', ln_traadv_mus 
    229218         WRITE(numout,*) '            + upstream scheme near river mouths    ln_mus_ups = ', ln_mus_ups 
    … …  
    233222      ENDIF 
    234223      ! 
    235       ioptio = 0                       !==  Parameter control  ==! 
    236       IF( ln_traadv_cen )   ioptio = ioptio + 1 
    237       IF( ln_traadv_fct )   ioptio = ioptio + 1 
    238       IF( ln_traadv_mus )   ioptio = ioptio + 1 
    239       IF( ln_traadv_ubs )   ioptio = ioptio + 1 
    240       IF( ln_traadv_qck )   ioptio = ioptio + 1 
    241       ! 
    242       IF( ioptio == 0 ) THEN 
    243          nadv = np_NO_adv 
    244          CALL ctl_warn( 'tra_adv_init: You are running without tracer advection.' ) 
    245       ENDIF 
    246       IF( ioptio /= 1 )   CALL ctl_stop( 'tra_adv_init: Choose ONE advection scheme in namelist namtra_adv' ) 
     224      !                                !==  Parameter control & set nadv ==! 
     225      ioptio = 0                        
     226      IF( ln_traadv_NONE ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_NO_adv   ;   ENDIF 
     227      IF( ln_traadv_cen  ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_CEN      ;   ENDIF 
     228      IF( ln_traadv_fct  ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_FCT      ;   ENDIF 
     229      IF( ln_traadv_mus  ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_MUS      ;   ENDIF 
     230      IF( ln_traadv_ubs  ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_UBS      ;   ENDIF 
     231      IF( ln_traadv_qck  ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_QCK      ;   ENDIF 
     232      ! 
     233      IF( ioptio /= 1 )   CALL ctl_stop( 'tra_adv_init: Choose ONE advection option in namelist namtra_adv' ) 
    247234      ! 
    248235      IF( ln_traadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 )   &          ! Centered 
    … …  
    254241        CALL ctl_stop( 'tra_adv_init: FCT scheme, choose 2nd or 4th order' ) 
    255242      ENDIF 
    256       IF( ln_traadv_fct .AND. nn_fct_zts > 0 ) THEN 
    257          IF( nn_fct_h == 4 ) THEN 
    258             nn_fct_h = 2 
    259             CALL ctl_stop( 'tra_adv_init: force 2nd order FCT scheme, 4th order does not exist with sub-timestepping' ) 
    260          ENDIF 
    261          IF( .NOT.ln_linssh ) THEN 
    262             CALL ctl_stop( 'tra_adv_init: vertical sub-timestepping not allow in non-linear free surface' ) 
    263          ENDIF 
    264          IF( nn_fct_zts == 1 )   CALL ctl_warn( 'tra_adv_init: FCT with ONE sub-timestep = FCT without sub-timestep' ) 
    265       ENDIF 
    266243      IF( ln_traadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 )   ) THEN     ! UBS 
    267244        CALL ctl_stop( 'tra_adv_init: UBS scheme, choose 2nd or 4th order' ) 
    … …  
    275252      ENDIF 
    276253      ! 
    277       !                                !==  used advection scheme  ==!   
    278       !                                      ! set nadv 
    279       IF( ln_traadv_cen                      )   nadv = np_CEN 
    280       IF( ln_traadv_fct                      )   nadv = np_FCT 
    281       IF( ln_traadv_fct .AND. nn_fct_zts > 0 )   nadv = np_FCT_zts 
    282       IF( ln_traadv_mus                      )   nadv = np_MUS 
    283       IF( ln_traadv_ubs                      )   nadv = np_UBS 
    284       IF( ln_traadv_qck                      )   nadv = np_QCK 
    285       ! 
    286       IF(lwp) THEN                           ! Print the choice 
     254      !                                !==  Print the choice  ==!   
     255      IF(lwp) THEN 
    287256         WRITE(numout,*) 
    288257         SELECT CASE ( nadv ) 
    … …  
    292261         CASE( np_FCT     )   ;   WRITE(numout,*) '      ===>>   FCT      scheme is used. Horizontal order: ', nn_fct_h,   & 
    293262            &                                                                      ' Vertical   order: ', nn_fct_v 
    294          CASE( np_FCT_zts )   ;   WRITE(numout,*) '      ===>>   use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping' 
    295263         CASE( np_MUS     )   ;   WRITE(numout,*) '      ===>>   MUSCL    scheme is used' 
    296264         CASE( np_UBS     )   ;   WRITE(numout,*) '      ===>>   UBS      scheme is used' 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/TRA/traadv_cen.F90

    r7646 r8568  
    1111   !!                   NB: on the vertical it is actually a 4th order COMPACT scheme which is used 
    1212   !!---------------------------------------------------------------------- 
    13    USE oce      , ONLY: tsn ! now ocean temperature and salinity 
    1413   USE dom_oce        ! ocean space and time domain 
    1514   USE eosbn2         ! equation of state 
    … …  
    2423   USE trc_oce        ! share passive tracers/Ocean variables 
    2524   USE lib_mpp        ! MPP library 
    26    USE wrk_nemo       ! Memory Allocation 
    2725   USE timing         ! Timing 
    2826 
    … …  
    3028   PRIVATE 
    3129 
    32    PUBLIC   tra_adv_cen       ! routine called by step.F90 
     30   PUBLIC   tra_adv_cen   ! called by traadv.F90 
    3331    
    3432   REAL(wp) ::   r1_6 = 1._wp / 6._wp   ! =1/6 
    3533 
    36    LOGICAL :: l_trd   ! flag to compute trends 
    37    LOGICAL :: l_ptr   ! flag to compute poleward transport 
    38    LOGICAL :: l_hst   ! flag to compute heat/salt transport 
     34   LOGICAL ::   l_trd   ! flag to compute trends 
     35   LOGICAL ::   l_ptr   ! flag to compute poleward transport 
     36   LOGICAL ::   l_hst   ! flag to compute heat/salt transport 
    3937 
    4038   !! * Substitutions 
    4139#  include "vectopt_loop_substitute.h90" 
    4240   !!---------------------------------------------------------------------- 
    43    !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    44    !! $Id$ 
     41   !! NEMO/OPA 4.0, NEMO Consortium (2017) 
     42   !! $Id:$ 
    4543   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4644   !!---------------------------------------------------------------------- 
    … …  
    4846 
    4947   SUBROUTINE tra_adv_cen( kt, kit000, cdtype, pun, pvn, pwn,     & 
    50       &                                             ptn, pta, kjpt, kn_cen_h, kn_cen_v )  
     48      &                                        ptn, pta, kjpt, kn_cen_h, kn_cen_v )  
    5149      !!---------------------------------------------------------------------- 
    5250      !!                  ***  ROUTINE tra_adv_cen  *** 
    … …  
    8078      REAL(wp) ::   zC2t_u, zC4t_u   ! local scalars 
    8179      REAL(wp) ::   zC2t_v, zC4t_v   !   -      - 
    82       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx, zwy, zwz, ztu, ztv, ztw 
     80      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwx, zwy, zwz, ztu, ztv, ztw 
    8381      !!---------------------------------------------------------------------- 
    8482      ! 
    85       IF( nn_timing == 1 )  CALL timing_start('tra_adv_cen') 
    86       ! 
    87       CALL wrk_alloc( jpi,jpj,jpk,   zwx, zwy, zwz, ztu, ztv, ztw ) 
     83      IF( ln_timing )   CALL timing_start('tra_adv_cen') 
    8884      ! 
    8985      IF( kt == kit000 )  THEN 
    … …  
    9288         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ ' 
    9389      ENDIF 
    94       ! 
     90      !                          ! set local switches 
    9591      l_trd = .FALSE. 
    9692      l_hst = .FALSE. 
    … …  
    130126               END DO 
    131127            END DO 
    132             CALL lbc_lnk( ztu, 'U', -1. )   ;    CALL lbc_lnk( ztv, 'V', -1. )   ! Lateral boundary cond. (unchanged sgn) 
     128            CALL lbc_lnk( ztu, 'U', -1. )   ;    CALL lbc_lnk( ztv, 'V', -1. )   ! Lateral boundary cond. 
    133129            ! 
    134130            DO jk = 1, jpkm1                       ! Horizontal advective fluxes 
    … …  
    203199         END IF 
    204200         !                                 ! "Poleward" heat and salt transports  
    205          IF( l_ptr )  CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) 
     201         IF( l_ptr )   CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) 
    206202         !                                 !  heat and salt transport 
    207          IF( l_hst )  CALL dia_ar5_hst( jn, 'adv', zwx(:,:,:), zwy(:,:,:) ) 
     203         IF( l_hst )   CALL dia_ar5_hst( jn, 'adv', zwx(:,:,:), zwy(:,:,:) ) 
    208204         ! 
    209205      END DO 
    210206      ! 
    211       CALL wrk_dealloc( jpi,jpj,jpk,   zwx, zwy, zwz, ztu, ztv, ztw ) 
    212       ! 
    213       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_cen') 
     207      IF( ln_timing )   CALL timing_stop('tra_adv_cen') 
    214208      ! 
    215209   END SUBROUTINE tra_adv_cen 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/TRA/traadv_fct.F90

    r7753 r8568  
    99   !!---------------------------------------------------------------------- 
    1010   !!  tra_adv_fct    : update the tracer trend with a 3D advective trends using a 2nd or 4th order FCT scheme 
    11    !!  tra_adv_fct_zts: update the tracer trend with a 3D advective trends using a 2nd order FCT scheme  
    1211   !!                   with sub-time-stepping in the vertical direction 
    1312   !!  nonosc         : compute monotonic tracer fluxes by a non-oscillatory algorithm  
    … …  
    2120   USE diaptr         ! poleward transport diagnostics 
    2221   USE diaar5         ! AR5 diagnostics 
    23    USE phycst, ONLY: rau0_rcp 
     22   USE phycst  , ONLY : rau0_rcp 
    2423   ! 
    2524   USE in_out_manager ! I/O manager 
    26    USE iom 
     25   USE iom            !  
    2726   USE lib_mpp        ! MPP library 
    2827   USE lbclnk         ! ocean lateral boundary condition (or mpp link)  
    2928   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    30    USE wrk_nemo       ! Memory Allocation 
    3129   USE timing         ! Timing 
    3230 
    … …  
    3432   PRIVATE 
    3533 
    36    PUBLIC   tra_adv_fct        ! routine called by traadv.F90 
    37    PUBLIC   tra_adv_fct_zts    ! routine called by traadv.F90 
    38    PUBLIC   interp_4th_cpt     ! routine called by traadv_cen.F90 
     34   PUBLIC   tra_adv_fct        ! called by traadv.F90 
     35   PUBLIC   interp_4th_cpt     ! called by traadv_cen.F90 
    3936 
    4037   LOGICAL  ::   l_trd   ! flag to compute trends 
    … …  
    5047#  include "vectopt_loop_substitute.h90" 
    5148   !!---------------------------------------------------------------------- 
    52    !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
     49   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    5350   !! $Id$ 
    5451   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    7067      !! 
    7168      !! ** Action : - update pta  with the now advective tracer trends 
    72       !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T) 
     69      !!             - send trends to trdtra module for further diagnostics (l_trdtra=T) 
    7370      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T) 
    7471      !!---------------------------------------------------------------------- 
    … …  
    8885      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk, zC2t_u, zC4t_u   !   -      - 
    8986      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk, zC2t_v, zC4t_v   !   -      - 
    90       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw 
    91       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdx, ztrdy, ztrdz, zptry 
    92       REAL(wp), POINTER, DIMENSION(:,:)   :: z2d 
    93       !!---------------------------------------------------------------------- 
    94       ! 
    95       IF( nn_timing == 1 )  CALL timing_start('tra_adv_fct') 
    96       ! 
    97       CALL wrk_alloc( jpi,jpj,jpk,   zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw ) 
     87      REAL(wp), DIMENSION(jpi,jpj,jpk)        ::   zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw 
     88      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdx, ztrdy, ztrdz, zptry 
     89      !!---------------------------------------------------------------------- 
     90      ! 
     91      IF( ln_timing )   CALL timing_start('tra_adv_fct') 
    9892      ! 
    9993      IF( kt == kit000 )  THEN 
    … …  
    10397      ENDIF 
    10498      ! 
    105       l_trd = .FALSE. 
     99      l_trd = .FALSE.            ! set local switches 
    106100      l_hst = .FALSE. 
    107101      l_ptr = .FALSE. 
    108       IF( ( cdtype == 'TRA'   .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )     l_trd = .TRUE. 
    109       IF(   cdtype == 'TRA'   .AND. ln_diaptr )                                              l_ptr = .TRUE.  
    110       IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
    111          &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE. 
     102      IF( ( cdtype =='TRA' .AND. l_trdtra  ) .OR. ( cdtype =='TRC' .AND. l_trdtrc ) )       l_trd = .TRUE. 
     103      IF(   cdtype =='TRA' .AND. ln_diaptr )                                                l_ptr = .TRUE.  
     104      IF(   cdtype =='TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
     105         &                         iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE. 
    112106      ! 
    113107      IF( l_trd .OR. l_hst )  THEN 
    114          CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
     108         ALLOCATE( ztrdx(jpi,jpj,jpk), ztrdy(jpi,jpj,jpk), ztrdz(jpi,jpj,jpk) ) 
    115109         ztrdx(:,:,:) = 0._wp   ;    ztrdy(:,:,:) = 0._wp   ;   ztrdz(:,:,:) = 0._wp 
    116110      ENDIF 
    117111      ! 
    118112      IF( l_ptr ) THEN   
    119          CALL wrk_alloc( jpi, jpj, jpk, zptry ) 
     113         ALLOCATE( zptry(jpi,jpj,jpk) ) 
    120114         zptry(:,:,:) = 0._wp 
    121115      ENDIF 
    … …  
    184178         END IF 
    185179         !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    186          IF( l_ptr )  zptry(:,:,:) = zwy(:,:,:)  
     180         IF( l_ptr )   zptry(:,:,:) = zwy(:,:,:)  
    187181         ! 
    188182         !        !==  anti-diffusive flux : high order minus low order  ==! 
    … …  
    308302         END DO 
    309303         ! 
    310          IF( l_trd .OR. l_hst ) THEN     ! trend diagnostics (contribution of upstream fluxes) 
    311             ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed 
    312             ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
    313             ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed 
     304         IF( l_trd .OR. l_hst ) THEN   ! trend diagnostics // heat/salt transport 
     305            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< add anti-diffusive fluxes  
     306            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  !     to upstream fluxes 
     307            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! 
     308            ! 
     309            IF( l_trd ) THEN              ! trend diagnostics 
     310               CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 
     311               CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 
     312               CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
     313            ENDIF 
     314            !                             ! heat/salt transport 
     315            IF( l_hst )   CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) ) 
     316            ! 
     317            DEALLOCATE( ztrdx, ztrdy, ztrdz ) 
    314318         ENDIF 
    315             ! 
    316          IF( l_trd ) THEN  
    317             CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 
    318             CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 
    319             CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
    320             ! 
    321          END IF 
    322          !                                !  heat/salt transport 
    323          IF( l_hst )  CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) ) 
    324  
    325          !                                ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    326          IF( l_ptr ) THEN   
    327             zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
     319         IF( l_ptr ) THEN              ! "Poleward" transports 
     320            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< add anti-diffusive fluxes 
    328321            CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) ) 
     322            DEALLOCATE( zptry ) 
    329323         ENDIF 
    330324         ! 
    331325      END DO                     ! end of tracer loop 
    332326      ! 
    333                               CALL wrk_dealloc( jpi,jpj,jpk,    zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw ) 
    334       IF( l_trd .OR. l_hst )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
    335       IF( l_ptr )             CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 
    336       ! 
    337       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_fct') 
     327      IF( ln_timing )   CALL timing_stop('tra_adv_fct') 
    338328      ! 
    339329   END SUBROUTINE tra_adv_fct 
    340  
    341  
    342    SUBROUTINE tra_adv_fct_zts( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      & 
    343       &                                                  ptb, ptn, pta, kjpt, kn_fct_zts ) 
    344       !!---------------------------------------------------------------------- 
    345       !!                  ***  ROUTINE tra_adv_fct_zts  *** 
    346       !!  
    347       !! **  Purpose :   Compute the now trend due to total advection of  
    348       !!       tracers and add it to the general trend of tracer equations 
    349       !! 
    350       !! **  Method  :   TVD ZTS scheme, i.e. 2nd order centered scheme with 
    351       !!       corrected flux (monotonic correction). This version use sub- 
    352       !!       timestepping for the vertical advection which increases stability 
    353       !!       when vertical metrics are small. 
    354       !!       note: - this advection scheme needs a leap-frog time scheme 
    355       !! 
    356       !! ** Action : - update (pta) with the now advective tracer trends 
    357       !!             - save the trends  
    358       !!---------------------------------------------------------------------- 
    359       INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    360       INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    361       CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    362       INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
    363       INTEGER                              , INTENT(in   ) ::   kn_fct_zts      ! number of number of vertical sub-timesteps 
    364       REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step 
    365       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components 
    366       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields 
    367       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    368       ! 
    369       REAL(wp), DIMENSION( jpk )                           ::   zts             ! length of sub-timestep for vertical advection 
    370       REAL(wp)                                             ::   zr_p2dt         ! reciprocal of tracer timestep 
    371       INTEGER  ::   ji, jj, jk, jl, jn       ! dummy loop indices   
    372       INTEGER  ::   jtb, jtn, jta   ! sub timestep pointers for leap-frog/euler forward steps 
    373       INTEGER  ::   jtaken          ! toggle for collecting appropriate fluxes from sub timesteps 
    374       REAL(wp) ::   z_rzts          ! Fractional length of Euler forward sub-timestep for vertical advection 
    375       REAL(wp) ::   ztra            ! local scalar 
    376       REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk   !   -      - 
    377       REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      - 
    378       REAL(wp), POINTER, DIMENSION(:,:  )   ::   zwx_sav , zwy_sav 
    379       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zwi, zwx, zwy, zwz, zhdiv, zwzts, zwz_sav 
    380       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   ztrdx, ztrdy, ztrdz 
    381       REAL(wp), POINTER, DIMENSION(:,:,:) :: zptry 
    382       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrs 
    383       !!---------------------------------------------------------------------- 
    384       ! 
    385       IF( nn_timing == 1 )  CALL timing_start('tra_adv_fct_zts') 
    386       ! 
    387       CALL wrk_alloc( jpi,jpj,             zwx_sav, zwy_sav ) 
    388       CALL wrk_alloc( jpi,jpj,jpk,         zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav ) 
    389       CALL wrk_alloc( jpi,jpj,jpk,kjpt+1,  ztrs ) 
    390       ! 
    391       IF( kt == kit000 )  THEN 
    392          IF(lwp) WRITE(numout,*) 
    393          IF(lwp) WRITE(numout,*) 'tra_adv_fct_zts : 2nd order FCT scheme with ', kn_fct_zts, ' vertical sub-timestep on ', cdtype 
    394          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    395       ENDIF 
    396       ! 
    397       l_trd = .FALSE. 
    398       l_hst = .FALSE. 
    399       l_ptr = .FALSE. 
    400       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )      l_trd = .TRUE. 
    401       IF(   cdtype == 'TRA' .AND. ln_diaptr )                                               l_ptr = .TRUE.  
    402       IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
    403          &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) ) l_hst = .TRUE. 
    404       ! 
    405       IF( l_trd .OR. l_hst )  THEN 
    406          CALL wrk_alloc( jpi,jpj,jpk,   ztrdx, ztrdy, ztrdz ) 
    407          ztrdx(:,:,:) = 0._wp  ;    ztrdy(:,:,:) = 0._wp  ;   ztrdz(:,:,:) = 0._wp 
    408       ENDIF 
    409       ! 
    410       IF( l_ptr ) THEN   
    411          CALL wrk_alloc( jpi, jpj,jpk, zptry ) 
    412          zptry(:,:,:) = 0._wp 
    413       ENDIF 
    414       zwi(:,:,:) = 0._wp 
    415       z_rzts = 1._wp / REAL( kn_fct_zts, wp ) 
    416       zr_p2dt = 1._wp / p2dt 
    417       ! 
    418       ! surface & Bottom value : flux set to zero for all tracers 
    419       zwz(:,:, 1 ) = 0._wp 
    420       zwx(:,:,jpk) = 0._wp   ;    zwz(:,:,jpk) = 0._wp 
    421       zwy(:,:,jpk) = 0._wp   ;    zwi(:,:,jpk) = 0._wp 
    422       ! 
    423       !                                                          ! =========== 
    424       DO jn = 1, kjpt                                            ! tracer loop 
    425          !                                                       ! =========== 
    426          ! 
    427          ! Upstream advection with initial mass fluxes & intermediate update 
    428          DO jk = 1, jpkm1        ! upstream tracer flux in the i and j direction 
    429             DO jj = 1, jpjm1 
    430                DO ji = 1, fs_jpim1   ! vector opt. 
    431                   ! upstream scheme 
    432                   zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) ) 
    433                   zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) ) 
    434                   zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) ) 
    435                   zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) ) 
    436                   zwx(ji,jj,jk) = 0.5_wp * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn) ) 
    437                   zwy(ji,jj,jk) = 0.5_wp * ( zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji  ,jj+1,jk,jn) ) 
    438                END DO 
    439             END DO 
    440          END DO 
    441          !                       ! upstream tracer flux in the k direction 
    442          DO jk = 2, jpkm1              ! Interior value 
    443             DO jj = 1, jpj 
    444                DO ji = 1, jpi 
    445                   zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) ) 
    446                   zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) ) 
    447                   zwz(ji,jj,jk) = 0.5_wp * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk) 
    448                END DO 
    449             END DO 
    450          END DO 
    451          IF( ln_linssh ) THEN          ! top value : linear free surface case only (as zwz is multiplied by wmask) 
    452             IF( ln_isfcav ) THEN             ! ice-shelf cavities: top value 
    453                DO jj = 1, jpj 
    454                   DO ji = 1, jpi 
    455                      zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)  
    456                   END DO 
    457                END DO    
    458             ELSE                             ! no cavities, surface value 
    459                zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) 
    460             ENDIF 
    461          ENDIF 
    462          ! 
    463          DO jk = 1, jpkm1         ! total advective trend 
    464             DO jj = 2, jpjm1 
    465                DO ji = fs_2, fs_jpim1   ! vector opt. 
    466                   !                             ! total intermediate advective trends 
    467                   ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
    468                      &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   & 
    469                      &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)   ) * r1_e1e2t(ji,jj) 
    470                   !                             ! update and guess with monotonic sheme 
    471                   pta(ji,jj,jk,jn) =                     pta(ji,jj,jk,jn) +        ztra   / e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
    472                   zwi(ji,jj,jk)    = ( e3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + p2dt * ztra ) / e3t_a(ji,jj,jk) * tmask(ji,jj,jk) 
    473                END DO 
    474             END DO 
    475          END DO 
    476          !                            
    477          CALL lbc_lnk( zwi, 'T', 1. )     ! Lateral boundary conditions on zwi  (unchanged sign) 
    478          !                 
    479          IF( l_trd .OR. l_hst )  THEN                ! trend diagnostics (contribution of upstream fluxes) 
    480             ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:) 
    481          END IF 
    482          !                                ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    483          IF( l_ptr )  zptry(:,:,:) = zwy(:,:,:) 
    484  
    485          ! 3. anti-diffusive flux : high order minus low order 
    486          ! --------------------------------------------------- 
    487  
    488          DO jk = 1, jpkm1                    !* horizontal anti-diffusive fluxes 
    489             ! 
    490             DO jj = 1, jpjm1 
    491                DO ji = 1, fs_jpim1   ! vector opt. 
    492                   zwx_sav(ji,jj) = zwx(ji,jj,jk) 
    493                   zwy_sav(ji,jj) = zwy(ji,jj,jk) 
    494                   ! 
    495                   zwx(ji,jj,jk) = 0.5_wp * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) 
    496                   zwy(ji,jj,jk) = 0.5_wp * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) 
    497                END DO 
    498             END DO 
    499             ! 
    500             DO jj = 2, jpjm1                    ! partial horizontal divergence 
    501                DO ji = fs_2, fs_jpim1 
    502                   zhdiv(ji,jj,jk) = (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk)   & 
    503                      &               + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk)  ) 
    504                END DO 
    505             END DO 
    506             ! 
    507             DO jj = 1, jpjm1 
    508                DO ji = 1, fs_jpim1   ! vector opt. 
    509                   zwx(ji,jj,jk) = zwx(ji,jj,jk) - zwx_sav(ji,jj) 
    510                   zwy(ji,jj,jk) = zwy(ji,jj,jk) - zwy_sav(ji,jj) 
    511                END DO 
    512             END DO 
    513          END DO 
    514          ! 
    515          !                                !* vertical anti-diffusive flux 
    516          zwz_sav(:,:,:)   = zwz(:,:,:) 
    517          ztrs   (:,:,:,1) = ptb(:,:,:,jn) 
    518          ztrs   (:,:,1,2) = ptb(:,:,1,jn) 
    519          ztrs   (:,:,1,3) = ptb(:,:,1,jn) 
    520          zwzts  (:,:,:)   = 0._wp 
    521          ! 
    522          DO jl = 1, kn_fct_zts                  ! Start of sub timestepping loop 
    523             ! 
    524             IF( jl == 1 ) THEN                        ! Euler forward to kick things off 
    525                jtb = 1   ;   jtn = 1   ;   jta = 2 
    526                zts(:) = p2dt * z_rzts 
    527                jtaken = MOD( kn_fct_zts + 1 , 2)            ! Toggle to collect every second flux 
    528                !                                            ! starting at jl =1 if kn_fct_zts is odd;  
    529                !                                            ! starting at jl =2 otherwise 
    530             ELSEIF( jl == 2 ) THEN                    ! First leapfrog step 
    531                jtb = 1   ;   jtn = 2   ;   jta = 3 
    532                zts(:) = 2._wp * p2dt * z_rzts 
    533             ELSE                                      ! Shuffle pointers for subsequent leapfrog steps 
    534                jtb = MOD(jtb,3) + 1 
    535                jtn = MOD(jtn,3) + 1 
    536                jta = MOD(jta,3) + 1 
    537             ENDIF 
    538             DO jk = 2, jpkm1                          ! interior value 
    539                DO jj = 2, jpjm1 
    540                   DO ji = fs_2, fs_jpim1 
    541                      zwz(ji,jj,jk) = 0.5_wp * pwn(ji,jj,jk) * ( ztrs(ji,jj,jk,jtn) + ztrs(ji,jj,jk-1,jtn) ) * wmask(ji,jj,jk) 
    542                      IF( jtaken == 0 )   zwzts(ji,jj,jk) = zwzts(ji,jj,jk) + zwz(ji,jj,jk) * zts(jk)    ! Accumulate time-weighted vertcal flux 
    543                   END DO 
    544                END DO 
    545             END DO 
    546             IF( ln_linssh ) THEN                    ! top value (only in linear free surface case) 
    547                IF( ln_isfcav ) THEN                      ! ice-shelf cavities 
    548                   DO jj = 1, jpj 
    549                      DO ji = 1, jpi 
    550                         zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface  
    551                      END DO 
    552                   END DO    
    553                ELSE                                      ! no ocean cavities 
    554                   zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) 
    555                ENDIF 
    556             ENDIF 
    557             ! 
    558             jtaken = MOD( jtaken + 1 , 2 ) 
    559             ! 
    560             DO jk = 2, jpkm1                             ! total advective trends 
    561                DO jj = 2, jpjm1 
    562                   DO ji = fs_2, fs_jpim1 
    563                      ztrs(ji,jj,jk,jta) = ztrs(ji,jj,jk,jtb)                                                 & 
    564                         &               - zts(jk) * (  zhdiv(ji,jj,jk) + zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )   & 
    565                         &                         * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    566                   END DO 
    567                END DO 
    568             END DO 
    569             ! 
    570          END DO 
    571  
    572          DO jk = 2, jpkm1          ! Anti-diffusive vertical flux using average flux from the sub-timestepping 
    573             DO jj = 2, jpjm1 
    574                DO ji = fs_2, fs_jpim1 
    575                   zwz(ji,jj,jk) = ( zwzts(ji,jj,jk) * zr_p2dt - zwz_sav(ji,jj,jk) ) * wmask(ji,jj,jk) 
    576                END DO 
    577             END DO 
    578          END DO 
    579          CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions 
    580          CALL lbc_lnk( zwz, 'W',  1. ) 
    581  
    582          ! 4. monotonicity algorithm 
    583          ! ------------------------- 
    584          CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt ) 
    585  
    586  
    587          ! 5. final trend with corrected fluxes 
    588          ! ------------------------------------ 
    589          DO jk = 1, jpkm1 
    590             DO jj = 2, jpjm1 
    591                DO ji = fs_2, fs_jpim1   ! vector opt.   
    592                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + (   zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )       & 
    593                      &                                    + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)   )   & 
    594                      &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    595                END DO 
    596             END DO 
    597          END DO 
    598  
    599         ! 
    600          IF( l_trd .OR. l_hst ) THEN     ! trend diagnostics (contribution of upstream fluxes) 
    601             ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed 
    602             ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
    603             ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed 
    604          ENDIF 
    605             ! 
    606          IF( l_trd ) THEN  
    607             CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 
    608             CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 
    609             CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
    610             ! 
    611          END IF 
    612          !                                             ! heat/salt transport 
    613          IF( l_hst )  CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) ) 
    614  
    615          !                                            ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    616          IF( l_ptr ) THEN   
    617             zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
    618             CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) ) 
    619          ENDIF 
    620          ! 
    621       END DO 
    622       ! 
    623                               CALL wrk_alloc( jpi,jpj,             zwx_sav, zwy_sav ) 
    624                               CALL wrk_alloc( jpi,jpj, jpk,        zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav ) 
    625                               CALL wrk_alloc( jpi,jpj,jpk,kjpt+1,  ztrs ) 
    626       IF( l_trd .OR. l_hst )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
    627       IF( l_ptr )             CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 
    628       ! 
    629       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_fct_zts') 
    630       ! 
    631    END SUBROUTINE tra_adv_fct_zts 
    632330 
    633331 
    … …  
    653351      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn    ! local scalars 
    654352      REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      - 
    655       REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo, zbup, zbdo 
    656       !!---------------------------------------------------------------------- 
    657       ! 
    658       IF( nn_timing == 1 )  CALL timing_start('nonosc') 
    659       ! 
    660       CALL wrk_alloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo ) 
     353      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zbetup, zbetdo, zbup, zbdo 
     354      !!---------------------------------------------------------------------- 
     355      ! 
     356      IF( ln_timing )   CALL timing_start('nonosc') 
    661357      ! 
    662358      zbig  = 1.e+40_wp 
    … …  
    734430      CALL lbc_lnk( paa, 'U', -1. )   ;   CALL lbc_lnk( pbb, 'V', -1. )   ! lateral boundary condition (changed sign) 
    735431      ! 
    736       CALL wrk_dealloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo ) 
    737       ! 
    738       IF( nn_timing == 1 )  CALL timing_stop('nonosc') 
     432      IF( ln_timing )   CALL timing_stop('nonosc') 
    739433      ! 
    740434   END SUBROUTINE nonosc 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/TRA/traadv_mle.F90

    r7753 r8568  
    1515   USE phycst         ! physical constant 
    1616   USE zdfmxl         ! mixed layer depth 
     17   ! 
    1718   USE lbclnk         ! lateral boundary condition / mpp link 
    1819   USE in_out_manager ! I/O manager 
    1920   USE iom            ! IOM library 
    2021   USE lib_mpp        ! MPP library 
    21    USE wrk_nemo       ! work arrays 
    2222   USE timing         ! Timing 
    2323 
    … …  
    8686      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pw         !   increased by the MLE induced transport 
    8787      ! 
    88       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    89       INTEGER  ::   ikmax        ! temporary integer 
    90       REAL(wp) ::   zcuw, zmuw   ! local scalar 
    91       REAL(wp) ::   zcvw, zmvw   !   -      - 
    92       REAL(wp) ::   zc                                     !   -      - 
    93       ! 
    94       INTEGER  ::   ii, ij, ik              ! local integers 
    95       INTEGER, DIMENSION(3) ::   ilocu      ! 
    96       INTEGER, DIMENSION(2) ::   ilocs      ! 
    97       REAL(wp), POINTER, DIMENSION(:,:  ) :: zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH 
    98       REAL(wp), POINTER, DIMENSION(:,:,:) :: zpsi_uw, zpsi_vw 
    99       INTEGER, POINTER, DIMENSION(:,:) :: inml_mle 
    100       !!---------------------------------------------------------------------- 
    101       ! 
    102       IF( nn_timing == 1 )  CALL timing_start('tra_adv_mle') 
    103       CALL wrk_alloc( jpi, jpj, zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH) 
    104       CALL wrk_alloc( jpi, jpj, jpk, zpsi_uw, zpsi_vw) 
    105       CALL wrk_alloc( jpi, jpj, inml_mle) 
     88      INTEGER  ::   ji, jj, jk          ! dummy loop indices 
     89      INTEGER  ::   ii, ij, ik, ikmax   ! local integers 
     90      REAL(wp) ::   zcuw, zmuw, zc      ! local scalar 
     91      REAL(wp) ::   zcvw, zmvw          !   -      - 
     92      INTEGER , DIMENSION(jpi,jpj)     :: inml_mle 
     93      REAL(wp), DIMENSION(jpi,jpj)     :: zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH 
     94      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpsi_uw, zpsi_vw 
     95      !!---------------------------------------------------------------------- 
     96      ! 
     97      IF( ln_timing )   CALL timing_start('tra_adv_mle') 
    10698      ! 
    10799      !                                      !==  MLD used for MLE  ==! 
    … …  
    256248         CALL iom_put( "psiv_mle", zpsi_vw )    ! j-mle streamfunction 
    257249      ENDIF 
    258       CALL wrk_dealloc( jpi, jpj, zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH) 
    259       CALL wrk_dealloc( jpi, jpj, jpk, zpsi_uw, zpsi_vw) 
    260       CALL wrk_dealloc( jpi, jpj, inml_mle) 
    261  
    262       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_mle') 
     250      ! 
     251      IF( ln_timing )   CALL timing_stop('tra_adv_mle') 
    263252      ! 
    264253   END SUBROUTINE tra_adv_mle 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/TRA/traadv_mus.F90

    r7753 r8568  
    2626 
    2727   ! 
    28    USE iom 
    29    USE wrk_nemo       ! Memory Allocation 
     28   USE iom            ! XIOS library 
    3029   USE timing         ! Timing 
    3130   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    … …  
    8584      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    8685      ! 
    87       INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices 
    88       INTEGER  ::   ierr                 ! local integer 
    89       REAL(wp) ::   zu, z0u, zzwx, zw    ! local scalars 
    90       REAL(wp) ::   zv, z0v, zzwy, z0w   !   -      - 
    91       REAL(wp) ::   zalpha               !   -      - 
    92       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zslpx, zslpy   ! 3D workspace 
    93       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx  , zwy     ! -      -  
     86      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     87      INTEGER  ::   ierr             ! local integer 
     88      REAL(wp) ::   zu, z0u, zzwx, zw , zalpha   ! local scalars 
     89      REAL(wp) ::   zv, z0v, zzwy, z0w           !   -      - 
     90      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwx, zslpx   ! 3D workspace 
     91      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwy, zslpy   ! -      -  
    9492      !!---------------------------------------------------------------------- 
    9593      ! 
    96       IF( nn_timing == 1 )  CALL timing_start('tra_adv_mus') 
    97       ! 
    98       CALL wrk_alloc( jpi,jpj,jpk,   zslpx, zslpy, zwx, zwy ) 
     94      IF( ln_timing )   CALL timing_start('tra_adv_mus') 
    9995      ! 
    10096      IF( kt == kit000 )  THEN 
    … …  
    279275      END DO                     ! end of tracer loop 
    280276      ! 
    281       CALL wrk_dealloc( jpi,jpj,jpk,   zslpx, zslpy, zwx, zwy ) 
    282       ! 
    283       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_mus') 
     277      IF( ln_timing )   CALL timing_stop('tra_adv_mus') 
    284278      ! 
    285279   END SUBROUTINE tra_adv_mus 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/TRA/traadv_qck.F90

    r7646 r8568  
    2525   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    2626   USE in_out_manager  ! I/O manager 
    27    USE wrk_nemo        ! Memory Allocation 
    2827   USE timing          ! Timing 
    2928   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    … …  
    4342#  include "vectopt_loop_substitute.h90" 
    4443   !!---------------------------------------------------------------------- 
    45    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     44   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    4645   !! $Id$ 
    4746   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    9695      !!---------------------------------------------------------------------- 
    9796      ! 
    98       IF( nn_timing == 1 )  CALL timing_start('tra_adv_qck') 
     97      IF( ln_timing )   CALL timing_start('tra_adv_qck') 
    9998      ! 
    10099      IF( kt == kit000 )  THEN 
    … …  
    118117      CALL tra_adv_cen2_k( kt, cdtype, pwn,         ptn, pta, kjpt ) 
    119118      ! 
    120       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_qck') 
     119      IF( ln_timing )   CALL timing_stop('tra_adv_qck') 
    121120      ! 
    122121   END SUBROUTINE tra_adv_qck 
    … …  
    138137      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    139138      REAL(wp) ::   ztra, zbtr, zdir, zdx, zmsk   ! local scalars 
    140       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx, zfu, zfc, zfd 
     139      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwx, zfu, zfc, zfd 
    141140      !---------------------------------------------------------------------- 
    142141      ! 
    143       CALL wrk_alloc( jpi, jpj, jpk, zwx, zfu, zfc, zfd ) 
    144142      !                                                          ! =========== 
    145143      DO jn = 1, kjpt                                            ! tracer loop 
    … …  
    230228         END DO 
    231229         !                                 ! trend diagnostics 
    232          IF( l_trd )                     CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) ) 
     230         IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) ) 
    233231         ! 
    234232      END DO 
    235       ! 
    236       CALL wrk_dealloc( jpi, jpj, jpk, zwx, zfu, zfc, zfd ) 
    237233      ! 
    238234   END SUBROUTINE tra_adv_qck_i 
    … …  
    252248      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
    253249      !! 
    254       INTEGER  :: ji, jj, jk, jn   ! dummy loop indices 
     250      INTEGER  :: ji, jj, jk, jn                ! dummy loop indices 
    255251      REAL(wp) :: ztra, zbtr, zdir, zdx, zmsk   ! local scalars 
    256       REAL(wp), POINTER, DIMENSION(:,:,:) :: zwy, zfu, zfc, zfd 
     252      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwy, zfu, zfc, zfd   ! 3D workspace 
    257253      !---------------------------------------------------------------------- 
    258       ! 
    259       CALL wrk_alloc( jpi, jpj, jpk, zwy, zfu, zfc, zfd ) 
    260254      ! 
    261255      !                                                          ! =========== 
    … …  
    320314            END DO 
    321315         END DO 
    322          !--- Lateral boundary conditions  
    323          CALL lbc_lnk( zfu(:,:,:), 'T', 1. )  
     316         CALL lbc_lnk( zfu(:,:,:), 'T', 1. )    !--- Lateral boundary conditions  
    324317         ! 
    325318         ! Tracer flux on the x-direction 
    … …  
    359352      END DO 
    360353      ! 
    361       CALL wrk_dealloc( jpi, jpj, jpk, zwy, zfu, zfc, zfd ) 
    362       ! 
    363354   END SUBROUTINE tra_adv_qck_j 
    364355 
    … …  
    377368      ! 
    378369      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    379       REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz 
    380       !!---------------------------------------------------------------------- 
    381       ! 
    382       CALL wrk_alloc( jpi,jpj,jpk,   zwz ) 
     370      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz   ! 3D workspace 
     371      !!---------------------------------------------------------------------- 
    383372      ! 
    384373      zwz(:,:, 1 ) = 0._wp       ! surface & bottom values set to zero for all tracers 
    … …  
    421410      END DO 
    422411      ! 
    423       CALL wrk_dealloc( jpi,jpj,jpk,   zwz ) 
    424       ! 
    425412   END SUBROUTINE tra_adv_cen2_k 
    426413 
    … …  
    443430      !---------------------------------------------------------------------- 
    444431      ! 
    445       IF( nn_timing == 1 )  CALL timing_start('quickest') 
     432      IF( ln_timing )   CALL timing_start('quickest') 
    446433      ! 
    447434      DO jk = 1, jpkm1 
    … …  
    475462      END DO 
    476463      ! 
    477       IF( nn_timing == 1 )  CALL timing_stop('quickest') 
     464      IF( ln_timing )   CALL timing_stop('quickest') 
    478465      ! 
    479466   END SUBROUTINE quickest 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/TRA/traadv_ubs.F90

    r7646 r8568  
    2222 
    2323   ! 
    24    USE iom 
    25    USE lib_mpp        ! I/O library 
     24   USE iom            ! XIOS library 
     25   USE lib_mpp        ! massively parallel library 
    2626   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
    2727   USE in_out_manager ! I/O manager 
    28    USE wrk_nemo       ! Memory Allocation 
    2928   USE timing         ! Timing 
    3029   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    … …  
    101100      REAL(wp) ::   zfp_ui, zfm_ui, zcenut, ztak, zfp_wk, zfm_wk   !   -      - 
    102101      REAL(wp) ::   zfp_vj, zfm_vj, zcenvt, zeeu, zeev, z_hdivn    !   -      - 
    103       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztu, ztv, zltu, zltv, zti, ztw 
    104       !!---------------------------------------------------------------------- 
    105       ! 
    106       IF( nn_timing == 1 )  CALL timing_start('tra_adv_ubs') 
    107       ! 
    108       CALL wrk_alloc( jpi,jpj,jpk,   ztu, ztv, zltu, zltv, zti, ztw ) 
     102      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztu, ztv, zltu, zltv, zti, ztw   ! 3D workspace 
     103      !!---------------------------------------------------------------------- 
     104      ! 
     105      IF( ln_timing )   CALL timing_start('tra_adv_ubs') 
    109106      ! 
    110107      IF( kt == kit000 )  THEN 
    … …  
    285282      END DO 
    286283      ! 
    287       CALL wrk_dealloc( jpi,jpj,jpk,   ztu, ztv, zltu, zltv, zti, ztw ) 
    288       ! 
    289       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_ubs') 
     284      IF( ln_timing )   CALL timing_stop('tra_adv_ubs') 
    290285      ! 
    291286   END SUBROUTINE tra_adv_ubs 
    … …  
    313308      INTEGER  ::   ikm1         ! local integer 
    314309      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn   ! local scalars 
    315       REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo 
    316       !!---------------------------------------------------------------------- 
    317       ! 
    318       IF( nn_timing == 1 )  CALL timing_start('nonosc_z') 
    319       ! 
    320       CALL wrk_alloc( jpi,jpj,jpk,   zbetup, zbetdo ) 
     310      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zbetup, zbetdo     ! 3D workspace 
     311      !!---------------------------------------------------------------------- 
     312      ! 
     313      IF( ln_timing )   CALL timing_start('nonosc_z') 
    321314      ! 
    322315      zbig  = 1.e+40_wp 
    … …  
    387380      END DO 
    388381      ! 
    389       CALL wrk_dealloc( jpi,jpj,jpk,   zbetup, zbetdo ) 
    390       ! 
    391       IF( nn_timing == 1 )  CALL timing_stop('nonosc_z') 
     382      IF( ln_timing )   CALL timing_stop('nonosc_z') 
    392383      ! 
    393384   END SUBROUTINE nonosc_z 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/TRA/trabbc.F90

    r7753 r8568  
    2727   USE lib_mpp        ! distributed memory computing library 
    2828   USE prtctl         ! Print control 
    29    USE wrk_nemo       ! Memory Allocation 
    3029   USE timing         ! Timing 
    3130 
    … …  
    7776      ! 
    7877      INTEGER  ::   ji, jj    ! dummy loop indices 
    79       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt 
     78      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt   ! 3D workspace 
    8079      !!---------------------------------------------------------------------- 
    8180      ! 
    82       IF( nn_timing == 1 )  CALL timing_start('tra_bbc') 
     81      IF( ln_timing )   CALL timing_start('tra_bbc') 
    8382      ! 
    8483      IF( l_trdtra )   THEN         ! Save the input temperature trend 
    85          CALL wrk_alloc( jpi,jpj,jpk,   ztrdt ) 
     84         ALLOCATE( ztrdt(jpi,jpj,jpk) ) 
    8685         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    8786      ENDIF 
    … …  
    9897         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    9998         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrdt ) 
    100          CALL wrk_dealloc( jpi,jpj,jpk,  ztrdt ) 
     99         DEALLOCATE( ztrdt ) 
    101100      ENDIF 
    102101      ! 
    103102      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 
    104103      ! 
    105       IF( nn_timing == 1 )  CALL timing_stop('tra_bbc') 
     104      IF( ln_timing )   CALL timing_stop('tra_bbc') 
    106105      ! 
    107106   END SUBROUTINE tra_bbc 
    … …  
    130129      TYPE(FLD_N)        ::   sn_qgh    ! informations about the geotherm. field to be read 
    131130      CHARACTER(len=256) ::   cn_dir    ! Root directory for location of ssr files 
    132       ! 
     131      !! 
    133132      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst, sn_qgh, cn_dir  
    134133      !!---------------------------------------------------------------------- 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/TRA/trabbl.F90

    r8367 r8568  
    3535   USE lbclnk         ! ocean lateral boundary conditions 
    3636   USE prtctl         ! Print control 
    37    USE wrk_nemo       ! Memory Allocation 
    3837   USE timing         ! Timing 
    3938   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    … …  
    104103      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
    105104      ! 
    106       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    107       !!---------------------------------------------------------------------- 
    108       ! 
    109       IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl') 
     105      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds 
     106      !!---------------------------------------------------------------------- 
     107      ! 
     108      IF( ln_timing )   CALL timing_start( 'tra_bbl') 
    110109      ! 
    111110      IF( l_trdtra )   THEN                         !* Save the T-S input trends 
    112          CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     111         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
    113112         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    114113         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    … …  
    148147         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrdt ) 
    149148         CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrds ) 
    150          CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
    151       ENDIF 
    152       ! 
    153       IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl') 
     149         DEALLOCATE( ztrdt, ztrds ) 
     150      ENDIF 
     151      ! 
     152      IF( ln_timing )  CALL timing_stop( 'tra_bbl') 
    154153      ! 
    155154   END SUBROUTINE tra_bbl 
    … …  
    184183      INTEGER  ::   ik           ! local integers 
    185184      REAL(wp) ::   zbtr         ! local scalars 
    186       REAL(wp), POINTER, DIMENSION(:,:) :: zptb 
    187       !!---------------------------------------------------------------------- 
    188       ! 
    189       IF( nn_timing == 1 )  CALL timing_start('tra_bbl_dif') 
    190       ! 
    191       CALL wrk_alloc( jpi, jpj, zptb ) 
     185      REAL(wp), DIMENSION(jpi,jpj) ::   zptb   ! workspace 
     186      !!---------------------------------------------------------------------- 
     187      ! 
     188      IF( ln_timing )   CALL timing_start('tra_bbl_dif') 
    192189      ! 
    193190      DO jn = 1, kjpt                                     ! tracer loop 
    … …  
    214211      END DO                                                ! end tracer 
    215212      !                                                     ! =========== 
    216       CALL wrk_dealloc( jpi, jpj, zptb ) 
    217       ! 
    218       IF( nn_timing == 1 )  CALL timing_stop('tra_bbl_dif') 
     213      ! 
     214      IF( ln_timing )   CALL timing_stop('tra_bbl_dif') 
    219215      ! 
    220216   END SUBROUTINE tra_bbl_dif 
    … …  
    247243      !!---------------------------------------------------------------------- 
    248244      ! 
    249       IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl_adv') 
     245      IF( ln_timing )   CALL timing_start( 'tra_bbl_adv') 
    250246      !                                                          ! =========== 
    251247      DO jn = 1, kjpt                                            ! tracer loop 
    … …  
    303299      !                                                     ! =========== 
    304300      ! 
    305       IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl_adv') 
     301      IF( ln_timing )   CALL timing_stop( 'tra_bbl_adv') 
    306302      ! 
    307303   END SUBROUTINE tra_bbl_adv 
    … …  
    348344      !!---------------------------------------------------------------------- 
    349345      ! 
    350       IF( nn_timing == 1 )  CALL timing_start( 'bbl') 
     346      IF( ln_timing )   CALL timing_start( 'bbl') 
    351347      ! 
    352348      IF( kt == kit000 )  THEN 
    … …  
    479475      ENDIF 
    480476      ! 
    481       IF( nn_timing == 1 )  CALL timing_stop( 'bbl') 
     477      IF( ln_timing )   CALL timing_stop( 'bbl') 
    482478      ! 
    483479   END SUBROUTINE bbl 
    … …  
    493489      !!              called by nemo_init at the first timestep (kit000) 
    494490      !!---------------------------------------------------------------------- 
    495       INTEGER ::   ji, jj               ! dummy loop indices 
    496       INTEGER ::   ii0, ii1, ij0, ij1   ! local integer 
    497       INTEGER ::   ios                  !   -      - 
    498       REAL(wp), POINTER, DIMENSION(:,:) :: zmbk 
     491      INTEGER ::   ji, jj                      ! dummy loop indices 
     492      INTEGER ::   ii0, ii1, ij0, ij1, ios     ! local integer 
     493      REAL(wp), DIMENSION(jpi,jpj) ::   zmbk   ! workspace 
    499494      !! 
    500495      NAMELIST/nambbl/ ln_trabbl, nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl 
    501496      !!---------------------------------------------------------------------- 
    502497      ! 
    503       IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl_init') 
     498      IF( ln_timing )   CALL timing_start( 'tra_bbl_init') 
    504499      ! 
    505500      REWIND( numnam_ref )              ! Namelist nambbl in reference namelist : Bottom boundary layer scheme 
    … …  
    544539      END DO 
    545540      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
    546       CALL wrk_alloc( jpi, jpj, zmbk ) 
    547541      zmbk(:,:) = REAL( mbku_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'U',1.)   ;   mbku_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
    548542      zmbk(:,:) = REAL( mbkv_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
    549       CALL wrk_dealloc( jpi, jpj, zmbk ) 
    550543      ! 
    551544      !                                 !* sign of grad(H) at u- and v-points 
    … …  
    570563      ahv_bbl_0(:,:) = rn_ahtbbl * e1_e2v(:,:) * e3v_bbl_0(:,:) * vmask(:,:,1) 
    571564      ! 
    572       IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl_init') 
     565      IF( ln_timing )   CALL timing_stop( 'tra_bbl_init') 
    573566      ! 
    574567   END SUBROUTINE tra_bbl_init 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/TRA/tradmp.F90

    r7753 r8568  
    3333   ! 
    3434   USE in_out_manager ! I/O manager 
     35   USE iom            ! XIOS 
    3536   USE lib_mpp        ! MPP library 
    3637   USE prtctl         ! Print control 
    37    USE wrk_nemo       ! Memory allocation 
    3838   USE timing         ! Timing 
    39    USE iom 
    4039 
    4140   IMPLICIT NONE 
    … …  
    9493      ! 
    9594      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
    96       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zts_dta, ztrdts 
    97       !!---------------------------------------------------------------------- 
    98       ! 
    99       IF( nn_timing == 1 )   CALL timing_start('tra_dmp') 
    100       ! 
    101       CALL wrk_alloc( jpi,jpj,jpk,jpts,   zts_dta ) 
     95      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts)     ::  zts_dta 
     96      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  ztrdts 
     97      !!---------------------------------------------------------------------- 
     98      ! 
     99      IF( ln_timing )   CALL timing_start('tra_dmp') 
     100      ! 
    102101      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    103          CALL wrk_alloc( jpi,jpj,jpk,jpts,   ztrdts )  
     102         ALLOCATE( ztrdts(jpi,jpj,jpk,jpts) )  
    104103         ztrdts(:,:,:,:) = tsa(:,:,:,:)  
    105104      ENDIF 
    … …  
    154153         CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) ) 
    155154         CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) ) 
    156          CALL wrk_dealloc( jpi,jpj,jpk,jpts,  ztrdts )  
     155         DEALLOCATE( ztrdts )  
    157156      ENDIF 
    158157      !                           ! Control print 
    … …  
    160159         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    161160      ! 
    162       CALL wrk_dealloc( jpi,jpj,jpk,jpts,   zts_dta ) 
    163       ! 
    164       IF( nn_timing == 1 )   CALL timing_stop('tra_dmp') 
     161      IF( ln_timing )   CALL timing_stop('tra_dmp') 
    165162      ! 
    166163   END SUBROUTINE tra_dmp 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/TRA/traldf.F90

    r7765 r8568  
    3030   USE lib_mpp        ! distribued memory computing library 
    3131   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    32    USE wrk_nemo       ! Memory allocation 
    3332   USE timing         ! Timing 
    3433 
    … …  
    5857      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    5958      !! 
    60       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    61       !!---------------------------------------------------------------------- 
    62       ! 
    63       IF( nn_timing == 1 )   CALL timing_start('tra_ldf') 
     59      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds 
     60      !!---------------------------------------------------------------------- 
     61      ! 
     62      IF( ln_timing )   CALL timing_start('tra_ldf') 
    6463      ! 
    6564      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    66          CALL wrk_alloc( jpi,jpj,jpk,   ztrdt, ztrds )  
     65         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )  
    6766         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)  
    6867         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    … …  
    8584         CALL trd_tra( kt, 'TRA', jp_tem, jptra_ldf, ztrdt ) 
    8685         CALL trd_tra( kt, 'TRA', jp_sal, jptra_ldf, ztrds ) 
    87          CALL wrk_dealloc( jpi,jpj,jpk,  ztrdt, ztrds )  
     86         DEALLOCATE( ztrdt, ztrds )  
    8887      ENDIF 
    8988      !                                        !* print mean trends (used for debugging) 
    … …  
    9190         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    9291      ! 
    93       IF( nn_timing == 1 )   CALL timing_stop('tra_ldf') 
     92      IF( ln_timing )   CALL timing_stop('tra_ldf') 
    9493      ! 
    9594   END SUBROUTINE tra_ldf 
    … …  
    107106      !!---------------------------------------------------------------------- 
    108107      ! 
    109       IF(lwp) THEN                     ! Namelist print 
     108      IF(lwp) THEN                     !==  Namelist print  ==! 
    110109         WRITE(numout,*) 
    111110         WRITE(numout,*) 'tra_ldf_init : lateral tracer diffusive operator' 
    … …  
    114113         WRITE(numout,*) '      see ldf_tra_init report for lateral mixing parameters' 
    115114      ENDIF 
    116       !                                   ! use of lateral operator or not 
     115      !                                !==  use of lateral operator or not  ==! 
    117116      nldf   = np_ERROR 
    118117      ioptio = 0 
    119       IF( ln_traldf_lap )   ioptio = ioptio + 1 
    120       IF( ln_traldf_blp )   ioptio = ioptio + 1 
    121       IF( ioptio >  1   )   CALL ctl_stop( 'tra_ldf_init: use ONE or NONE of the 2 lap/bilap operator type on tracer' ) 
    122       IF( ioptio == 0   )   nldf = np_no_ldf     ! No lateral diffusion 
    123       ! 
    124       IF( nldf /= np_no_ldf ) THEN        ! direction ==>> type of operator   
     118      IF( ln_traldf_NONE ) THEN   ;   nldf = np_no_ldf   ;   ioptio = ioptio + 1   ;   ENDIF 
     119      IF( ln_traldf_lap  ) THEN   ;                          ioptio = ioptio + 1   ;   ENDIF 
     120      IF( ln_traldf_blp  ) THEN   ;                          ioptio = ioptio + 1   ;   ENDIF 
     121      IF( ioptio /=  1   )   CALL ctl_stop( 'tra_ldf_init: use ONE of the 3 operator options (NONE/lap/blp)' ) 
     122      ! 
     123      IF( .NOT.ln_traldf_NONE ) THEN   !==  direction ==>> type of operator  ==! 
    125124         ioptio = 0 
    126125         IF( ln_traldf_lev )   ioptio = ioptio + 1 
    127126         IF( ln_traldf_hor )   ioptio = ioptio + 1 
    128127         IF( ln_traldf_iso )   ioptio = ioptio + 1 
    129          IF( ioptio >  1 )   CALL ctl_stop( 'tra_ldf_init: use only ONE direction (level/hor/iso)' ) 
     128         IF( ioptio /=  1  )   CALL ctl_stop( 'tra_ldf_init: use ONE direction (level/hor/iso)' ) 
    130129         ! 
    131130         !                                ! defined the type of lateral diffusion from ln_traldf_... logicals 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/TRA/traldf_iso.F90

    r7753 r8568  
    3030   USE phycst         ! physical constants 
    3131   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    32    USE wrk_nemo       ! Memory Allocation 
    3332   USE timing         ! Timing 
    3433 
    … …  
    111110      REAL(wp) ::  zmskv, zahv_w, zabe2, zcof2, zcoef4   !   -      - 
    112111      REAL(wp) ::  zcoef0, ze3w_2, zsign, z2dt, z1_2dt   !   -      - 
    113       REAL(wp), POINTER, DIMENSION(:,:)   ::   zdkt, zdk1t, z2d 
    114       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdit, zdjt, zftu, zftv, ztfw  
    115       !!---------------------------------------------------------------------- 
    116       ! 
    117       IF( nn_timing == 1 )  CALL timing_start('tra_ldf_iso') 
    118       ! 
    119       CALL wrk_alloc( jpi,jpj,       zdkt, zdk1t, z2d )  
    120       CALL wrk_alloc( jpi,jpj,jpk,   zdit, zdjt , zftu, zftv, ztfw  )  
     112      REAL(wp), DIMENSION(jpi,jpj)     ::   zdkt, zdk1t, z2d 
     113      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdit, zdjt, zftu, zftv, ztfw  
     114      !!---------------------------------------------------------------------- 
     115      ! 
     116      IF( ln_timing )   CALL timing_start('tra_ldf_iso') 
    121117      ! 
    122118      IF( kt == kit000 )  THEN 
    … …  
    386382         !                                                        ! =============== 
    387383      END DO                                                      ! end tracer loop 
    388       !                                                           ! =============== 
    389       ! 
    390       CALL wrk_dealloc( jpi, jpj,      zdkt, zdk1t, z2d )  
    391       CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt , zftu, zftv, ztfw  )  
    392       ! 
    393       IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_iso') 
     384      ! 
     385      IF( ln_timing )   CALL timing_stop('tra_ldf_iso') 
    394386      ! 
    395387   END SUBROUTINE tra_ldf_iso 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/TRA/traldf_lap_blp.F90

    r7646 r8568  
    2222   ! 
    2323   USE in_out_manager ! I/O manager 
     24   USE iom            ! I/O library 
    2425   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    2526   USE lib_mpp        ! distribued memory computing library 
    2627   USE timing         ! Timing 
    27    USE wrk_nemo       ! Memory allocation 
    28    USE iom 
    2928 
    3029   IMPLICIT NONE 
    … …  
    8786      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    8887      REAL(wp) ::   zsign            ! local scalars 
    89       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztu, ztv, zaheeu, zaheev 
    90       !!---------------------------------------------------------------------- 
    91       ! 
    92       IF( nn_timing == 1 )   CALL timing_start('tra_ldf_lap') 
     88      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztu, ztv, zaheeu, zaheev 
     89      !!---------------------------------------------------------------------- 
     90      ! 
     91      IF( ln_timing )   CALL timing_start('tra_ldf_lap') 
    9392      ! 
    9493      IF( kt == nit000 .AND. lwp )  THEN 
    … …  
    9796         WRITE(numout,*) '~~~~~~~~~~~ ' 
    9897      ENDIF 
    99       ! 
    100       CALL wrk_alloc( jpi,jpj,jpk,   ztu, ztv, zaheeu, zaheev )  
    10198      ! 
    10299      l_hst = .FALSE. 
    … …  
    169166      !                             ! ================== 
    170167      ! 
    171       CALL wrk_dealloc( jpi,jpj,jpk,   ztu, ztv, zaheeu, zaheev )  
    172       ! 
    173       IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_lap') 
     168      IF( ln_timing )   CALL timing_stop('tra_ldf_lap') 
    174169      ! 
    175170   END SUBROUTINE tra_ldf_lap 
    … …  
    203198      ! 
    204199      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
    205       REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zlap         ! laplacian at t-point 
    206       REAL(wp), POINTER, DIMENSION(:,:,:)  :: zglu, zglv   ! bottom GRADh of the laplacian (u- and v-points) 
    207       REAL(wp), POINTER, DIMENSION(:,:,:)  :: zgui, zgvi   ! top    GRADh of the laplacian (u- and v-points) 
     200      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt) :: zlap         ! laplacian at t-point 
     201      REAL(wp), DIMENSION(jpi,jpj,    kjpt) :: zglu, zglv   ! bottom GRADh of the laplacian (u- and v-points) 
     202      REAL(wp), DIMENSION(jpi,jpj,    kjpt) :: zgui, zgvi   ! top    GRADh of the laplacian (u- and v-points) 
    208203      !!--------------------------------------------------------------------- 
    209204      ! 
    210       IF( nn_timing == 1 )  CALL timing_start('tra_ldf_blp') 
    211       ! 
    212       CALL wrk_alloc( jpi,jpj,jpk,kjpt,   zlap )  
    213       CALL wrk_alloc( jpi,jpj,    kjpt,   zglu, zglv, zgui, zgvi )  
     205      IF( ln_timing )   CALL timing_start('tra_ldf_blp') 
    214206      ! 
    215207      IF( kt == kit000 .AND. lwp )  THEN 
    … …  
    253245      END SELECT 
    254246      ! 
    255       CALL wrk_dealloc( jpi,jpj,jpk,kjpt,   zlap )  
    256       CALL wrk_dealloc( jpi,jpj    ,kjpt,   zglu, zglv, zgui, zgvi )  
    257       ! 
    258       IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_blp') 
     247      IF( ln_timing )   CALL timing_stop('tra_ldf_blp') 
    259248      ! 
    260249   END SUBROUTINE tra_ldf_blp 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/TRA/traldf_triad.F90

    r7646 r8568  
    2727   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    2828   USE lib_mpp        ! MPP library 
    29    USE wrk_nemo       ! Memory Allocation 
    3029   USE timing         ! Timing 
    3130 
    … …  
    9493      REAL(wp) ::   ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt 
    9594      REAL(wp) ::   zah, zah_slp, zaei_slp 
    96       REAL(wp), POINTER, DIMENSION(:,:  ) :: z2d                                            ! 2D workspace 
    97       REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw   ! 3D     - 
     95      REAL(wp), DIMENSION(jpi,jpj    ) ::   z2d                                              ! 2D workspace 
     96      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw   ! 3D     - 
    9897      !!---------------------------------------------------------------------- 
    9998      ! 
    100       IF( nn_timing == 1 )  CALL timing_start('tra_ldf_triad') 
    101       ! 
    102       CALL wrk_alloc( jpi,jpj,       z2d )  
    103       CALL wrk_alloc( jpi,jpj,jpk,   zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw  )  
     99      IF( ln_timing )   CALL timing_start('tra_ldf_triad') 
    104100      ! 
    105101      IF( .NOT.ALLOCATED(zdkt3d) )  THEN 
    … …  
    434430      END DO                                                      ! end tracer loop 
    435431      !                                                           ! =============== 
    436       ! 
    437       CALL wrk_dealloc( jpi,jpj,       z2d )  
    438       CALL wrk_dealloc( jpi,jpj,jpk,   zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw  )  
    439       ! 
    440       IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_triad') 
     432      IF( ln_timing )   CALL timing_stop('tra_ldf_triad') 
    441433      ! 
    442434   END SUBROUTINE tra_ldf_triad 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/TRA/tranpc.F90

    r6140 r8568  
    2626   USE in_out_manager ! I/O manager 
    2727   USE lib_mpp        ! MPP library 
    28    USE wrk_nemo       ! Memory Allocation 
    2928   USE timing         ! Timing 
    3029 
    … …  
    6766      REAL(wp) ::   zta, zalfa, zsum_temp, zsum_alfa, zaw, zdz, zsum_z 
    6867      REAL(wp) ::   zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw, z1_r2dt 
    69       REAL(wp), PARAMETER :: zn2_zero = 1.e-14_wp       ! acceptance criteria for neutrality (N2==0) 
    70       REAL(wp), POINTER, DIMENSION(:)       ::   zvn2   ! vertical profile of N2 at 1 given point... 
    71       REAL(wp), POINTER, DIMENSION(:,:)     ::   zvts   ! vertical profile of T and S at 1 given point... 
    72       REAL(wp), POINTER, DIMENSION(:,:)     ::   zvab   ! vertical profile of alpha and beta 
    73       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zn2    ! N^2  
    74       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zab    ! alpha and beta 
    75       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   ztrdt, ztrds   ! 3D workspace 
     68      REAL(wp), PARAMETER ::   zn2_zero = 1.e-14_wp      ! acceptance criteria for neutrality (N2==0) 
     69      REAL(wp), DIMENSION(        jpk     ) ::   zvn2         ! vertical profile of N2 at 1 given point... 
     70      REAL(wp), DIMENSION(        jpk,jpts) ::   zvts, zvab   ! vertical profile of T & S , and  alpha & betaat 1 given point 
     71      REAL(wp), DIMENSION(jpi,jpj,jpk     ) ::   zn2          ! N^2  
     72      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) ::   zab          ! alpha and beta 
     73      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds   ! 3D workspace 
    7674      ! 
    7775      LOGICAL, PARAMETER :: l_LB_debug = .FALSE. ! set to true if you want to follow what is 
    … …  
    8078      !!---------------------------------------------------------------------- 
    8179      ! 
    82       IF( nn_timing == 1 )  CALL timing_start('tra_npc') 
     80      IF( ln_timing )   CALL timing_start('tra_npc') 
    8381      ! 
    8482      IF( MOD( kt, nn_npc ) == 0 ) THEN 
    8583         ! 
    86          CALL wrk_alloc( jpi, jpj, jpk, zn2 )    ! N2 
    87          CALL wrk_alloc( jpi, jpj, jpk, 2, zab ) ! Alpha and Beta 
    88          CALL wrk_alloc( jpk, 2, zvts, zvab )    ! 1D column vector at point ji,jj 
    89          CALL wrk_alloc( jpk, zvn2 )             ! 1D column vector at point ji,jj 
    90  
    9184         IF( l_trdtra )   THEN                    !* Save initial after fields 
    92             CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     85            ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
    9386            ztrdt(:,:,:) = tsa(:,:,:,jp_tem)  
    9487            ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    9588         ENDIF 
    96  
     89         ! 
    9790         IF( l_LB_debug ) THEN 
    9891            ! Location of 1 known convection site to follow what's happening in the water column 
    … …  
    10194            klc1 =  mbkt(ilc1,jlc1) ! bottom of the ocean for debug point...           
    10295         ENDIF 
    103           
     96         ! 
    10497         CALL eos_rab( tsa, zab )         ! after alpha and beta (given on T-points) 
    10598         CALL bn2    ( tsa, zab, zn2 )    ! after Brunt-Vaisala  (given on W-points) 
    106          
     99         ! 
    107100         inpcc = 0 
    108  
     101         ! 
    109102         DO jj = 2, jpjm1                 ! interior column only 
    110103            DO ji = fs_2, fs_jpim1 
    … …  
    313306            CALL trd_tra( kt, 'TRA', jp_tem, jptra_npc, ztrdt ) 
    314307            CALL trd_tra( kt, 'TRA', jp_sal, jptra_npc, ztrds ) 
    315             CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     308            DEALLOCATE( ztrdt, ztrds ) 
    316309         ENDIF 
    317310         ! 
    … …  
    323316         ENDIF 
    324317         ! 
    325          CALL wrk_dealloc(jpi, jpj, jpk, zn2 ) 
    326          CALL wrk_dealloc(jpi, jpj, jpk, 2, zab ) 
    327          CALL wrk_dealloc(jpk, zvn2 ) 
    328          CALL wrk_dealloc(jpk, 2, zvts, zvab ) 
    329          ! 
    330318      ENDIF   ! IF( MOD( kt, nn_npc ) == 0 ) THEN 
    331319      ! 
    332       IF( nn_timing == 1 )  CALL timing_stop('tra_npc') 
     320      IF( ln_timing )   CALL timing_stop('tra_npc') 
    333321      ! 
    334322   END SUBROUTINE tra_npc 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/TRA/tranxt.F90

    r7753 r8568  
    3535   USE traqsr          ! penetrative solar radiation (needed for nksr) 
    3636   USE phycst          ! physical constant 
    37    USE ldftra          ! lateral physics on tracers 
    38    USE ldfslp 
    39    USE bdy_oce   , ONLY: ln_bdy 
     37   USE ldftra          ! lateral physics : tracers 
     38   USE ldfslp          ! lateral physics : slopes 
     39   USE bdy_oce  , ONLY : ln_bdy 
    4040   USE bdytra          ! open boundary condition (bdy_tra routine) 
    4141   ! 
    … …  
    4343   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    4444   USE prtctl          ! Print control 
    45    USE wrk_nemo        ! Memory allocation 
    4645   USE timing          ! Timing 
    4746#if defined key_agrif 
    … …  
    9190      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    9291      REAL(wp) ::   zfact            ! local scalars 
    93       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    94       !!---------------------------------------------------------------------- 
    95       ! 
    96       IF( nn_timing == 1 )  CALL timing_start( 'tra_nxt') 
     92      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds 
     93      !!---------------------------------------------------------------------- 
     94      ! 
     95      IF( ln_timing )   CALL timing_start( 'tra_nxt') 
    9796      ! 
    9897      IF( kt == nit000 ) THEN 
    … …  
    120119      ! trends computation initialisation 
    121120      IF( l_trdtra )   THEN                     
    122          CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     121         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
    123122         ztrdt(:,:,jk) = 0._wp 
    124123         ztrds(:,:,jk) = 0._wp 
    … …  
    170169         CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt ) 
    171170         CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds ) 
    172          CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     171         DEALLOCATE( ztrdt , ztrds ) 
    173172      END IF 
    174173      ! 
    … …  
    177176         &                       tab3d_2=tsn(:,:,:,jp_sal), clinfo2=       ' Sn: ', mask2=tmask ) 
    178177      ! 
    179       IF( nn_timing == 1 )   CALL timing_stop('tra_nxt') 
     178      IF( ln_timing )   CALL timing_stop('tra_nxt') 
    180179      ! 
    181180   END SUBROUTINE tra_nxt 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/TRA/traqsr.F90

    r7753 r8568  
    2929   USE in_out_manager ! I/O manager 
    3030   USE prtctl         ! Print control 
    31    USE iom            ! I/O manager 
     31   USE iom            ! I/O library 
    3232   USE fldread        ! read input fields 
    3333   USE restart        ! ocean restart 
    3434   USE lib_mpp        ! MPP library 
    3535   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    36    USE wrk_nemo       ! Memory Allocation 
    3736   USE timing         ! Timing 
    3837 
    … …  
    113112      REAL(wp) ::   zCb, zCmax, zze, zpsi, zpsimax, zdelpsi, zCtot, zCze 
    114113      REAL(wp) ::   zlogc, zlogc2, zlogc3  
    115       REAL(wp), POINTER, DIMENSION(:,:)   :: zekb, zekg, zekr 
    116       REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt 
    117       REAL(wp), POINTER, DIMENSION(:,:,:) :: zetot, zchl3d 
    118       !!---------------------------------------------------------------------- 
    119       ! 
    120       IF( nn_timing == 1 )  CALL timing_start('tra_qsr') 
     114      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   :: zekb, zekg, zekr 
     115      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt 
     116      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zetot, zchl3d 
     117      !!---------------------------------------------------------------------- 
     118      ! 
     119      IF( ln_timing )   CALL timing_start('tra_qsr') 
    121120      ! 
    122121      IF( kt == nit000 ) THEN 
    … …  
    127126      ! 
    128127      IF( l_trdtra ) THEN      ! trends diagnostic: save the input temperature trend 
    129          CALL wrk_alloc( jpi,jpj,jpk,   ztrdt )  
     128         ALLOCATE( ztrdt(jpi,jpj,jpk) )  
    130129         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    131130      ENDIF 
    … …  
    161160      CASE( np_RGB , np_RGBc )         !==  R-G-B fluxes  ==! 
    162161         ! 
    163          CALL wrk_alloc( jpi,jpj,       zekb, zekg, zekr        )  
    164          CALL wrk_alloc( jpi,jpj,jpk,   ze0, ze1, ze2, ze3, zea, zchl3d )  
     162         ALLOCATE( zekb(jpi,jpj)     , zekg(jpi,jpj)     , zekr  (jpi,jpj)     , & 
     163            &      ze0 (jpi,jpj,jpk) , ze1 (jpi,jpj,jpk) , ze2   (jpi,jpj,jpk) , & 
     164            &      ze3 (jpi,jpj,jpk) , zea (jpi,jpj,jpk) , zchl3d(jpi,jpj,jpk)   )  
    165165         ! 
    166166         IF( nqsr == np_RGBc ) THEN          !*  Variable Chlorophyll 
    … …  
    240240         END DO 
    241241         ! 
    242          CALL wrk_dealloc( jpi,jpj,        zekb, zekg, zekr        )  
    243          CALL wrk_dealloc( jpi,jpj,jpk,   ze0, ze1, ze2, ze3, zea, zchl3d )  
     242         DEALLOCATE( zekb , zekg , zekr , ze0 , ze1 , ze2 , ze3 , zea , zchl3d )  
    244243         ! 
    245244      CASE( np_2BD  )            !==  2-bands fluxes  ==! 
    … …  
    282281      ! 
    283282      IF( iom_use('qsr3d') ) THEN      ! output the shortwave Radiation distribution 
    284          CALL wrk_alloc( jpi,jpj,jpk,   zetot ) 
    285          ! 
     283         ALLOCATE( zetot(jpi,jpj,jpk) ) 
    286284         zetot(:,:,nksr+1:jpk) = 0._wp     ! below ~400m set to zero 
    287285         DO jk = nksr, 1, -1 
    288             zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) / r1_rau0_rcp 
     286            zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) * rau0_rcp 
    289287         END DO          
    290288         CALL iom_put( 'qsr3d', zetot )   ! 3D distribution of shortwave Radiation 
    291          ! 
    292          CALL wrk_dealloc( jpi,jpj,jpk,   zetot )  
     289         DEALLOCATE( zetot )  
    293290      ENDIF 
    294291      ! 
    … …  
    301298         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    302299         CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt ) 
    303          CALL wrk_dealloc( jpi,jpj,jpk,  ztrdt )  
     300         DEALLOCATE( ztrdt )  
    304301      ENDIF 
    305302      !                       ! print mean trends (used for debugging) 
    306303      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 
    307304      ! 
    308       IF( nn_timing == 1 )  CALL timing_stop('tra_qsr') 
     305      IF( ln_timing )   CALL timing_stop('tra_qsr') 
    309306      ! 
    310307   END SUBROUTINE tra_qsr 
    … …  
    340337      !!---------------------------------------------------------------------- 
    341338      ! 
    342       IF( nn_timing == 1 )   CALL timing_start('tra_qsr_init') 
     339      IF( ln_timing )   CALL timing_start('tra_qsr_init') 
    343340      ! 
    344341      REWIND( numnam_ref )              ! Namelist namtra_qsr in reference     namelist 
    … …  
    435432      ENDIF 
    436433      ! 
    437       IF( nn_timing == 1 )   CALL timing_stop('tra_qsr_init') 
     434      IF( ln_timing )   CALL timing_stop('tra_qsr_init') 
    438435      ! 
    439436   END SUBROUTINE tra_qsr_init 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/TRA/trasbc.F90

    r7788 r8568  
    3232   USE iom            ! xIOS server 
    3333   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    34    USE wrk_nemo       ! Memory Allocation 
    3534   USE timing         ! Timing 
    3635 
    … …  
    7574      INTEGER  ::   ikt, ikb              ! local integers 
    7675      REAL(wp) ::   zfact, z1_e3t, zdep   ! local scalar 
    77       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds 
     76      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    7877      !!---------------------------------------------------------------------- 
    7978      ! 
    80       IF( nn_timing == 1 )  CALL timing_start('tra_sbc') 
     79      IF( ln_timing )   CALL timing_start('tra_sbc') 
    8180      ! 
    8281      IF( kt == nit000 ) THEN 
    … …  
    8786      ! 
    8887      IF( l_trdtra ) THEN                    !* Save ta and sa trends 
    89          CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )  
     88         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )  
    9089         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    9190         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    … …  
    232231         CALL trd_tra( kt, 'TRA', jp_tem, jptra_nsr, ztrdt ) 
    233232         CALL trd_tra( kt, 'TRA', jp_sal, jptra_nsr, ztrds ) 
    234          CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )  
     233         DEALLOCATE( ztrdt , ztrds )  
    235234      ENDIF 
    236235      ! 
    … …  
    238237         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    239238      ! 
    240       IF( nn_timing == 1 )  CALL timing_stop('tra_sbc') 
     239      IF( ln_timing )   CALL timing_stop('tra_sbc') 
    241240      ! 
    242241   END SUBROUTINE tra_sbc 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/TRA/trazdf.F90

    r8367 r8568  
    5656      !!--------------------------------------------------------------------- 
    5757      ! 
    58       IF( nn_timing == 1 )  CALL timing_start('tra_zdf') 
     58      IF( ln_timing )   CALL timing_start('tra_zdf') 
    5959      ! 
    6060      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000 
    … …  
    9797         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    9898      ! 
    99       IF( nn_timing == 1 )  CALL timing_stop('tra_zdf') 
     99      IF( ln_timing )   CALL timing_stop('tra_zdf') 
    100100      ! 
    101101   END SUBROUTINE tra_zdf 
    … …  
    135135      !!--------------------------------------------------------------------- 
    136136      ! 
    137       IF( nn_timing == 1 )  CALL timing_start('tra_zdf_imp') 
     137      IF( ln_timing )   CALL timing_start('tra_zdf_imp') 
    138138      ! 
    139139      IF( kt == kit000 )  THEN 
    … …  
    255255      !                                               ! ================= ! 
    256256      ! 
    257       IF( nn_timing == 1 )  CALL timing_stop('tra_zdf_imp') 
     257      IF( ln_timing )   CALL timing_stop('tra_zdf_imp') 
    258258      ! 
    259259   END SUBROUTINE tra_zdf_imp 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/TRA/zpshde.F90

    r7753 r8568  
    2222   USE lbclnk          ! lateral boundary conditions (or mpp link) 
    2323   USE lib_mpp         ! MPP library 
    24    USE wrk_nemo        ! Memory allocation 
    2524   USE timing          ! Timing 
    2625 
    … …  
    9998      !!---------------------------------------------------------------------- 
    10099      ! 
    101       IF( nn_timing == 1 )   CALL timing_start( 'zps_hde') 
    102       ! 
    103       pgtu(:,:,:)=0._wp   ;   zti (:,:,:)=0._wp   ;   zhi (:,:  )=0._wp 
    104       pgtv(:,:,:)=0._wp   ;   ztj (:,:,:)=0._wp   ;   zhj (:,:  )=0._wp 
     100      IF( ln_timing )   CALL timing_start( 'zps_hde') 
     101      ! 
     102      pgtu(:,:,:) = 0._wp   ;   zti (:,:,:) = 0._wp   ;   zhi (:,:) = 0._wp 
     103      pgtv(:,:,:) = 0._wp   ;   ztj (:,:,:) = 0._wp   ;   zhj (:,:) = 0._wp 
    105104      ! 
    106105      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==! 
    … …  
    188187      END IF 
    189188      ! 
    190       IF( nn_timing == 1 )   CALL timing_stop( 'zps_hde') 
     189      IF( ln_timing )   CALL timing_stop( 'zps_hde') 
    191190      ! 
    192191   END SUBROUTINE zps_hde 
    193    ! 
     192 
     193 
    194194   SUBROUTINE zps_hde_isf( kt, kjpt, pta, pgtu, pgtv, pgtui, pgtvi,  & 
    195195      &                          prd, pgru, pgrv, pgrui, pgrvi ) 
    … …  
    256256      !!---------------------------------------------------------------------- 
    257257      ! 
    258       IF( nn_timing == 1 )  CALL timing_start( 'zps_hde_isf') 
     258      IF( ln_timing )   CALL timing_start( 'zps_hde_isf') 
    259259      ! 
    260260      pgtu (:,:,:) = 0._wp   ;   pgtv (:,:,:) =0._wp 
    … …  
    453453      END IF   
    454454      ! 
    455       IF( nn_timing == 1 )   CALL timing_stop( 'zps_hde_isf') 
     455      IF( ln_timing )   CALL timing_stop( 'zps_hde_isf') 
    456456      ! 
    457457   END SUBROUTINE zps_hde_isf 
     458 
    458459   !!====================================================================== 
    459460END MODULE zpshde 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/ZDF/zdfddm.F90

    r8367 r8568  
    8383      !!---------------------------------------------------------------------- 
    8484      ! 
    85       IF( nn_timing == 1 )   CALL timing_start('zdf_ddm') 
     85      IF( ln_timing )   CALL timing_start('zdf_ddm') 
    8686      ! 
    8787      !                                                ! =============== 
    … …  
    170170      ENDIF 
    171171      ! 
    172       IF( nn_timing == 1 )  CALL timing_stop('zdf_ddm') 
     172      IF( ln_timing )   CALL timing_stop('zdf_ddm') 
    173173      ! 
    174174   END SUBROUTINE zdf_ddm 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/ZDF/zdfdrg.F90

    r8367 r8568  
    2020   !!---------------------------------------------------------------------- 
    2121   USE oce            ! ocean dynamics and tracers variables 
    22    USE phycst   , ONLY: vkarmn 
     22   USE phycst  , ONLY : vkarmn 
    2323   USE dom_oce        ! ocean space and time domain variables 
    2424   USE zdf_oce        ! ocean vertical physics variables 
    … …  
    109109      !!---------------------------------------------------------------------- 
    110110      ! 
    111       IF( nn_timing == 1 )  CALL timing_start('zdf_drg') 
     111      IF( ln_timing )   CALL timing_start('zdf_drg') 
    112112      ! 
    113113      ! 
    … …  
    140140      IF(ln_ctl)   CALL prt_ctl( tab2d_1=pCdU, clinfo1=' Cd*U ') 
    141141      ! 
    142       IF( nn_timing == 1 )  CALL timing_stop('zdf_drg') 
     142      IF( ln_timing )   CALL timing_stop('zdf_drg') 
    143143      ! 
    144144   END SUBROUTINE zdf_drg 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/ZDF/zdfevd.F90

    r8367 r8568  
    6262      !!---------------------------------------------------------------------- 
    6363      ! 
    64       IF( nn_timing == 1 )  CALL timing_start('zdf_evd') 
     64      IF( ln_timing )   CALL timing_start('zdf_evd') 
    6565      ! 
    6666      IF( kt == nit000 ) THEN 
    … …  
    121121      IF( l_trdtra ) CALL trd_tra( kt, 'TRA', jp_tem, jptra_evd, zavt_evd ) 
    122122      ! 
    123       IF( nn_timing == 1 )  CALL timing_stop('zdf_evd') 
     123      IF( ln_timing )   CALL timing_stop('zdf_evd') 
    124124      ! 
    125125   END SUBROUTINE zdf_evd 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/ZDF/zdfgls.F90

    r8367 r8568  
    159159      !!-------------------------------------------------------------------- 
    160160      ! 
    161       IF( nn_timing == 1 )   CALL timing_start('zdf_gls') 
     161      IF( ln_timing )   CALL timing_start('zdf_gls') 
    162162      ! 
    163163      ! Preliminary computing 
    … …  
    822822      ENDIF 
    823823      ! 
    824       IF( nn_timing == 1 )   CALL timing_stop('zdf_gls') 
     824      IF( ln_timing )   CALL timing_stop('zdf_gls') 
    825825      ! 
    826826   END SUBROUTINE zdf_gls 
    … …  
    852852      !!---------------------------------------------------------- 
    853853      ! 
    854       IF( nn_timing == 1 )  CALL timing_start('zdf_gls_init') 
     854      IF( ln_timing )   CALL timing_start('zdf_gls_init') 
    855855      ! 
    856856      REWIND( numnam_ref )              ! Namelist namzdf_gls in reference namelist : Vertical eddy diffivity and viscosity using gls turbulent closure scheme 
    … …  
    10771077         rl_sf = vkarmn 
    10781078      ELSE 
    1079          rl_sf = rc0 * SQRT(rc0/rcm_sf) * SQRT( ( (1._wp + 4._wp*rmm + 8._wp*rmm**2_wp)*rsc_tke          & 
    1080                  &                                       + 12._wp * rsc_psi0*rpsi2 - (1._wp + 4._wp*rmm) & 
    1081                  &                                                *SQRT(rsc_tke*(rsc_tke                 & 
    1082                  &                                                   + 24._wp*rsc_psi0*rpsi2)) )         & 
    1083                  &                                         /(12._wp*rnn**2.)                             & 
    1084                  &                                       ) 
     1079         rl_sf = rc0 * SQRT(rc0/rcm_sf) * SQRT( ( (1._wp + 4._wp*rmm + 8._wp*rmm**2_wp) * rsc_tke        & 
     1080            &                                            + 12._wp*rsc_psi0*rpsi2 - (1._wp + 4._wp*rmm)   & 
     1081            &                                                     *SQRT(rsc_tke*(rsc_tke                 & 
     1082            &                                                        + 24._wp*rsc_psi0*rpsi2)) )         & 
     1083            &                                              /(12._wp*rnn**2.)                             ) 
    10851084      ENDIF 
    10861085 
    … …  
    11301129      CALL gls_rst( nit000, 'READ' )      ! (en, avt_k, avm_k, hmxl_n) 
    11311130      ! 
    1132       IF( nn_timing == 1 )  CALL timing_stop('zdf_gls_init') 
     1131      IF( ln_timing )   CALL timing_stop('zdf_gls_init') 
    11331132      ! 
    11341133   END SUBROUTINE zdf_gls_init 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/ZDF/zdfiwm.F90

    r8367 r8568  
    141141      !!---------------------------------------------------------------------- 
    142142      ! 
    143       IF( nn_timing == 1 )   CALL timing_start('zdf_iwm') 
     143      IF( ln_timing )   CALL timing_start('zdf_iwm') 
    144144      ! 
    145145      !                      ! ----------------------------- ! 
    … …  
    366366      IF(ln_ctl)   CALL prt_ctl(tab3d_1=zav_wave , clinfo1=' iwm - av_wave: ', tab3d_2=avt, clinfo2=' avt: ', ovlap=1, kdim=jpk) 
    367367      ! 
    368       IF( nn_timing == 1 )   CALL timing_stop('zdf_iwm') 
     368      IF( ln_timing )   CALL timing_stop('zdf_iwm') 
    369369      ! 
    370370   END SUBROUTINE zdf_iwm 
    … …  
    405405      !!---------------------------------------------------------------------- 
    406406      ! 
    407       IF( nn_timing == 1 )  CALL timing_start('zdf_iwm_init') 
     407      IF( ln_timing )   CALL timing_start('zdf_iwm_init') 
    408408      ! 
    409409      REWIND( numnam_ref )              ! Namelist namzdf_iwm in reference namelist : Wave-driven mixing 
    … …  
    483483      ENDIF 
    484484      ! 
    485       IF( nn_timing == 1 )  CALL timing_stop('zdf_iwm_init') 
     485      IF( ln_timing )   CALL timing_stop('zdf_iwm_init') 
    486486      ! 
    487487   END SUBROUTINE zdf_iwm_init 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/ZDF/zdfmxl.F90

    r8367 r8568  
    8282      !!---------------------------------------------------------------------- 
    8383      ! 
    84       IF( nn_timing == 1 )  CALL timing_start('zdf_mxl') 
     84      IF( ln_timing )   CALL timing_start('zdf_mxl') 
    8585      ! 
    8686      IF( kt == nit000 ) THEN 
    … …  
    141141      IF(ln_ctl)   CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ', ovlap=1 ) 
    142142      ! 
    143       IF( nn_timing == 1 )  CALL timing_stop('zdf_mxl') 
     143      IF( ln_timing )   CALL timing_stop('zdf_mxl') 
    144144      ! 
    145145   END SUBROUTINE zdf_mxl 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/ZDF/zdfphy.F90

    r8367 r8568  
    3232   USE lbclnk         ! lateral boundary conditions 
    3333   USE lib_mpp        ! distribued memory computing 
     34   USE timing         ! Timing 
    3435 
    3536   IMPLICIT NONE 
    … …  
    7576         &             rn_avm0, rn_avt0, nn_avb, nn_havtb                  ! coefficients 
    7677      !!---------------------------------------------------------------------- 
     78      ! 
     79      IF( ln_timing )   CALL timing_start('zdf_phy_init') 
    7780      ! 
    7881      !                           !==  Namelist  ==! 
    … …  
    193196      !!gm move it here ? 
    194197      ! 
     198      IF( ln_timing )   CALL timing_stop('zdf_phy_init') 
     199      ! 
    195200   END SUBROUTINE zdf_phy_init 
    196201 
    … …  
    213218      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zsh2   ! shear production 
    214219      !! --------------------------------------------------------------------- 
     220      ! 
     221      IF( ln_timing )   CALL timing_start('zdf_phy') 
    215222      ! 
    216223      IF( l_zdfdrg ) THEN     !==  update top/bottom drag  ==!   (non-linear cases) 
    … …  
    289296      ENDIF 
    290297      ! 
     298      IF( ln_timing )   CALL timing_stop('zdf_phy') 
     299      ! 
    291300   END SUBROUTINE zdf_phy 
    292301 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/ZDF/zdfric.F90

    r8367 r8568  
    158158      !!---------------------------------------------------------------------- 
    159159      ! 
    160       IF( nn_timing == 1 )   CALL timing_start('zdf_ric') 
     160      IF( ln_timing )   CALL timing_start('zdf_ric') 
    161161      ! 
    162162      !                       !==  avm and avt = F(Richardson number)  ==! 
    … …  
    197197      ENDIF 
    198198      ! 
    199       IF( nn_timing == 1 )   CALL timing_stop('zdf_ric') 
     199      IF( ln_timing )   CALL timing_stop('zdf_ric') 
    200200      ! 
    201201   END SUBROUTINE zdf_ric 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/ZDF/zdfsh2.F90

    r8367 r8568  
    5656      !!-------------------------------------------------------------------- 
    5757      ! 
    58       IF( nn_timing == 1 )  CALL timing_start('zdf_sh2') 
     58      IF( ln_timing )   CALL timing_start('zdf_sh2') 
    5959      ! 
    6060      DO jk = 2, jpkm1 
    … …  
    7777      END DO  
    7878      ! 
    79       IF( nn_timing == 1 )  CALL timing_stop('zdf_sh2')      
     79      IF( ln_timing )   CALL timing_stop('zdf_sh2')      
    8080      ! 
    8181   END SUBROUTINE zdf_sh2 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/ZDF/zdftke.F90

    r8367 r8568  
    159159      !!              Bruchard OM 2002 
    160160      !!---------------------------------------------------------------------- 
    161       INTEGER                    , INTENT(in   ) ::   kt             ! ocean time step 
     161      INTEGER                   , INTENT(in   ) ::   kt             ! ocean time step 
    162162      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   p_sh2          ! shear production term 
    163       REAL(wp), DIMENSION(:,:,:) , INTENT(inout) ::   p_avm, p_avt   !  momentum and tracer Kz (w-points) 
     163      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   p_avm, p_avt   !  momentum and tracer Kz (w-points) 
    164164      !!---------------------------------------------------------------------- 
    165165      ! 
    … …  
    194194      !!                a tridiagonal linear system by a "methode de chasse" 
    195195      !!              - increase TKE due to surface and internal wave breaking 
     196      !!             NB: when sea-ice is present, both LC parameterization  
     197      !!                 and TKE penetration are turned off when the ice fraction  
     198      !!                 is smaller than 0.25  
    196199      !! 
    197200      !! ** Action  : - en : now turbulent kinetic energy) 
    … …  
    217220      !!-------------------------------------------------------------------- 
    218221      ! 
    219       IF( nn_timing == 1 )  CALL timing_start('tke_tke') 
     222      IF( ln_timing )   CALL timing_start('tke_tke') 
    220223      ! 
    221224      zbbrau = rn_ebb / rau0       ! Local constant initialisation 
    … …  
    312315                  zwlc = zind * rn_lc * zus * SIN( rpi * pdepw(ji,jj,jk) / zhlc(ji,jj) ) 
    313316                  !                                           ! TKE Langmuir circulation source term 
    314                   en(ji,jj,jk) = en(ji,jj,jk) + rdt * MAX(0.,1._wp - 2.*fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc )   & 
     317                  en(ji,jj,jk) = en(ji,jj,jk) + rdt * MAX(0.,1._wp - 4.*fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc )   & 
    315318                     &                              / zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    316319               END DO 
    … …  
    415418               DO ji = fs_2, fs_jpim1   ! vector opt. 
    416419                  en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   & 
    417                      &                                 * MAX(0.,1._wp - 2.*fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     420                     &                                 * MAX(0.,1._wp - 4.*fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    418421               END DO 
    419422            END DO 
    … …  
    424427               jk = nmln(ji,jj) 
    425428               en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   & 
    426                   &                                 * MAX(0.,1._wp - 2.*fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     429                  &                                 * MAX(0.,1._wp - 4.*fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    427430            END DO 
    428431         END DO 
    … …  
    437440                  zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add )  ! apply some modifications... 
    438441                  en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   & 
    439                      &                        * MAX(0.,1._wp - 2.*fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    440                END DO 
    441             END DO 
    442          END DO 
    443       ENDIF 
    444       ! 
    445       IF( nn_timing == 1 )  CALL timing_stop('tke_tke') 
     442                     &                        * MAX(0.,1._wp - 4.*fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     443               END DO 
     444            END DO 
     445         END DO 
     446      ENDIF 
     447      ! 
     448      IF( ln_timing )   CALL timing_stop('tke_tke') 
    446449      ! 
    447450   END SUBROUTINE tke_tke 
    … …  
    493496      !!-------------------------------------------------------------------- 
    494497      ! 
    495       IF( nn_timing == 1 )  CALL timing_start('tke_avn') 
     498      IF( ln_timing )   CALL timing_start('tke_avn') 
    496499 
    497500      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    … …  
    636639      ENDIF 
    637640      ! 
    638       IF( nn_timing == 1 )  CALL timing_stop('tke_avn') 
     641      IF( ln_timing )   CALL timing_stop('tke_avn') 
    639642      ! 
    640643   END SUBROUTINE tke_avn 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/nemogcm.F90

    r8367 r8568  
    206206#if defined key_agrif 
    207207      IF( .NOT. Agrif_Root() ) THEN 
    208                          CALL Agrif_ParentGrid_To_ChildGrid() 
    209          IF( ln_diaobs ) CALL dia_obs_wri 
    210          IF( nn_timing == 1 )   CALL timing_finalize 
    211                                 CALL Agrif_ChildGrid_To_ParentGrid() 
    212       ENDIF 
    213 #endif 
    214       IF( nn_timing == 1 )   CALL timing_finalize 
     208                           CALL Agrif_ParentGrid_To_ChildGrid() 
     209         IF( ln_diaobs )   CALL dia_obs_wri 
     210         IF( ln_timing )   CALL timing_finalize 
     211                           CALL Agrif_ChildGrid_To_ParentGrid() 
     212      ENDIF 
     213#endif 
     214      IF( ln_timing    )   CALL timing_finalize 
    215215      ! 
    216216      CALL nemo_closefile 
    … …  
    242242      NAMELIST/namctl/ ln_ctl   , nn_print, nn_ictls, nn_ictle,   & 
    243243         &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,   & 
    244          &             nn_timing, nn_diacfl 
     244         &             ln_timing, ln_diacfl 
    245245      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
    246246      !!---------------------------------------------------------------------- 
    … …  
    416416      ENDIF 
    417417      ! 
    418       IF( nn_timing == 1 )  CALL timing_init 
     418      IF( ln_timing    )   CALL timing_init 
    419419      ! 
    420420      !                                      ! General initialization 
    421                             CALL     phy_cst    ! Physical constants 
    422                             CALL     eos_init   ! Equation of state 
    423       IF( lk_c1d        )   CALL     c1d_init   ! 1D column configuration 
    424                             CALL     wad_init   ! Wetting and drying options 
    425                             CALL     dom_init   ! Domain 
    426       IF( ln_crs        )   CALL     crs_init   ! coarsened grid: domain initialization  
    427       IF( ln_nnogather )    CALL nemo_northcomms! northfold neighbour lists (must be done after the masks are defined) 
    428       IF( ln_ctl        )   CALL prt_ctl_init   ! Print control 
     421                           CALL     phy_cst    ! Physical constants 
     422                           CALL     eos_init   ! Equation of state 
     423      IF( lk_c1d       )   CALL     c1d_init   ! 1D column configuration 
     424                           CALL     wad_init   ! Wetting and drying options 
     425                           CALL     dom_init   ! Domain 
     426      IF( ln_crs       )   CALL     crs_init   ! coarsened grid: domain initialization  
     427      IF( ln_nnogather )   CALL nemo_northcomms! northfold neighbour lists (must be done after the masks are defined) 
     428      IF( ln_ctl       )   CALL prt_ctl_init   ! Print control 
    429429       
    430430      CALL diurnal_sst_bulk_init             ! diurnal sst 
    … …  
    432432       
    433433      ! IF ln_diurnal_only, then we only want a subset of the initialisation routines 
    434       IF ( ln_diurnal_only ) THEN 
     434      IF( ln_diurnal_only ) THEN 
    435435         CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
    436436         CALL     sbc_init   ! Forcings : surface module 
    437437         CALL tra_qsr_init   ! penetrative solar radiation qsr 
    438          IF( ln_diaobs     ) THEN                  ! Observation & model comparison 
    439             CALL dia_obs_init            ! Initialize observational data 
    440             CALL dia_obs( nit000 - 1 )   ! Observation operator for restart 
     438         IF( ln_diaobs ) THEN                   ! Observation & model comparison 
     439            CALL dia_obs_init                      ! Initialize observational data 
     440            CALL dia_obs( nit000 - 1 )             ! Observation operator for restart 
    441441         ENDIF      
    442442         !                                     ! Assimilation increments 
    443          IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments 
     443         IF( lk_asminc )   CALL asm_inc_init   ! Initialize assimilation increments 
    444444                  
    445445         IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 
    … …  
    447447      ENDIF 
    448448       
    449                             CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
     449                           CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
    450450 
    451451      !                                      ! external forcing  
    452452!!gm to be added : creation and call of sbc_apr_init 
    453                             CALL    tide_init   ! tidal harmonics 
    454                             CALL     sbc_init   ! surface boundary conditions (including sea-ice) 
    455                             CALL     bdy_init   ! Open boundaries initialisation 
     453                           CALL    tide_init   ! tidal harmonics 
     454                           CALL     sbc_init   ! surface boundary conditions (including sea-ice) 
     455                           CALL     bdy_init   ! Open boundaries initialisation 
    456456 
    457457      !                                      ! Ocean physics 
    458                             CALL zdf_phy_init   ! Vertical physics 
     458                           CALL zdf_phy_init    ! Vertical physics 
    459459                                      
    460460      !                                         ! Lateral physics 
    461                             CALL ldf_tra_init      ! Lateral ocean tracer physics 
    462                             CALL ldf_eiv_init      ! eddy induced velocity param. 
    463                             CALL ldf_dyn_init      ! Lateral ocean momentum physics 
     461                           CALL ldf_tra_init      ! Lateral ocean tracer physics 
     462                           CALL ldf_eiv_init      ! eddy induced velocity param. 
     463                           CALL ldf_dyn_init      ! Lateral ocean momentum physics 
    464464 
    465465      !                                      ! Active tracers 
    466                             CALL tra_qsr_init      ! penetrative solar radiation qsr 
    467                             CALL tra_bbc_init      ! bottom heat flux 
    468       IF( ln_trabbl     )   CALL tra_bbl_init      ! advective (and/or diffusive) bottom boundary layer scheme 
    469                             CALL tra_dmp_init      ! internal tracer damping 
    470                             CALL tra_adv_init      ! horizontal & vertical advection 
    471                             CALL tra_ldf_init      ! lateral mixing 
     466                           CALL tra_qsr_init      ! penetrative solar radiation qsr 
     467                           CALL tra_bbc_init      ! bottom heat flux 
     468      IF( ln_trabbl    )   CALL tra_bbl_init      ! advective (and/or diffusive) bottom boundary layer scheme 
     469                           CALL tra_dmp_init      ! internal tracer damping 
     470                           CALL tra_adv_init      ! horizontal & vertical advection 
     471                           CALL tra_ldf_init      ! lateral mixing 
    472472 
    473473      !                                      ! Dynamics 
    474       IF( lk_c1d        )   CALL dyn_dmp_init      ! internal momentum damping 
    475                             CALL dyn_adv_init      ! advection (vector or flux form) 
    476                             CALL dyn_vor_init      ! vorticity term including Coriolis 
    477                             CALL dyn_ldf_init      ! lateral mixing 
    478                             CALL dyn_hpg_init      ! horizontal gradient of Hydrostatic pressure 
    479                             CALL dyn_spg_init      ! surface pressure gradient 
     474      IF( lk_c1d       )   CALL dyn_dmp_init      ! internal momentum damping 
     475                           CALL dyn_adv_init      ! advection (vector or flux form) 
     476                           CALL dyn_vor_init      ! vorticity term including Coriolis 
     477                           CALL dyn_ldf_init      ! lateral mixing 
     478                           CALL dyn_hpg_init      ! horizontal gradient of Hydrostatic pressure 
     479                           CALL dyn_spg_init      ! surface pressure gradient 
    480480 
    481481#if defined key_top 
    482482      !                                      ! Passive tracers 
    483                             CALL     trc_init 
    484 #endif 
    485       IF( l_ldfslp      )   CALL ldf_slp_init   ! slope of lateral mixing 
     483                           CALL     trc_init 
     484#endif 
     485      IF( l_ldfslp     )   CALL ldf_slp_init    ! slope of lateral mixing 
    486486 
    487487      !                                      ! Icebergs 
    488                             CALL icb_init( rdt, nit000)   ! initialise icebergs instance 
     488                           CALL icb_init( rdt, nit000)   ! initialise icebergs instance 
    489489 
    490490      !                                      ! Misc. options 
    491                             CALL sto_par_init   ! Stochastic parametrization 
    492       IF( ln_sto_eos     )  CALL sto_pts_init   ! RRandom T/S fluctuations 
     491                           CALL sto_par_init    ! Stochastic parametrization 
     492      IF( ln_sto_eos   )   CALL sto_pts_init    ! RRandom T/S fluctuations 
    493493      
    494494      !                                      ! Diagnostics 
    495       IF( lk_floats     )   CALL     flo_init   ! drifting Floats 
    496                             CALL dia_cfl_init   ! Initialise CFL diagnostics 
    497                             CALL dia_ptr_init   ! Poleward TRansports initialization 
    498       IF( lk_diadct     )   CALL dia_dct_init   ! Sections tranports 
    499                             CALL dia_hsb_init   ! heat content, salt content and volume budgets 
    500                             CALL     trd_init   ! Mixed-layer/Vorticity/Integral constraints trends 
    501                             CALL dia_obs_init            ! Initialize observational data 
    502       IF( ln_diaobs     )   CALL dia_obs( nit000 - 1 )   ! Observation operator for restart 
     495      IF( lk_floats    )   CALL     flo_init    ! drifting Floats 
     496      IF( ln_diacfl    )   CALL dia_cfl_init    ! Initialise CFL diagnostics 
     497                           CALL dia_ptr_init    ! Poleward TRansports initialization 
     498      IF( lk_diadct    )   CALL dia_dct_init    ! Sections tranports 
     499                           CALL dia_hsb_init    ! heat content, salt content and volume budgets 
     500                           CALL     trd_init    ! Mixed-layer/Vorticity/Integral constraints trends 
     501                           CALL dia_obs_init    ! Initialize observational data 
     502      IF( ln_diaobs    )   CALL dia_obs( nit000 - 1 )   ! Observation operator for restart 
    503503 
    504504      !                                      ! Assimilation increments 
    505       IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments 
     505      IF( lk_asminc    )   CALL asm_inc_init    ! Initialize assimilation increments 
    506506      IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 
    507                             CALL dia_tmb_init  ! TMB outputs 
    508                             CALL dia_25h_init  ! 25h mean  outputs 
     507                           CALL dia_tmb_init    ! TMB outputs 
     508                           CALL dia_25h_init    ! 25h mean  outputs 
    509509      ! 
    510510   END SUBROUTINE nemo_init 
    … …  
    533533         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    534534         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    535          WRITE(numout,*) '      timing activated    (0/1)       nn_timing  = ', nn_timing 
     535         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing 
     536         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl 
    536537      ENDIF 
    537538      ! 
    … …  
    543544      isplt     = nn_isplt 
    544545      jsplt     = nn_jsplt 
     546!!gm to be remove at the end of the 2017 merge party 
     547      if( ln_timing ) then  ;  nn_timing = 1 
     548      else                  ;  nn_timing = 0 
     549      endif 
     550!!gm end 
     551       
    545552 
    546553      IF(lwp) THEN                  ! control print 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/step.F90

    r8367 r8568  
    208208      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    209209      IF( lk_floats  )   CALL flo_stp( kstp )         ! drifting Floats 
    210       IF( nn_diacfl == 1 )   CALL dia_cfl( kstp )         ! Courant number diagnostics 
     210      IF( ln_diacfl )   CALL dia_cfl( kstp )         ! Courant number diagnostics 
    211211      IF( lk_diahth  )   CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth) 
    212212      IF( lk_diadct  )   CALL dia_dct( kstp )         ! Transports 
    … …  
    324324#endif 
    325325      ! 
    326       IF( nn_timing == 1 .AND.  kstp == nit000  )   CALL timing_reset 
     326      IF( ln_timing .AND.  kstp == nit000  )   CALL timing_reset 
    327327      ! 
    328328   END SUBROUTINE stp 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/stpctl.F90

    r8367 r8568  
    9696         IF( lk_mpp ) THEN 
    9797            CALL mpp_maxloc( ABS(sshn)        , tmask(:,:,1), zzz, iih, ijh ) 
    98             CALL mpp_maxloc( ABS(un)          , umask       , zzz, iiu, iju, iku ) 
     98            CALL mpp_maxloc( ABS(un)          , umask(:,:,:), zzz, iiu, iju, iku ) 
    9999            CALL mpp_minloc( tsn(:,:,1,jp_sal), tmask(:,:,1), zzz, iis, ijs ) 
    100100         ELSE 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/SAO_SRC/nemogcm.F90

    r7646 r8568  
    9797      NAMELIST/namctl/ ln_ctl   , nn_print, nn_ictls, nn_ictle,   & 
    9898         &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,   & 
    99          &             nn_timing, nn_diacfl 
     99         &             ln_timing, ln_diacfl 
    100100      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
    101101      !!---------------------------------------------------------------------- 
    … …  
    259259      !                             !-------------------------------! 
    260260 
    261       CALL nemo_ctl                          ! Control prints & Benchmark 
    262  
    263       !                                      ! Domain decomposition 
     261      CALL nemo_ctl                             ! Control prints & Benchmark 
     262 
     263      !                                         ! Domain decomposition 
    264264      IF( jpni*jpnj == jpnij ) THEN   ;   CALL mpp_init      ! standard cutting out 
    265265      ELSE                            ;   CALL mpp_init2     ! eliminate land processors 
    266266      ENDIF 
    267267      ! 
    268       IF( nn_timing == 1 )  CALL timing_init 
    269       ! 
    270       !                                      ! General initialization 
    271                             CALL     phy_cst    ! Physical constants 
    272                             CALL     eos_init   ! Equation of state 
    273                             CALL     dom_init   ! Domain 
    274  
    275       IF( ln_nnogather )    CALL nemo_northcomms  ! Initialise the northfold neighbour lists (must be done after the masks are defined) 
    276  
    277       IF( ln_ctl        )   CALL prt_ctl_init   ! Print control 
    278  
    279                             CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
     268      IF( ln_timing    )   CALL timing_init     ! timing by routine 
     269      ! 
     270      !                                         ! General initialization 
     271                           CALL phy_cst            ! Physical constants 
     272                           CALL eos_init           ! Equation of state 
     273                           CALL dom_init           ! Domain 
     274 
     275      IF( ln_nnogather )   CALL nemo_northcomms ! Initialise the northfold neighbour lists (must be done after the masks are defined) 
     276 
     277      IF( ln_ctl       )   CALL prt_ctl_init    ! Print control 
     278 
     279                           CALL istate_init     ! ocean initial state (Dynamics and tracers) 
    280280   END SUBROUTINE nemo_init 
    281281 
    … …  
    303303         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    304304         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    305          WRITE(numout,*) '      timing activated    (0/1)       nn_timing  = ', nn_timing 
     305         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing 
     306         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl 
    306307      ENDIF 
    307308      ! 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90

    r7761 r8568  
    136136      IF( .NOT. Agrif_Root() ) THEN 
    137137         CALL Agrif_ParentGrid_To_ChildGrid() 
    138          IF( nn_timing == 1 )   CALL timing_finalize 
     138         IF( ln_timing )   CALL timing_finalize 
    139139         CALL Agrif_ChildGrid_To_ParentGrid() 
    140140      ENDIF 
    141141#endif 
    142       IF( nn_timing == 1 )   CALL timing_finalize 
     142      IF( ln_timing )   CALL timing_finalize 
    143143      ! 
    144144      CALL nemo_closefile 
    … …  
    172172      NAMELIST/namctl/ ln_ctl   , nn_print, nn_ictls, nn_ictle,   & 
    173173         &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,   & 
    174          &             nn_timing, nn_diacfl 
     174         &             ln_timing, ln_diacfl 
    175175      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
    176176      !!---------------------------------------------------------------------- 
    … …  
    353353      ENDIF 
    354354      ! 
    355       IF( nn_timing == 1 )  CALL timing_init 
     355      IF( ln_timing    )   CALL timing_init 
    356356      ! 
    357357      !                                     ! General initialization 
    358                             CALL phy_cst    ! Physical constants 
    359                             CALL eos_init   ! Equation of state 
    360                             CALL dom_init   ! Domain 
    361  
    362      IF( ln_nnogather )     CALL nemo_northcomms   ! Initialise the northfold neighbour lists (must be done after the masks are defined) 
    363  
    364       IF( ln_ctl      )     CALL prt_ctl_init   ! Print control 
    365                             CALL day_init   ! model calendar (using both namelist and restart infos) 
    366  
    367                             CALL sbc_init   ! Forcings : surface module  
     358                           CALL phy_cst    ! Physical constants 
     359                           CALL eos_init   ! Equation of state 
     360                           CALL dom_init   ! Domain 
     361 
     362     IF( ln_nnogather )    CALL nemo_northcomms   ! Initialise the northfold neighbour lists (must be done after the masks are defined) 
     363 
     364      IF( ln_ctl      )    CALL prt_ctl_init   ! Print control 
     365                           CALL day_init   ! model calendar (using both namelist and restart infos) 
     366 
     367                           CALL sbc_init   ! Forcings : surface module  
    368368 
    369369      ! ==> clem: open boundaries init. is mandatory for LIM3 because ice BDY is not decoupled from   
    370370      !           the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules.  
    371371      !           This is not clean and should be changed in the future.  
    372                             CALL bdy_init 
     372                           CALL bdy_init 
    373373      ! ==> 
    374                             CALL icb_init( rdt, nit000)   ! initialise icebergs instance 
     374                           CALL icb_init( rdt, nit000)   ! initialise icebergs instance 
    375375       
    376376      IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 
    … …  
    401401         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    402402         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    403          WRITE(numout,*) '      timing activated    (0/1)       nn_timing  = ', nn_timing 
     403         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing 
     404         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl 
    404405      ENDIF 
    405406      ! 
    … …  
    411412      isplt     = nn_isplt 
    412413      jsplt     = nn_jsplt 
     414!!gm to be remove at the end of the 2017 merge party 
     415      if( ln_timing ) then  ;  nn_timing = 1 
     416      else                  ;  nn_timing = 0 
     417      endif 
     418!!gm end 
    413419 
    414420      IF(lwp) THEN                  ! control print 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/SAS_SRC/step.F90

    r7761 r8568  
    127127#endif 
    128128      ! 
    129       IF( nn_timing == 1 .AND.  kstp == nit000  )   CALL timing_reset 
     129      IF( ln_timing .AND.  kstp == nit000  )   CALL timing_reset 
    130130      ! 
    131131   END SUBROUTINE stp 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r7753 r8568  
    77   !!            3.0  !  2010-06  (C. Ethe)   Adapted to passive tracers 
    88   !!            3.7  !  2014-05  (G. Madec, C. Ethe)  Add 2nd/4th order cases for CEN and FCT schemes  
     9   !!            4.0  !  2017-09  (G. Madec)  remove vertical time-splitting option 
    910   !!---------------------------------------------------------------------- 
    1011#if defined key_top 
    … …  
    1718   USE oce_trc        ! ocean dynamics and active tracers 
    1819   USE trc            ! ocean passive tracers variables 
     20   USE sbcwave        ! wave module 
     21   USE sbc_oce        ! surface boundary condition: ocean 
    1922   USE traadv_cen     ! centered scheme           (tra_adv_cen  routine) 
    2023   USE traadv_fct     ! FCT      scheme           (tra_adv_fct  routine) 
    … …  
    2326   USE traadv_qck     ! QUICKEST scheme           (tra_adv_qck  routine) 
    2427   USE traadv_mle     ! ML eddy induced velocity  (tra_adv_mle  routine) 
    25    USE ldftra         ! lateral diffusion coefficient on tracers 
     28   USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff. 
    2629   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces 
    2730   ! 
    28    USE prtctl_trc     ! Print control 
     31   USE prtctl_trc     ! control print 
     32   USE timing         ! Timing 
    2933 
    3034   IMPLICIT NONE 
    3135   PRIVATE 
    3236 
    33    PUBLIC   trc_adv        
    34    PUBLIC   trc_adv_ini   
     37   PUBLIC   trc_adv       ! called by trctrp.F90 
     38   PUBLIC   trc_adv_ini   ! called by trcini.F90 
    3539 
    3640   !                            !!* Namelist namtrc_adv * 
     41   LOGICAL ::   ln_trcadv_NONE   ! no advection on passive tracers 
    3742   LOGICAL ::   ln_trcadv_cen    ! centered scheme flag 
    3843   INTEGER ::      nn_cen_h, nn_cen_v   ! =2/4 : horizontal and vertical choices of the order of CEN scheme 
    3944   LOGICAL ::   ln_trcadv_fct    ! FCT scheme flag 
    4045   INTEGER ::      nn_fct_h, nn_fct_v   ! =2/4 : horizontal and vertical choices of the order of FCT scheme 
    41    INTEGER ::      nn_fct_zts           ! >=1 : 2nd order FCT with vertical sub-timestepping 
    4246   LOGICAL ::   ln_trcadv_mus    ! MUSCL scheme flag 
    4347   LOGICAL ::      ln_mus_ups           ! use upstream scheme in vivcinity of river mouths 
    … …  
    4650   LOGICAL ::   ln_trcadv_qck    ! QUICKEST scheme flag 
    4751 
    48    !                                        ! choices of advection scheme: 
     52   INTEGER ::   nadv             ! choice of the type of advection scheme 
     53   !                             ! associated indices: 
    4954   INTEGER, PARAMETER ::   np_NO_adv  = 0   ! no T-S advection 
    5055   INTEGER, PARAMETER ::   np_CEN     = 1   ! 2nd/4th order centered scheme 
    5156   INTEGER, PARAMETER ::   np_FCT     = 2   ! 2nd/4th order Flux Corrected Transport scheme 
    52    INTEGER, PARAMETER ::   np_FCT_zts = 3   ! 2nd order FCT scheme with vertical sub-timestepping 
    53    INTEGER, PARAMETER ::   np_MUS     = 4   ! MUSCL scheme 
    54    INTEGER, PARAMETER ::   np_UBS     = 5   ! 3rd order Upstream Biased Scheme 
    55    INTEGER, PARAMETER ::   np_QCK     = 6   ! QUICK scheme 
    56  
    57    INTEGER ::              nadv             ! chosen advection scheme 
    58    ! 
     57   INTEGER, PARAMETER ::   np_MUS     = 3   ! MUSCL scheme 
     58   INTEGER, PARAMETER ::   np_UBS     = 4   ! 3rd order Upstream Biased Scheme 
     59   INTEGER, PARAMETER ::   np_QCK     = 5   ! QUICK scheme 
     60    
    5961   !! * Substitutions 
    6062#  include "vectopt_loop_substitute.h90" 
    6163   !!---------------------------------------------------------------------- 
    62    !! NEMO/TOP 3.7 , NEMO Consortium (2015) 
     64   !! NEMO/TOP 4.0 , NEMO Consortium (2017) 
    6365   !! $Id$  
    64    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     66   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6567   !!---------------------------------------------------------------------- 
    6668CONTAINS 
    … …  
    7274      !! ** Purpose :   compute the ocean tracer advection trend. 
    7375      !! 
    74       !! ** Method  : - Update the tracer with the advection term following nadv 
     76      !! ** Method  : - Update after tracers (tra) with the advection term following nadv 
    7577      !!---------------------------------------------------------------------- 
    7678      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    … …  
    7880      INTEGER ::   jk   ! dummy loop index 
    7981      CHARACTER (len=22) ::   charout 
    80       REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn  ! effective velocity 
    81       !!---------------------------------------------------------------------- 
    82       ! 
    83       IF( nn_timing == 1 )   CALL timing_start('trc_adv') 
    84       ! 
    85       CALL wrk_alloc( jpi,jpj,jpk,   zun, zvn, zwn ) 
    86       !                                               !==  effective transport  ==! 
     82      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zun, zvn, zwn  ! effective velocity 
     83      !!---------------------------------------------------------------------- 
     84      ! 
     85      IF( ln_timing )   CALL timing_start('trc_adv') 
     86      ! 
     87      !                                         !==  effective transport  ==! 
    8788      IF( l_offline ) THEN 
    88          zun(:,:,:) = un(:,:,:)     ! effective transport already in un/vn/wn 
     89         zun(:,:,:) = un(:,:,:)                    ! already in (un,vn,wn) 
    8990         zvn(:,:,:) = vn(:,:,:) 
    9091         zwn(:,:,:) = wn(:,:,:) 
    91       ELSE 
    92          !        
    93          DO jk = 1, jpkm1 
    94             zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)                   ! eulerian transport 
    95             zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    96             zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
    97          END DO 
     92      ELSE                                         ! build the effective transport 
     93         zun(:,:,jpk) = 0._wp 
     94         zvn(:,:,jpk) = 0._wp 
     95         zwn(:,:,jpk) = 0._wp 
     96         IF( ln_wave .AND. ln_sdw )  THEN 
     97            DO jk = 1, jpkm1                                                       ! eulerian transport + Stokes Drift 
     98               zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * ( un(:,:,jk) + usd(:,:,jk) ) 
     99               zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * ( vn(:,:,jk) + vsd(:,:,jk) ) 
     100               zwn(:,:,jk) = e1e2t(:,:)                 * ( wn(:,:,jk) + wsd(:,:,jk) ) 
     101            END DO 
     102         ELSE 
     103            DO jk = 1, jpkm1 
     104               zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)                   ! eulerian transport 
     105               zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
     106               zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
     107            END DO 
     108         ENDIF 
    98109         ! 
    99110         IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                 ! add z-tilde and/or vvl corrections 
    … …  
    107118         IF( ln_mle    )   CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the mle transport 
    108119         ! 
    109          zun(:,:,jpk) = 0._wp                                                       ! no transport trough the bottom 
    110          zvn(:,:,jpk) = 0._wp 
    111          zwn(:,:,jpk) = 0._wp 
    112          ! 
    113120      ENDIF 
    114121      ! 
    115122      SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==! 
    116123      ! 
    117       CASE ( np_CEN )                                    ! Centered : 2nd / 4th order 
    118          CALL tra_adv_cen    ( kt, nittrc000,'TRC',       zun, zvn, zwn     , trn, tra, jptra, nn_cen_h, nn_cen_v ) 
    119       CASE ( np_FCT )                                    ! FCT      : 2nd / 4th order 
    120          CALL tra_adv_fct    ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v ) 
    121       CASE ( np_FCT_zts )                                ! 2nd order FCT with vertical time-splitting 
    122          CALL tra_adv_fct_zts( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra        , nn_fct_zts ) 
    123       CASE ( np_MUS )                                    ! MUSCL 
    124          CALL tra_adv_mus    ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb,      tra, jptra        , ln_mus_ups )  
    125       CASE ( np_UBS )                                    ! UBS 
    126          CALL tra_adv_ubs    ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra        , nn_ubs_v   ) 
    127       CASE ( np_QCK )                                    ! QUICKEST 
    128          CALL tra_adv_qck    ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra                     ) 
     124      CASE ( np_CEN )                                 ! Centered : 2nd / 4th order 
     125         CALL tra_adv_cen( kt, nittrc000,'TRC',          zun, zvn, zwn     , trn, tra, jptra, nn_cen_h, nn_cen_v ) 
     126      CASE ( np_FCT )                                 ! FCT      : 2nd / 4th order 
     127         CALL tra_adv_fct( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v ) 
     128      CASE ( np_MUS )                                 ! MUSCL 
     129         CALL tra_adv_mus( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb,      tra, jptra        , ln_mus_ups )  
     130      CASE ( np_UBS )                                 ! UBS 
     131         CALL tra_adv_ubs( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra          , nn_ubs_v ) 
     132      CASE ( np_QCK )                                 ! QUICKEST 
     133         CALL tra_adv_qck( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra                     ) 
    129134      ! 
    130135      END SELECT 
    131136      !                   
    132       IF( ln_ctl )   THEN                             !== print mean trends (used for debugging) 
    133          WRITE(charout, FMT="('adv ')")  ;  CALL prt_ctl_trc_info(charout) 
    134                                             CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     137      IF( ln_ctl ) THEN                         !== print mean trends (used for debugging) 
     138         WRITE(charout, FMT="('adv ')") 
     139         CALL prt_ctl_trc_info(charout) 
     140         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    135141      END IF 
    136142      ! 
    137       CALL wrk_dealloc( jpi,jpj,jpk,   zun, zvn, zwn ) 
    138       ! 
    139       IF( nn_timing == 1 )  CALL timing_stop('trc_adv') 
     143      IF( ln_timing )   CALL timing_stop('trc_adv') 
    140144      ! 
    141145   END SUBROUTINE trc_adv 
    … …  
    146150      !!                  ***  ROUTINE trc_adv_ini  *** 
    147151      !!                 
    148       !! ** Purpose : Control the consistency between namelist options for  
     152      !! ** Purpose :   Control the consistency between namelist options for  
    149153      !!              passive tracer advection schemes and set nadv 
    150154      !!---------------------------------------------------------------------- 
    … …  
    152156      INTEGER ::  ios                 ! Local integer output status for namelist read 
    153157      !! 
    154       NAMELIST/namtrc_adv/ ln_trcadv_cen, nn_cen_h, nn_cen_v,               &   ! CEN 
    155          &                 ln_trcadv_fct, nn_fct_h, nn_fct_v, nn_fct_zts,   &   ! FCT 
    156          &                 ln_trcadv_mus,                     ln_mus_ups,   &   ! MUSCL 
    157          &                 ln_trcadv_ubs,           nn_ubs_v,               &   ! UBS 
    158          &                 ln_trcadv_qck                                        ! QCK 
    159       !!---------------------------------------------------------------------- 
    160       ! 
    161       REWIND( numnat_ref )              !  namtrc_adv in reference namelist  
     158      NAMELIST/namtrc_adv/ ln_trcadv_NONE,                       &   ! No advection 
     159         &                 ln_trcadv_cen, nn_cen_h, nn_cen_v,    &   ! CEN 
     160         &                 ln_trcadv_fct, nn_fct_h, nn_fct_v,    &   ! FCT 
     161         &                 ln_trcadv_mus, ln_mus_ups,            &   ! MUSCL 
     162         &                 ln_trcadv_ubs,           nn_ubs_v,    &   ! UBS 
     163         &                 ln_trcadv_qck                             ! QCK 
     164      !!---------------------------------------------------------------------- 
     165      ! 
     166      !                                !==  Namelist  ==! 
     167      REWIND( numnat_ref )                   !  namtrc_adv in reference namelist  
    162168      READ  ( numnat_ref, namtrc_adv, IOSTAT = ios, ERR = 901) 
    163169901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in reference namelist', lwp ) 
    164  
    165       REWIND( numnat_cfg )              ! namtrc_adv in configuration namelist 
     170      ! 
     171      REWIND( numnat_cfg )                   ! namtrc_adv in configuration namelist 
    166172      READ  ( numnat_cfg, namtrc_adv, IOSTAT = ios, ERR = 902 ) 
    167173902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist', lwp ) 
    168174      IF(lwm) WRITE ( numont, namtrc_adv ) 
    169  
    170       IF(lwp) THEN                    ! Namelist print 
     175      ! 
     176      IF(lwp) THEN                           ! Namelist print 
    171177         WRITE(numout,*) 
    172178         WRITE(numout,*) 'trc_adv_ini : choice/control of the tracer advection scheme' 
    173179         WRITE(numout,*) '~~~~~~~~~~~' 
    174180         WRITE(numout,*) '   Namelist namtrc_adv : chose a advection scheme for tracers' 
     181         WRITE(numout,*) '      No advection on passive tracers           ln_trcadv_NONE= ', ln_trcadv_NONE 
    175182         WRITE(numout,*) '      centered scheme                           ln_trcadv_cen = ', ln_trcadv_cen 
    176183         WRITE(numout,*) '            horizontal 2nd/4th order               nn_cen_h   = ', nn_fct_h 
    … …  
    179186         WRITE(numout,*) '            horizontal 2nd/4th order               nn_fct_h   = ', nn_fct_h 
    180187         WRITE(numout,*) '            vertical   2nd/4th order               nn_fct_v   = ', nn_fct_v 
    181          WRITE(numout,*) '            2nd order + vertical sub-timestepping  nn_fct_zts = ', nn_fct_zts 
    182188         WRITE(numout,*) '      MUSCL scheme                              ln_trcadv_mus = ', ln_trcadv_mus 
    183189         WRITE(numout,*) '            + upstream scheme near river mouths    ln_mus_ups = ', ln_mus_ups 
    … …  
    187193      ENDIF 
    188194      ! 
    189  
    190       ioptio = 0                       !==  Parameter control  ==! 
    191       IF( ln_trcadv_cen )   ioptio = ioptio + 1 
    192       IF( ln_trcadv_fct )   ioptio = ioptio + 1 
    193       IF( ln_trcadv_mus )   ioptio = ioptio + 1 
    194       IF( ln_trcadv_ubs )   ioptio = ioptio + 1 
    195       IF( ln_trcadv_qck )   ioptio = ioptio + 1 
    196  
    197       ! 
    198       IF( ioptio == 0 ) THEN 
    199          nadv = np_NO_adv 
    200          CALL ctl_warn( 'trc_adv_init: You are running without tracer advection.' ) 
    201       ENDIF 
    202       IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namtrc_adv' ) 
     195      !                                !==  Parameter control & set nadv ==! 
     196      ioptio = 0 
     197      IF( ln_trcadv_NONE ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_NO_adv   ;   ENDIF 
     198      IF( ln_trcadv_cen  ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_CEN      ;   ENDIF 
     199      IF( ln_trcadv_fct  ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_FCT      ;   ENDIF 
     200      IF( ln_trcadv_mus  ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_MUS      ;   ENDIF 
     201      IF( ln_trcadv_ubs  ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_UBS      ;   ENDIF 
     202      IF( ln_trcadv_qck  ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_QCK      ;   ENDIF 
     203      ! 
     204      IF( ioptio /= 1 )   CALL ctl_stop( 'trc_adv_ini: Choose ONE advection option in namelist namtrc_adv' ) 
    203205      ! 
    204206      IF( ln_trcadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 )   & 
    205207                        .AND. ( nn_cen_v /= 2 .AND. nn_cen_v /= 4 )   ) THEN 
    206         CALL ctl_stop( 'trc_adv_init: CEN scheme, choose 2nd or 4th order' ) 
     208        CALL ctl_stop( 'trc_adv_ini: CEN scheme, choose 2nd or 4th order' ) 
    207209      ENDIF 
    208210      IF( ln_trcadv_fct .AND. ( nn_fct_h /= 2 .AND. nn_fct_h /= 4 )   & 
    209211                        .AND. ( nn_fct_v /= 2 .AND. nn_fct_v /= 4 )   ) THEN 
    210         CALL ctl_stop( 'trc_adv_init: FCT scheme, choose 2nd or 4th order' ) 
    211       ENDIF 
    212       IF( ln_trcadv_fct .AND. nn_fct_zts > 0 ) THEN 
    213          IF( nn_fct_h == 4 ) THEN 
    214             nn_fct_h = 2 
    215             CALL ctl_stop( 'trc_adv_init: force 2nd order FCT scheme, 4th order does not exist with sub-timestepping' ) 
    216          ENDIF 
    217          IF( .NOT.ln_linssh ) THEN 
    218             CALL ctl_stop( 'trc_adv_init: vertical sub-timestepping not allow in non-linear free surface' ) 
    219          ENDIF 
    220          IF( nn_fct_zts == 1 )   CALL ctl_warn( 'trc_adv_init: FCT with ONE sub-timestep = FCT without sub-timestep' ) 
     212        CALL ctl_stop( 'trc_adv_ini: FCT scheme, choose 2nd or 4th order' ) 
    221213      ENDIF 
    222214      IF( ln_trcadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 )   ) THEN 
    223         CALL ctl_stop( 'trc_adv_init: UBS scheme, choose 2nd or 4th order' ) 
     215        CALL ctl_stop( 'trc_adv_ini: UBS scheme, choose 2nd or 4th order' ) 
    224216      ENDIF 
    225217      IF( ln_trcadv_ubs .AND. nn_ubs_v == 4 ) THEN 
    226          CALL ctl_warn( 'trc_adv_init: UBS scheme, only 2nd FCT scheme available on the vertical. It will be used' ) 
     218         CALL ctl_warn( 'trc_adv_ini: UBS scheme, only 2nd FCT scheme available on the vertical. It will be used' ) 
    227219      ENDIF 
    228220      IF( ln_isfcav ) THEN                                                       ! ice-shelf cavities 
    229          IF(  ln_trcadv_cen .AND. nn_cen_v /= 4    .OR.   &                            ! NO 4th order with ISF 
    230             & ln_trcadv_fct .AND. nn_fct_v /= 4   )   CALL ctl_stop( 'tra_adv_init: 4th order COMPACT scheme not allowed with ISF' ) 
    231       ENDIF 
    232       ! 
    233       !                                !==  used advection scheme  ==! 
    234       !                                      ! set nadv 
    235       IF( ln_trcadv_cen                      )   nadv = np_CEN 
    236       IF( ln_trcadv_fct                      )   nadv = np_FCT 
    237       IF( ln_trcadv_fct .AND. nn_fct_zts > 0 )   nadv = np_FCT_zts 
    238       IF( ln_trcadv_mus                      )   nadv = np_MUS 
    239       IF( ln_trcadv_ubs                      )   nadv = np_UBS 
    240       IF( ln_trcadv_qck                      )   nadv = np_QCK 
    241       ! 
    242       IF(lwp) THEN                   ! Print the choice 
     221         IF(  ln_trcadv_cen .AND. nn_cen_v == 4    .OR.   &                            ! NO 4th order with ISF 
     222            & ln_trcadv_fct .AND. nn_fct_v == 4   )   CALL ctl_stop( 'tra_adv_ini: 4th order COMPACT scheme not allowed with ISF' ) 
     223      ENDIF 
     224      ! 
     225      !                                !==  Print the choice  ==!   
     226      IF(lwp) THEN 
    243227         WRITE(numout,*) 
    244          IF( nadv == np_NO_adv  )   WRITE(numout,*) '         NO passive tracer advection' 
    245          IF( nadv == np_CEN     )   WRITE(numout,*) '         CEN      scheme is used. Horizontal order: ', nn_cen_h,   & 
    246             &                                                                        ' Vertical   order: ', nn_cen_v 
    247          IF( nadv == np_FCT     )   WRITE(numout,*) '         FCT      scheme is used. Horizontal order: ', nn_fct_h,   & 
    248             &                                                                       ' Vertical   order: ', nn_fct_v 
    249          IF( nadv == np_FCT_zts )   WRITE(numout,*) '         use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping' 
    250          IF( nadv == np_MUS     )   WRITE(numout,*) '         MUSCL    scheme is used' 
    251          IF( nadv == np_UBS     )   WRITE(numout,*) '         UBS      scheme is used' 
    252          IF( nadv == np_QCK     )   WRITE(numout,*) '         QUICKEST scheme is used' 
     228         SELECT CASE ( nadv ) 
     229         CASE( np_NO_adv  )   ;   WRITE(numout,*) '      ===>>   NO passive tracer advection' 
     230         CASE( np_CEN     )   ;   WRITE(numout,*) '      ===>>   CEN      scheme is used. Horizontal order: ', nn_cen_h,   & 
     231            &                                                                     ' Vertical   order: ', nn_cen_v 
     232         CASE( np_FCT     )   ;   WRITE(numout,*) '      ===>>   FCT      scheme is used. Horizontal order: ', nn_fct_h,   & 
     233            &                                                                      ' Vertical   order: ', nn_fct_v 
     234         CASE( np_MUS     )   ;   WRITE(numout,*) '      ===>>   MUSCL    scheme is used' 
     235         CASE( np_UBS     )   ;   WRITE(numout,*) '      ===>>   UBS      scheme is used' 
     236         CASE( np_QCK     )   ;   WRITE(numout,*) '      ===>>   QUICKEST scheme is used' 
     237         END SELECT 
    253238      ENDIF 
    254239      ! 
    255240   END SUBROUTINE trc_adv_ini 
    256241    
    257 #else 
    258    !!---------------------------------------------------------------------- 
    259    !!   Default option                                         Empty module 
    260    !!---------------------------------------------------------------------- 
    261 CONTAINS 
    262    SUBROUTINE trc_adv( kt ) 
    263       INTEGER, INTENT(in) :: kt 
    264       WRITE(*,*) 'trc_adv: You should not have seen this print! error?', kt 
    265    END SUBROUTINE trc_adv 
    266242#endif 
    267243 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90

    r7753 r8568  
    1717   USE trc            ! ocean passive tracers variables 
    1818   USE oce_trc        ! ocean dynamics and active tracers 
    19    USE ldfslp         ! lateral diffusion: iso-neutral slope 
     19   USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff. 
     20   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces 
    2021   USE traldf_lap_blp ! lateral diffusion: lap/bilaplacian iso-level      operator  (tra_ldf_lap/_blp   routine) 
    2122   USE traldf_iso     ! lateral diffusion: laplacian iso-neutral standard operator  (tra_ldf_iso        routine) 
    … …  
    3233   PUBLIC   trc_ldf_ini    
    3334   ! 
     35   LOGICAL , PUBLIC ::   ln_trcldf_NONE      !: No operator (no explicit lateral diffusion) 
    3436   LOGICAL , PUBLIC ::   ln_trcldf_lap       !:   laplacian operator 
    3537   LOGICAL , PUBLIC ::   ln_trcldf_blp       !: bilaplacian operator 
    … …  
    4547   REAL(wp) ::  rldf       ! ratio between active and passive tracers diffusive coefficient 
    4648    
    47    INTEGER  ::  nldf = 0   ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals) 
     49   INTEGER  ::  nldf       ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals) 
    4850    
    4951   !! * Substitutions 
    … …  
    98100      CASE ( np_lap   )                               ! iso-level laplacian 
    99101         CALL tra_ldf_lap  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb,      tra, jptra,  1   ) 
    100          ! 
    101102      CASE ( np_lap_i )                               ! laplacian : standard iso-neutral operator (Madec) 
    102103         CALL tra_ldf_iso  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra,  1   ) 
    103          ! 
    104104      CASE ( np_lap_it )                              ! laplacian : triad iso-neutral operator (griffies) 
    105105         CALL tra_ldf_triad( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra,  1   ) 
    106          ! 
    107106      CASE ( np_blp , np_blp_i , np_blp_it )          ! bilaplacian: all operator (iso-level, -neutral) 
    108107         CALL tra_ldf_blp  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb     , tra, jptra, nldf ) 
    109          ! 
    110108      END SELECT 
    111109      ! 
    … …  
    148146      NAMELIST/namtrc_ldf/ ln_trcldf_lap, ln_trcldf_blp,                                  & 
    149147         &                 ln_trcldf_lev, ln_trcldf_hor, ln_trcldf_iso, ln_trcldf_triad,  & 
    150          &                 rn_ahtrc_0   , rn_bhtrc_0, rn_fact_lap   
     148         &                 rn_ahtrc_0   , rn_bhtrc_0   , rn_fact_lap   
    151149      !!---------------------------------------------------------------------- 
    152150      ! 
    … …  
    166164         WRITE(numout,*) '   Namelist namtrc_ldf : set lateral mixing parameters (type, direction, coefficients)' 
    167165         WRITE(numout,*) '      operator' 
     166         WRITE(numout,*) '         no explicit diffusion       ln_trcldf_NONE  = ', ln_trcldf_NONE 
    168167         WRITE(numout,*) '           laplacian                 ln_trcldf_lap   = ', ln_trcldf_lap 
    169168         WRITE(numout,*) '         bilaplacian                 ln_trcldf_blp   = ', ln_trcldf_blp 
    … …  
    182181      !                                ! control the namelist parameters 
    183182      ioptio = 0 
    184       IF( ln_trcldf_lap )   ioptio = ioptio + 1 
    185       IF( ln_trcldf_blp )   ioptio = ioptio + 1 
    186       IF( ioptio >  1   )   CALL ctl_stop( 'trc_ldf_ctl: use ONE or NONE of the 2 lap/bilap operator type on tracer' ) 
    187       IF( ioptio == 0   )   nldf = np_no_ldf   ! No lateral diffusion 
     183      IF( ln_trcldf_NONE ) THEN   ;   nldf = np_no_ldf   ;   ioptio = ioptio + 1   ;   ENDIF 
     184      IF( ln_trcldf_lap  ) THEN   ;                          ioptio = ioptio + 1   ;   ENDIF 
     185      IF( ln_trcldf_blp  ) THEN   ;                          ioptio = ioptio + 1   ;   ENDIF 
     186      IF( ioptio /=  1   )   CALL ctl_stop( 'trc_ldf_ini: use ONE of the 3 operator options (NONE/lap/blp)' ) 
    188187       
    189       IF( ln_trcldf_lap .AND. ln_trcldf_blp )   CALL ctl_stop( 'trc_ldf_ctl: bilaplacian should be used on both TRC and TRA' ) 
    190       IF( ln_trcldf_blp .AND. ln_trcldf_lap )   CALL ctl_stop( 'trc_ldf_ctl:   laplacian should be used on both TRC and TRA' ) 
    191       ! 
    192       ioptio = 0 
    193       IF( ln_trcldf_lev )   ioptio = ioptio + 1 
    194       IF( ln_trcldf_hor )   ioptio = ioptio + 1 
    195       IF( ln_trcldf_iso )   ioptio = ioptio + 1 
    196       IF( ioptio /= 1   )   CALL ctl_stop( 'trc_ldf_ctl: use only ONE direction (level/hor/iso)' ) 
    197       ! 
    198       ! defined the type of lateral diffusion from ln_trcldf_... logicals 
    199       ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully 
    200       ierr = 0 
    201       IF( ln_trcldf_lap ) THEN      !==  laplacian operator  ==! 
    202          IF ( ln_zco ) THEN                ! z-coordinate 
    203             IF ( ln_trcldf_lev   )   nldf = np_lap     ! iso-level = horizontal (no rotation) 
    204             IF ( ln_trcldf_hor   )   nldf = np_lap     ! iso-level = horizontal (no rotation) 
    205             IF ( ln_trcldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard  (   rotation) 
    206             IF ( ln_trcldf_triad )   nldf = np_lap_it  ! iso-neutral: triad     (   rotation) 
     188      IF( ln_trcldf_lap .AND. .NOT.ln_traldf_lap )   CALL ctl_stop( 'trc_ldf_ini:   laplacian should be used on both TRC and TRA' ) 
     189      IF( ln_trcldf_blp .AND. .NOT.ln_traldf_blp )   CALL ctl_stop( 'trc_ldf_ini: bilaplacian should be used on both TRC and TRA' ) 
     190      ! 
     191      IF( .NOT.ln_trcldf_NONE ) THEN   ! direction ==>> type of operator  
     192         ioptio = 0 
     193         IF( ln_trcldf_lev )   ioptio = ioptio + 1 
     194         IF( ln_trcldf_hor )   ioptio = ioptio + 1 
     195         IF( ln_trcldf_iso )   ioptio = ioptio + 1 
     196         IF( ioptio /= 1   )   CALL ctl_stop( 'trc_ldf_ini: use ONE direction (level/hor/iso)' ) 
     197         ! 
     198         ! defined the type of lateral diffusion from ln_trcldf_... logicals 
     199         ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully 
     200         ierr = 0 
     201         IF( ln_trcldf_lap ) THEN      !==  laplacian operator  ==! 
     202            IF( ln_zco ) THEN                ! z-coordinate 
     203               IF( ln_trcldf_lev   )   nldf = np_lap     ! iso-level = horizontal (no rotation) 
     204               IF( ln_trcldf_hor   )   nldf = np_lap     ! iso-level = horizontal (no rotation) 
     205               IF( ln_trcldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard  (   rotation) 
     206               IF( ln_trcldf_triad )   nldf = np_lap_it  ! iso-neutral: triad     (   rotation) 
     207            ENDIF 
     208            IF( ln_zps ) THEN             ! z-coordinate with partial step 
     209               IF( ln_trcldf_lev   )   ierr = 1          ! iso-level not allowed  
     210               IF( ln_trcldf_hor   )   nldf = np_lap     ! horizontal (no rotation) 
     211               IF( ln_trcldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard (rotation) 
     212               IF( ln_trcldf_triad )   nldf = np_lap_it  ! iso-neutral: triad    (rotation) 
     213            ENDIF 
     214            IF( ln_sco ) THEN             ! s-coordinate 
     215               IF( ln_trcldf_lev   )   nldf = np_lap     ! iso-level  (no rotation) 
     216               IF( ln_trcldf_hor   )   nldf = np_lap_it  ! horizontal (   rotation)       !!gm   a checker.... 
     217               IF( ln_trcldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard (rotation) 
     218               IF( ln_trcldf_triad )   nldf = np_lap_it  ! iso-neutral: triad    (rotation) 
     219            ENDIF 
     220            !                                ! diffusivity ratio: passive / active tracers  
     221            IF( ABS(rn_aht_0) < 2._wp*TINY(1._wp) ) THEN 
     222               IF( ABS(rn_ahtrc_0) < 2._wp*TINY(1._wp) ) THEN 
     223                  rldf = 1.0_wp 
     224               ELSE 
     225                  CALL ctl_stop( 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
     226               ENDIF 
     227            ELSE 
     228               rldf = rn_ahtrc_0 / rn_aht_0 
     229            ENDIF 
    207230         ENDIF 
    208          IF ( ln_zps ) THEN             ! z-coordinate with partial step 
    209             IF ( ln_trcldf_lev   )   ierr = 1         ! iso-level not allowed  
    210             IF ( ln_trcldf_hor   )   nldf = np_lap     ! horizontal (no rotation) 
    211             IF ( ln_trcldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard (rotation) 
    212             IF ( ln_trcldf_triad )   nldf = np_lap_it  ! iso-neutral: triad    (rotation) 
     231         ! 
     232         IF( ln_trcldf_blp ) THEN      !==  bilaplacian operator  ==! 
     233            IF ( ln_zco ) THEN                ! z-coordinate 
     234               IF ( ln_trcldf_lev   )   nldf = np_blp     ! iso-level = horizontal (no rotation) 
     235               IF ( ln_trcldf_hor   )   nldf = np_blp     ! iso-level = horizontal (no rotation) 
     236               IF ( ln_trcldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard (rotation) 
     237               IF ( ln_trcldf_triad )   nldf = np_blp_it  ! iso-neutral: triad    (rotation) 
     238            ENDIF 
     239            IF ( ln_zps ) THEN             ! z-coordinate with partial step 
     240               IF ( ln_trcldf_lev   )   ierr = 1         ! iso-level not allowed  
     241               IF ( ln_trcldf_hor   )   nldf = np_blp     ! horizontal (no rotation) 
     242               IF ( ln_trcldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard (rotation) 
     243               IF ( ln_trcldf_triad )   nldf = np_blp_it  ! iso-neutral: triad    (rotation) 
     244            ENDIF 
     245            IF ( ln_sco ) THEN             ! s-coordinate 
     246               IF ( ln_trcldf_lev   )   nldf = np_blp     ! iso-level  (no rotation) 
     247               IF ( ln_trcldf_hor   )   nldf = np_blp_it  ! horizontal (   rotation)       !!gm   a checker.... 
     248               IF ( ln_trcldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard (rotation) 
     249               IF ( ln_trcldf_triad )   nldf = np_blp_it  ! iso-neutral: triad    (rotation) 
     250            ENDIF 
     251            !                                ! diffusivity ratio: passive / active tracers  
     252            IF( ABS(rn_bht_0) < 2._wp*TINY(1._wp) ) THEN 
     253               IF( ABS(rn_bhtrc_0) < 2._wp*TINY(1._wp) ) THEN 
     254                  rldf = 1.0_wp 
     255               ELSE 
     256                  CALL ctl_stop( 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
     257               ENDIF 
     258            ELSE 
     259               rldf = SQRT(  ABS( rn_bhtrc_0 / rn_bht_0 )  ) 
     260            ENDIF 
    213261         ENDIF 
    214          IF ( ln_sco ) THEN             ! s-coordinate 
    215             IF ( ln_trcldf_lev   )   nldf = np_lap     ! iso-level  (no rotation) 
    216             IF ( ln_trcldf_hor   )   nldf = np_lap_it  ! horizontal (   rotation)       !!gm   a checker.... 
    217             IF ( ln_trcldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard (rotation) 
    218             IF ( ln_trcldf_triad )   nldf = np_lap_it  ! iso-neutral: triad    (rotation) 
    219          ENDIF 
    220          !                                ! diffusivity ratio: passive / active tracers  
    221          IF( ABS(rn_aht_0) < 2._wp*TINY(1._wp) ) THEN 
    222             IF( ABS(rn_ahtrc_0) < 2._wp*TINY(1._wp) ) THEN 
    223                rldf = 1.0_wp 
    224             ELSE 
    225                CALL ctl_stop( 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
    226             ENDIF 
    227          ELSE 
    228             rldf = rn_ahtrc_0 / rn_aht_0 
    229          ENDIF 
    230       ENDIF 
    231       ! 
    232       IF( ln_trcldf_blp ) THEN      !==  bilaplacian operator  ==! 
    233          IF ( ln_zco ) THEN                ! z-coordinate 
    234             IF ( ln_trcldf_lev   )   nldf = np_blp     ! iso-level = horizontal (no rotation) 
    235             IF ( ln_trcldf_hor   )   nldf = np_blp     ! iso-level = horizontal (no rotation) 
    236             IF ( ln_trcldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard (rotation) 
    237             IF ( ln_trcldf_triad )   nldf = np_blp_it  ! iso-neutral: triad    (rotation) 
    238          ENDIF 
    239          IF ( ln_zps ) THEN             ! z-coordinate with partial step 
    240             IF ( ln_trcldf_lev   )   ierr = 1         ! iso-level not allowed  
    241             IF ( ln_trcldf_hor   )   nldf = np_blp     ! horizontal (no rotation) 
    242             IF ( ln_trcldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard (rotation) 
    243             IF ( ln_trcldf_triad )   nldf = np_blp_it  ! iso-neutral: triad    (rotation) 
    244          ENDIF 
    245          IF ( ln_sco ) THEN             ! s-coordinate 
    246             IF ( ln_trcldf_lev   )   nldf = np_blp     ! iso-level  (no rotation) 
    247             IF ( ln_trcldf_hor   )   nldf = np_blp_it  ! horizontal (   rotation)       !!gm   a checker.... 
    248             IF ( ln_trcldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard (rotation) 
    249             IF ( ln_trcldf_triad )   nldf = np_blp_it  ! iso-neutral: triad    (rotation) 
    250          ENDIF 
    251          !                                ! diffusivity ratio: passive / active tracers  
    252          IF( ABS(rn_bht_0) < 2._wp*TINY(1._wp) ) THEN 
    253             IF( ABS(rn_bhtrc_0) < 2._wp*TINY(1._wp) ) THEN 
    254                rldf = 1.0_wp 
    255             ELSE 
    256                CALL ctl_stop( 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
    257             ENDIF 
    258          ELSE 
    259             rldf = SQRT(  ABS( rn_bhtrc_0 / rn_bht_0 )  ) 
    260          ENDIF 
    261       ENDIF 
    262       ! 
    263       IF( ierr == 1 )   CALL ctl_stop( 'trc_ldf_ctl: iso-level in z-partial step, not allowed' ) 
    264       IF( ln_ldfeiv .AND. .NOT.ln_trcldf_iso )   CALL ctl_stop( 'trc_ldf_ctl: eiv requires isopycnal laplacian diffusion' ) 
     262         ! 
     263         IF( ierr == 1 )   CALL ctl_stop( 'trc_ldf_ini: iso-level in z-partial step, not allowed' ) 
     264      ENDIF 
     265      ! 
     266      IF( ln_ldfeiv .AND. .NOT.ln_trcldf_iso )   CALL ctl_stop( 'trc_ldf_ini: eiv requires isopycnal laplacian diffusion' ) 
    265267      IF( nldf == 1 .OR. nldf == 3 )   l_ldfslp = .TRUE.    ! slope of neutral surfaces required  
    266268      ! 
    … …  
    268270         WRITE(numout,*) 
    269271         SELECT CASE( nldf ) 
    270          CASE( np_no_ldf )   ;   WRITE(numout,*) '          NO lateral diffusion' 
    271          CASE( np_lap    )   ;   WRITE(numout,*) '          laplacian iso-level operator' 
    272          CASE( np_lap_i  )   ;   WRITE(numout,*) '          Rotated laplacian operator (standard)' 
    273          CASE( np_lap_it )   ;   WRITE(numout,*) '          Rotated laplacian operator (triad)' 
    274          CASE( np_blp    )   ;   WRITE(numout,*) '          bilaplacian iso-level operator' 
    275          CASE( np_blp_i  )   ;   WRITE(numout,*) '          Rotated bilaplacian operator (standard)' 
    276          CASE( np_blp_it )   ;   WRITE(numout,*) '          Rotated bilaplacian operator (triad)' 
     272         CASE( np_no_ldf )   ;   WRITE(numout,*) '      ===>>   NO lateral diffusion' 
     273         CASE( np_lap    )   ;   WRITE(numout,*) '      ===>>   laplacian iso-level operator' 
     274         CASE( np_lap_i  )   ;   WRITE(numout,*) '      ===>>   Rotated laplacian operator (standard)' 
     275         CASE( np_lap_it )   ;   WRITE(numout,*) '      ===>>   Rotated laplacian operator (triad)' 
     276         CASE( np_blp    )   ;   WRITE(numout,*) '      ===>>   bilaplacian iso-level operator' 
     277         CASE( np_blp_i  )   ;   WRITE(numout,*) '      ===>>   Rotated bilaplacian operator (standard)' 
     278         CASE( np_blp_it )   ;   WRITE(numout,*) '      ===>>   Rotated bilaplacian operator (triad)' 
    277279         END SELECT 
    278280      ENDIF 
    279281      ! 
    280282   END SUBROUTINE trc_ldf_ini 
    281 #else 
    282    !!---------------------------------------------------------------------- 
    283    !!   Default option                                         Empty module 
    284    !!---------------------------------------------------------------------- 
    285 CONTAINS 
    286    SUBROUTINE trc_ldf( kt ) 
    287       INTEGER, INTENT(in) :: kt 
    288       WRITE(*,*) 'trc_ldf: You should not have seen this print! error?', kt 
    289    END SUBROUTINE trc_ldf 
     283 
    290284#endif 
    291285   !!====================================================================== 
Note: See TracChangeset for help on using the changeset viewer.