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 4596 for branches/2014/dev_CNRS0_NOC1_LDF – NEMO

Ignore:
Timestamp:
2014-03-26T12:02:30+01:00 (10 years ago)
Author:
gm
Message:

#1260: LDF simplification + bilap iso-neutral for TRA and GYRE

Location:
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM
Files:
3 added
17 deleted
46 edited
1 moved

Legend:

Unmodified
Added
Removed

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg

    r4370 r4596  
    8282!----------------------------------------------------------------------- 
    8383   nn_fsbc     = 1         !  frequency of surface boundary condition computation 
    84                            !     (also = the frequency of sea-ice model call) 
     84   !                       !     (also = the frequency of sea-ice model call) 
    8585   ln_ana      = .true.    !  analytical formulation                    (T => fill namsbc_ana ) 
    8686   ln_blk_core = .false.   !  CORE bulk formulation                     (T => fill namsbc_core) 
    … …  
    212212&namtra_ldf    !   lateral diffusion scheme for tracers 
    213213!---------------------------------------------------------------------------------- 
    214    rn_aeiv_0        =     0.    !  eddy induced velocity coefficient [m2/s] 
    215    rn_aht_0         =  1000.    !  horizontal eddy diffusivity for tracers [m2/s] 
     214   !                       !  Operator type: 
     215   ln_traldf_lap   =  .true.   !  laplacian operator 
     216   ln_traldf_blp   =  .false.  !  bilaplacian operator 
     217   !                       !  Direction of action: 
     218   ln_traldf_lev   =  .false.  !  iso-level 
     219   ln_traldf_hor   =  .false.  !  horizontal (geopotential) 
     220   ln_traldf_iso   =  .false.  !  iso-neutral 
     221   ln_traldf_triad =  .true.   !  iso-neutral with Griffies triads 
     222   ! 
     223   !                       !  iso-neutral options          
     224   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operator) 
     225   rn_slpmax       =   0.01    !  slope limit                      (both operator) 
     226   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML     (triad only) 
     227   ln_botmix_triad =  .false.  !  lateral mixing on bottom         (triad only) 
     228   ! 
     229   !                       !  Coefficients 
     230   nn_aht_ijk_t    =  0        !  space/time variation of eddy coef 
     231   !                                   !   =0 constant ; =10 F(k) ; =20 F(i,j)=F(grid spacing) ; =30 F(i,j,k)  
     232   !                                   !   =21 F(i,jt)=Treguier et al. JPO 1997 formulation 
     233   !                                   !   =-20 (=-30) read in eddy_induced_velocity_2D.nc (..._3D.nc) file 
     234   rn_aht_0        = 1000.     !  lateral eddy diffusivity   (lap. operator) [m2/s] 
     235   rn_bht_0        = 5.e+11    !  lateral eddy diffusivity (bilap. operator) [m4/s] 
     236/ 
     237!---------------------------------------------------------------------------------- 
     238&namtra_ldfeiv !   eddy induced velocity param. 
     239!---------------------------------------------------------------------------------- 
     240   ln_ldfeiv     =.false.  ! use eddy induced velocity parameterization 
     241   ln_ldfeiv_dia =.false.  ! diagnose eiv stream function and velocities 
     242   rn_aeiv_0     = 1000.   ! eddy induced velocity coefficient   [m2/s] 
     243   nn_aei_ijk_t  =  0      ! space/time variation of the eiv coeficient 
     244   !                              !   =0 constant ; =10 F(k) ; =20 F(i,j) = F(grid spacing) ; =30 F(i,j,k)  
     245   !                              !   =21 F(i,jt)=Treguier et al. JPO 1997 formulation 
     246   !                              !   =-20 (=-30) read in eddy_induced_velocity_2D.nc (..._3D.nc) file 
    216247/ 
    217248!----------------------------------------------------------------------- 
    … …  
    242273!namdyn_spg    !   surface pressure gradient   (CPP key only) 
    243274!----------------------------------------------------------------------- 
     275 
    244276!----------------------------------------------------------------------- 
    245277&namdyn_ldf    !   lateral diffusion on momentum 
    246278!----------------------------------------------------------------------- 
    247    rn_ahm_0_lap     = 100000.   !  horizontal laplacian eddy viscosity   [m2/s] 
     279   !                       !  Type of the operator : 
     280   ln_dynldf_lap =  .true.     !  laplacian operator 
     281   ln_dynldf_blp =  .false.    !  bilaplacian operator 
     282   !                       !  Direction of action  : 
     283   ln_dynldf_lev =  .false.    !  iso-level 
     284   ln_dynldf_hor =  .true.     !  horizontal (geopotential) 
     285   ln_dynldf_iso =  .false.    !  iso-neutral 
     286   !                       !  Coefficient 
     287   nn_ahm_ijk_t  = 0           !  space/time variation of eddy coef 
     288   !                                !   =0 constant ; =10 F(k) ; =20 F(i,j)=F(grid spacing) ; =30 F(i,j,k)  
     289   !                                !   =-20 (=-30) read in eddy_induced_velocity_2D.nc (..._3D.nc) file 
     290   rn_ahm_0      = 100000.     !  horizontal laplacian eddy viscosity   [m2/s] 
     291   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s] 
     292   rn_bhm_0      = 1.e+12      !  horizontal bilaplacian eddy viscosity [m4/s] 
    248293/ 
    249294!----------------------------------------------------------------------- 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/CONFIG/GYRE/cpp_GYRE.fcm

    r4230 r4596  
    1  bld::tool::fppkeys key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi 
     1 bld::tool::fppkeys key_dynspg_flt key_zdftke key_iomput key_mpp_mpi 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/CONFIG/SHARED/field_def.xml

    r4341 r4596  
    144144         <field id="precip"       long_name="Total precipitation"                                           unit="kg/m2/s"  /> 
    145145 
    146  
    147146         <field id="qt"           long_name="Net Downward Heat Flux"                                       unit="W/m2"     /> 
    148147         <field id="qns"          long_name="non solar Downward Heat Flux"                                 unit="W/m2"     /> 
    … …  
    274273         <field id="uocet"        long_name="ocean transport along i-axis times temperature" unit="degC.m/s" grid_ref="grid_U_3D" /> 
    275274         <field id="uoces"        long_name="ocean transport along i-axis times salinity"    unit="psu.m/s"  grid_ref="grid_U_3D" /> 
     275         <!-- u-eddy coefficients (ldftra, ldfdyn) --> 
     276         <field id="aeiu_2d"      long_name=" surface u-EIV coefficient"                unit="m2/s" /> 
     277         <field id="aeiu_3d"      long_name=" 3D u-EIV coefficient"                     unit="m2/s"  grid_ref="grid_U_3D"/> 
     278         <field id="ahtu_2d"      long_name=" surface u-eddy diffusivity coefficient"   unit="m2/s or m4/s" /> 
     279         <field id="ahtu_3d"      long_name=" 3D u-EIV coefficient"                     unit="m2/s or m4/s"  grid_ref="grid_U_3D"/> 
    276280         <!-- variables available with MLE --> 
    277281         <field id="psiu_mle"     long_name="MLE streamfunction along i-axis"             unit="m3/s"  grid_ref="grid_U_3D"  /> 
    … …  
    279283         <field id="uoce_eiv"     long_name="EIV ocean current along i-axis"              unit="m/s"  grid_ref="grid_U_3D" /> 
    280284         <!-- uoce_eiv: available with key_trabbl --> 
    281          <field id="uoce_bbl"     long_name="BBL ocean current along i-axis"              unit="m/s"  grid_ref="grid_U_3D" /> 
    282     <field id="ahu_bbl"      long_name="BBL diffusive flux along i-axis"             unit="m3/s" /> 
     285         <field id="uoce_bbl"     long_name="BBL  ocean current along i-axis"             unit="m/s"  grid_ref="grid_U_3D" /> 
     286         <field id="ahu_bbl"      long_name="BBL diffusive flux along i-axis"             unit="m3/s" /> 
    283287         <!-- variables available with key_diaar5 --> 
    284288         <field id="u_masstr"     long_name="ocean eulerian mass transport along i-axis"  unit="kg/s" grid_ref="grid_U_3D" /> 
    … …  
    297301         <field id="vocet"        long_name="ocean transport along j-axis times temperature" unit="degC.m/s" grid_ref="grid_V_3D" /> 
    298302         <field id="voces"        long_name="ocean transport along j-axis times salinity"    unit="psu.m/s"  grid_ref="grid_V_3D" /> 
     303         <!-- v-eddy coefficients (ldftra, ldfdyn) --> 
     304         <field id="aeiv_2d"      long_name=" surface v-EIV coefficient"                  unit="m2/s" /> 
     305         <field id="aeiv_3d"      long_name=" 3D v-EIV coefficient"                       unit="m2/s" grid_ref="grid_V_3D" /> 
     306         <field id="ahtv_2d"      long_name=" surface v-eddy diffusivity coefficient"     unit="m2/s or (m4/s)^1/2" /> 
     307         <field id="ahtv_3d"      long_name=" 3D v-eddy diffusivity coefficient"          unit="m2/s or (m4/s)^1/2" grid_ref="grid_V_3D"/> 
    299308         <!-- variables available with MLE --> 
    300309         <field id="psiv_mle"     long_name="MLE streamfunction along j-axis"             unit="m3/s"  grid_ref="grid_V_3D"  /> 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/CONFIG/SHARED/namelist_ref

    r4384 r4596  
    11!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    2 !! NEMO/OPA  :  1 - run manager      (namrun, namcfg) 
    3 !! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namtsd) 
    4 !!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core, namsbc_sas 
    5 !!                                    namsbc_cpl, namtra_qsr, namsbc_rnf, 
    6 !!                                    namsbc_apr, namsbc_ssr, namsbc_alb) 
     2!! NEMO/OPA  :  1 - run manager      (namrun) 
     3!! namelists    2 - Domain           (namcfg, namzgr, nam_vvl, namzgr_sco, namdom, namtsd) 
     4!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core, 
     5!!                                            namsbc_sas, namsbc_cpl, namtra_qsr , namsbc_rnf , 
     6!!                                            namsbc_apr, namsbc_ssr, namsbc_alb) 
    77!!              4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide) 
    88!!              5 - bottom  boundary (nambfr, nambbc, nambbl) 
    9 !!              6 - Tracer           (nameos, namtra_adv, namtra_ldf, namtra_dmp) 
     9!!              6 - Tracer           (nameos, namtra_adv, namtra_ldf, namtra_ldfeiv, namtra_dmp) 
    1010!!              7 - dynamics         (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf) 
    1111!!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_kpp, namzdf_ddm, namzdf_tmx) 
    … …  
    3131   nn_leapy    =       0   !  Leap year calendar (1) or not (0) 
    3232   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T) 
    33    nn_euler    =       1   !  = 0 : start with forward time step if ln_rstart=.true. 
    34    nn_rstctl   =       0   !  restart control => activated only if ln_rstart = T 
     33   nn_euler    =       1   !  = 0 : start with forward time step if ln_rstart=T 
     34   nn_rstctl   =       0   !  restart control ==> activated only if ln_rstart=T 
    3535                           !    = 0 nn_date0 read in namelist ; nn_it000 : read in namelist 
    3636                           !    = 1 nn_date0 read in namelist ; nn_it000 : check consistancy between namelist and restart 
    … …  
    4646   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines) 
    4747/ 
     48!!====================================================================== 
     49!!                      ***  Domain namelists  *** 
     50!!====================================================================== 
     51!!   namcfg       parameters of the configuration 
     52!!   namzgr       vertical coordinate 
     53!!   nam_vvl      vertical coordinate options (z-star, z-tilde) 
     54!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate 
     55!!   namdom       space and time domain (bathymetry, mesh, timestep) 
     56!!   namtsd       data: temperature & salinity 
     57!!====================================================================== 
    4858! 
    4959!----------------------------------------------------------------------- 
    50 &namcfg     !   default parameters of the configuration       
     60&namcfg     !   parameters of the configuration       
    5161!----------------------------------------------------------------------- 
    5262   cp_cfg      =  "default"            !  name of the configuration 
    53    cp_cfz      =         ''            !  name of the zoom of configuration 
     63   cp_cfz      =  "no zoom"            !  name of the zoom of configuration 
    5464   jp_cfg      =       0               !  resolution of the configuration 
    5565   jpidta      =      10               !  1st lateral dimension ( >= jpi ) 
    … …  
    5767   jpkdta      =      31               !  number of levels      ( >= jpk ) 
    5868   jpiglo      =      10               !  1st dimension of global domain --> i =jpidta 
    59    jpjglo      =      12               !  2nd    -                  -    --> j  =jpjdta 
     69   jpjglo      =      12               !  2nd    -                  -    --> j =jpjdta 
    6070   jpizoom     =       1               !  left bottom (i,j) indices of the zoom 
    6171   jpjzoom     =       1               !  in data domain indices 
    … …  
    6777                                       !  = 6 cyclic East-West AND North fold F-point pivot 
    6878/ 
    69 !!====================================================================== 
    70 !!                      ***  Domain namelists  *** 
    71 !!====================================================================== 
    72 !!   namzgr       vertical coordinate 
    73 !!   namzgr_sco   s-coordinate or hybrid z-s-coordinate 
    74 !!   namdom       space and time domain (bathymetry, mesh, timestep) 
    75 !!   namtsd       data: temperature & salinity 
    76 !!====================================================================== 
    77 ! 
    7879!----------------------------------------------------------------------- 
    7980&namzgr        !   vertical coordinate 
    … …  
    8283   ln_zps      = .true.    !  z-coordinate - partial steps   (T/F) 
    8384   ln_sco      = .false.   !  s- or hybrid z-s-coordinate    (T/F) 
     85/ 
     86!----------------------------------------------------------------------- 
     87&nam_vvl       !   vertical coordinate options 
     88!----------------------------------------------------------------------- 
     89   ln_vvl_zstar  = .true.           !  zstar vertical coordinate                    
     90   ln_vvl_ztilde = .false.          !  ztilde vertical coordinate: only high frequency variations 
     91   ln_vvl_layer  = .false.          !  full layer vertical coordinate 
     92   ln_vvl_ztilde_as_zstar = .false. !  ztilde vertical coordinate emulating zstar 
     93   ln_vvl_zstar_at_eqtor  = .false. !  ztilde near the equator 
     94   rn_ahe3       = 0.0e0            !  thickness diffusion coefficient 
     95   rn_rst_e3t    = 30.e0            !  ztilde to zstar restoration timescale [days] 
     96   rn_lf_cutoff  = 5.0e0            !  cutoff frequency for low-pass filter  [days] 
     97   rn_zdef_max   = 0.9e0            !  maximum fractional e3t deformation 
     98   ln_vvl_dbg    = .true.           !  debug prints    (T/F) 
    8499/ 
    85100!----------------------------------------------------------------------- 
    … …  
    205220!!   namsbc_mfs      MFS  bulk formulae formulation 
    206221!!   namsbc_cpl      CouPLed            formulation                     ("key_coupled") 
    207 !!   namsbc_sas      StAndalone Surface module 
     222!!   namsbc_sas      Stand Alone Surface module 
    208223!!   namtra_qsr      penetrative solar radiation 
    209224!!   namsbc_rnf      river runoffs 
    … …  
    633648!!                        Tracer (T & S ) namelists 
    634649!!====================================================================== 
    635 !!   nameos        equation of state 
    636 !!   namtra_adv    advection scheme 
    637 !!   namtra_ldf    lateral diffusion scheme 
    638 !!   namtra_dmp    T & S newtonian damping 
     650!!   nameos           equation of state 
     651!!   namtra_adv       advection scheme 
     652!!   namtra_adv_mle   mixed layer eddy param. (Fox-Kemper param.) 
     653!!   namtra_ldf       lateral diffusion scheme 
     654!!   namtra_ldfeiv    eddy induced velocity param. 
     655!!   namtra_dmp       T & S newtonian damping 
    639656!!====================================================================== 
    640657! 
    … …  
    661678/ 
    662679!----------------------------------------------------------------------- 
    663 &namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) 
     680&namtra_adv_mle !   mixed layer eddy param. (Fox-Kemper param.) 
    664681!----------------------------------------------------------------------- 
    665682   ln_mle    = .true.      ! (T) use the Mixed Layer Eddy (MLE) parameterisation 
    … …  
    677694!---------------------------------------------------------------------------------- 
    678695   !                       !  Operator type: 
    679    ln_traldf_lap    =  .true.   !  laplacian operator 
    680    ln_traldf_bilap  =  .false.  !  bilaplacian operator 
     696   ln_traldf_lap   =  .true.   !    laplacian operator 
     697   ln_traldf_blp   =  .false.  !  bilaplacian operator 
    681698   !                       !  Direction of action: 
    682    ln_traldf_level  =  .false.  !  iso-level 
    683    ln_traldf_hor    =  .false.  !  horizontal (geopotential)   (needs "key_ldfslp" when ln_sco=T) 
    684    ln_traldf_iso    =  .true.   !  iso-neutral                 (needs "key_ldfslp") 
    685    !                 !  Griffies parameters              (all need "key_ldfslp") 
    686    ln_traldf_grif   =  .false.  !  use griffies triads 
    687    ln_traldf_gdia   =  .false.  !  output griffies eddy velocities 
    688    ln_triad_iso     =  .false.  !  pure lateral mixing in ML 
    689    ln_botmix_grif   =  .false.  !  lateral mixing on bottom 
    690    !                       !  Coefficients 
    691    ! Eddy-induced (GM) advection always used with Griffies; otherwise needs "key_traldf_eiv" 
    692    ! Value rn_aeiv_0 is ignored unless = 0 with Held-Larichev spatially varying aeiv 
    693    !                                  (key_traldf_c2d & key_traldf_eiv & key_orca_r2, _r1 or _r05) 
    694    rn_aeiv_0        =  2000.    !  eddy induced velocity coefficient [m2/s] 
    695    rn_aht_0         =  2000.    !  horizontal eddy diffusivity for tracers [m2/s] 
    696    rn_ahtb_0        =     0.    !  background eddy diffusivity for ldf_iso [m2/s] 
    697    !                                           (normally=0; not used with Griffies) 
    698    rn_slpmax        =     0.01  !  slope limit 
    699    rn_chsmag        =     1.    !  multiplicative factor in Smagorinsky diffusivity 
    700    rn_smsh          =     1.    !  Smagorinsky diffusivity: = 0 - use only sheer 
    701    rn_aht_m         =  2000.    !  upper limit or stability criteria for lateral eddy diffusivity (m2/s) 
     699   ln_traldf_lev   =  .false.  !  iso-level 
     700   ln_traldf_hor   =  .false.  !  horizontal (geopotential) 
     701   ln_traldf_iso   =  .true.   !  iso-neutral 
     702   ln_traldf_triad =  .false.  !  iso-neutral using Griffies triads 
     703   ! 
     704   !                       !  iso-neutral options:         
     705   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators) 
     706   rn_slpmax       =   0.01    !  slope limit                      (both operators) 
     707   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML     (triad only) 
     708   ln_botmix_triad =  .false.  !  lateral mixing on bottom         (triad only) 
     709   ! 
     710   !                       !  Coefficients: 
     711   nn_aht_ijk_t    = 21        !  space/time variation of eddy coef 
     712   !                                !   =0 constant ; =10 F(k) ; =20 F(i,j)=F(grid spacing) ; =30 F(i,j,k)  
     713   !                                !   =21 F(i,jt)=Treguier et al. JPO 1997 formulation 
     714   !                                !   =-20 (=-30) read in eddy_induced_velocity_2D.nc (..._3D.nc) file 
     715   rn_aht_0        = 2000.     !  lateral eddy diffusivity   (lap. operator) [m2/s] 
     716   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s] 
     717 
     718!!gm   rn_chsmag        =    1.    !  multiplicative factor in Smagorinsky diffusivity 
     719!!gm   rn_smsh          =    1.    !  Smagorinsky diffusivity: = 0 - use only sheer 
     720/ 
     721!---------------------------------------------------------------------------------- 
     722&namtra_ldfeiv !   eddy induced velocity param. 
     723!---------------------------------------------------------------------------------- 
     724   ln_ldfeiv     =.true.   ! use eddy induced velocity parameterization 
     725   ln_ldfeiv_dia =.true.   ! diagnose eiv stream function and velocities 
     726   rn_aeiv_0     = 2000.   ! eddy induced velocity coefficient   [m2/s] 
     727   nn_aei_ijk_t  = 21      ! space/time variation of the eiv coeficient 
     728   !                           !   =0 constant ; =10 F(k) ; =20 F(i,j) = F(grid spacing) ; =30 F(i,j,k)  
     729   !                           !   =21 F(i,jt)=Treguier et al. JPO 1997 formulation 
     730   !                           !   =-20 (=-30) read in eddy_induced_velocity_2D.nc (..._3D.nc) file 
    702731/ 
    703732!----------------------------------------------------------------------- 
    … …  
    735764/ 
    736765!----------------------------------------------------------------------- 
    737 &nam_vvl    !   vertical coordinate options 
    738 !----------------------------------------------------------------------- 
    739    ln_vvl_zstar  = .true.           !  zstar vertical coordinate                    
    740    ln_vvl_ztilde = .false.          !  ztilde vertical coordinate: only high frequency variations 
    741    ln_vvl_layer  = .false.          !  full layer vertical coordinate 
    742    ln_vvl_ztilde_as_zstar = .false. !  ztilde vertical coordinate emulating zstar 
    743    ln_vvl_zstar_at_eqtor = .false.  !  ztilde near the equator 
    744    rn_ahe3       = 0.0e0            !  thickness diffusion coefficient 
    745    rn_rst_e3t    = 30.e0            !  ztilde to zstar restoration timescale [days] 
    746    rn_lf_cutoff  = 5.0e0            !  cutoff frequency for low-pass filter  [days] 
    747    rn_zdef_max   = 0.9e0            !  maximum fractional e3t deformation 
    748    ln_vvl_dbg    = .true.           !  debug prints    (T/F) 
    749 / 
    750 !----------------------------------------------------------------------- 
    751766&namdyn_vor    !   option of physics/algorithm (not control by CPP keys) 
    752767!----------------------------------------------------------------------- 
    … …  
    778793!----------------------------------------------------------------------- 
    779794   !                       !  Type of the operator : 
    780    ln_dynldf_lap    =  .true.   !  laplacian operator 
    781    ln_dynldf_bilap  =  .false.  !  bilaplacian operator 
     795   ln_dynldf_lap =  .true.     !  laplacian operator 
     796   ln_dynldf_blp =  .false.    !  bilaplacian operator 
    782797   !                       !  Direction of action  : 
    783    ln_dynldf_level  =  .false.  !  iso-level 
    784    ln_dynldf_hor    =  .true.   !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.) 
    785    ln_dynldf_iso    =  .false.  !  iso-neutral                          (require "key_ldfslp") 
     798   ln_dynldf_lev =  .false.    !  iso-level 
     799   ln_dynldf_hor =  .true.     !  horizontal (geopotential) 
     800   ln_dynldf_iso =  .false.    !  iso-neutral 
    786801   !                       !  Coefficient 
    787    rn_ahm_0_lap     = 40000.    !  horizontal laplacian eddy viscosity   [m2/s] 
    788    rn_ahmb_0        =     0.    !  background eddy viscosity for ldf_iso [m2/s] 
    789    rn_ahm_0_blp     =     0.    !  horizontal bilaplacian eddy viscosity [m4/s] 
    790    rn_cmsmag_1      =     3.    !  constant in laplacian Smagorinsky viscosity 
    791    rn_cmsmag_2      =     3     !  constant in bilaplacian Smagorinsky viscosity 
    792    rn_cmsh          =     1.    !  1 or 0 , if 0 -use only shear for Smagorinsky viscosity 
    793    rn_ahm_m_blp     =    -1.e12 !  upper limit for bilap  abs(ahm) < min( dx^4/128rdt, rn_ahm_m_blp) 
    794    rn_ahm_m_lap     = 40000.    !  upper limit for lap  ahm < min(dx^2/16rdt, rn_ahm_m_lap) 
     802   nn_ahm_ijk_t  = 0           !  space/time variation of eddy coef 
     803   !                                !   =0 constant ; =10 F(k) ; =20 F(i,j)=F(grid spacing) ; =30 F(i,j,k)  
     804   !                                !   =-20 (=-30) read in eddy_induced_velocity_2D.nc (..._3D.nc) file 
     805   rn_ahm_0      =  40000.     !  horizontal laplacian eddy viscosity   [m2/s] 
     806   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s] 
     807   rn_bhm_0      = 1.e+12      !  horizontal bilaplacian eddy viscosity [m4/s] 
     808 
     809 
     810!!gm   rn_cmsmag_1      =     3.    !  constant in laplacian Smagorinsky viscosity 
     811!!gm   rn_cmsmag_2      =     3     !  constant in bilaplacian Smagorinsky viscosity 
     812!!gm   rn_cmsh          =     1.    !  1 or 0 , if 0 -use only shear for Smagorinsky viscosity 
    795813/ 
    796814 
    … …  
    914932!!                  ***  Miscellaneous namelists  *** 
    915933!!====================================================================== 
     934!!   namsol            elliptic solver / island / free surface 
    916935!!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi) 
    917936!!   namctl            Control prints & Benchmark 
    918 !!   namsol            elliptic solver / island / free surface 
     937!!   namc1d            1D configuration options                         ("key_c1d") 
     938!!   namc1d_uvd        data: U & V currents                             ("key_c1d") 
     939!!   namc1d_dyndmp     U & V newtonian damping                          ("key_c1d") 
    919940!!====================================================================== 
    920941! 
    … …  
    9811002   ln_dyndmp   =  .false.  !  add a damping term (T) or not (F) 
    9821003/ 
     1004 
    9831005!!====================================================================== 
    9841006!!                  ***  Diagnostics namelists  *** 
    … …  
    9891011!!   namptr       Poleward Transport Diagnostics 
    9901012!!   namhsb       Heat and salt budgets 
     1013!!   nam_diaharm  Harmonic analysis of tidal constituents               ('key_diaharm') 
     1014!!   namdct       transports through sections 
    9911015!!====================================================================== 
    9921016! 
    … …  
    10681092!!   namobs       observation and model comparison                      ('key_diaobs') 
    10691093!!   nam_asminc   assimilation increments                               ('key_asminc') 
     1094!!   namsbc_wave  External fields from wave model 
     1095!!   namdyn_nept  Neptune effect  
    10701096!!====================================================================== 
    10711097! 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90

    r3764 r4596  
    1818 
    1919   !!---------------------------------------------------------------------- 
    20    !!   'key_asminc' : Switch on the assimilation increment interface 
    21    !!---------------------------------------------------------------------- 
    2220   !!   asm_bkg_wri  : Write out the background state 
    2321   !!   asm_trj_wri  : Write out the model state trajectory (used with 4D-Var) 
    … …  
    2725   USE zdf_oce            ! Vertical mixing variables 
    2826   USE zdfddm             ! Double diffusion mixing parameterization 
    29    USE ldftra_oce         ! Lateral tracer mixing coefficient defined in memory 
    30    USE ldfslp             ! Slopes of neutral surfaces 
     27   USE ldftra             ! Lateral diffusion: eddy diffusivity coeff. defined in memory 
     28   USE ldfslp             ! Lateral diffusion: slopes of neutral surfaces 
    3129   USE tradmp             ! Tracer damping 
    3230#if defined key_zdftke 
    … …  
    4139   USE asmpar             ! Parameters for the assmilation interface 
    4240   USE zdfmxl             ! mixed layer depth 
    43 #if defined key_traldf_c2d 
    44    USE ldfeiv             ! eddy induced velocity coef.      (ldf_eiv routine) 
    45 #endif 
    4641#if defined key_lim2 
    4742   USE ice_2 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

    r4313 r4596  
    1414 
    1515   !!---------------------------------------------------------------------- 
    16    !!   'key_asminc'   : Switch on the assimilation increment interface 
     16   !!   'key_asminc' : Switch on the assimilation increment interface 
    1717   !!---------------------------------------------------------------------- 
    18    !!   asm_inc_init   : Initialize the increment arrays and IAU weights 
    19    !!   calc_date      : Compute the calendar date YYYYMMDD on a given step 
    20    !!   tra_asm_inc    : Apply the tracer (T and S) increments 
    21    !!   dyn_asm_inc    : Apply the dynamic (u and v) increments 
    22    !!   ssh_asm_inc    : Apply the SSH increment 
    23    !!   seaice_asm_inc : Apply the seaice increment 
     18   !!   asm_inc_init : Initialize the increment arrays and IAU weights 
     19   !!   calc_date    : Compute the calendar date YYYYMMDD on a given step 
     20   !!   tra_asm_inc  : Apply the tracer (T and S) increments 
     21   !!   dyn_asm_inc  : Apply the dynamic (u and v) increments 
     22   !!   ssh_asm_inc  : Apply the SSH increment 
     23   !!   seaice_asm_inc  : Apply the seaice increment 
    2424   !!---------------------------------------------------------------------- 
    2525   USE wrk_nemo         ! Memory Allocation 
    … …  
    2828   USE domvvl           ! domain: variable volume level 
    2929   USE oce              ! Dynamics and active tracers defined in memory 
    30    USE ldfdyn_oce       ! ocean dynamics: lateral physics 
     30   USE ldfdyn           ! lateral diffusion: eddy viscosity coef. 
    3131   USE eosbn2           ! Equation of state - in situ and potential density 
    3232   USE zpshde           ! Partial step : Horizontal Derivative 
    … …  
    9090   !! * Substitutions 
    9191#  include "domzgr_substitute.h90" 
    92 #  include "ldfdyn_substitute.h90" 
    9392#  include "vectopt_loop_substitute.h90" 
    9493   !!---------------------------------------------------------------------- 
    … …  
    109108      !! ** Action  :  
    110109      !!---------------------------------------------------------------------- 
    111       INTEGER :: ji, jj, jk 
    112       INTEGER :: jt 
    113       INTEGER :: imid 
    114       INTEGER :: inum 
    115       INTEGER :: iiauper         ! Number of time steps in the IAU period 
    116       INTEGER :: icycper         ! Number of time steps in the cycle 
    117       INTEGER :: iitend_date     ! Date YYYYMMDD of final time step 
    118       INTEGER :: iitbkg_date     ! Date YYYYMMDD of background time step for Jb term 
    119       INTEGER :: iitdin_date     ! Date YYYYMMDD of background time step for DI 
    120       INTEGER :: iitiaustr_date  ! Date YYYYMMDD of IAU interval start time step 
    121       INTEGER :: iitiaufin_date  ! Date YYYYMMDD of IAU interval final time step 
    122       INTEGER :: ios             ! Local integer output status for namelist read 
    123  
    124       REAL(wp) :: znorm        ! Normalization factor for IAU weights 
    125       REAL(wp) :: ztotwgt      ! Value of time-integrated IAU weights  
    126                                ! (should be equal to one) 
    127       REAL(wp) :: z_inc_dateb  ! Start date of interval on which increment is valid 
    128       REAL(wp) :: z_inc_datef  ! End date of interval on which increment is valid 
    129       REAL(wp) :: zdate_bkg    ! Date in background state file for DI 
    130       REAL(wp) :: zdate_inc    ! Time axis in increments file 
    131  
     110      INTEGER ::   ji, jj, jk, jt 
     111      INTEGER ::   imid, inum 
     112      INTEGER ::   iiauper         ! Number of time steps in the IAU period 
     113      INTEGER ::   icycper         ! Number of time steps in the cycle 
     114      INTEGER ::   iitend_date     ! Date YYYYMMDD of final time step 
     115      INTEGER ::   iitbkg_date     ! Date YYYYMMDD of background time step for Jb term 
     116      INTEGER ::   iitdin_date     ! Date YYYYMMDD of background time step for DI 
     117      INTEGER ::   iitiaustr_date  ! Date YYYYMMDD of IAU interval start time step 
     118      INTEGER ::   iitiaufin_date  ! Date YYYYMMDD of IAU interval final time step 
     119      INTEGER ::   ios             ! Local integer output status for namelist read 
     120      ! 
     121      REAL(wp) ::   znorm        ! Normalization factor for IAU weights 
     122      REAL(wp) ::   ztotwgt      ! Value of time-integrated IAU weights  
     123      !                          ! (should be equal to one) 
     124      REAL(wp) ::   z_inc_dateb  ! Start date of interval on which increment is valid 
     125      REAL(wp) ::   z_inc_datef  ! End date of interval on which increment is valid 
     126      REAL(wp) ::   zdate_bkg    ! Date in background state file for DI 
     127      REAL(wp) ::   zdate_inc    ! Time axis in increments file 
     128      ! 
    132129      REAL(wp), POINTER, DIMENSION(:,:) :: hdiv 
    133130      !! 
    … …  
    143140      ! Read Namelist nam_asminc : assimilation increment interface 
    144141      !----------------------------------------------------------------------- 
    145  
    146       ln_seaiceinc = .FALSE. 
     142      ln_seaiceinc   = .FALSE. 
    147143      ln_temnofreeze = .FALSE. 
    148144 
    … …  
    449445         CALL wrk_alloc(jpi,jpj,hdiv)  
    450446 
    451          DO  jt = 1, nn_divdmp 
    452  
     447         DO jt = 1, nn_divdmp 
     448            ! 
    453449            DO jk = 1, jpkm1 
    454  
    455450               hdiv(:,:) = 0._wp 
    456  
    457451               DO jj = 2, jpjm1 
    458452                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    462456                         + e1v(ji  ,jj  ) * fse3v(ji  ,jj  ,jk) * v_bkginc(ji  ,jj  ,jk)     & 
    463457                         - e1v(ji  ,jj-1) * fse3v(ji  ,jj-1,jk) * v_bkginc(ji  ,jj-1,jk)  )  & 
    464                          / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     458                         / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    465459                  END DO 
    466460               END DO 
    467  
    468461               CALL lbc_lnk( hdiv, 'T', 1. )   ! lateral boundary cond. (no sign change) 
    469  
     462               ! 
    470463               DO jj = 2, jpjm1 
    471464                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    472                      u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) + 0.2_wp * ( e1t(ji+1,jj)*e2t(ji+1,jj) * hdiv(ji+1,jj)   & 
    473                                                                         - e1t(ji  ,jj)*e2t(ji  ,jj) * hdiv(ji  ,jj) ) & 
    474                                                                       / e1u(ji,jj) * umask(ji,jj,jk)  
    475                      v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) + 0.2_wp * ( e1t(ji,jj+1)*e2t(ji,jj+1) * hdiv(ji,jj+1)   & 
    476                                                                         - e1t(ji,jj  )*e2t(ji,jj  ) * hdiv(ji,jj  ) ) & 
    477                                                                       / e2v(ji,jj) * vmask(ji,jj,jk)  
     465                     u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) + 0.2_wp * ( e1e2t(ji+1,jj) * hdiv(ji+1,jj)   & 
     466                        &                                               - e1e2t(ji  ,jj) * hdiv(ji  ,jj) ) & 
     467                        &                                             / e1u(ji,jj) * umask(ji,jj,jk)  
     468                     v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) + 0.2_wp * ( e1e2t(ji,jj+1) * hdiv(ji,jj+1)   & 
     469                        &                                               - e1e2t(ji,jj  ) * hdiv(ji,jj  ) ) & 
     470                        &                                             / e2v(ji,jj) * vmask(ji,jj,jk)  
    478471                  END DO 
    479472               END DO 
    480  
    481473            END DO 
    482  
     474            ! 
    483475         END DO 
    484  
     476         ! 
    485477         CALL wrk_dealloc(jpi,jpj,hdiv)  
    486  
     478         ! 
    487479      ENDIF 
    488  
    489  
    490480 
    491481      !----------------------------------------------------------------------- 
    … …  
    677667      DO jk=1, jpkm1 
    678668         fzptnz (:,:,jk) = tfreez( tsn(:,:,jk,jp_sal), fsdept(:,:,jk) ) 
    679       ENDDO 
    680  
    681       IF ( ln_asmiau ) THEN 
     669      END DO 
     670 
     671      IF( ln_asmiau ) THEN 
    682672 
    683673         !-------------------------------------------------------------------- 
    … …  
    950940      !! 
    951941      !!---------------------------------------------------------------------- 
    952       IMPLICIT NONE 
    953       ! 
    954       INTEGER, INTENT(in)           ::   kt   ! Current time step 
     942      INTEGER, INTENT(in)           ::   kt       ! Current time step 
    955943      INTEGER, INTENT(in), OPTIONAL ::   kindic   ! flag for disabling the deallocation 
    956944      ! 
    … …  
    10211009 
    10221010#if defined key_cice && defined key_asminc 
    1023             ! Sea-ice : CICE case. Zero ice increment tendency into CICE 
    1024             ndaice_da(:,:) = 0.0_wp 
     1011            ndaice_da(:,:) = 0._wp        ! Sea-ice : CICE case. Zero ice increment tendency into CICE 
    10251012#endif 
    10261013 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90

    r2287 r4596  
    66 
    77   IMPLICIT NONE 
    8  
    9    !! * Routine accessibility 
    108   PRIVATE 
    119 
    12    !! * Shared Modules variables 
    13    CHARACTER (LEN=40), PUBLIC, PARAMETER :: & 
    14       & c_asmbkg = 'assim_background_state_Jb',  & !: Filename for storing the  
    15                                                    !: background state for use  
    16                                                    !: in the Jb term 
    17       & c_asmdin = 'assim_background_state_DI',  & !: Filename for storing the  
    18                                                    !: background state for direct  
    19                                                    !: initialization 
    20       & c_asmtrj = 'assim_trj',                  & !: Filename for storing the  
    21                                                    !: reference trajectory 
    22       & c_asminc = 'assim_background_increments'   !: Filename for storing the  
    23                                                    !: increments to the background 
    24                                                    !: state 
     10   CHARACTER(LEN=40), PUBLIC, PARAMETER ::   c_asmbkg = 'assim_background_state_Jb'   !: Filename for storing the background state 
     11   !                                                                                  !  for use in the Jb term 
     12   CHARACTER(LEN=40), PUBLIC, PARAMETER ::   c_asmdin = 'assim_background_state_DI'   !: Filename for storing the background state 
     13   !                                                                                  !  for direct initialization 
     14   CHARACTER(LEN=40), PUBLIC, PARAMETER ::   c_asmtrj = 'assim_trj'                   !: Filename for storing the reference trajectory 
     15   CHARACTER(LEN=40), PUBLIC, PARAMETER ::   c_asminc = 'assim_background_increments' !: Filename for storing the increments  
     16   !                                                                                  !  to the background state 
    2517 
    26    INTEGER, PUBLIC :: nitbkg_r      !: Background time step referenced to nit000 
    27    INTEGER, PUBLIC :: nitdin_r      !: Direct Initialization time step referenced to nit000 
    28    INTEGER, PUBLIC :: nitiaustr_r   !: IAU starting time step referenced to nit000 
    29    INTEGER, PUBLIC :: nitiaufin_r   !: IAU final time step referenced to nit000 
    30    INTEGER, PUBLIC :: nittrjfrq     !: Frequency of trajectory output for 4D-VAR 
     18   INTEGER, PUBLIC ::   nitbkg_r      !: Background time step referenced to nit000 
     19   INTEGER, PUBLIC ::   nitdin_r      !: Direct Initialization time step referenced to nit000 
     20   INTEGER, PUBLIC ::   nitiaustr_r   !: IAU starting time step referenced to nit000 
     21   INTEGER, PUBLIC ::   nitiaufin_r   !: IAU final time step referenced to nit000 
     22   INTEGER, PUBLIC ::   nittrjfrq     !: Frequency of trajectory output for 4D-VAR 
    3123 
    3224   !!---------------------------------------------------------------------- 
    … …  
    3426   !! $Id$ 
    3527   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    36    !!---------------------------------------------------------------------- 
    37  
     28   !!====================================================================== 
    3829END MODULE asmpar 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90

    r4149 r4596  
    1111   !!                       other variables needed to be passed to TOP 
    1212   !!---------------------------------------------------------------------- 
     13   USE crs 
     14   USE crsdom 
     15   USE crslbclnk 
    1316   USE oce             ! ocean dynamics and tracers  
    1417   USE dom_oce         ! ocean space and time domain 
    15    USE ldftra_oce      ! ocean active tracers: lateral physics 
     18   USE ldftra          ! ocean active tracers: lateral physics 
    1619   USE sbc_oce         ! Surface boundary condition: ocean fields 
    1720   USE zdf_oce         ! vertical  physics: ocean fields 
    1821   USE zdfddm          ! vertical  physics: double diffusion 
     22   ! 
     23   USE in_out_manager  ! I/O manager 
     24   USE iom             !  
    1925   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    20    USE in_out_manager  ! I/O manager 
    2126   USE timing          ! preformance summary 
    2227   USE wrk_nemo        ! working array 
    23    USE crs 
    24    USE crsdom 
    25    USE crslbclnk 
    26    USE iom 
    2728 
    2829   IMPLICIT NONE 
    … …  
    3031 
    3132   PUBLIC   crs_fld                 ! routines called by step.F90 
    32  
    3333 
    3434   !! * Substitutions 
    … …  
    5656      !! ** Method  :   
    5757      !!---------------------------------------------------------------------- 
    58       !! 
    59        
    6058      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    61       !! 
     59      ! 
    6260      INTEGER               ::   ji, jj, jk              ! dummy loop indices 
    6361      !! 
    … …  
    6664      REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs ! 
    6765      REAL(wp)       :: z2dcrsu, z2dcrsv 
    68       !! 
    69        !!---------------------------------------------------------------------- 
     66      !!---------------------------------------------------------------------- 
    7067      !  
    71  
    7268      IF( nn_timing == 1 )   CALL timing_start('crs_fld') 
    7369 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r4292 r4596  
    1111 
    1212   !!---------------------------------------------------------------------- 
    13    !!   dia_ptr      : Poleward Transport Diagnostics module 
    14    !!   dia_ptr_init : Initialization, namelist read 
    15    !!   dia_ptr_wri  : Output of poleward fluxes 
    16    !!   ptr_vjk      : "zonal" sum computation of a "meridional" flux array 
    17    !!   ptr_tjk      : "zonal" mean computation of a tracer field 
    18    !!   ptr_vj       : "zonal" and vertical sum computation of a "meridional" flux array 
    19    !!                   (Generic interface to ptr_vj_3d, ptr_vj_2d) 
     13   !!   dia_ptr       : Poleward Transport Diagnostics module 
     14   !!   dia_ptr_init  : Initialization, namelist read 
     15   !!   dia_ptr_wri   : Output of poleward fluxes 
     16   !!   ptr_vjk       : "zonal" sum computation of a "meridional" flux array 
     17   !!   ptr_tjk       : "zonal" mean computation of a tracer field 
     18   !!   ptr_vj        : "zonal" and vertical sum computation of a "meridional" flux array 
     19   !!                    (Generic interface to ptr_vj_3d, ptr_vj_2d) 
    2020   !!---------------------------------------------------------------------- 
    21    USE oce              ! ocean dynamics and active tracers 
    22    USE dom_oce          ! ocean space and time domain 
    23    USE phycst           ! physical constants 
    24    USE ldftra_oce       ! ocean active tracers: lateral physics 
    25    USE dianam           ! 
    26    USE iom              ! IOM library 
    27    USE ioipsl           ! IO-IPSL library 
    28    USE in_out_manager   ! I/O manager 
     21   USE oce            ! ocean dynamics and active tracers 
     22   USE dom_oce        ! ocean space and time domain 
     23   USE phycst         ! physical constants 
     24   USE ldftra         ! lateral physics: eddy diffusivity & EIV coeff. 
     25   ! 
     26   USE dianam         ! 
     27   USE iom            ! IOM library 
     28   USE ioipsl         ! IO-IPSL library 
     29   USE in_out_manager ! I/O manager 
    2930   USE lib_mpp          ! MPP library 
    3031   USE lbclnk           ! lateral boundary condition - processor exchanges 
    … …  
    363364            END DO 
    364365#if defined key_diaeiv 
    365             DO jn = 1, nptr                  ! bolus velocity 
    366                v_msf_eiv(:,:,jn) = ptr_vjk( v_eiv(:,:,:), btmsk(:,:,jn) )   ! here no btm30 for MSFeiv 
    367             END DO 
    368             !                                ! add bolus stream-function to the eulerian one 
    369             v_msf(:,:,:) = v_msf(:,:,:) + v_msf_eiv(:,:,:) 
     366!!gm            DO jn = 1, nptr                  ! bolus velocity 
     367!!               v_msf_eiv(:,:,jn) = ptr_vjk( v_eiv(:,:,:), btmsk(:,:,jn) )   ! here no btm30 for MSFeiv 
     368!!            END DO 
     369!!            !                                ! add bolus stream-function to the eulerian one 
     370!!gm            v_msf(:,:,:) = v_msf(:,:,:) + v_msf_eiv(:,:,:) 
    370371#endif 
    371372            ! 
    … …  
    376377               DO jj = 2, jpj 
    377378                  DO ji = 1, jpi 
    378 #if defined key_diaeiv  
    379                      zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) + v_eiv(ji,jj,jk) + v_eiv(ji,jj-1,jk) ) * 0.5_wp 
    380 #else 
     379!!gm#if defined key_diaeiv  
     380!!gm                     zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) + v_eiv(ji,jj,jk) + v_eiv(ji,jj-1,jk) ) * 0.5_wp 
     381!!gm#else 
    381382                     zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) ) * 0.5_wp 
    382 #endif  
     383!!gm#endif  
    383384                     vt(ji,jj,jk) = zv * tsn(ji,jj,jk,jp_tem) 
    384385                     vs(ji,jj,jk) = zv * tsn(ji,jj,jk,jp_sal) 
    … …  
    408409 
    409410#if defined key_diaeiv 
    410             DO jn = 1, nptr                  ! Bolus component 
    411                htr_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * tn_jk(:,:,jn), 2 ) * rc_pwatt   ! SUM over jk 
    412                str_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * sn_jk(:,:,jn), 2 ) * rc_ggram   ! SUM over jk 
    413             END DO 
     411!!gm            DO jn = 1, nptr                  ! Bolus component 
     412!!gm               htr_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * tn_jk(:,:,jn), 2 ) * rc_pwatt   ! SUM over jk 
     413!!gm               str_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * sn_jk(:,:,jn), 2 ) * rc_ggram   ! SUM over jk 
     414!!gm            END DO 
    414415#endif 
    415416            !                                ! "Meridional" Stream-Function 
    … …  
    418419                  v_msf    (:,jk,jn) = v_msf    (:,jk-1,jn) + v_msf    (:,jk,jn)       ! Eulerian j-Stream-Function 
    419420#if defined key_diaeiv 
    420                   v_msf_eiv(:,jk,jn) = v_msf_eiv(:,jk-1,jn) + v_msf_eiv(:,jk,jn)       ! Bolus    j-Stream-Function 
    421  
     421!!gm                  v_msf_eiv(:,jk,jn) = v_msf_eiv(:,jk-1,jn) + v_msf_eiv(:,jk,jn)       ! Bolus    j-Stream-Function 
     422!!gm 
    422423#endif 
    423424               END DO 
    … …  
    425426            v_msf    (:,:,:) = v_msf    (:,:,:) * rc_sv       ! converte in Sverdrups 
    426427#if defined key_diaeiv 
    427             v_msf_eiv(:,:,:) = v_msf_eiv(:,:,:) * rc_sv 
     428!!gm            v_msf_eiv(:,:,:) = v_msf_eiv(:,:,:) * rc_sv 
    428429#endif 
    429430         ENDIF 
    … …  
    554555      !! ** Method  :   NetCDF file 
    555556      !!---------------------------------------------------------------------- 
    556       !! 
    557557      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    558       !! 
     558      ! 
    559559      INTEGER, SAVE ::   nhoridz, ndepidzt, ndepidzw 
    560560      INTEGER, SAVE ::   ndim  , ndim_atl     , ndim_pac     , ndim_ind     , ndim_ipc 
    561561      INTEGER, SAVE ::           ndim_atl_30  , ndim_pac_30  , ndim_ind_30  , ndim_ipc_30 
    562562      INTEGER, SAVE ::   ndim_h, ndim_h_atl_30, ndim_h_pac_30, ndim_h_ind_30, ndim_h_ipc_30 
    563       !! 
     563      ! 
    564564      CHARACTER (len=40) ::   clhstnam, clop, clop_once, cl_comment   ! temporary names 
    565565      INTEGER            ::   iline, it, itmod, ji, jj, jk            ! 
    … …  
    568568#endif 
    569569      REAL(wp)           ::   zsto, zout, zdt, zjulian                ! temporary scalars 
    570       !! 
     570      ! 
    571571      REAL(wp), POINTER, DIMENSION(:)   ::   zphi, zfoo    ! 1D workspace 
    572572      REAL(wp), POINTER, DIMENSION(:,:) ::   z_1           ! 2D workspace 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r4492 r4596  
    1717   !!                 ! 2005-11  (V. Garnier) Surface pressure gradient organization 
    1818   !!            3.2  ! 2008-11  (B. Lemaire) creation from old diawri 
     19   !!            3.7  ! 2014-01  (G. Madec) remove eddy induced velocity from no-IOM output 
     20   !!                 !                     change name of output variabls in dia_wri_state 
    1921   !!---------------------------------------------------------------------- 
    2022 
    … …  
    2729   USE dynadv, ONLY: ln_dynadv_vec 
    2830   USE zdf_oce         ! ocean vertical physics 
    29    USE ldftra_oce      ! ocean active tracers: lateral physics 
    30    USE ldfdyn_oce      ! ocean dynamics: lateral physics 
    31    USE traldf_iso_grif, ONLY : psix_eiv, psiy_eiv 
     31   USE ldftra          ! lateral physics: eddy diffusivity coef. 
    3232   USE sol_oce         ! solver variables 
    3333   USE sbc_oce         ! Surface boundary condition: ocean fields 
    … …  
    4545   USE diadimg         ! dimg direct access file format output 
    4646   USE diaar5, ONLY :   lk_diaar5 
    47    USE dynadv, ONLY :   ln_dynadv_vec 
    4847   USE iom 
    4948   USE ioipsl 
    … …  
    250249      !!      Each nwrite time step, output the instantaneous or mean fields 
    251250      !!---------------------------------------------------------------------- 
    252       !! 
    253251      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    254       !! 
     252      ! 
    255253      LOGICAL ::   ll_print = .FALSE.                        ! =T print and flush numout 
    256254      CHARACTER (len=40) ::   clhstnam, clop, clmx           ! local names 
    … …  
    261259      INTEGER  ::   jn, ierror                               ! local integers 
    262260      REAL(wp) ::   zsto, zout, zmax, zjulian, zdt           ! local scalars 
    263       !! 
     261      ! 
    264262      REAL(wp), POINTER, DIMENSION(:,:)   :: zw2d       ! 2D workspace 
    265263      REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d       ! 3D workspace 
    … …  
    268266      IF( nn_timing == 1 )   CALL timing_start('dia_wri') 
    269267      ! 
    270       CALL wrk_alloc( jpi , jpj      , zw2d ) 
    271       IF ( ln_traldf_gdia .OR. lk_vvl )  call wrk_alloc( jpi , jpj , jpk  , zw3d ) 
     268                     CALL wrk_alloc( jpi , jpj        , zw2d ) 
     269      IF( lk_vvl )   CALL wrk_alloc( jpi , jpj , jpk  , zw3d ) 
    272270      ! 
    273271      ! Output the initial state and forcings 
    … …  
    531529# endif  
    532530#endif  
    533  
    534531         CALL histend( nid_T, snc4chunks=snc4set ) 
    535532 
    … …  
    537534         CALL histdef( nid_U, "vozocrtx", "Zonal Current"                      , "m/s"    ,   &  ! un 
    538535            &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout ) 
    539          IF( ln_traldf_gdia ) THEN 
    540             CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current"                  , "m/s"    ,   &  ! u_eiv 
    541                  &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout ) 
    542          ELSE 
    543 #if defined key_diaeiv 
    544             CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current"                  , "m/s"    ,   &  ! u_eiv 
    545             &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout ) 
    546 #endif 
    547          END IF 
    548536         !                                                                                      !!! nid_U : 2D 
    549537         CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis"           , "N/m2"   ,   &  ! utau 
    … …  
    555543         CALL histdef( nid_V, "vomecrty", "Meridional Current"                 , "m/s"    ,   &  ! vn 
    556544            &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout ) 
    557          IF( ln_traldf_gdia ) THEN 
    558             CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current"             , "m/s"    ,   &  ! v_eiv 
    559                  &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout ) 
    560          ELSE  
    561 #if defined key_diaeiv 
    562             CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current"             , "m/s"    ,   &  ! v_eiv 
    563             &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout ) 
    564 #endif 
    565          END IF 
    566545         !                                                                                      !!! nid_V : 2D 
    567546         CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis"           , "N/m2"   ,   &  ! vtau 
    … …  
    573552         CALL histdef( nid_W, "vovecrtz", "Vertical Velocity"                  , "m/s"    ,   &  ! wn 
    574553            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 
    575          IF( ln_traldf_gdia ) THEN 
    576             CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity"              , "m/s"    ,   &  ! w_eiv 
    577                  &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 
    578          ELSE 
    579 #if defined key_diaeiv 
    580             CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity"              , "m/s"    ,   &  ! w_eiv 
    581                  &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 
    582 #endif 
    583          END IF 
    584554         CALL histdef( nid_W, "votkeavt", "Vertical Eddy Diffusivity"          , "m2/s"   ,   &  ! avt 
    585555            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 
    … …  
    592562         ENDIF 
    593563         !                                                                                      !!! nid_W : 2D 
    594 #if defined key_traldf_c2d 
    595          CALL histdef( nid_W, "soleahtw", "lateral eddy diffusivity"           , "m2/s"   ,   &  ! ahtw 
    596             &          jpi, jpj, nh_W, 1  , 1, 1  , - 99, 32, clop, zsto, zout ) 
    597 # if defined key_traldf_eiv  
    598             CALL histdef( nid_W, "soleaeiw", "eddy induced vel. coeff. at w-point", "m2/s",   &  ! aeiw 
    599                &       jpi, jpj, nh_W, 1  , 1, 1  , - 99, 32, clop, zsto, zout ) 
    600 # endif 
    601 #endif 
    602  
    603564         CALL histend( nid_W, snc4chunks=snc4set ) 
    604565 
    … …  
    716677         ! Write fields on U grid 
    717678      CALL histwrite( nid_U, "vozocrtx", it, un            , ndim_U , ndex_U )    ! i-current 
    718       IF( ln_traldf_gdia ) THEN 
    719          IF (.not. ALLOCATED(psix_eiv))THEN 
    720             ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr ) 
    721             IF( lk_mpp   )   CALL mpp_sum ( ierr ) 
    722             IF( ierr > 0 )   CALL ctl_stop('STOP', 'diawri: unable to allocate psi{x,y}_eiv') 
    723             psix_eiv(:,:,:) = 0.0_wp 
    724             psiy_eiv(:,:,:) = 0.0_wp 
    725          ENDIF 
    726          DO jk=1,jpkm1 
    727             zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk)  ! u_eiv = -dpsix/dz 
    728          END DO 
    729          zw3d(:,:,jpk) = 0._wp 
    730          CALL histwrite( nid_U, "vozoeivu", it, zw3d, ndim_U , ndex_U )           ! i-eiv current 
    731       ELSE 
    732 #if defined key_diaeiv 
    733          CALL histwrite( nid_U, "vozoeivu", it, u_eiv, ndim_U , ndex_U )          ! i-eiv current 
    734 #endif 
    735       ENDIF 
    736679      CALL histwrite( nid_U, "sozotaux", it, utau          , ndim_hU, ndex_hU )   ! i-wind stress 
    737680 
    738681         ! Write fields on V grid 
    739682      CALL histwrite( nid_V, "vomecrty", it, vn            , ndim_V , ndex_V  )   ! j-current 
    740       IF( ln_traldf_gdia ) THEN 
    741          DO jk=1,jpk-1 
    742             zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk)  ! v_eiv = -dpsiy/dz 
    743          END DO 
    744          zw3d(:,:,jpk) = 0._wp 
    745          CALL histwrite( nid_V, "vomeeivv", it, zw3d, ndim_V , ndex_V )           ! j-eiv current 
    746       ELSE 
    747 #if defined key_diaeiv 
    748          CALL histwrite( nid_V, "vomeeivv", it, v_eiv, ndim_V , ndex_V )          ! j-eiv current 
    749 #endif 
    750       ENDIF 
    751683      CALL histwrite( nid_V, "sometauy", it, vtau          , ndim_hV, ndex_hV )   ! j-wind stress 
    752684 
    753685         ! Write fields on W grid 
    754686      CALL histwrite( nid_W, "vovecrtz", it, wn             , ndim_T, ndex_T )    ! vert. current 
    755       IF( ln_traldf_gdia ) THEN 
    756          DO jk=1,jpk-1 
    757             DO jj = 2, jpjm1 
    758                DO ji = fs_2, fs_jpim1  ! vector opt. 
    759                   zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2v(ji,jj) + & 
    760                        &    (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1u(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx 
    761                END DO 
    762             END DO 
    763          END DO 
    764          zw3d(:,:,jpk) = 0._wp 
    765          CALL histwrite( nid_W, "voveeivw", it, zw3d          , ndim_T, ndex_T )    ! vert. eiv current 
    766       ELSE 
    767 #   if defined key_diaeiv 
    768          CALL histwrite( nid_W, "voveeivw", it, w_eiv          , ndim_T, ndex_T )    ! vert. eiv current 
    769 #   endif 
    770       ENDIF 
    771687      CALL histwrite( nid_W, "votkeavt", it, avt            , ndim_T, ndex_T )    ! T vert. eddy diff. coef. 
    772688      CALL histwrite( nid_W, "votkeavm", it, avmu           , ndim_T, ndex_T )    ! T vert. eddy visc. coef. 
    … …  
    774690         CALL histwrite( nid_W, "voddmavs", it, fsavs(:,:,:), ndim_T, ndex_T )    ! S vert. eddy diff. coef. 
    775691      ENDIF 
    776 #if defined key_traldf_c2d 
    777       CALL histwrite( nid_W, "soleahtw", it, ahtw          , ndim_hT, ndex_hT )   ! lateral eddy diff. coef. 
    778 # if defined key_traldf_eiv 
    779          CALL histwrite( nid_W, "soleaeiw", it, aeiw       , ndim_hT, ndex_hT )   ! EIV coefficient at w-point 
    780 # endif 
    781 #endif 
    782692 
    783693      ! 3. Close all files 
    … …  
    790700      ENDIF 
    791701      ! 
    792       CALL wrk_dealloc( jpi , jpj      , zw2d ) 
    793       IF ( ln_traldf_gdia .OR. lk_vvl )  call wrk_dealloc( jpi , jpj , jpk  , zw3d ) 
     702                     CALL wrk_dealloc( jpi , jpj        , zw2d ) 
     703      IF( lk_vvl )   CALL wrk_dealloc( jpi , jpj , jpk  , zw3d ) 
    794704      ! 
    795705      IF( nn_timing == 1 )   CALL timing_stop('dia_wri') 
    … …  
    823733      !!---------------------------------------------------------------------- 
    824734      !  
    825 !     IF( nn_timing == 1 )   CALL timing_start('dia_wri_state') ! not sure this works for routines not called in first timestep 
    826  
    827735      ! 0. Initialisation 
    828736      ! ----------------- 
    … …  
    883791         CALL histdef( id_i, "vovvldep", "T point depth"         , "m"      ,   &   ! t-point depth 
    884792            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    885       END IF 
     793      ENDIF 
    886794 
    887795#if defined key_lim2 
    … …  
    925833      ENDIF 
    926834#endif 
    927         
    928 !     IF( nn_timing == 1 )   CALL timing_stop('dia_wri_state') ! not sure this works for routines not called in first timestep 
    929835      !  
    930  
    931836   END SUBROUTINE dia_wri_state 
     837    
    932838   !!====================================================================== 
    933839END MODULE diawri 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r4292 r4596  
    622622      !!              - update bathy : meter bathymetry (in meters) 
    623623      !!---------------------------------------------------------------------- 
    624       !! 
    625624      INTEGER ::   ji, jj, jl                    ! dummy loop indices 
    626625      INTEGER ::   icompt, ibtest, ikmax         ! temporary integers 
    627626      REAL(wp), POINTER, DIMENSION(:,:) ::  zbathy 
    628  
    629627      !!---------------------------------------------------------------------- 
    630628      ! 
    … …  
    11151113      !! 
    11161114      !!---------------------------------------------------------------------- 
    1117       ! 
    11181115      INTEGER  ::   ji, jj, jk, jl           ! dummy loop argument 
    1119       INTEGER  ::   iip1, ijp1, iim1, ijm1   ! temporary integers 
     1116      INTEGER  ::   iip1, ijp1, iim1, ijm1   ! local integers 
    11201117      INTEGER  ::   ios                      ! Local integer output status for namelist read 
    1121       REAL(wp) ::   zrmax, ztaper   ! temporary scalars 
    1122       REAL(wp) ::   zrfact 
     1118      REAL(wp) ::   zrmax, ztaper, zrfact    ! local scalars 
    11231119      ! 
    11241120      REAL(wp), POINTER, DIMENSION(:,:  ) :: ztmpi1, ztmpi2, ztmpj1, ztmpj2 
    … …  
    12831279         DO jj = 1, jpj 
    12841280            DO ji = 1, jpi 
    1285                ztaper = EXP( -(gphit(ji,jj)/8._wp)**2._wp ) 
     1281               ztaper = EXP( -(gphit(ji,jj)/8._wp)**2 ) 
    12861282               hbatt(ji,jj) = rn_sbot_max * ztaper + hbatt(ji,jj) * ( 1._wp - ztaper ) 
    12871283            END DO 
    … …  
    15521548   END SUBROUTINE zgr_sco 
    15531549 
    1554 !!====================================================================== 
     1550 
    15551551   SUBROUTINE s_sh94() 
    1556  
    15571552      !!---------------------------------------------------------------------- 
    15581553      !!                  ***  ROUTINE s_sh94  *** 
    … …  
    15651560      !! Reference : Song and Haidvogel 1994.  
    15661561      !!---------------------------------------------------------------------- 
    1567       ! 
    15681562      INTEGER  ::   ji, jj, jk           ! dummy loop argument 
    15691563      REAL(wp) ::   zcoeft, zcoefw   ! temporary scalars 
    … …  
    16511645   END SUBROUTINE s_sh94 
    16521646 
     1647 
    16531648   SUBROUTINE s_sf12 
    1654  
    16551649      !!---------------------------------------------------------------------- 
    16561650      !!                  ***  ROUTINE s_sf12 ***  
    … …  
    16661660      !! 
    16671661      !! 
    1668       !! Reference : Siddorn and Furner 2012 (submitted Ocean modelling). 
    1669       !!---------------------------------------------------------------------- 
    1670       ! 
     1662      !! Reference : Siddorn and Furner 2013 (Ocean modelling). 
     1663      !!---------------------------------------------------------------------- 
    16711664      INTEGER  ::   ji, jj, jk           ! dummy loop argument 
    16721665      REAL(wp) ::   zsmth               ! smoothing around critical depth 
    … …  
    16741667      ! 
    16751668      REAL(wp), POINTER, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3 
    1676       REAL(wp), POINTER, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3            
    1677  
     1669      REAL(wp), POINTER, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 
     1670      !!---------------------------------------------------------------------- 
    16781671      ! 
    16791672      CALL wrk_alloc( jpi, jpj, jpk, z_gsigw3, z_gsigt3, z_gsi3w3                                      ) 
    … …  
    17441737          END DO 
    17451738 
    1746         ENDDO   ! for all jj's 
    1747       ENDDO    ! for all ji's 
     1739        END DO   ! for all jj's 
     1740      END DO    ! for all ji's 
    17481741 
    17491742      DO ji=1,jpi-1 
    … …  
    17731766          END DO 
    17741767 
    1775         ENDDO 
    1776       ENDDO 
     1768        END DO 
     1769      END DO 
    17771770      ! 
    17781771      CALL lbc_lnk(e3t_0 ,'T',1.) ; CALL lbc_lnk(e3u_0 ,'T',1.) 
    … …  
    17881781   END SUBROUTINE s_sf12 
    17891782 
     1783 
    17901784   SUBROUTINE s_tanh() 
    1791  
    17921785      !!---------------------------------------------------------------------- 
    17931786      !!                  ***  ROUTINE s_tanh***  
    … …  
    17991792      !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408. 
    18001793      !!---------------------------------------------------------------------- 
    1801  
    18021794      INTEGER  ::   ji, jj, jk           ! dummy loop argument 
    18031795      REAL(wp) ::   zcoeft, zcoefw   ! temporary scalars 
    1804  
     1796      ! 
    18051797      REAL(wp), POINTER, DIMENSION(:) :: z_gsigw, z_gsigt, z_gsi3w 
    18061798      REAL(wp), POINTER, DIMENSION(:) :: z_esigt, z_esigw 
     1799      !!---------------------------------------------------------------------- 
    18071800 
    18081801      CALL wrk_alloc( jpk, z_gsigw, z_gsigt, z_gsi3w                                      ) 
    … …  
    18621855   END SUBROUTINE s_tanh 
    18631856 
     1857 
    18641858   FUNCTION fssig( pk ) RESULT( pf ) 
    18651859      !!---------------------------------------------------------------------- 
    … …  
    19321926      REAL(wp), INTENT(in   ) ::   pk1(jpk)       ! continuous "k" coordinate 
    19331927      REAL(wp)                ::   p_gamma(jpk)   ! stretched coordinate 
    1934       REAL(wp), INTENT(in   ) ::   pzb           ! Bottom box depth 
    1935       REAL(wp), INTENT(in   ) ::   pzs           ! surface box depth 
    1936       REAL(wp), INTENT(in   ) ::   psmth       ! Smoothing parameter 
     1928      REAL(wp), INTENT(in   ) ::   pzb            ! Bottom box depth 
     1929      REAL(wp), INTENT(in   ) ::   pzs            ! surface box depth 
     1930      REAL(wp), INTENT(in   ) ::   psmth          ! Smoothing parameter 
     1931      ! 
     1932      INTEGER                 ::   jk 
    19371933      REAL(wp)                ::   za1,za2,za3    ! local variables 
    19381934      REAL(wp)                ::   zn1,zn2        ! local variables 
    19391935      REAL(wp)                ::   za,zb,zx       ! local variables 
    1940       integer                 ::   jk 
    1941       !!---------------------------------------------------------------------- 
    1942       ! 
    1943  
     1936      !!---------------------------------------------------------------------- 
     1937      ! 
    19441938      zn1  =  1./(jpk-1.) 
    19451939      zn2  =  1. -  zn1 
    1946  
     1940      ! 
    19471941      za1 = (rn_alpha+2.0_wp)*zn1**(rn_alpha+1.0_wp)-(rn_alpha+1.0_wp)*zn1**(rn_alpha+2.0_wp)  
    19481942      za2 = (rn_alpha+2.0_wp)*zn2**(rn_alpha+1.0_wp)-(rn_alpha+1.0_wp)*zn2**(rn_alpha+2.0_wp) 
    19491943      za3 = (zn2**3.0_wp - za2)/( zn1**3.0_wp - za1) 
    1950       
     1944      ! 
    19511945      za = pzb - za3*(pzs-za1)-za2 
    19521946      za = za/( zn2-0.5_wp*(za2+zn2**2.0_wp) - za3*(zn1-0.5_wp*(za1+zn1**2.0_wp) ) ) 
    19531947      zb = (pzs - za1 - za*( zn1-0.5_wp*(za1+zn1**2.0_wp ) ) ) / (zn1**3.0_wp - za1) 
    19541948      zx = 1.0_wp-za/2.0_wp-zb 
    1955   
     1949      ! 
    19561950      DO jk = 1, jpk 
    19571951        p_gamma(jk) = za*(pk1(jk)*(1.0_wp-pk1(jk)/2.0_wp))+zb*pk1(jk)**3.0_wp +  & 
    … …  
    19591953                    &      (rn_alpha+1.0_wp)*pk1(jk)**(rn_alpha+2.0_wp) ) 
    19601954        p_gamma(jk) = p_gamma(jk)*psmth+pk1(jk)*(1.0_wp-psmth) 
    1961       ENDDO  
    1962  
     1955      END DO  
    19631956      ! 
    19641957   END FUNCTION fgamma 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    r4370 r4596  
    2929   USE daymod          ! calendar 
    3030   USE eosbn2          ! eq. of state, Brunt Vaisala frequency (eos     routine) 
    31    USE ldftra_oce      ! ocean active tracers: lateral physics 
     31   USE ldftra          ! lateral physics: ocean active tracers 
    3232   USE zdf_oce         ! ocean vertical physics 
    3333   USE phycst          ! physical constants 
    3434   USE dtatsd          ! data temperature and salinity   (dta_tsd routine) 
    3535   USE dtauvd          ! data: U & V current             (dta_uvd routine) 
    36    USE in_out_manager  ! I/O manager 
    37    USE iom             ! I/O library 
    3836   USE zpshde          ! partial step: hor. derivative (zps_hde routine) 
    3937   USE eosbn2          ! equation of state            (eos bn2 routine) 
    … …  
    4240   USE dynspg_flt      ! filtered free surface 
    4341   USE sol_oce         ! ocean solver variables 
     42   ! 
     43   USE in_out_manager  ! I/O manager 
     44   USE iom             ! I/O library 
    4445   USE lib_mpp         ! MPP library 
    4546   USE restart         ! restart 
    … …  
    6869      !! ** Purpose :   Initialization of the dynamics and tracer fields. 
    6970      !!---------------------------------------------------------------------- 
    70       ! - ML - needed for initialization of e3t_b 
    71       INTEGER  ::  ji,jj,jk     ! dummy loop indices 
    72       REAL(wp), POINTER, DIMENSION(:,:,:,:)  ::  zuvd    ! U & V data workspace 
     71      INTEGER ::   ji, jj, jk     ! dummy loop indices 
     72      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zuvd   ! U & V data workspace 
    7373      !!---------------------------------------------------------------------- 
    7474      ! 
    7575      IF( nn_timing == 1 )  CALL timing_start('istate_init') 
    7676      ! 
    77  
    7877      IF(lwp) WRITE(numout,*) 
    7978      IF(lwp) WRITE(numout,*) 'istate_ini : Initialization of the dynamics and tracers' 
    8079      IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    8180 
    82       CALL dta_tsd_init                       ! Initialisation of T & S input data 
    83       IF( lk_c1d ) CALL dta_uvd_init          ! Initialization of U & V input data 
    84  
    85       rhd  (:,:,:  ) = 0.e0 
    86       rhop (:,:,:  ) = 0.e0 
    87       rn2  (:,:,:  ) = 0.e0  
    88       tsa  (:,:,:,:) = 0.e0     
     81                     CALL dta_tsd_init        ! Initialisation of T & S input data 
     82      IF( lk_c1d )   CALL dta_uvd_init        ! Initialization of U & V input data 
     83 
     84      rhd  (:,:,:  ) = 0._wp 
     85      rhop (:,:,:  ) = 0._wp 
     86      rn2  (:,:,:  ) = 0._wp 
     87      tsa  (:,:,:,:) = 0._wp    
    8988 
    9089      IF( ln_rstart ) THEN                    ! Restart from a file 
    … …  
    103102         ub   (:,:,:) = 0._wp   ;   un   (:,:,:) = 0._wp 
    104103         vb   (:,:,:) = 0._wp   ;   vn   (:,:,:) = 0._wp   
    105          rotb (:,:,:) = 0._wp   ;   rotn (:,:,:) = 0._wp 
    106          hdivb(:,:,:) = 0._wp   ;   hdivn(:,:,:) = 0._wp 
     104                                    hdivn(:,:,:) = 0._wp 
    107105         ! 
    108106         IF( cp_cfg == 'eel' ) THEN 
    … …  
    158156      ! 
    159157      ! 
    160       un_b(:,:) = 0._wp ; vn_b(:,:) = 0._wp 
    161       ub_b(:,:) = 0._wp ; vb_b(:,:) = 0._wp 
     158      un_b(:,:) = 0._wp   ;  vn_b(:,:) = 0._wp 
     159      ub_b(:,:) = 0._wp   ;  vb_b(:,:) = 0._wp 
    162160      ! 
    163161      DO jk = 1, jpkm1 
    164 #if defined key_vectopt_loop 
    165          DO jj = 1, 1         !Vector opt. => forced unrolling 
    166             DO ji = 1, jpij 
    167 #else  
    168162         DO jj = 1, jpj 
    169163            DO ji = 1, jpi 
    170 #endif                   
    171164               un_b(ji,jj) = un_b(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 
    172165               vn_b(ji,jj) = vn_b(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 
    … …  
    188181      ! 
    189182   END SUBROUTINE istate_init 
     183 
    190184 
    191185   SUBROUTINE istate_t_s 
    … …  
    201195      !! References :  Philander ??? 
    202196      !!---------------------------------------------------------------------- 
    203       INTEGER  :: ji, jj, jk 
    204       REAL(wp) ::   zsal = 35.50 
     197      INTEGER  ::   ji, jj, jk 
     198      REAL(wp) ::   zsal = 35.50_wp 
    205199      !!---------------------------------------------------------------------- 
    206200      ! 
    … …  
    218212      ! 
    219213   END SUBROUTINE istate_t_s 
     214 
    220215 
    221216   SUBROUTINE istate_eel 
    … …  
    231226      !!                and relative vorticity fields 
    232227      !!---------------------------------------------------------------------- 
    233       USE divcur     ! hor. divergence & rel. vorticity      (div_cur routine) 
     228      USE divhor     ! hor. divergence      (div_hor routine) 
    234229      USE iom 
    235   
     230      ! 
    236231      INTEGER  ::   inum              ! temporary logical unit 
    237232      INTEGER  ::   ji, jj, jk        ! dummy loop indices 
    … …  
    280275            tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 
    281276            ! 
    282             ! set the dynamics: U,V, hdiv, rot (and ssh if necessary) 
     277            ! set the dynamics: U,V, hdiv (and ssh if necessary) 
    283278            ! ---------------- 
    284279            ! Start EEL5 configuration with barotropic geostrophic velocities  
    … …  
    316311            ENDIF 
    317312            ! 
    318             CALL div_cur( nit000 )                  ! horizontal divergence and relative vorticity (curl) 
     313            CALL div_hor( nit000 )                  ! horizontal divergence and relative vorticity (curl) 
    319314            ! N.B. the vertical velocity will be computed from the horizontal divergence field 
    320315            ! in istate by a call to wzv routine 
    … …  
    369364      !! 
    370365      !! ** Method  : - set temprature field 
    371       !!              - set salinity field 
     366      !!              - set salinity   field 
    372367      !!---------------------------------------------------------------------- 
    373368      INTEGER :: ji, jj, jk  ! dummy loop indices 
    … …  
    443438   END SUBROUTINE istate_gyre 
    444439 
     440 
    445441   SUBROUTINE istate_uvg 
    446442      !!---------------------------------------------------------------------- 
    … …  
    455451      !!---------------------------------------------------------------------- 
    456452      USE dynspg          ! surface pressure gradient             (dyn_spg routine) 
    457       USE divcur          ! hor. divergence & rel. vorticity      (div_cur routine) 
     453      USE divhor          ! hor. divergence                       (div_hor routine) 
    458454      USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    459  
     455      ! 
    460456      INTEGER ::   ji, jj, jk        ! dummy loop indices 
    461457      INTEGER ::   indic             ! ??? 
    … …  
    553549      un(:,:,:) = ub(:,:,:) 
    554550      vn(:,:,:) = vb(:,:,:) 
    555         
    556       ! Compute the divergence and curl 
    557  
    558       CALL div_cur( nit000 )            ! now horizontal divergence and curl 
    559  
    560       hdivb(:,:,:) = hdivn(:,:,:)       ! set the before to the now value 
    561       rotb (:,:,:) = rotn (:,:,:)       ! set the before to the now value 
     551      ! 
     552!!gm  Check  here call to div_hor should not be necessary 
     553!!gm         div_hor call runoffs  not sure they are defined at that level 
     554      CALL div_hor( nit000 )            ! now horizontal divergence 
    562555      ! 
    563556      CALL wrk_dealloc( jpi, jpj, jpk, zprn) 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90

    r4557 r4596  
    1 MODULE divcur 
     1MODULE divhor 
    22   !!============================================================================== 
    3    !!                       ***  MODULE  divcur  *** 
    4    !! Ocean diagnostic variable : horizontal divergence and relative vorticity 
     3   !!                       ***  MODULE  divhor  *** 
     4   !! Ocean diagnostic variable : now horizontal divergence 
    55   !!============================================================================== 
    66   !! History :  OPA  ! 1987-06  (P. Andrich, D. L Hostis)  Original code 
    … …  
    1717   !!            3.3  ! 2010-09  (D.Storkey and E.O'Dea) bug fixes for BDY module 
    1818   !!             -   ! 2010-10  (R. Furner, G. Madec) runoff and cla added directly here 
     19   !!            3.7  ! 2014-01  (G. Madec) suppression of velocity curl from in-core memory 
    1920   !!---------------------------------------------------------------------- 
    2021 
    2122   !!---------------------------------------------------------------------- 
    22    !!   div_cur    : Compute the horizontal divergence and relative 
    23    !!                vorticity fields 
     23   !!   div_hor    : Compute the horizontal divergence field 
    2424   !!---------------------------------------------------------------------- 
    2525   USE oce             ! ocean dynamics and tracers 
    … …  
    2828   USE sbcrnf          ! river runoff  
    2929   USE cla             ! cross land advection             (cla_div routine) 
     30   ! 
    3031   USE in_out_manager  ! I/O manager 
    3132   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    … …  
    3738   PRIVATE 
    3839 
    39    PUBLIC   div_cur    ! routine called by step.F90 and istate.F90 
     40   PUBLIC   div_hor    ! routine called by step.F90 and istate.F90 
    4041 
    4142   !! * Substitutions 
    … …  
    4344#  include "vectopt_loop_substitute.h90" 
    4445   !!---------------------------------------------------------------------- 
    45    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     46   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    4647   !! $Id$  
    4748   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    4950CONTAINS 
    5051 
    51 #if defined key_noslip_accurate 
    52    !!---------------------------------------------------------------------- 
    53    !!   'key_noslip_accurate'   2nd order interior + 4th order at the coast 
    54    !!---------------------------------------------------------------------- 
    55  
    56    SUBROUTINE div_cur( kt ) 
     52   SUBROUTINE div_hor( kt ) 
    5753      !!---------------------------------------------------------------------- 
    58       !!                  ***  ROUTINE div_cur  *** 
     54      !!                  ***  ROUTINE div_hor  *** 
     55      !!                     
     56      !! ** Purpose :   compute the horizontal divergence at now time-step 
    5957      !! 
    60       !! ** Purpose :   compute the horizontal divergence and the relative 
    61       !!              vorticity at before and now time-step 
     58      !! ** Method  :   the now divergence is computed as : 
     59      !!         hdivn = 1/(e1t*e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] ) 
     60      !!      and correct with runoff inflow (div_rnf) and cross land flow (div_cla)  
    6261      !! 
    63       !! ** Method  : I.  divergence : 
    64       !!         - save the divergence computed at the previous time-step 
    65       !!      (note that the Asselin filter has not been applied on hdivb) 
    66       !!         - compute the now divergence given by : 
    67       !!         hdivn = 1/(e1t*e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] ) 
    68       !!      correct hdiv with runoff inflow (div_rnf) and cross land flow (div_cla)  
    69       !!              II. vorticity : 
    70       !!         - save the curl computed at the previous time-step 
    71       !!            rotb = rotn 
    72       !!      (note that the Asselin time filter has not been applied to rotb) 
    73       !!         - compute the now curl in tensorial formalism: 
    74       !!            rotn = 1/(e1f*e2f) ( di[e2v vn] - dj[e1u un] ) 
    75       !!         - Coastal boundary condition: 'key_noslip_accurate' defined, 
    76       !!      the no-slip boundary condition is computed using Schchepetkin 
    77       !!      and O'Brien (1996) scheme (i.e. 4th order at the coast). 
    78       !!      For example, along east coast, the one-sided finite difference 
    79       !!      approximation used for di[v] is: 
    80       !!         di[e2v vn] =  1/(e1f*e2f) * ( (e2v vn)(i) + (e2v vn)(i-1) + (e2v vn)(i-2) ) 
    81       !! 
    82       !! ** Action  : - update hdivb, hdivn, the before & now hor. divergence 
    83       !!              - update rotb , rotn , the before & now rel. vorticity 
    84       !!---------------------------------------------------------------------- 
    85       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    86       ! 
    87       INTEGER ::   ji, jj, jk, jl           ! dummy loop indices 
    88       INTEGER ::   ii, ij, ijt, iju, ierr   ! local integer 
    89       REAL(wp) ::  zraur, zdep              ! local scalar 
    90       REAL(wp), POINTER,  DIMENSION(:,:) ::   zwu   ! specific 2D workspace 
    91       REAL(wp), POINTER,  DIMENSION(:,:) ::   zwv   ! specific 2D workspace 
    92       !!---------------------------------------------------------------------- 
    93       ! 
    94       IF( nn_timing == 1 )  CALL timing_start('div_cur') 
    95       ! 
    96       CALL wrk_alloc( jpi  , jpj+2, zwu               ) 
    97       CALL wrk_alloc( jpi+4, jpj  , zwv, kjstart = -1 ) 
    98       ! 
    99       IF( kt == nit000 ) THEN 
    100          IF(lwp) WRITE(numout,*) 
    101          IF(lwp) WRITE(numout,*) 'div_cur : horizontal velocity divergence and relative vorticity' 
    102          IF(lwp) WRITE(numout,*) '~~~~~~~   NOT optimal for auto-tasking case' 
    103       ENDIF 
    104  
    105       !                                                ! =============== 
    106       DO jk = 1, jpkm1                                 ! Horizontal slab 
    107          !                                             ! =============== 
    108          ! 
    109          hdivb(:,:,jk) = hdivn(:,:,jk)    ! time swap of div arrays 
    110          rotb (:,:,jk) = rotn (:,:,jk)    ! time swap of rot arrays 
    111          ! 
    112          !                                             ! -------- 
    113          ! Horizontal divergence                       !   div 
    114          !                                             ! -------- 
    115          DO jj = 2, jpjm1 
    116             DO ji = fs_2, fs_jpim1   ! vector opt. 
    117                hdivn(ji,jj,jk) =   & 
    118                   (  e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj  )*fse3u(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)       & 
    119                    + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji  ,jj-1)*fse3v(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)  )    & 
    120                   / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    121             END DO 
    122          END DO 
    123  
    124          IF( .NOT. AGRIF_Root() ) THEN 
    125             IF ((nbondi ==  1).OR.(nbondi == 2)) hdivn(nlci-1 , :     ,jk) = 0.e0      ! east 
    126             IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2      , :     ,jk) = 0.e0      ! west 
    127             IF ((nbondj ==  1).OR.(nbondj == 2)) hdivn(:      ,nlcj-1 ,jk) = 0.e0      ! north 
    128             IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(:      ,2      ,jk) = 0.e0      ! south 
    129          ENDIF 
    130  
    131          !                                             ! -------- 
    132          ! relative vorticity                          !   rot  
    133          !                                             ! -------- 
    134          ! contravariant velocity (extended for lateral b.c.) 
    135          ! inside the model domain 
    136          DO jj = 1, jpj 
    137             DO ji = 1, jpi 
    138                zwu(ji,jj) = e1u(ji,jj) * un(ji,jj,jk) 
    139                zwv(ji,jj) = e2v(ji,jj) * vn(ji,jj,jk) 
    140             END DO   
    141          END DO   
    142   
    143          ! East-West boundary conditions 
    144          IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN 
    145             zwv(  0  ,:) = zwv(jpi-2,:) 
    146             zwv( -1  ,:) = zwv(jpi-3,:) 
    147             zwv(jpi+1,:) = zwv(  3  ,:) 
    148             zwv(jpi+2,:) = zwv(  4  ,:) 
    149          ELSE 
    150             zwv(  0  ,:) = 0.e0 
    151             zwv( -1  ,:) = 0.e0 
    152             zwv(jpi+1,:) = 0.e0 
    153             zwv(jpi+2,:) = 0.e0 
    154          ENDIF 
    155  
    156          ! North-South boundary conditions 
    157          IF( nperio == 3 .OR. nperio == 4 ) THEN 
    158             ! north fold ( Grid defined with a T-point pivot) ORCA 2 degre 
    159             zwu(jpi,jpj+1) = 0.e0 
    160             zwu(jpi,jpj+2) = 0.e0 
    161             DO ji = 1, jpi-1 
    162                iju = jpi - ji + 1 
    163                zwu(ji,jpj+1) = - zwu(iju,jpj-3) 
    164                zwu(ji,jpj+2) = - zwu(iju,jpj-4) 
    165             END DO 
    166          ELSEIF( nperio == 5 .OR. nperio == 6 ) THEN 
    167             ! north fold ( Grid defined with a F-point pivot) ORCA 0.5 degre\ 
    168             zwu(jpi,jpj+1) = 0.e0 
    169             zwu(jpi,jpj+2) = 0.e0 
    170             DO ji = 1, jpi-1 
    171                iju = jpi - ji 
    172                zwu(ji,jpj  ) = - zwu(iju,jpj-1) 
    173                zwu(ji,jpj+1) = - zwu(iju,jpj-2) 
    174                zwu(ji,jpj+2) = - zwu(iju,jpj-3) 
    175             END DO 
    176             DO ji = -1, jpi+2 
    177                ijt = jpi - ji + 1 
    178                zwv(ji,jpj) = - zwv(ijt,jpj-2) 
    179             END DO 
    180             DO ji = jpi/2+1, jpi+2 
    181                ijt = jpi - ji + 1 
    182                zwv(ji,jpjm1) = - zwv(ijt,jpjm1) 
    183             END DO 
    184          ELSE 
    185             ! closed 
    186             zwu(:,jpj+1) = 0.e0 
    187             zwu(:,jpj+2) = 0.e0 
    188          ENDIF 
    189  
    190          ! relative vorticity (vertical component of the velocity curl)  
    191          DO jj = 1, jpjm1 
    192             DO ji = 1, fs_jpim1   ! vector opt. 
    193                rotn(ji,jj,jk) = (  zwv(ji+1,jj  ) - zwv(ji,jj)      & 
    194                   &              - zwu(ji  ,jj+1) + zwu(ji,jj)  ) * fmask(ji,jj,jk) / ( e1f(ji,jj)*e2f(ji,jj) ) 
    195             END DO 
    196          END DO 
    197  
    198          ! second order accurate scheme along straight coast 
    199          DO jl = 1, npcoa(1,jk) 
    200             ii = nicoa(jl,1,jk) 
    201             ij = njcoa(jl,1,jk) 
    202             rotn(ii,ij,jk) = 1. / ( e1f(ii,ij) * e2f(ii,ij) )   & 
    203                            * ( + 4. * zwv(ii+1,ij) - zwv(ii+2,ij) + 0.2 * zwv(ii+3,ij) ) 
    204          END DO 
    205          DO jl = 1, npcoa(2,jk) 
    206             ii = nicoa(jl,2,jk) 
    207             ij = njcoa(jl,2,jk) 
    208             rotn(ii,ij,jk) = 1./(e1f(ii,ij)*e2f(ii,ij))   & 
    209                *(-4.*zwv(ii,ij)+zwv(ii-1,ij)-0.2*zwv(ii-2,ij)) 
    210          END DO 
    211          DO jl = 1, npcoa(3,jk) 
    212             ii = nicoa(jl,3,jk) 
    213             ij = njcoa(jl,3,jk) 
    214             rotn(ii,ij,jk) = -1. / ( e1f(ii,ij)*e2f(ii,ij) )   & 
    215                * ( +4. * zwu(ii,ij+1) - zwu(ii,ij+2) + 0.2 * zwu(ii,ij+3) ) 
    216          END DO 
    217          DO jl = 1, npcoa(4,jk) 
    218             ii = nicoa(jl,4,jk) 
    219             ij = njcoa(jl,4,jk) 
    220             rotn(ii,ij,jk) = -1. / ( e1f(ii,ij)*e2f(ii,ij) )   & 
    221                * ( -4. * zwu(ii,ij) + zwu(ii,ij-1) - 0.2 * zwu(ii,ij-2) ) 
    222          END DO 
    223          !                                             ! =============== 
    224       END DO                                           !   End of slab 
    225       !                                                ! =============== 
    226  
    227       IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field) 
    228       IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2 )   CALL cla_div    ( kt )             ! Cross Land Advection (Update Hor. divergence) 
    229        
    230       ! 4. Lateral boundary conditions on hdivn and rotn 
    231       ! ---------------------------------=======---====== 
    232       CALL lbc_lnk( hdivn, 'T', 1. )   ;   CALL lbc_lnk( rotn , 'F', 1. )    ! lateral boundary cond. (no sign change) 
    233       ! 
    234       CALL wrk_dealloc( jpi  , jpj+2, zwu               ) 
    235       CALL wrk_dealloc( jpi+4, jpj  , zwv, kjstart = -1 ) 
    236       ! 
    237       IF( nn_timing == 1 )  CALL timing_stop('div_cur') 
    238       ! 
    239    END SUBROUTINE div_cur 
    240     
    241 #else 
    242    !!---------------------------------------------------------------------- 
    243    !!   Default option                           2nd order centered schemes 
    244    !!---------------------------------------------------------------------- 
    245  
    246    SUBROUTINE div_cur( kt ) 
    247       !!---------------------------------------------------------------------- 
    248       !!                  ***  ROUTINE div_cur  *** 
    249       !!                     
    250       !! ** Purpose :   compute the horizontal divergence and the relative 
    251       !!      vorticity at before and now time-step 
    252       !! 
    253       !! ** Method  : - Divergence: 
    254       !!      - save the divergence computed at the previous time-step 
    255       !!      (note that the Asselin filter has not been applied on hdivb) 
    256       !!      - compute the now divergence given by : 
    257       !!         hdivn = 1/(e1t*e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] ) 
    258       !!      correct hdiv with runoff inflow (div_rnf) and cross land flow (div_cla)  
    259       !!              - Relavtive Vorticity : 
    260       !!      - save the curl computed at the previous time-step (rotb = rotn) 
    261       !!      (note that the Asselin time filter has not been applied to rotb) 
    262       !!      - compute the now curl in tensorial formalism: 
    263       !!            rotn = 1/(e1f*e2f) ( di[e2v vn] - dj[e1u un] ) 
    264       !!      Note: Coastal boundary condition: lateral friction set through 
    265       !!      the value of fmask along the coast (see dommsk.F90) and shlat 
    266       !!      (namelist parameter) 
    267       !! 
    268       !! ** Action  : - update hdivb, hdivn, the before & now hor. divergence 
    269       !!              - update rotb , rotn , the before & now rel. vorticity 
     62      !! ** Action  : - update hdivn, the now horizontal divergence 
    27063      !!---------------------------------------------------------------------- 
    27164      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    … …  
    27568      !!---------------------------------------------------------------------- 
    27669      ! 
    277       IF( nn_timing == 1 )  CALL timing_start('div_cur') 
     70      IF( nn_timing == 1 )  CALL timing_start('div_hor') 
    27871      ! 
    27972      IF( kt == nit000 ) THEN 
    28073         IF(lwp) WRITE(numout,*) 
    281          IF(lwp) WRITE(numout,*) 'div_cur : horizontal velocity divergence and' 
    282          IF(lwp) WRITE(numout,*) '~~~~~~~   relative vorticity' 
     74         IF(lwp) WRITE(numout,*) 'div_hor : horizontal velocity divergence ' 
     75         IF(lwp) WRITE(numout,*) '~~~~~~~   ' 
    28376      ENDIF 
    284  
    285       !                                                ! =============== 
    286       DO jk = 1, jpkm1                                 ! Horizontal slab 
    287          !                                             ! =============== 
    288          ! 
    289          hdivb(:,:,jk) = hdivn(:,:,jk)    ! time swap of div arrays 
    290          rotb (:,:,jk) = rotn (:,:,jk)    ! time swap of rot arrays 
    291          ! 
    292          !                                             ! -------- 
    293          ! Horizontal divergence                       !   div  
    294          !                                             ! -------- 
     77      ! 
     78      DO jk = 1, jpkm1                                      !==  Horizontal divergence  ==! 
    29579         DO jj = 2, jpjm1 
    29680            DO ji = fs_2, fs_jpim1   ! vector opt. 
    297                hdivn(ji,jj,jk) =   & 
    298                   (  e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk) * un(ji-1,jj,jk)       & 
    299                    + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk) * vn(ji,jj-1,jk)  )    & 
    300                   / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     81               hdivn(ji,jj,jk) = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * un(ji  ,jj,jk)        & 
     82                  &               - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * un(ji-1,jj,jk)        & 
     83                  &               + e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * vn(ji,jj  ,jk)        & 
     84                  &               - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * vn(ji,jj-1,jk)   )    & 
     85                  &            / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    30186            END DO   
    30287         END DO   
    303  
    30488         IF( .NOT. AGRIF_Root() ) THEN 
    305             IF ((nbondi ==  1).OR.(nbondi == 2)) hdivn(nlci-1 , :     ,jk) = 0.e0      ! east 
    306             IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2      , :     ,jk) = 0.e0      ! west 
    307             IF ((nbondj ==  1).OR.(nbondj == 2)) hdivn(:      ,nlcj-1 ,jk) = 0.e0      ! north 
    308             IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(:      ,2      ,jk) = 0.e0      ! south 
     89            IF( nbondi ==  1 .OR. nbondi == 2 )   hdivn(nlci-1,   :  ,jk) = 0.e0      ! east 
     90            IF( nbondi == -1 .OR. nbondi == 2 )   hdivn(  2   ,   :  ,jk) = 0.e0      ! west 
     91            IF( nbondj ==  1 .OR. nbondj == 2 )   hdivn(  :   ,nlcj-1,jk) = 0.e0      ! north 
     92            IF( nbondj == -1 .OR. nbondj == 2 )   hdivn(  :   ,  2   ,jk) = 0.e0      ! south 
    30993         ENDIF 
    310  
    311          !                                             ! -------- 
    312          ! relative vorticity                          !   rot  
    313          !                                             ! -------- 
    314          DO jj = 1, jpjm1 
    315             DO ji = 1, fs_jpim1   ! vector opt. 
    316                rotn(ji,jj,jk) = (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    & 
    317                   &              - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) & 
    318                   &           * fmask(ji,jj,jk) / ( e1f(ji,jj) * e2f(ji,jj) ) 
    319             END DO 
    320          END DO 
    321          !                                             ! =============== 
    322       END DO                                           !   End of slab 
    323       !                                                ! =============== 
    324  
    325       IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field) 
    326       IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field) 
     94      END DO 
    32795      ! 
    328       CALL lbc_lnk( hdivn, 'T', 1. )   ;   CALL lbc_lnk( rotn , 'F', 1. )     ! lateral boundary cond. (no sign change) 
     96      IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )         !==  runoffs  ==!   (update hdivn field) 
    32997      ! 
    330       IF( nn_timing == 1 )  CALL timing_stop('div_cur') 
     98      IF( nn_cla == 1 )   CALL cla_div    ( kt )            !==  Cross Land Advection  ==!   (update hdivn field) 
    33199      ! 
    332    END SUBROUTINE div_cur 
     100      CALL lbc_lnk( hdivn, 'T', 1. )                        !==  lateral boundary cond.  ==!   (no sign change) 
     101      ! 
     102      IF( nn_timing == 1 )  CALL timing_stop('div_hor') 
     103      ! 
     104   END SUBROUTINE div_hor 
    333105    
    334 #endif 
    335106   !!====================================================================== 
    336 END MODULE divcur 
     107END MODULE divhor 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r4292 r4596  
    124124      INTEGER ::   ios             ! Local integer output status for namelist read 
    125125      !! 
    126       NAMELIST/namdyn_hpg/ ln_hpg_zco, ln_hpg_zps, ln_hpg_sco,     & 
     126      NAMELIST/namdyn_hpg/ ln_hpg_zco, ln_hpg_zps, ln_hpg_sco   ,     & 
    127127         &                 ln_hpg_djc, ln_hpg_prj, ln_dynhpg_imp 
    128128      !!---------------------------------------------------------------------- 
    … …  
    434434   END SUBROUTINE hpg_sco 
    435435 
     436 
    436437   SUBROUTINE hpg_djc( kt ) 
    437438      !!--------------------------------------------------------------------- 
    … …  
    580581 
    581582!!bug gm    : here also, simplification is possible 
    582 !!bug gm    : optimisation: 1/10 and 1/12 the division should be done before the loop 
    583583 
    584584      DO jk = 2, jpkm1 
    585585         DO jj = 2, jpjm1 
    586586            DO ji = fs_2, fs_jpim1   ! vector opt. 
    587  
     587               ! 
    588588               rho_k(ji,jj,jk) = zcoef0 * ( rhd   (ji,jj,jk) + rhd   (ji,jj,jk-1) )                                   & 
    589589                  &                     * ( fsde3w(ji,jj,jk) - fsde3w(ji,jj,jk-1) )                                   & 
    … …  
    594594                  &   * ( rhd   (ji,jj,jk) - rhd   (ji,jj,jk-1) - z1_12 * ( drhow(ji,jj,jk) + drhow(ji,jj,jk-1) ) )   & 
    595595                  &                             ) 
    596  
     596                  ! 
    597597               rho_i(ji,jj,jk) = zcoef0 * ( rhd   (ji+1,jj,jk) + rhd   (ji,jj,jk) )                                   & 
    598598                  &                     * ( fsde3w(ji+1,jj,jk) - fsde3w(ji,jj,jk) )                                   & 
    … …  
    603603                  &   * ( rhd   (ji+1,jj,jk) - rhd   (ji,jj,jk) - z1_12 * ( drhou(ji+1,jj,jk) + drhou(ji,jj,jk) ) )   & 
    604604                  &                            ) 
    605  
     605                  ! 
    606606               rho_j(ji,jj,jk) = zcoef0 * ( rhd   (ji,jj+1,jk) + rhd   (ji,jj,jk) )                                   & 
    607607                  &                     * ( fsde3w(ji,jj+1,jk) - fsde3w(ji,jj,jk) )                                   & 
    … …  
    612612                  &   * ( rhd   (ji,jj+1,jk) - rhd   (ji,jj,jk) - z1_12 * ( drhov(ji,jj+1,jk) + drhov(ji,jj,jk) ) )   & 
    613613                  &                            ) 
    614  
    615614            END DO 
    616615         END DO 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90

    r4522 r4596  
    44   !! Ocean physics:  lateral diffusivity trends  
    55   !!===================================================================== 
    6    !! History :  9.0  !  05-11  (G. Madec)  Original code (new step architecture) 
     6   !! History :  2.0  ! 2005-11  (G. Madec)  Original code (new step architecture) 
     7   !!            3.7  ! 2014-01  (F. Lemarie, G. Madec)  restructuration/simplification of ahm specification, 
     8   !!                 !                                  add velocity dependent coefficient and optional read in file 
    79   !!---------------------------------------------------------------------- 
    810 
    … …  
    1416   USE dom_oce        ! ocean space and time domain 
    1517   USE phycst         ! physical constants 
    16    USE ldfdyn_oce     ! ocean dynamics lateral physics 
    17    USE ldfslp         ! lateral mixing: slopes of mixing orientation 
    18    USE dynldf_bilapg  ! lateral mixing            (dyn_ldf_bilapg routine) 
    19    USE dynldf_bilap   ! lateral mixing            (dyn_ldf_bilap  routine) 
    20    USE dynldf_iso     ! lateral mixing            (dyn_ldf_iso    routine) 
    21    USE dynldf_lap     ! lateral mixing            (dyn_ldf_lap    routine) 
    22    USE ldftra_oce, ONLY: ln_traldf_hor     ! ocean tracers lateral physics 
     18   USE ldfdyn         ! lateral diffusion: eddy viscosity coef. 
     19   USE ldfslp         ! lateral diffusion: slopes of mixing orientation 
     20   USE dynldf_bilapg  ! lateral mixing            (dyn_ldf_blpg routine) 
     21   USE dynldf_iso     ! lateral mixing            (dyn_ldf_iso  routine) 
     22   USE dynldf_lap     ! lateral mixing            (dyn_ldf_lap  routine) 
    2323   USE trdmod         ! ocean dynamics and tracer trends 
    2424   USE trdmod_oce     ! ocean variables trends 
     25   ! 
    2526   USE prtctl         ! Print control 
    2627   USE in_out_manager ! I/O manager 
    2728   USE lib_mpp        ! distribued memory computing library 
    2829   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    29    USE wrk_nemo        ! Memory Allocation 
    30    USE timing          ! Timing 
    31  
     30   USE wrk_nemo       ! Memory Allocation 
     31   USE timing         ! Timing 
    3232 
    3333   IMPLICIT NONE 
    … …  
    4343#  include "vectopt_loop_substitute.h90" 
    4444   !!---------------------------------------------------------------------- 
    45    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     45   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    4646   !! $Id$ 
    4747   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    5555      !! ** Purpose :   compute the lateral ocean dynamics physics. 
    5656      !!---------------------------------------------------------------------- 
    57       ! 
    5857      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    5958      ! 
    … …  
    6362      IF( nn_timing == 1 )  CALL timing_start('dyn_ldf') 
    6463      ! 
    65       IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends 
     64      IF( l_trddyn )   THEN                      ! temporary save of momentum trends 
    6665         CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 
    6766         ztrdu(:,:,:) = ua(:,:,:)  
    … …  
    7170      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend 
    7271      ! 
    73       CASE ( 0 )    ;   CALL dyn_ldf_lap    ( kt )      ! iso-level laplacian 
    74       CASE ( 1 )    ;   CALL dyn_ldf_iso    ( kt )      ! rotated laplacian (except dk[ dk[.] ] part) 
    75       CASE ( 2 )    ;   CALL dyn_ldf_bilap  ( kt )      ! iso-level bilaplacian 
    76       CASE ( 3 )    ;   CALL dyn_ldf_bilapg ( kt )      ! s-coord. horizontal bilaplacian 
    77       CASE ( 4 )                                        ! iso-level laplacian + bilaplacian 
    78          CALL dyn_ldf_lap    ( kt ) 
    79          CALL dyn_ldf_bilap  ( kt ) 
    80       CASE ( 5 )                                        ! rotated laplacian + bilaplacian (s-coord) 
    81          CALL dyn_ldf_iso    ( kt ) 
    82          CALL dyn_ldf_bilapg ( kt ) 
     72      CASE ( 0 )    ;   CALL dyn_ldf_lap  ( kt, ub, vb, ua, va, 1 )      ! iso-level laplacian 
     73      CASE ( 1 )    ;   CALL dyn_ldf_iso  ( kt )                         ! rotated laplacian 
     74      CASE ( 2 )    ;   CALL dyn_ldf_blp  ( kt, ub, vb, ua, va    )      ! iso-level bilaplacian 
     75      CASE ( 3 )    ;   CALL dyn_ldf_blpg ( kt )                         ! s-coord. horizontal bilaplacian 
    8376      ! 
    8477      CASE ( -1 )                                       ! esopa: test all possibility with control print 
    85                         CALL dyn_ldf_lap    ( kt ) 
     78                        CALL dyn_ldf_lap ( kt , ub, vb, ua, va, 1 ) 
    8679                        CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf0 - Ua: ', mask1=umask,   & 
    87             &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    88                         CALL dyn_ldf_iso    ( kt ) 
     80         &                            tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     81                        CALL dyn_ldf_iso ( kt ) 
    8982                        CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf1 - Ua: ', mask1=umask,   & 
    90             &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    91                         CALL dyn_ldf_bilap  ( kt ) 
     83         &                            tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     84                        CALL dyn_ldf_blp ( kt, ub, vb, ua, va    ) 
    9285                        CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf2 - Ua: ', mask1=umask,   & 
    93             &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    94                         CALL dyn_ldf_bilapg ( kt ) 
     86         &                            tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     87                        CALL dyn_ldf_blpg( kt ) 
    9588                        CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf3 - Ua: ', mask1=umask,   & 
    96             &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    97       ! 
     89         &                            tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     90         ! 
    9891      CASE ( -2 )                                       ! neither laplacian nor bilaplacian schemes used 
    9992         IF( kt == nit000 ) THEN 
    … …  
    127120      INTEGER ::   ioptio, ierr         ! temporary integers  
    128121      !!---------------------------------------------------------------------- 
    129      
     122      ! 
    130123      !                                   ! Namelist nam_dynldf: already read in ldfdyn module 
    131  
     124      ! 
    132125      IF(lwp) THEN                        ! Namelist print 
    133126         WRITE(numout,*) 
    … …  
    135128         WRITE(numout,*) '~~~~~~~~~~~' 
    136129         WRITE(numout,*) '       Namelist nam_dynldf : set lateral mixing parameters (type, direction, coefficients)' 
    137          WRITE(numout,*) '          laplacian operator          ln_dynldf_lap   = ', ln_dynldf_lap 
    138          WRITE(numout,*) '          bilaplacian operator        ln_dynldf_bilap = ', ln_dynldf_bilap 
    139          WRITE(numout,*) '          iso-level                   ln_dynldf_level = ', ln_dynldf_level 
    140          WRITE(numout,*) '          horizontal (geopotential)   ln_dynldf_hor   = ', ln_dynldf_hor 
    141          WRITE(numout,*) '          iso-neutral                 ln_dynldf_iso   = ', ln_dynldf_iso 
     130         WRITE(numout,*) '          laplacian operator          ln_dynldf_lap = ', ln_dynldf_lap 
     131         WRITE(numout,*) '          bilaplacian operator        ln_dynldf_blp = ', ln_dynldf_blp 
     132         WRITE(numout,*) '          iso-level                   ln_dynldf_lev = ', ln_dynldf_lev 
     133         WRITE(numout,*) '          horizontal (geopotential)   ln_dynldf_hor = ', ln_dynldf_hor 
     134         WRITE(numout,*) '          iso-neutral                 ln_dynldf_iso = ', ln_dynldf_iso 
    142135      ENDIF 
    143136 
    144137      !                                   ! control the consistency 
    145138      ioptio = 0 
    146       IF( ln_dynldf_lap   )   ioptio = ioptio + 1 
    147       IF( ln_dynldf_bilap )   ioptio = ioptio + 1 
     139      IF( ln_dynldf_lap )   ioptio = ioptio + 1 
     140      IF( ln_dynldf_blp )   ioptio = ioptio + 1 
    148141      IF( ioptio <  1 ) CALL ctl_warn( '          neither laplacian nor bilaplacian operator set for dynamics' ) 
     142      IF( ioptio == 2 ) CALL ctl_stop( '          you cannot use laplacian AND bilaplacian operator at the same time' ) 
    149143      ioptio = 0 
    150       IF( ln_dynldf_level )   ioptio = ioptio + 1 
    151       IF( ln_dynldf_hor   )   ioptio = ioptio + 1 
    152       IF( ln_dynldf_iso   )   ioptio = ioptio + 1 
     144      IF( ln_dynldf_lev )   ioptio = ioptio + 1 
     145      IF( ln_dynldf_hor )   ioptio = ioptio + 1 
     146      IF( ln_dynldf_iso )   ioptio = ioptio + 1 
    153147      IF( ioptio >  1 ) CALL ctl_stop( '          use only ONE direction (level/hor/iso)' ) 
    154148 
    155       IF( ln_dynldf_iso .AND. ln_traldf_hor ) CALL ctl_stop & 
    156       &   ( 'Not sensible to use geopotential diffusion for tracers with isoneutral diffusion for dynamics' ) 
     149!!gm      IF( ln_dynldf_iso .AND. ln_traldf_hor )   CALL ctl_stop  & 
     150!!gm      &   ( 'Not sensible to use geopotential diffusion for tracers with isoneutral diffusion for dynamics' ) 
    157151 
    158152      !                                   ! Set nldf, the type of lateral diffusion, from ln_dynldf_... logicals 
    … …  
    160154      IF ( ln_dynldf_lap ) THEN      ! laplacian operator 
    161155         IF ( ln_zco ) THEN                ! z-coordinate 
    162             IF ( ln_dynldf_level )   nldf = 0      ! iso-level  (no rotation) 
    163             IF ( ln_dynldf_hor   )   nldf = 0      ! horizontal (no rotation) 
    164             IF ( ln_dynldf_iso   )   nldf = 1      ! isoneutral (   rotation) 
    165          ENDIF 
    166          IF ( ln_zps ) THEN             ! z-coordinate 
    167             IF ( ln_dynldf_level )   ierr = 1      ! iso-level not allowed 
    168             IF ( ln_dynldf_hor   )   nldf = 0      ! horizontal (no rotation) 
    169             IF ( ln_dynldf_iso   )   nldf = 1      ! isoneutral (   rotation) 
     156            IF ( ln_dynldf_lev )   nldf = 0      ! iso-level  (no rotation) 
     157            IF ( ln_dynldf_hor )   nldf = 0      ! horizontal (no rotation) 
     158            IF ( ln_dynldf_iso )   nldf = 1      ! isoneutral (   rotation) 
     159         ENDIF 
     160         IF ( ln_zps ) THEN             ! z-coordinate with partial step 
     161            IF ( ln_dynldf_lev )   ierr = 1      ! iso-level not allowed 
     162            IF ( ln_dynldf_hor )   nldf = 0      ! horizontal (no rotation) 
     163            IF ( ln_dynldf_iso )   nldf = 1      ! isoneutral (   rotation) 
    170164         ENDIF 
    171165         IF ( ln_sco ) THEN             ! s-coordinate 
    172             IF ( ln_dynldf_level )   nldf = 0      ! iso-level  (no rotation) 
    173             IF ( ln_dynldf_hor   )   nldf = 1      ! horizontal (   rotation) 
    174             IF ( ln_dynldf_iso   )   nldf = 1      ! isoneutral (   rotation) 
    175          ENDIF 
    176       ENDIF 
    177  
    178       IF( ln_dynldf_bilap ) THEN      ! bilaplacian operator 
     166            IF ( ln_dynldf_lev )   nldf = 0      ! iso-level  (no rotation) 
     167            IF ( ln_dynldf_hor )   nldf = 1      ! horizontal (   rotation) 
     168            IF ( ln_dynldf_iso )   nldf = 1      ! isoneutral (   rotation) 
     169         ENDIF 
     170      ENDIF 
     171 
     172      IF( ln_dynldf_blp ) THEN          ! bilaplacian operator 
    179173         IF ( ln_zco ) THEN                ! z-coordinate 
    180             IF ( ln_dynldf_level )   nldf = 2      ! iso-level  (no rotation) 
    181             IF ( ln_dynldf_hor   )   nldf = 2      ! horizontal (no rotation) 
    182             IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
    183          ENDIF 
    184          IF ( ln_zps ) THEN             ! z-coordinate 
    185             IF ( ln_dynldf_level )   ierr = 1      ! iso-level not allowed  
    186             IF ( ln_dynldf_hor   )   nldf = 2      ! horizontal (no rotation) 
    187             IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
     174            IF ( ln_dynldf_lev )   nldf = 2      ! iso-level  (no rotation) 
     175            IF ( ln_dynldf_hor )   nldf = 2      ! horizontal (no rotation) 
     176            IF ( ln_dynldf_iso )   ierr = 2      ! isoneutral (   rotation) 
     177         ENDIF 
     178         IF ( ln_zps ) THEN             ! z-coordinate with partial step 
     179            IF ( ln_dynldf_lev )   ierr = 1      ! iso-level not allowed  
     180            IF ( ln_dynldf_hor )   nldf = 2      ! horizontal (no rotation) 
     181            IF ( ln_dynldf_iso )   ierr = 2      ! isoneutral (   rotation) 
    188182         ENDIF 
    189183         IF ( ln_sco ) THEN             ! s-coordinate 
    190             IF ( ln_dynldf_level )   nldf = 2      ! iso-level  (no rotation) 
    191             IF ( ln_dynldf_hor   )   nldf = 3      ! horizontal (   rotation) 
    192             IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
     184            IF ( ln_dynldf_lev )   nldf = 2      ! iso-level  (no rotation) 
     185            IF ( ln_dynldf_hor )   nldf = 3      ! horizontal (   rotation) 
     186            IF ( ln_dynldf_iso )   ierr = 2      ! isoneutral (   rotation) 
    193187         ENDIF 
    194188      ENDIF 
    195189       
    196       IF( ln_dynldf_lap .AND. ln_dynldf_bilap ) THEN  ! mixed laplacian and bilaplacian operators 
     190      IF( ln_dynldf_lap .AND. ln_dynldf_blp ) THEN  ! mixed laplacian and bilaplacian operators 
    197191         IF ( ln_zco ) THEN                ! z-coordinate 
    198             IF ( ln_dynldf_level )   nldf = 4      ! iso-level  (no rotation) 
    199             IF ( ln_dynldf_hor   )   nldf = 4      ! horizontal (no rotation) 
    200             IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
    201          ENDIF 
    202          IF ( ln_zps ) THEN             ! z-coordinate 
    203             IF ( ln_dynldf_level )   ierr = 1      ! iso-level not allowed  
    204             IF ( ln_dynldf_hor   )   nldf = 4      ! horizontal (no rotation) 
    205             IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
     192            IF ( ln_dynldf_lev )   nldf = 4      ! iso-level  (no rotation) 
     193            IF ( ln_dynldf_hor )   nldf = 4      ! horizontal (no rotation) 
     194            IF ( ln_dynldf_iso )   ierr = 2      ! isoneutral (   rotation) 
     195         ENDIF 
     196         IF ( ln_zps ) THEN             ! z-coordinate with partial step 
     197            IF ( ln_dynldf_lev )   ierr = 1      ! iso-level not allowed  
     198            IF ( ln_dynldf_hor )   nldf = 4      ! horizontal (no rotation) 
     199            IF ( ln_dynldf_iso )   ierr = 2      ! isoneutral (   rotation) 
    206200         ENDIF 
    207201         IF ( ln_sco ) THEN             ! s-coordinate 
    208             IF ( ln_dynldf_level )   nldf = 4      ! iso-level  (no rotation) 
    209             IF ( ln_dynldf_hor   )   nldf = 5      ! horizontal (   rotation) 
    210             IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
     202            IF ( ln_dynldf_lev )   nldf = 4      ! iso-level  (no rotation) 
     203            IF ( ln_dynldf_hor )   nldf = 5      ! horizontal (   rotation) 
     204            IF ( ln_dynldf_iso )   ierr = 2      ! isoneutral (   rotation) 
    211205         ENDIF 
    212206      ENDIF 
    … …  
    216210      IF( ierr == 1 )   CALL ctl_stop( 'iso-level in z-coordinate - partial step, not allowed' ) 
    217211      IF( ierr == 2 )   CALL ctl_stop( 'isoneutral bilaplacian operator does not exist' ) 
    218       IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation 
    219          IF( .NOT.lk_ldfslp )   CALL ctl_stop( 'the rotation of the diffusive tensor require key_ldfslp' ) 
    220       ENDIF 
     212      IF( nldf == 1 .OR. nldf == 3 )   l_ldfslp = .TRUE.      ! rotation require the computation of the slopes 
    221213 
    222214      IF(lwp) THEN 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90

    r4488 r4596  
    77   !!  NEMO      1.0  !  2002-08  (G. Madec)  F90: Free form and module 
    88   !!            2.0  !  2004-08  (C. Talandier) New trends organization 
     9   !!            3.7  ! 2014-01  (F. Lemarie, G. Madec)  restructuration/simplification of ahm specification, 
     10   !!                 !                                  add velocity dependent coefficient and optional read in file 
    911   !!---------------------------------------------------------------------- 
    10 #if defined key_ldfslp   ||   defined key_esopa 
     12 
    1113   !!---------------------------------------------------------------------- 
    12    !!   'key_ldfslp'                              Rotation of mixing tensor 
    13    !!---------------------------------------------------------------------- 
    14    !!   dyn_ldf_bilapg : update the momentum trend with the horizontal part 
    15    !!                    of the horizontal s-coord. bilaplacian diffusion 
    16    !!   ldfguv         :  
     14   !!   dyn_ldf_blpg : update the momentum trend with the horizontal part 
     15   !!                  of the horizontal s-coord. bilaplacian diffusion 
     16   !!   ldfguv       :  
    1717   !!---------------------------------------------------------------------- 
    1818   USE oce             ! ocean dynamics and tracers 
    1919   USE dom_oce         ! ocean space and time domain 
    20    USE ldfdyn_oce      ! ocean dynamics lateral physics 
    21    USE ldftra_oce, ONLY: ln_traldf_iso 
     20   USE ldfdyn          ! lateral diffusion: eddy viscosity coef. 
    2221   USE zdf_oce         ! ocean vertical physics 
    2322   USE trdmod          ! ocean dynamics trends  
    2423   USE trdmod_oce      ! ocean variables trends 
    2524   USE ldfslp          ! iso-neutral slopes available 
     25   ! 
    2626   USE in_out_manager  ! I/O manager 
    2727   USE lib_mpp         ! MPP library 
    … …  
    3434   PRIVATE 
    3535 
    36    PUBLIC   dyn_ldf_bilapg       ! called by step.F90 
     36   PUBLIC   dyn_ldf_blpg       ! called by step.F90 
    3737 
    3838   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zfuw, zfvw , zdiu, zdiv   ! 2D workspace (ldfguv) 
    … …  
    4141   !! * Substitutions 
    4242#  include "domzgr_substitute.h90" 
    43 #  include "ldfdyn_substitute.h90" 
    4443   !!---------------------------------------------------------------------- 
    45    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     44   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    4645   !! $Id$  
    4746   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    4948CONTAINS 
    5049 
    51    INTEGER FUNCTION dyn_ldf_bilapg_alloc() 
    52       !!---------------------------------------------------------------------- 
    53       !!               ***  ROUTINE dyn_ldf_bilapg_alloc  *** 
     50   INTEGER FUNCTION dyn_ldf_blpg_alloc() 
     51      !!---------------------------------------------------------------------- 
     52      !!               ***  ROUTINE dyn_ldf_blpg_alloc  *** 
    5453      !!---------------------------------------------------------------------- 
    5554      ALLOCATE( zfuw(jpi,jpk) , zfvw (jpi,jpk) , zdiu(jpi,jpk) , zdiv (jpi,jpk) ,     & 
    56          &      zdju(jpi,jpk) , zdj1u(jpi,jpk) , zdjv(jpi,jpk) , zdj1v(jpi,jpk) , STAT=dyn_ldf_bilapg_alloc ) 
     55         &      zdju(jpi,jpk) , zdj1u(jpi,jpk) , zdjv(jpi,jpk) , zdj1v(jpi,jpk) , STAT=dyn_ldf_blpg_alloc ) 
    5756         ! 
    58       IF( dyn_ldf_bilapg_alloc /= 0 )   CALL ctl_warn('dyn_ldf_bilapg_alloc: failed to allocate arrays') 
    59    END FUNCTION dyn_ldf_bilapg_alloc 
    60  
    61  
    62    SUBROUTINE dyn_ldf_bilapg( kt ) 
    63       !!---------------------------------------------------------------------- 
    64       !!                   ***  ROUTINE dyn_ldf_bilapg  *** 
     57      IF( dyn_ldf_blpg_alloc /= 0 )   CALL ctl_warn('dyn_ldf_blpg_alloc: failed to allocate arrays') 
     58   END FUNCTION dyn_ldf_blpg_alloc 
     59 
     60 
     61   SUBROUTINE dyn_ldf_blpg( kt ) 
     62      !!---------------------------------------------------------------------- 
     63      !!                   ***  ROUTINE dyn_ldf_blpg  *** 
    6564      !!                       
    6665      !! ** Purpose :   Compute the before trend of the horizontal momentum 
    … …  
    9392      !!---------------------------------------------------------------------- 
    9493      ! 
    95       IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_bilapg') 
     94      IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_blpg') 
    9695      ! 
    9796      CALL wrk_alloc( jpi, jpj, jpk, zwk1, zwk2, zwk3, zwk4 )  
    … …  
    9998      IF( kt == nit000 ) THEN 
    10099         IF(lwp) WRITE(numout,*) 
    101          IF(lwp) WRITE(numout,*) 'dyn_ldf_bilapg : horizontal biharmonic operator in s-coordinate' 
    102          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~' 
    103          !                                      ! allocate dyn_ldf_bilapg arrays 
    104          IF( dyn_ldf_bilapg_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_ldf_bilapg: failed to allocate arrays') 
     100         IF(lwp) WRITE(numout,*) 'dyn_ldf_blpg : horizontal biharmonic operator in s-coordinate' 
     101         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
     102         !                                      ! allocate dyn_ldf_blpg arrays 
     103         IF( dyn_ldf_blpg_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_ldf_blpg: failed to allocate arrays') 
    105104      ENDIF 
    106  
    107       ! s-coordinate: Iso-level diffusion on tracer, but geopotential level diffusion on momentum 
    108       IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN 
    109          ! 
    110          DO jk = 1, jpk         ! set the slopes of iso-level 
    111             DO jj = 2, jpjm1 
    112                DO ji = 2, jpim1 
    113                   uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk) 
    114                   vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk) 
    115                   wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5 
    116                   wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5 
    117                END DO 
    118             END DO 
    119          END DO 
    120          ! Lateral boundary conditions on the slopes 
    121          CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. ) 
    122          CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. ) 
    123   
    124 !!bug 
    125          IF( kt == nit000 ) then 
    126             IF(lwp) WRITE(numout,*) ' max slop: u', SQRT( MAXVAL(uslp*uslp)), ' v ', SQRT(MAXVAL(vslp)),  & 
    127                &                             ' wi', sqrt(MAXVAL(wslpi))     , ' wj', sqrt(MAXVAL(wslpj)) 
    128          endif 
    129 !!end 
    130       ENDIF 
    131  
     105      ! 
    132106      zwk1(:,:,:) = 0.e0   ;   zwk3(:,:,:) = 0.e0 
    133107      zwk2(:,:,:) = 0.e0   ;   zwk4(:,:,:) = 0.e0 
    … …  
    157131      CALL wrk_dealloc( jpi, jpj, jpk, zwk1, zwk2, zwk3, zwk4 )  
    158132      ! 
    159       IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_bilapg') 
    160       ! 
    161    END SUBROUTINE dyn_ldf_bilapg 
     133      IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_blpg') 
     134      ! 
     135   END SUBROUTINE dyn_ldf_blpg 
    162136 
    163137 
    … …  
    178152      !!      ==========  pu as follows (idem on pv) 
    179153      !!      horizontal fluxes : 
    180       !!         zftu = e2u*e3u/e1u di[ pu ] - e2u*uslp dk[ mi(mk(pu)) ] 
    181       !!         zftv = e1v*e3v/e2v dj[ pu ] - e1v*vslp dk[ mj(mk(pu)) ] 
     154      !!         zftu = ahmt ( e2u*e3u/e1u di[ pu ] - e2u*uslp dk[ mi(mk(pu)) ] ) 
     155      !!         zftv = ahmf ( e1v*e3v/e2v dj[ pu ] - e1v*vslp dk[ mj(mk(pu)) ] ) 
    182156      !!      take the horizontal divergence of the fluxes (no divided by 
    183157      !!      the volume element : 
    184       !!         plu  = di-1[ zftu ] +  dj-1[ zftv ] 
     158      !!         plu  = di-1[ zftu ] + dj-1[ zftv ] 
    185159      !! 
    186160      !!      Second step: vertical part of the operator. It is computed on 
    187161      !!      ===========  pu as follows (idem on pv) 
    188162      !!      vertical fluxes : 
    189       !!         zftw = e1t*e2t/e3w * (wslpi^2+wslpj^2)  dk-1[ pu ] 
    190       !!              -     e2t     *       wslpi        di[ mi(mk(pu)) ] 
    191       !!              -     e1t     *       wslpj        dj[ mj(mk(pu)) ] 
     163      !!         zftw = e1t*e2t/e3w * (ahm*wslpi^2+ahm*wslpj^2)  dk-1[ pu ] 
     164      !!              -     e2t     *  ahm*wslpi                di[ mi(mk(pu)) ] 
     165      !!              -     e1t     *  ahm*wslpj                dj[ mj(mk(pu)) ] 
    192166      !!      take the vertical divergence of the fluxes add it to the hori- 
    193       !!      zontal component, divide the result by the volume element and 
    194       !!      if kahm=1, multiply by the eddy diffusivity coefficient: 
    195       !!         plu  = aht / (e1t*e2t*e3t) { plu + dk[ zftw ] } 
    196       !!      else: 
    197       !!         plu  =  1  / (e1t*e2t*e3t) { plu + dk[ zftw ] } 
     167      !!      zontal component, divide the result by the volume element : 
     168      !!         plu  =  zsign / (e1t*e2t*e3t) { plu + dk[ zftw ] } 
     169      !!      where  zsign=+1  if kahm =1 (laplacian or 1st pass of bilaplacian) 
     170      !!                  =-1  if kahm =2 (2nd pass in case of bilaplacian) 
    198171      !! 
    199172      !! ** Action : 
    … …  
    203176      !!      'key_trddyn' defined: the trend is saved for diagnostics. 
    204177      !!---------------------------------------------------------------------- 
    205       !! 
    206       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu , pv    ! 1st call: before horizontal velocity  
    207       !                                                               ! 2nd call: ahm x these fields 
    208       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   plu, plv   ! partial harmonic operator applied to 
     178      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu , pv    ! fields on which laplacian is applied  
     179      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   plu, plv   ! partial laplacian operator applied to 
    209180      !                                                               ! pu and pv (all the components except 
    210181      !                                                               ! second order vertical derivative term) 
    … …  
    213184      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    214185      REAL(wp) ::   zabe1 , zabe2 , zcof1 , zcof2        ! local scalar 
    215       REAL(wp) ::   zcoef0, zcoef3, zcoef4               !   -      - 
     186      REAL(wp) ::   zcoef0, zcoef3, zcoef4, zsign        !   -      - 
    216187      REAL(wp) ::   zbur, zbvr, zmkt, zmkf, zuav, zvav   !   -      - 
    217188      REAL(wp) ::   zuwslpi, zuwslpj, zvwslpi, zvwslpj   !   -      - 
     189      REAL(wp) ::   zaht_uw, zahf_uw                     !   -      - 
     190      REAL(wp) ::   zaht_vw, zahf_vw                     !   -      - 
    218191      ! 
    219192      REAL(wp), POINTER, DIMENSION(:,:) :: ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v 
    … …  
    223196      ! 
    224197      CALL wrk_alloc( jpi, jpj, ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v )  
     198      ! 
     199      IF    ( kahm == 1 ) THEN   ;   zsign = +1._wp 
     200      ELSEIF( kahm == 2 ) THEN   ;   zsign = -1._wp 
     201      ELSE 
     202         IF(lwp)WRITE(numout,*) ' ldfguv: kahm= 1 or 2, here =', kahm 
     203         IF(lwp)WRITE(numout,*) '         We stop' 
     204         STOP 'ldfguv' 
     205      ENDIF       
    225206      ! 
    226207      !                               ! ********** !   ! =============== 
    … …  
    252233            DO ji = 2, jpi 
    253234               zabe1 = e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj) 
    254  
     235               ! 
    255236               zmkt  = 1./MAX(  umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)   & 
    256                               + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ), 1. ) 
    257  
    258                zcof1 = -e2t(ji,jj) * zmkt   & 
    259                      * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 
    260  
    261                ziut(ji,jj) = tmask(ji,jj,jk) *   & 
    262                            (  zabe1 * ( pu(ji,jj,jk) - pu(ji-1,jj,jk) )   & 
    263                             + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)     & 
    264                                        +zdk1u(ji,jj) + zdku (ji-1,jj) )  ) 
     237                  &           + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ), 1. ) 
     238                  ! 
     239               zcof1 = -e2t(ji,jj) * zmkt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 
     240               ! 
     241               ziut(ji,jj) = tmask(ji,jj,jk) * ahmt(ji,jj,jk) *           & 
     242                  &        (  zabe1 * ( pu(ji,jj,jk) - pu(ji-1,jj,jk) )   & 
     243                  &         + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)     & 
     244                  &                    +zdk1u(ji,jj) + zdku (ji-1,jj) )  ) 
    265245            END DO 
    266246         END DO 
    … …  
    270250            DO ji = 1, jpim1 
    271251               zabe2 = e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj) 
    272  
     252               ! 
    273253               zmkf  = 1./MAX(  umask(ji,jj+1,jk  )+umask(ji,jj,jk+1)   & 
    274                               + umask(ji,jj+1,jk+1)+umask(ji,jj,jk  ), 1. ) 
    275  
    276                zcof2 = -e1f(ji,jj) * zmkf   & 
    277                      * 0.5  * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) ) 
    278  
    279                zjuf(ji,jj) = fmask(ji,jj,jk) *   & 
    280                            (  zabe2 * ( pu(ji,jj+1,jk) - pu(ji,jj,jk) )   & 
    281                             + zcof2 * ( zdku (ji,jj+1) + zdk1u(ji,jj)     & 
    282                                        +zdk1u(ji,jj+1) + zdku (ji,jj) )  ) 
     254                  &           + umask(ji,jj+1,jk+1)+umask(ji,jj,jk  ), 1. ) 
     255                  ! 
     256               zcof2 = -e1f(ji,jj) * zmkf * 0.5  * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) ) 
     257 
     258!!gm caution here fmask multiplication already done in the def of ahmf... 
     259!!gm so in noslip.... with fmask value=2 at the coast  !!!! 
     260 
     261               ! 
     262               zjuf(ji,jj) = fmask(ji,jj,jk) * ahmf(ji,jj,jk) *           & 
     263                  &        (  zabe2 * ( pu(ji,jj+1,jk) - pu(ji,jj,jk) )   & 
     264                  &         + zcof2 * ( zdku (ji,jj+1) + zdk1u(ji,jj)     & 
     265                  &                    +zdk1u(ji,jj+1) + zdku (ji,jj) )  ) 
    283266            END DO 
    284267         END DO 
    … …  
    292275            DO ji = 1, jpim1 
    293276               zabe1 = e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj) 
    294  
     277               ! 
    295278               zmkf  = 1./MAX(  vmask(ji+1,jj,jk  )+vmask(ji,jj,jk+1)   & 
    296                               + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk  ), 1. ) 
    297  
    298                zcof1 = -e2f(ji,jj) * zmkf   & 
    299                      * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) ) 
    300  
    301                zivf(ji,jj) = fmask(ji,jj,jk) *   & 
    302                            (  zabe1 * ( pu(ji+1,jj,jk) - pu(ji,jj,jk) )   & 
    303                             + zcof1 * ( zdku (ji,jj) + zdk1u(ji+1,jj)     & 
    304                                        +zdk1u(ji,jj) + zdku (ji+1,jj) )  ) 
     279                  &           + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk  ), 1. ) 
     280                  ! 
     281               zcof1 = -e2f(ji,jj) * zmkf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) ) 
     282               ! 
     283               zivf(ji,jj) = fmask(ji,jj,jk) * ahmf(ji,jj,jk) *           & 
     284                  &        (  zabe1 * ( pu(ji+1,jj,jk) - pu(ji,jj,jk) )   & 
     285                  &         + zcof1 * ( zdku (ji,jj) + zdk1u(ji+1,jj)     & 
     286                  &                    +zdk1u(ji,jj) + zdku (ji+1,jj) )  ) 
    305287            END DO 
    306288         END DO 
    … …  
    310292            DO ji = 1, jpim1 
    311293               zabe2 = e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj) 
    312  
     294               ! 
    313295               zmkt  = 1./MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)   & 
    314                               + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ), 1. ) 
    315  
    316                zcof2 = -e1t(ji,jj) * zmkt   & 
    317                      * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 
    318  
    319                zjvt(ji,jj) = tmask(ji,jj,jk) *   & 
    320                            (  zabe2 * ( pu(ji,jj,jk) - pu(ji,jj-1,jk) )   & 
    321                             + zcof2 * ( zdku (ji,jj-1) + zdk1u(ji,jj)     & 
    322                                        +zdk1u(ji,jj-1) + zdku (ji,jj) )  ) 
     296                  &           + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ), 1. ) 
     297                  ! 
     298               zcof2 = -e1t(ji,jj) * zmkt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 
     299               ! 
     300               zjvt(ji,jj) = tmask(ji,jj,jk) * ahmt(ji,jj,jk) *            & 
     301                  &        (  zabe2 * ( pu(ji,jj,jk) - pu(ji,jj-1,jk) )    & 
     302                  &         + zcof2 * ( zdku (ji,jj-1) + zdk1u(ji,jj)      & 
     303                  &                    +zdk1u(ji,jj-1) + zdku (ji,jj) )  ) 
    323304            END DO 
    324305         END DO 
    … …  
    330311         DO jj = 2, jpjm1 
    331312            DO ji = 2, jpim1 
    332                plu(ji,jj,jk) = ziut (ji+1,jj) - ziut (ji,jj  )   & 
    333                              + zjuf (ji  ,jj) - zjuf (ji,jj-1) 
    334                plv(ji,jj,jk) = zivf (ji,jj  ) - zivf (ji-1,jj)   & 
    335                              + zjvt (ji,jj+1) - zjvt (ji,jj  )  
    336             END DO 
    337          END DO 
    338  
     313               plu(ji,jj,jk) =   ziut (ji+1,jj) - ziut (ji,jj  )   & 
     314                  &            + zjuf (ji  ,jj) - zjuf (ji,jj-1)    
     315               plv(ji,jj,jk) =   zivf (ji,jj  ) - zivf (ji-1,jj)   & 
     316                  &            + zjvt (ji,jj+1) - zjvt (ji,jj  )    
     317            END DO 
     318         END DO 
    339319         !                                             ! =============== 
    340320      END DO                                           !   End of slab 
    … …  
    352332         DO jk = 1, jpk 
    353333            DO ji = 2, jpi 
    354                ! i-gradient of u at jj 
     334!!gm caution here fmask multiplication already done in the def of ahmf... 
     335!!gm so in noslip.... with fmask value=2 at the coast  !!!! 
     336               !                                ! i-gradient of u at jj 
    355337               zdiu (ji,jk) = tmask(ji,jj  ,jk) * ( pu(ji,jj  ,jk) - pu(ji-1,jj  ,jk) ) 
    356                ! j-gradient of u and v at jj 
     338               !                                ! j-gradient of u and v at jj 
    357339               zdju (ji,jk) = fmask(ji,jj  ,jk) * ( pu(ji,jj+1,jk) - pu(ji  ,jj  ,jk) ) 
    358340               zdjv (ji,jk) = tmask(ji,jj  ,jk) * ( pv(ji,jj  ,jk) - pv(ji  ,jj-1,jk) ) 
    359                ! j-gradient of u and v at jj+1 
     341               !                                ! j-gradient of u and v at jj+1 
    360342               zdj1u(ji,jk) = fmask(ji,jj-1,jk) * ( pu(ji,jj  ,jk) - pu(ji  ,jj-1,jk) ) 
    361343               zdj1v(ji,jk) = tmask(ji,jj+1,jk) * ( pv(ji,jj+1,jk) - pv(ji  ,jj  ,jk) ) 
    … …  
    363345         END DO 
    364346         DO jk = 1, jpk 
    365             DO ji = 1, jpim1 
    366                ! i-gradient of v at jj 
     347            DO ji = 1, jpim1               ! i-gradient of v at jj 
    367348               zdiv (ji,jk) = fmask(ji,jj  ,jk) * ( pv(ji+1,jj,jk) - pv(ji  ,jj  ,jk) ) 
    368349            END DO 
    … …  
    375356         ! Surface and bottom vertical fluxes set to zero 
    376357 
    377          zfuw(:, 1 ) = 0.e0 
    378          zfvw(:, 1 ) = 0.e0 
    379          zfuw(:,jpk) = 0.e0 
    380          zfvw(:,jpk) = 0.e0 
     358         zfuw(:, 1 ) = 0._wp 
     359         zfvw(:, 1 ) = 0._wp 
     360         zfuw(:,jpk) = 0._wp 
     361         zfvw(:,jpk) = 0._wp 
    381362 
    382363         ! interior (2=<jk=<jpk-1) on pu field 
    … …  
    389370               ! coef. for the vertical dirative 
    390371               zcoef0 = e1u(ji,jj) * e2u(ji,jj) / fse3u(ji,jj,jk)   & 
    391                       * ( zuwslpi * zuwslpi + zuwslpj * zuwslpj ) 
     372                  &   * ( zuwslpi * zuwslpi + zuwslpj * zuwslpj ) 
    392373               ! weights for the i-k, j-k averaging at t- and f-points, resp. 
    393374               zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji+1,jj,jk-1)   & 
    394                              + tmask(ji,jj,jk  )+tmask(ji+1,jj,jk  ), 1. ) 
     375                  &          + tmask(ji,jj,jk  )+tmask(ji+1,jj,jk  ), 1. ) 
     376!!gm caution here fmask multiplication already done in the def of ahmf... 
     377!!gm so in noslip.... with fmask value=2 at the coast  !!!! 
    395378               zmkf = 1./MAX(  fmask(ji,jj-1,jk-1)+fmask(ji,jj,jk-1)   & 
    396                              + fmask(ji,jj-1,jk  )+fmask(ji,jj,jk  ), 1. ) 
     379                  &          + fmask(ji,jj-1,jk  )+fmask(ji,jj,jk  ), 1. ) 
     380               zaht_uw = (   ahmt(ji,jj,jk-1) + ahmt(ji+1,jj,jk-1)    & 
     381                  &        + ahmt(ji,jj,jk  ) + ahmt(ji+1,jj,jk  )  ) * zmkt 
     382               zahf_uw = (   ahmf(ji,jj-1,jk-1) + ahmf(ji,jj,jk-1)    & 
     383                  &        + ahmf(ji,jj-1,jk  ) + ahmf(ji,jj,jk  )  ) * zmkf 
    397384               ! coef. for the horitontal derivative 
    398                zcoef3 = - e2u(ji,jj) * zmkt * zuwslpi 
    399                zcoef4 = - e1u(ji,jj) * zmkf * zuwslpj 
     385               zcoef3 = - e2u(ji,jj) * zaht_uw * zuwslpi 
     386               zcoef4 = - e1u(ji,jj) * zahf_uw * zuwslpj 
    400387               ! vertical flux on u field 
    401388               zfuw(ji,jk) = umask(ji,jj,jk) *   & 
    402                            (  zcoef0 * ( pu  (ji,jj,jk-1) - pu  (ji,jj,jk) )   & 
    403                             + zcoef3 * ( zdiu (ji,jk-1) + zdiu (ji+1,jk-1)     & 
    404                                         +zdiu (ji,jk  ) + zdiu (ji+1,jk  ) )   & 
    405                             + zcoef4 * ( zdj1u(ji,jk-1) + zdju (ji  ,jk-1)     & 
    406                                         +zdj1u(ji,jk  ) + zdju (ji  ,jk  ) ) ) 
     389                  &        (  zcoef0 * ( pu  (ji,jj,jk-1) - pu  (ji,jj,jk) )   & 
     390                  &         + zcoef3 * ( zdiu (ji,jk-1) + zdiu (ji+1,jk-1)     & 
     391                  &                     +zdiu (ji,jk  ) + zdiu (ji+1,jk  ) )   & 
     392                  &         + zcoef4 * ( zdj1u(ji,jk-1) + zdju (ji  ,jk-1)     & 
     393                  &                     +zdj1u(ji,jk  ) + zdju (ji  ,jk  ) ) ) 
    407394            END DO 
    408395         END DO 
    … …  
    417404               ! coef. for the vertical derivative 
    418405               zcoef0 = e1v(ji,jj) * e2v(ji,jj) / fse3v(ji,jj,jk)   & 
    419                       * ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) 
     406                  &   * ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) 
     407!!gm caution here fmask multiplication already done in the def of ahmf... 
     408!!gm so in noslip.... with fmask value=2 at the coast  !!!! 
    420409               ! weights for the i-k, j-k averaging at f- and t-points, resp. 
    421410               zmkf = 1./MAX(  fmask(ji-1,jj,jk-1)+fmask(ji,jj,jk-1)   & 
    422                              + fmask(ji-1,jj,jk  )+fmask(ji,jj,jk  ), 1. ) 
     411                  &          + fmask(ji-1,jj,jk  )+fmask(ji,jj,jk  ), 1. ) 
    423412               zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji,jj+1,jk-1)   & 
    424                              + tmask(ji,jj,jk  )+tmask(ji,jj+1,jk  ), 1. ) 
     413                  &          + tmask(ji,jj,jk  )+tmask(ji,jj+1,jk  ), 1. ) 
     414               zahf_vw = (   ahmf(ji-1,jj,jk-1) + ahmf(ji,jj,jk-1)    & 
     415                  &        + ahmf(ji-1,jj,jk  ) + ahmf(ji,jj,jk  )  ) * zmkf 
     416               zaht_vw = (   ahmt(ji,jj,jk-1) + ahmt(ji,jj+1,jk-1)    & 
     417                  &        + ahmt(ji,jj,jk  ) + ahmt(ji,jj+1,jk  )  ) * zmkt 
    425418               ! coef. for the horizontal derivatives 
    426                zcoef3 = - e2v(ji,jj) * zmkf * zvwslpi 
    427                zcoef4 = - e1v(ji,jj) * zmkt * zvwslpj 
     419               zcoef3 = - e2v(ji,jj) * zahf_vw * zvwslpi 
     420               zcoef4 = - e1v(ji,jj) * zaht_vw * zvwslpj 
    428421               ! vertical flux on pv field 
    429422               zfvw(ji,jk) = vmask(ji,jj,jk) *   & 
    430                            (  zcoef0 * ( pv  (ji,jj,jk-1) - pv  (ji,jj,jk) )   & 
    431                             + zcoef3 * ( zdiv (ji,jk-1) + zdiv (ji-1,jk-1)     & 
    432                                         +zdiv (ji,jk  ) + zdiv (ji-1,jk  ) )   & 
    433                             + zcoef4 * ( zdjv (ji,jk-1) + zdj1v(ji  ,jk-1)     & 
    434                                         +zdjv (ji,jk  ) + zdj1v(ji  ,jk  ) )  ) 
     423                  &        (  zcoef0 * ( pv  (ji,jj,jk-1) - pv  (ji,jj,jk) )   & 
     424                  &         + zcoef3 * ( zdiv (ji,jk-1) + zdiv (ji-1,jk-1)     & 
     425                  &                     +zdiv (ji,jk  ) + zdiv (ji-1,jk  ) )   & 
     426                  &         + zcoef4 * ( zdjv (ji,jk-1) + zdj1v(ji  ,jk-1)     & 
     427                  &                     +zdjv (ji,jk  ) + zdj1v(ji  ,jk  ) )  ) 
    435428            END DO 
    436429         END DO 
    … …  
    439432         ! II.3 Divergence of vertical fluxes added to the horizontal divergence 
    440433         ! --------------------------------------------------------------------- 
    441          IF( (kahm -nkahm_smag) ==1 ) THEN 
    442             ! multiply the laplacian by the eddy viscosity coefficient 
    443             DO jk = 1, jpkm1 
    444                DO ji = 2, jpim1 
    445                   ! eddy coef. divided by the volume element 
    446                   zbur = fsahmu(ji,jj,jk) / ( e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) ) 
    447                   zbvr = fsahmv(ji,jj,jk) / ( e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk) ) 
    448                   ! vertical divergence 
    449                   zuav = zfuw(ji,jk) - zfuw(ji,jk+1) 
    450                   zvav = zfvw(ji,jk) - zfvw(ji,jk+1) 
    451                   ! harmonic operator applied to (pu,pv) and multiply by ahm 
    452                   plu(ji,jj,jk) = ( plu(ji,jj,jk) + zuav ) * zbur 
    453                   plv(ji,jj,jk) = ( plv(ji,jj,jk) + zvav ) * zbvr 
    454                END DO 
    455             END DO 
    456          ELSEIF( (kahm +nkahm_smag ) == 2 ) THEN 
    457             ! second call, no multiplication 
    458             DO jk = 1, jpkm1 
    459                DO ji = 2, jpim1 
    460                   ! inverse of the volume element 
    461                   zbur = 1. / ( e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) ) 
    462                   zbvr = 1. / ( e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk) ) 
    463                   ! vertical divergence 
    464                   zuav = zfuw(ji,jk) - zfuw(ji,jk+1) 
    465                   zvav = zfvw(ji,jk) - zfvw(ji,jk+1) 
    466                   ! harmonic operator applied to (pu,pv)  
    467                   plu(ji,jj,jk) = ( plu(ji,jj,jk) + zuav ) * zbur 
    468                   plv(ji,jj,jk) = ( plv(ji,jj,jk) + zvav ) * zbvr 
    469                END DO 
    470             END DO 
    471          ELSE 
    472             IF(lwp)WRITE(numout,*) ' ldfguv: kahm= 1 or 2, here =', kahm 
    473             IF(lwp)WRITE(numout,*) '         We stop' 
    474             STOP 'ldfguv' 
    475          ENDIF 
     434          
     435         DO jk = 1, jpkm1 
     436            DO ji = 2, jpim1 
     437               ! vertical divergence 
     438               zuav = zfuw(ji,jk) - zfuw(ji,jk+1) 
     439               zvav = zfvw(ji,jk) - zfvw(ji,jk+1) 
     440               ! harmonic operator applied to (pu,pv) and multiply by ahm 
     441               plu(ji,jj,jk) = zsign * ( plu(ji,jj,jk) + zuav ) / ( e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) ) 
     442               plv(ji,jj,jk) = zsign * ( plv(ji,jj,jk) + zvav ) / ( e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk) ) 
     443            END DO 
     444         END DO 
    476445         !                                             ! =============== 
    477446      END DO                                           !   End of slab 
    … …  
    484453   END SUBROUTINE ldfguv 
    485454 
    486 #else 
    487    !!---------------------------------------------------------------------- 
    488    !!   Dummy module :                         NO rotation of mixing tensor 
    489    !!---------------------------------------------------------------------- 
    490 CONTAINS 
    491    SUBROUTINE dyn_ldf_bilapg( kt )               ! Dummy routine 
    492       INTEGER, INTENT(in) :: kt 
    493       WRITE(*,*) 'dyn_ldf_bilapg: You should not have seen this print! error?', kt 
    494    END SUBROUTINE dyn_ldf_bilapg 
    495 #endif 
    496  
    497455   !!====================================================================== 
    498456END MODULE dynldf_bilapg 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90

    r4488 r4596  
    88   !!             -   !  2004-08  (C. Talandier) New trends organization 
    99   !!            2.0  !  2005-11  (G. Madec)  s-coordinate: horizontal diffusion 
     10   !!            3.7  !  2014-01  (F. Lemarie, G. Madec)  restructuration/simplification of ahm specification, 
     11   !!                 !                                   add velocity dependent coefficient and optional read in file 
    1012   !!---------------------------------------------------------------------- 
    11 #if defined key_ldfslp   ||   defined key_esopa 
    12    !!---------------------------------------------------------------------- 
    13    !!   'key_ldfslp'                      slopes of the direction of mixing 
     13 
    1414   !!---------------------------------------------------------------------- 
    1515   !!   dyn_ldf_iso  : update the momentum trend with the horizontal part 
    … …  
    1919   USE oce             ! ocean dynamics and tracers 
    2020   USE dom_oce         ! ocean space and time domain 
    21    USE ldfdyn_oce      ! ocean dynamics lateral physics 
    22    USE ldftra_oce      ! ocean tracer   lateral physics 
     21   USE ldfdyn          ! lateral diffusion: eddy viscosity coef. 
     22   USE ldftra          ! lateral physics: eddy diffusivity 
    2323   USE zdf_oce         ! ocean vertical physics 
    2424   USE trdmod          ! ocean dynamics trends  
    … …  
    4343   !! * Substitutions 
    4444#  include "domzgr_substitute.h90" 
    45 #  include "ldfdyn_substitute.h90" 
    4645#  include "vectopt_loop_substitute.h90" 
    4746   !!---------------------------------------------------------------------- 
    … …  
    8483      !!      horizontal fluxes associated with the rotated lateral mixing: 
    8584      !!      u-component: 
    86       !!         ziut = ( ahmt + ahmb0 ) e2t * e3t / e1t  di[ ub ] 
    87       !!               -      ahmt       e2t * mi-1(uslp) dk[ mi(mk(ub)) ] 
    88       !!         zjuf = ( ahmf + ahmb0 ) e1f * e3f / e2f  dj[ ub ] 
    89       !!               -      ahmf       e1f * mi(vslp)   dk[ mj(mk(ub)) ] 
     85      !!         ziut = ( ahmt + rn_ahm_b ) e2t * e3t / e1t  di[ ub ] 
     86      !!               -  ahmt              e2t * mi-1(uslp) dk[ mi(mk(ub)) ] 
     87      !!         zjuf = ( ahmf + rn_ahm_b ) e1f * e3f / e2f  dj[ ub ] 
     88      !!               -  ahmf              e1f * mi(vslp)   dk[ mj(mk(ub)) ] 
    9089      !!      v-component: 
    91       !!         zivf = ( ahmf + ahmb0 ) e2t * e3t / e1t  di[ vb ] 
    92       !!               -      ahmf       e2t * mj(uslp)   dk[ mi(mk(vb)) ] 
    93       !!         zjvt = ( ahmt + ahmb0 ) e1f * e3f / e2f  dj[ ub ] 
    94       !!               -      ahmt       e1f * mj-1(vslp) dk[ mj(mk(vb)) ] 
     90      !!         zivf = ( ahmf + rn_ahm_b ) e2t * e3t / e1t  di[ vb ] 
     91      !!               -  ahmf              e2t * mj(uslp)   dk[ mi(mk(vb)) ] 
     92      !!         zjvt = ( ahmt + rn_ahm_b ) e1f * e3f / e2f  dj[ ub ] 
     93      !!               -  ahmt              e1f * mj-1(vslp) dk[ mj(mk(vb)) ] 
    9594      !!      take the horizontal divergence of the fluxes: 
    9695      !!         diffu = 1/(e1u*e2u*e3u) {  di  [ ziut ] + dj-1[ zjuf ]  } 
    … …  
    107106      !!      of the rotated operator in dynzdf module 
    108107      !!---------------------------------------------------------------------- 
    109       ! 
    110108      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    111109      ! 
    … …  
    131129      ENDIF 
    132130 
    133       ! s-coordinate: Iso-level diffusion on tracer, but geopotential level diffusion on momentum 
     131      ! s-coordinate: Iso-level diffusion on momentum but not on tracer 
    134132      IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN 
    135133         ! 
    … …  
    185183            DO jj = 2, jpjm1 
    186184               DO ji = fs_2, jpi   ! vector opt. 
    187                   zabe1 = (fsahmt(ji,jj,jk)+ahmb0) * e2t(ji,jj) * MIN( fse3u(ji,jj,jk), fse3u(ji-1,jj,jk) ) / e1t(ji,jj) 
    188  
    189                   zmskt = 1./MAX(  umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)   & 
    190                      &           + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ), 1. ) 
    191  
    192                   zcof1 = - aht0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 
     185                  zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * MIN( fse3u(ji,jj,jk), fse3u(ji-1,jj,jk) ) / e1t(ji,jj) 
     186 
     187                  zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)     & 
     188                     &                 + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ) , 1._wp ) 
     189 
     190                  zcof1 = - rn_aht_0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 
    193191    
     192                  ziut(ji,jj) = (  zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) )    & 
     193                     &           + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)      & 
     194                     &                      +zdk1u(ji,jj) + zdku (ji-1,jj) )  ) * tmask(ji,jj,jk) 
     195               END DO 
     196            END DO 
     197         ELSE                   ! other coordinate system (zco or sco) : e3t 
     198            DO jj = 2, jpjm1 
     199               DO ji = fs_2, jpi   ! vector opt. 
     200                  zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj) 
     201 
     202                  zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  ) + umask(ji,jj,jk+1)     & 
     203                     &                 + umask(ji-1,jj,jk+1) + umask(ji,jj,jk  ) , 1._wp ) 
     204 
     205                  zcof1 = - rn_aht_0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 
     206 
    194207                  ziut(ji,jj) = (  zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) )   & 
    195208                     &           + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)     & 
    … …  
    197210               END DO 
    198211            END DO 
    199          ELSE                   ! other coordinate system (zco or sco) : e3t 
    200             DO jj = 2, jpjm1 
    201                DO ji = fs_2, jpi   ! vector opt. 
    202                   zabe1 = (fsahmt(ji,jj,jk)+ahmb0) * e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj) 
    203  
    204                   zmskt = 1./MAX(  umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)   & 
    205                      &           + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ), 1. ) 
    206  
    207                   zcof1 = - aht0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 
    208  
    209                   ziut(ji,jj) = (  zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) )   & 
    210                      &           + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)     & 
    211                      &                      +zdk1u(ji,jj) + zdku (ji-1,jj) )  ) * tmask(ji,jj,jk) 
    212                END DO 
    213             END DO 
    214212         ENDIF 
    215213 
    … …  
    217215         DO jj = 1, jpjm1 
    218216            DO ji = 1, fs_jpim1   ! vector opt. 
    219                zabe2 = ( fsahmf(ji,jj,jk) + ahmb0 ) * e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj) 
    220  
    221                zmskf = 1./MAX(  umask(ji,jj+1,jk  )+umask(ji,jj,jk+1)   & 
    222                   &           + umask(ji,jj+1,jk+1)+umask(ji,jj,jk  ), 1. ) 
    223  
    224                zcof2 = - aht0 * e1f(ji,jj) * zmskf * 0.5  * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) ) 
     217               zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj) 
     218 
     219               zmskf = 1._wp / MAX(   umask(ji,jj+1,jk  )+umask(ji,jj,jk+1)     & 
     220                  &                 + umask(ji,jj+1,jk+1)+umask(ji,jj,jk  ) , 1._wp ) 
     221 
     222               zcof2 = - rn_aht_0 * e1f(ji,jj) * zmskf * 0.5  * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) ) 
    225223 
    226224               zjuf(ji,jj) = (  zabe2 * ( ub(ji,jj+1,jk) - ub(ji,jj,jk) )   & 
    … …  
    238236         DO jj = 2, jpjm1 
    239237            DO ji = 1, fs_jpim1   ! vector opt. 
    240                zabe1 = ( fsahmf(ji,jj,jk) + ahmb0 ) * e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj) 
    241  
    242                zmskf = 1./MAX(  vmask(ji+1,jj,jk  )+vmask(ji,jj,jk+1)   & 
    243                   &           + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk  ), 1. ) 
    244  
    245                zcof1 = - aht0 * e2f(ji,jj) * zmskf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) ) 
    246  
    247                zivf(ji,jj) = (  zabe1 * ( vb(ji+1,jj,jk) - vb(ji,jj,jk) )   & 
    248                   &           + zcof1 * ( zdkv (ji,jj) + zdk1v(ji+1,jj)     & 
    249                   &                      +zdk1v(ji,jj) + zdkv (ji+1,jj) )  ) * fmask(ji,jj,jk) 
     238               zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj) 
     239 
     240               zmskf = 1._wp / MAX(  vmask(ji+1,jj,jk  )+vmask(ji,jj,jk+1)     & 
     241                  &                + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk  ) , 1._wp ) 
     242 
     243               zcof1 = - rn_aht_0 * e2f(ji,jj) * zmskf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) ) 
     244 
     245               zivf(ji,jj) = (  zabe1 * ( vb(ji+1,jj,jk) - vb(ji,jj,jk) )    & 
     246                  &           + zcof1 * (  zdkv (ji,jj) + zdk1v(ji+1,jj)      & 
     247                  &                      + zdk1v(ji,jj) + zdkv (ji+1,jj) )  ) * fmask(ji,jj,jk) 
    250248            END DO 
    251249         END DO 
    … …  
    255253            DO jj = 2, jpj 
    256254               DO ji = 1, fs_jpim1   ! vector opt. 
    257                   zabe2 = (fsahmt(ji,jj,jk)+ahmb0) * e1t(ji,jj) * MIN( fse3v(ji,jj,jk), fse3v(ji,jj-1,jk) ) / e2t(ji,jj) 
    258  
    259                   zmskt = 1./MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)   & 
    260                      &           + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ), 1. ) 
    261  
    262                   zcof2 = - aht0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 
    263  
    264                   zjvt(ji,jj) = (  zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) )   & 
    265                      &           + zcof2 * ( zdkv (ji,jj-1) + zdk1v(ji,jj)     & 
     255                  zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * MIN( fse3v(ji,jj,jk), fse3v(ji,jj-1,jk) ) / e2t(ji,jj) 
     256 
     257                  zmskt = 1._wp / MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)     & 
     258                     &                + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ) , 1._wp ) 
     259 
     260                  zcof2 = - rn_aht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 
     261 
     262                  zjvt(ji,jj) = (  zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) )    & 
     263                     &           + zcof2 * ( zdkv (ji,jj-1) + zdk1v(ji,jj)      & 
    266264                     &                      +zdk1v(ji,jj-1) + zdkv (ji,jj) )  ) * tmask(ji,jj,jk) 
    267265               END DO 
    … …  
    270268            DO jj = 2, jpj 
    271269               DO ji = 1, fs_jpim1   ! vector opt. 
    272                   zabe2 = (fsahmt(ji,jj,jk)+ahmb0) * e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj) 
     270                  zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj) 
    273271 
    274272                  zmskt = 1./MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)   & 
    275273                     &           + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ), 1. ) 
    276274 
    277                   zcof2 = - aht0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 
     275                  zcof2 = - rn_aht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 
    278276 
    279277                  zjvt(ji,jj) = (  zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) )   & 
    … …  
    359357         DO jk = 2, jpkm1 
    360358            DO ji = 2, jpim1 
    361                zcoef0= 0.5 * aht0 * umask(ji,jj,jk) 
    362  
     359               zcoef0= 0.5 * rn_aht_0 * umask(ji,jj,jk) 
     360               ! 
    363361               zuwslpi = zcoef0 * ( wslpi(ji+1,jj,jk) + wslpi(ji,jj,jk) ) 
    364362               zuwslpj = zcoef0 * ( wslpj(ji+1,jj,jk) + wslpj(ji,jj,jk) ) 
    365  
     363               ! 
    366364               zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji+1,jj,jk-1)   & 
    367365                             + tmask(ji,jj,jk  )+tmask(ji+1,jj,jk  ), 1. ) 
    368                zmkf = 1./MAX(  fmask(ji,jj-1,jk-1)+fmask(ji,jj,jk-1)   & 
    369                              + fmask(ji,jj-1,jk  )+fmask(ji,jj,jk  ), 1. ) 
     366               zmkf = 1./MAX(  fmask(ji,jj-1,jk-1) + fmask(ji,jj,jk-1)   & 
     367                             + fmask(ji,jj-1,jk  ) + fmask(ji,jj,jk  ), 1. ) 
    370368 
    371369               zcoef3 = - e2u(ji,jj) * zmkt * zuwslpi 
    … …  
    377375                                       +zdj1u(ji,jk  ) + zdju (ji  ,jk  ) ) 
    378376               ! update avmu (add isopycnal vertical coefficient to avmu) 
    379                ! Caution: zcoef0 include aht0, so divided by aht0 to obtain slp^2 * aht0 
    380                avmu(ji,jj,jk) = avmu(ji,jj,jk) + ( zuwslpi * zuwslpi + zuwslpj * zuwslpj ) / aht0 
     377               ! Caution: zcoef0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0 
     378               avmu(ji,jj,jk) = avmu(ji,jj,jk) + ( zuwslpi * zuwslpi + zuwslpj * zuwslpj ) / rn_aht_0 
    381379            END DO 
    382380         END DO 
    … …  
    385383         DO jk = 2, jpkm1 
    386384            DO ji = 2, jpim1 
    387                zcoef0= 0.5 * aht0 * vmask(ji,jj,jk) 
     385               zcoef0 = 0.5 * rn_aht_0 * vmask(ji,jj,jk) 
    388386 
    389387               zvwslpi = zcoef0 * ( wslpi(ji,jj+1,jk) + wslpi(ji,jj,jk) ) 
    … …  
    399397               ! vertical flux on v field 
    400398               zfvw(ji,jk) = zcoef3 * ( zdiv (ji,jk-1) + zdiv (ji-1,jk-1)     & 
    401                                        +zdiv (ji,jk  ) + zdiv (ji-1,jk  ) )   & 
    402                            + zcoef4 * ( zdjv (ji,jk-1) + zdj1v(ji  ,jk-1)     & 
    403                                        +zdjv (ji,jk  ) + zdj1v(ji  ,jk  ) ) 
     399                  &                    +zdiv (ji,jk  ) + zdiv (ji-1,jk  ) )   & 
     400                  &        + zcoef4 * ( zdjv (ji,jk-1) + zdj1v(ji  ,jk-1)     & 
     401                  &                    +zdjv (ji,jk  ) + zdj1v(ji  ,jk  ) ) 
    404402               ! update avmv (add isopycnal vertical coefficient to avmv) 
    405                ! Caution: zcoef0 include aht0, so divided by aht0 to obtain slp^2 * aht0 
    406                avmv(ji,jj,jk) = avmv(ji,jj,jk) + ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) / aht0 
     403               ! Caution: zcoef0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0 
     404               avmv(ji,jj,jk) = avmv(ji,jj,jk) + ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) / rn_aht_0 
    407405            END DO 
    408406         END DO 
    … …  
    433431   END SUBROUTINE dyn_ldf_iso 
    434432 
    435 # else 
    436    !!---------------------------------------------------------------------- 
    437    !!   Dummy module                           NO rotation of mixing tensor 
    438    !!---------------------------------------------------------------------- 
    439 CONTAINS 
    440    SUBROUTINE dyn_ldf_iso( kt )               ! Empty routine 
    441       INTEGER, INTENT(in) :: kt 
    442       WRITE(*,*) 'dyn_ldf_iso: You should not have seen this print! error?', kt 
    443    END SUBROUTINE dyn_ldf_iso 
    444 #endif 
    445  
    446433   !!====================================================================== 
    447434END MODULE dynldf_iso 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90

    r3294 r4596  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  dynldf_lap  *** 
    4    !! Ocean dynamics:  lateral viscosity trend 
     4   !! Ocean dynamics:  lateral viscosity trend (laplacian and bilaplacian) 
    55   !!====================================================================== 
    66   !! History :  OPA  ! 1990-09 (G. Madec) Original code 
    … …  
    99   !!   NEMO     1.0  ! 2002-06 (G. Madec)  F90: Free form and module 
    1010   !!             -   ! 2004-08 (C. Talandier) New trends organization 
     11   !!            3.7  ! 2014-01  (F. Lemarie, G. Madec)  restructuration/simplification of ahm specification, 
     12   !!                 !                                  add velocity dependent coefficient and optional read in file 
    1113   !!---------------------------------------------------------------------- 
    1214 
    1315   !!---------------------------------------------------------------------- 
    14    !!   dyn_ldf_lap  : update the momentum trend with the lateral diffusion 
    15    !!                  using an iso-level harmonic operator 
     16   !!   dyn_ldf_lap   : update the momentum trend with the lateral viscosity using an iso-level   laplacian operator 
     17   !!   dyn_ldf_blp   : update the momentum trend with the lateral viscosity using an iso-level bilaplacian operator 
    1618   !!---------------------------------------------------------------------- 
    17    USE oce             ! ocean dynamics and tracers 
    18    USE dom_oce         ! ocean space and time domain 
    19    USE ldfdyn_oce      ! ocean dynamics: lateral physics 
    20    USE zdf_oce         ! ocean vertical physics 
    21    USE in_out_manager  ! I/O manager 
    22    USE trdmod          ! ocean dynamics trends  
    23    USE trdmod_oce      ! ocean variables trends 
    24    USE ldfslp          ! iso-neutral slopes  
    25    USE timing          ! Timing 
     19   USE oce            ! ocean dynamics and tracers 
     20   USE dom_oce        ! ocean space and time domain 
     21   USE ldfdyn         ! lateral diffusion: eddy viscosity coef. 
     22   USE ldfslp         ! iso-neutral slopes  
     23   USE zdf_oce        ! ocean vertical physics 
     24   ! 
     25   USE trdmod         ! ocean dynamics trends  
     26   USE trdmod_oce     ! ocean variables trends 
     27   USE in_out_manager ! I/O manager 
     28   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     29   USE wrk_nemo       ! Memory Allocation 
     30   USE timing         ! Timing 
    2631 
    2732   IMPLICIT NONE 
    2833   PRIVATE 
    2934 
    30    PUBLIC dyn_ldf_lap  ! called by step.F90 
     35   PUBLIC dyn_ldf_lap  ! called by dynldf.F90 
     36   PUBLIC dyn_ldf_blp  ! called by dynldf.F90 
    3137 
    3238   !! * Substitutions 
    3339#  include "domzgr_substitute.h90" 
    34 #  include "ldfdyn_substitute.h90" 
    3540#  include "vectopt_loop_substitute.h90" 
    3641   !!---------------------------------------------------------------------- 
    37    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     42   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    3843   !! $Id$  
    3944   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    4146CONTAINS 
    4247 
    43    SUBROUTINE dyn_ldf_lap( kt ) 
     48   SUBROUTINE dyn_ldf_lap( kt, pub, pvb, pua, pva, kpass ) 
    4449      !!---------------------------------------------------------------------- 
    4550      !!                     ***  ROUTINE dyn_ldf_lap  *** 
    4651      !!                        
    47       !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive  
    48       !!      trend and add it to the general trend of tracer equation. 
     52      !! ** Purpose :   Compute the before horizontal momentum diffusive  
     53      !!      trend and add it to the general trend of momentum equation. 
    4954      !! 
    50       !! ** Method  :   The before horizontal momentum diffusion trend is an 
    51       !!      harmonic operator (laplacian type) which separates the divergent 
    52       !!      and rotational parts of the flow. 
    53       !!      Its horizontal components are computed as follow: 
    54       !!         difu = 1/e1u di[ahmt hdivb] - 1/(e2u*e3u) dj-1[e3f ahmf rotb] 
    55       !!         difv = 1/e2v dj[ahmt hdivb] + 1/(e1v*e3v) di-1[e3f ahmf rotb] 
    56       !!      in the rotational part of the diffusion. 
    57       !!      Add this before trend to the general trend (ua,va): 
    58       !!            (ua,va) = (ua,va) + (diffu,diffv) 
    59       !!      'key_trddyn' activated: the two components of the horizontal 
    60       !!                                 diffusion trend are saved. 
     55      !! ** Method  :   The Laplacian operator apply on horizontal velocity is  
     56      !!      writen as :   grad_h( ahm div_h(U )) - curl_h( ahm curl_z(U) )  
    6157      !! 
    62       !! ** Action : - Update (ua,va) with the before iso-level harmonic  
    63       !!               mixing trend. 
     58      !! ** Action : - pua, pva increased by the harmonic operator applied on pub, pvb. 
    6459      !!---------------------------------------------------------------------- 
    65       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     60      INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index 
     61      INTEGER                         , INTENT(in   ) ::   kpass      ! =1/2 first or second passage 
     62      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pub, pvb   ! before velocity  [m/s] 
     63      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva   ! velocity trend   [m/s2] 
    6664      ! 
    67       INTEGER  ::   ji, jj, jk             ! dummy loop indices 
    68       REAL(wp) ::   zua, zva, ze2u, ze1v   ! local scalars 
     65      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     66      REAL(wp) ::   zsign        ! local scalars 
     67      REAL(wp) ::   zua, zva   ! local scalars 
     68      REAL(wp), POINTER, DIMENSION(:,:) ::  zcur, zdiv 
    6969      !!---------------------------------------------------------------------- 
    7070      ! 
    71       IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_lap') 
     71      IF( kt == nit000 .AND. lwp ) THEN 
     72         WRITE(numout,*) 
     73         WRITE(numout,*) 'dyn_ldf : iso-level harmonic (laplacian) operator, pass=', kpass 
     74         WRITE(numout,*) '~~~~~~~ ' 
     75      ENDIF 
    7276      ! 
    73       IF( kt == nit000 ) THEN 
    74          IF(lwp) WRITE(numout,*) 
    75          IF(lwp) WRITE(numout,*) 'dyn_ldf : iso-level harmonic (laplacian) operator' 
    76          IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
     77      IF( nn_timing == 1 )   CALL timing_start('dyn_ldf_lap') 
     78      ! 
     79      CALL wrk_alloc( jpi, jpj, zcur, zdiv )  
     80      ! 
     81      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign 
     82      ELSE                    ;   zsign = -1._wp      !  (eddy viscosity coef. >0) 
    7783      ENDIF 
     84      ! 
    7885      !                                                ! =============== 
    7986      DO jk = 1, jpkm1                                 ! Horizontal slab 
    8087         !                                             ! =============== 
    81          DO jj = 2, jpjm1 
     88         DO jj = 2, jpj 
     89            DO ji = fs_2, jpi   ! vector opt. 
     90               !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1) 
     91               zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * fse3f(ji-1,jj-1,jk) / ( e1f(ji-1,jj-1) * e2f(ji-1,jj-1) )     & 
     92                  &     * (  e2v(ji  ,jj-1) * pvb(ji  ,jj-1,jk) - e2v(ji-1,jj-1) * pvb(ji-1,jj-1,jk)                & 
     93                  &        - e1u(ji-1,jj  ) * pub(ji-1,jj  ,jk) + e1u(ji-1,jj-1) * pub(ji-1,jj-1,jk)  ) * fmask(ji-1,jj-1,jk) 
     94               !                                      ! ahm * div        (computed from 2 to jpi/jpj) 
     95               zdiv(ji,jj)     = ahmt(ji,jj,jk) / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )                    * tmask(ji,jj,jk)     & 
     96                  &     * (  e2u(ji,jj)*fse3u(ji,jj,jk) * pub(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk) * pub(ji-1,jj,jk)    & 
     97                  &        + e1v(ji,jj)*fse3v(ji,jj,jk) * pvb(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk) * pvb(ji,jj-1,jk)  ) 
     98            END DO   
     99         END DO   
     100 
     101         DO jj = 2, jpjm1                             ! - curl( curl) + grad( div ) 
    82102            DO ji = fs_2, fs_jpim1   ! vector opt. 
    83                ze2u = rotb (ji,jj,jk) * fsahmf(ji,jj,jk) * fse3f(ji,jj,jk) 
    84                ze1v = hdivb(ji,jj,jk) * fsahmt(ji,jj,jk) 
    85                ! horizontal diffusive trends 
    86                zua = - ( ze2u - rotb (ji,jj-1,jk)*fsahmf(ji,jj-1,jk)*fse3f(ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   & 
    87                      + ( hdivb(ji+1,jj,jk)*fsahmt(ji+1,jj,jk) - ze1v                   ) / e1u(ji,jj) 
    88  
    89                zva = + ( ze2u - rotb (ji-1,jj,jk)*fsahmf(ji-1,jj,jk)*fse3f(ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   & 
    90                      + ( hdivb(ji,jj+1,jk)*fsahmt(ji,jj+1,jk) - ze1v                   ) / e2v(ji,jj) 
    91  
    92                ! add it to the general momentum trends 
    93                ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
    94                va(ji,jj,jk) = va(ji,jj,jk) + zva 
     103               pua(ji,jj,jk) = pua(ji,jj,jk) + zsign * (                                                  & 
     104                  &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   & 
     105                  &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) /   e1u(ji,jj)                     ) 
     106                  ! 
     107               pva(ji,jj,jk) = pva(ji,jj,jk) + zsign * (                                                  & 
     108                  &                ( zcur(ji,jj  ) - zcur(ji-1,jj) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   & 
     109                  &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) /   e2v(ji,jj)                     ) 
    95110            END DO 
    96111         END DO 
    … …  
    98113      END DO                                           !   End of slab 
    99114      !                                                ! =============== 
     115      CALL wrk_dealloc( jpi, jpj, zcur, zdiv )  
     116      ! 
    100117      IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_lap') 
    101118      ! 
    102119   END SUBROUTINE dyn_ldf_lap 
    103120 
     121 
     122   SUBROUTINE dyn_ldf_blp( kt, pub, pvb, pua, pva ) 
     123      !!---------------------------------------------------------------------- 
     124      !!                 ***  ROUTINE dyn_ldf_blp  *** 
     125      !!                     
     126      !! ** Purpose :   Compute the before lateral momentum viscous trend  
     127      !!              and add it to the general trend of momentum equation. 
     128      !! 
     129      !! ** Method  :   The lateral viscous trends is provided by a bilaplacian 
     130      !!      operator applied to before field (forward in time). 
     131      !!      It is computed by two successive calls to dyn_ldf_lap routine 
     132      !! 
     133      !! ** Action :   pta   updated with the before rotated bilaplacian diffusion 
     134      !!---------------------------------------------------------------------- 
     135      INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index 
     136      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pub, pvb   ! before velocity fields 
     137      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva   ! momentum trend 
     138      ! 
     139      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zulap, zvlap   ! laplacian at u- and v-point 
     140      !!---------------------------------------------------------------------- 
     141      ! 
     142      IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_blp') 
     143      ! 
     144      CALL wrk_alloc( jpi, jpj, jpk, zulap, zvlap )  
     145      ! 
     146      IF( kt == nit000 )  THEN 
     147         IF(lwp) WRITE(numout,*) 
     148         IF(lwp) WRITE(numout,*) 'dyn_ldf_blp : bilaplacian operator momentum ' 
     149         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
     150      ENDIF 
     151      ! 
     152      zulap(:,:,:) = 0._wp 
     153      zvlap(:,:,:) = 0._wp 
     154      ! 
     155      CALL dyn_ldf_lap( kt, pub, pvb, zulap, zvlap, 1 )   ! rotated laplacian applied to ptb (output in zlap) 
     156      ! 
     157      CALL lbc_lnk( zulap(:,:,:) , 'U', -1. )             ! Lateral boundary conditions 
     158      CALL lbc_lnk( zvlap(:,:,:) , 'V', -1. ) 
     159      ! 
     160      CALL dyn_ldf_lap( kt, zulap, zvlap, pua, pva, 2 )   ! rotated laplacian applied to zlap (output in pta) 
     161      ! 
     162      CALL wrk_dealloc( jpi, jpj, jpk, zulap, zvlap )  
     163      ! 
     164      IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_blp') 
     165      ! 
     166   END SUBROUTINE dyn_ldf_blp 
     167 
    104168   !!====================================================================== 
    105169END MODULE dynldf_lap 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r4292 r4596  
    1515   !!            3.2  ! 2009-04  (R. Benshila)  vvl: correction of een scheme 
    1616   !!            3.3  ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
     17   !!            3.7  ! 2014-01  (G. Madec) suppression of velocity curl from in-core memory 
    1718   !!---------------------------------------------------------------------- 
    1819 
    … …  
    2122   !!       vor_ens  : enstrophy conserving scheme       (ln_dynvor_ens=T) 
    2223   !!       vor_ene  : energy conserving scheme          (ln_dynvor_ene=T) 
    23    !!       vor_mix  : mixed enstrophy/energy conserving (ln_dynvor_mix=T) 
    2424   !!       vor_een  : energy and enstrophy conserving   (ln_dynvor_een=T) 
    2525   !!   dyn_vor_init : set and control of the different vorticity option 
    … …  
    3131   USE trdmod         ! ocean dynamics trends  
    3232   USE trdmod_oce     ! ocean variables trends 
     33   ! 
    3334   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    3435   USE prtctl         ! Print control 
    … …  
    4344 
    4445   PUBLIC   dyn_vor        ! routine called by step.F90 
    45    PUBLIC   dyn_vor_init   ! routine called by opa.F90 
     46   PUBLIC   dyn_vor_init   ! routine called by nemogcm.F90 
    4647 
    4748   !                                   !!* Namelist namdyn_vor: vorticity term 
    … …  
    5657   INTEGER ::   ntot = 4   ! =4 total vorticity (relative + planetary) ; =5 coriolis + metric term 
    5758 
     59   REAL(wp) ::   r1_4  = 0.250_wp         ! =1/4 
     60   REAL(wp) ::   r1_8  = 0.125_wp         ! =1/8 
     61   REAL(wp) ::   r1_12 = 1._wp / 12._wp   ! 1/12 
     62    
    5863   !! * Substitutions 
    5964#  include "domzgr_substitute.h90" 
    6065#  include "vectopt_loop_substitute.h90" 
    6166   !!---------------------------------------------------------------------- 
    62    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     67   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    6368   !! $Id$ 
    6469   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    9499         CALL prt_ctl( tab3d_1=ua, clinfo1=' vor1 - Ua: ', mask1=umask, & 
    95100            &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    96          CALL vor_mix( kt ) 
    97          CALL prt_ctl( tab3d_1=ua, clinfo1=' vor2 - Ua: ', mask1=umask, & 
    98             &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    99101         CALL vor_een( kt, ntot, ua, va ) 
    100102         CALL prt_ctl( tab3d_1=ua, clinfo1=' vor3 - Ua: ', mask1=umask, & 
    … …  
    155157            CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_dat, 'DYN', kt ) 
    156158         ELSE 
    157             CALL vor_mix( kt )                               ! total vorticity (mix=ens-ene) 
    158          ENDIF 
     159            CALL vor_ens( kt, nrvm, ua, va )                ! relative vorticity or metric trend (ens) 
     160            CALL vor_ene( kt, ncor, ua, va )                ! planetary vorticity trend (ene) 
     161        ENDIF 
    159162         ! 
    160163      CASE ( 3 )                                       ! energy and enstrophy conserving scheme 
    … …  
    198201      !! 
    199202      !! ** Method  :   Trend evaluated using now fields (centered in time)  
    200       !!      and the Sadourny (1975) flux form formulation : conserves the 
    201       !!      horizontal kinetic energy. 
    202       !!      The trend of the vorticity term is given by: 
    203       !!       * s-coordinate (ln_sco=T), the e3. are inside the derivatives: 
    204       !!          voru = 1/e1u  mj-1[ (rotn+f)/e3f  mi(e1v*e3v vn) ] 
    205       !!          vorv = 1/e2v  mi-1[ (rotn+f)/e3f  mj(e2u*e3u un) ] 
    206       !!       * z-coordinate (default key), e3t=e3u=e3v, the trend becomes: 
    207       !!          voru = 1/e1u  mj-1[ (rotn+f)  mi(e1v vn) ] 
    208       !!          vorv = 1/e2v  mi-1[ (rotn+f)  mj(e2u un) ] 
    209       !!      Add this trend to the general momentum trend (ua,va): 
    210       !!          (ua,va) = (ua,va) + ( voru , vorv ) 
     203      !!       and the Sadourny (1975) flux form formulation : conserves the 
     204      !!       horizontal kinetic energy. 
     205      !!         The general trend of momentum is increased due to the vorticity  
     206      !!       term which is given by: 
     207      !!          voru = 1/e1u  mj-1[ (rvor+f)/e3f  mi(e1v*e3v vn) ] 
     208      !!          vorv = 1/e2v  mi-1[ (rvor+f)/e3f  mj(e2u*e3u un) ] 
     209      !!       where rvor is the relative vorticity 
    211210      !! 
    212211      !! ** Action : - Update (ua,va) with the now vorticity term trend 
    213       !!             - save the trends in (ztrdu,ztrdv) in 2 parts (relative 
    214       !!               and planetary vorticity trends) ('key_trddyn') 
    215212      !! 
    216213      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
    217214      !!---------------------------------------------------------------------- 
    218       ! 
    219215      INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index 
    220216      INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ; 
    … …  
    223219      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend 
    224220      ! 
    225       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    226       REAL(wp) ::   zx1, zy1, zfact2, zx2, zy2   ! local scalars 
    227       REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz 
     221      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
     222      REAL(wp) ::   zx1, zy1, zx2, zy2   ! local scalars 
     223      REAL(wp), POINTER, DIMENSION(:,:) ::   zwx, zwy, zwz   ! 2D workspace 
    228224      !!---------------------------------------------------------------------- 
    229225      ! 
    … …  
    237233         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    238234      ENDIF 
    239  
    240       zfact2 = 0.5 * 0.5      ! Local constant initialization 
    241  
    242 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz ) 
     235      ! 
    243236      !                                                ! =============== 
    244237      DO jk = 1, jpkm1                                 ! Horizontal slab 
    245238         !                                             ! =============== 
    246239         ! 
    247          ! Potential vorticity and horizontal fluxes 
    248          ! ----------------------------------------- 
    249          SELECT CASE( kvor )      ! vorticity considered 
    250          CASE ( 1 )   ;   zwz(:,:) =                  ff(:,:)      ! planetary vorticity (Coriolis) 
    251          CASE ( 2 )   ;   zwz(:,:) =   rotn(:,:,jk)                ! relative  vorticity 
    252          CASE ( 3 )                                                ! metric term 
     240         SELECT CASE( kvor )                 !==  vorticity considered  ==! 
     241         CASE ( 1 )                                         ! planetary vorticity (Coriolis) 
     242            zwz(:,:) = ff(:,:)  
     243         CASE ( 2 )                                         ! relative  vorticity (no fmask) 
     244            DO jj = 1, jpjm1 
     245               DO ji = 1, fs_jpim1   ! vector opt. 
     246                  zwz(ji,jj) = (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    & 
     247                     &          - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) & 
     248                     &       / ( e1f(ji,jj) * e2f(ji,jj) ) 
     249               END DO 
     250            END DO 
     251         CASE ( 3 )                                         ! metric term 
    253252            DO jj = 1, jpjm1 
    254253               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    258257               END DO 
    259258            END DO 
    260          CASE ( 4 )   ;   zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) )    ! total (relative + planetary vorticity) 
    261          CASE ( 5 )                                                ! total (coriolis + metric) 
    262             DO jj = 1, jpjm1 
    263                DO ji = 1, fs_jpim1   ! vector opt. 
    264                   zwz(ji,jj) = ( ff (ji,jj)                                                                       & 
    265                        &       + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
    266                        &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
    267                        &       * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )                                               & 
    268                        &       ) 
    269                END DO 
    270             END DO 
     259         CASE ( 4 )                                         ! total ( planetary + relative vorticity)   (no fmask) 
     260            DO jj = 1, jpjm1 
     261               DO ji = 1, fs_jpim1   ! vector opt. 
     262                  zwz(ji,jj) = ff(ji,jj) + (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    & 
     263                     &                      - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) & 
     264                     &                   / ( e1f(ji,jj) * e2f(ji,jj) ) 
     265               END DO 
     266            END DO 
     267         CASE ( 5 )                                         ! total (coriolis + metric) 
     268            DO jj = 1, jpjm1 
     269               DO ji = 1, fs_jpim1   ! vector opt. 
     270                  zwz(ji,jj) = ff(ji,jj)                                                                        & 
     271                       &     + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
     272                       &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
     273                       &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) 
     274               END DO 
     275            END DO 
     276         CASE DEFAULT                                             ! error 
     277            CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  ) 
    271278         END SELECT 
    272  
     279         ! 
    273280         IF( ln_sco ) THEN 
    274281            zwz(:,:) = zwz(:,:) / fse3f(:,:,jk) 
    … …  
    279286            zwy(:,:) = e1v(:,:) * vn(:,:,jk) 
    280287         ENDIF 
    281  
    282          ! Compute and add the vorticity term trend 
    283          ! ---------------------------------------- 
     288         !                                   !==  compute and add the vorticity term trend  =! 
    284289         DO jj = 2, jpjm1 
    285290            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    288293               zx1 = zwx(ji-1,jj) + zwx(ji-1,jj+1) 
    289294               zx2 = zwx(ji  ,jj) + zwx(ji  ,jj+1) 
    290                pua(ji,jj,jk) = pua(ji,jj,jk) + zfact2 / e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 
    291                pva(ji,jj,jk) = pva(ji,jj,jk) - zfact2 / e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )  
     295               pua(ji,jj,jk) = pua(ji,jj,jk) + r1_4 / e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 
     296               pva(ji,jj,jk) = pva(ji,jj,jk) - r1_4 / e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )  
    292297            END DO   
    293298         END DO   
    … …  
    302307 
    303308 
    304    SUBROUTINE vor_mix( kt ) 
    305       !!---------------------------------------------------------------------- 
    306       !!                 ***  ROUTINE vor_mix  *** 
    307       !! 
    308       !! ** Purpose :   Compute the now total vorticity trend and add it to 
    309       !!      the general trend of the momentum equation. 
    310       !! 
    311       !! ** Method  :   Trend evaluated using now fields (centered in time) 
    312       !!      Mixte formulation : conserves the potential enstrophy of a hori- 
    313       !!      zontally non-divergent flow for (rotzu x uh), the relative vor- 
    314       !!      ticity term and the horizontal kinetic energy for (f x uh), the 
    315       !!      coriolis term. the now trend of the vorticity term is given by: 
    316       !!       * s-coordinate (ln_sco=T), the e3. are inside the derivatives: 
    317       !!          voru = 1/e1u  mj-1(rotn/e3f) mj-1[ mi(e1v*e3v vn) ] 
    318       !!              +1/e1u  mj-1[ f/e3f          mi(e1v*e3v vn) ] 
    319       !!          vorv = 1/e2v  mi-1(rotn/e3f) mi-1[ mj(e2u*e3u un) ] 
    320       !!              +1/e2v  mi-1[ f/e3f          mj(e2u*e3u un) ] 
    321       !!       * z-coordinate (default key), e3t=e3u=e3v, the trend becomes: 
    322       !!          voru = 1/e1u  mj-1(rotn) mj-1[ mi(e1v vn) ] 
    323       !!              +1/e1u  mj-1[ f          mi(e1v vn) ] 
    324       !!          vorv = 1/e2v  mi-1(rotn) mi-1[ mj(e2u un) ] 
    325       !!              +1/e2v  mi-1[ f          mj(e2u un) ] 
    326       !!      Add this now trend to the general momentum trend (ua,va): 
    327       !!          (ua,va) = (ua,va) + ( voru , vorv ) 
    328       !! 
    329       !! ** Action : - Update (ua,va) arrays with the now vorticity term trend 
    330       !!             - Save the trends in (ztrdu,ztrdv) in 2 parts (relative 
    331       !!               and planetary vorticity trends) ('key_trddyn') 
    332       !! 
    333       !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
    334       !!---------------------------------------------------------------------- 
    335       ! 
    336       INTEGER, INTENT(in) ::   kt   ! ocean timestep index 
    337       ! 
    338       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    339       REAL(wp) ::   zfact1, zua, zcua, zx1, zy1   ! local scalars 
    340       REAL(wp) ::   zfact2, zva, zcva, zx2, zy2   !   -      - 
    341       REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz, zww 
    342       !!---------------------------------------------------------------------- 
    343       ! 
    344       IF( nn_timing == 1 )  CALL timing_start('vor_mix') 
    345       ! 
    346       CALL wrk_alloc( jpi, jpj, zwx, zwy, zwz, zww )  
    347       ! 
    348       IF( kt == nit000 ) THEN 
    349          IF(lwp) WRITE(numout,*) 
    350          IF(lwp) WRITE(numout,*) 'dyn:vor_mix : vorticity term: mixed energy/enstrophy conserving scheme' 
    351          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    352       ENDIF 
    353  
    354       zfact1 = 0.5 * 0.25      ! Local constant initialization 
    355       zfact2 = 0.5 * 0.5 
    356  
    357 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz, zww ) 
    358       !                                                ! =============== 
    359       DO jk = 1, jpkm1                                 ! Horizontal slab 
    360          !                                             ! =============== 
    361          ! 
    362          ! Relative and planetary potential vorticity and horizontal fluxes 
    363          ! ---------------------------------------------------------------- 
    364          IF( ln_sco ) THEN         
    365             IF( ln_dynadv_vec ) THEN 
    366                zww(:,:) = rotn(:,:,jk) / fse3f(:,:,jk) 
    367             ELSE                        
    368                DO jj = 1, jpjm1 
    369                   DO ji = 1, fs_jpim1   ! vector opt. 
    370                      zww(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
    371                         &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
    372                         &       * 0.5 / ( e1f(ji,jj) * e2f (ji,jj) * fse3f(ji,jj,jk) ) 
    373                   END DO 
    374                END DO 
    375             ENDIF 
    376             zwz(:,:) = ff  (:,:)    / fse3f(:,:,jk) 
    377             zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) 
    378             zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
    379          ELSE 
    380             IF( ln_dynadv_vec ) THEN 
    381                zww(:,:) = rotn(:,:,jk) 
    382             ELSE                        
    383                DO jj = 1, jpjm1 
    384                   DO ji = 1, fs_jpim1   ! vector opt. 
    385                      zww(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
    386                         &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
    387                         &       * 0.5 / ( e1f(ji,jj) * e2f (ji,jj) ) 
    388                   END DO 
    389                END DO 
    390             ENDIF 
    391             zwz(:,:) = ff (:,:) 
    392             zwx(:,:) = e2u(:,:) * un(:,:,jk) 
    393             zwy(:,:) = e1v(:,:) * vn(:,:,jk) 
    394          ENDIF 
    395  
    396          ! Compute and add the vorticity term trend 
    397          ! ---------------------------------------- 
    398          DO jj = 2, jpjm1 
    399             DO ji = fs_2, fs_jpim1   ! vector opt. 
    400                zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) / e1u(ji,jj) 
    401                zy2 = ( zwy(ji,jj  ) + zwy(ji+1,jj  ) ) / e1u(ji,jj) 
    402                zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) / e2v(ji,jj) 
    403                zx2 = ( zwx(ji  ,jj) + zwx(ji  ,jj+1) ) / e2v(ji,jj) 
    404                ! enstrophy conserving formulation for relative vorticity term 
    405                zua = zfact1 * ( zww(ji  ,jj-1) + zww(ji,jj) ) * ( zy1 + zy2 ) 
    406                zva =-zfact1 * ( zww(ji-1,jj  ) + zww(ji,jj) ) * ( zx1 + zx2 ) 
    407                ! energy conserving formulation for planetary vorticity term 
    408                zcua = zfact2 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 
    409                zcva =-zfact2 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 ) 
    410                ! mixed vorticity trend added to the momentum trends 
    411                ua(ji,jj,jk) = ua(ji,jj,jk) + zcua + zua 
    412                va(ji,jj,jk) = va(ji,jj,jk) + zcva + zva 
    413             END DO   
    414          END DO   
    415          !                                             ! =============== 
    416       END DO                                           !   End of slab 
    417       !                                                ! =============== 
    418       CALL wrk_dealloc( jpi, jpj, zwx, zwy, zwz, zww )  
    419       ! 
    420       IF( nn_timing == 1 )  CALL timing_stop('vor_mix') 
    421       ! 
    422    END SUBROUTINE vor_mix 
    423  
    424  
    425309   SUBROUTINE vor_ens( kt, kvor, pua, pva ) 
    426310      !!---------------------------------------------------------------------- 
    … …  
    434318      !!      potential enstrophy of a horizontally non-divergent flow. the 
    435319      !!      trend of the vorticity term is given by: 
    436       !!       * s-coordinate (ln_sco=T), the e3. are inside the derivative: 
    437       !!          voru = 1/e1u  mj-1[ (rotn+f)/e3f ]  mj-1[ mi(e1v*e3v vn) ] 
    438       !!          vorv = 1/e2v  mi-1[ (rotn+f)/e3f ]  mi-1[ mj(e2u*e3u un) ] 
    439       !!       * z-coordinate (default key), e3t=e3u=e3v, the trend becomes: 
    440       !!          voru = 1/e1u  mj-1[ rotn+f ]  mj-1[ mi(e1v vn) ] 
    441       !!          vorv = 1/e2v  mi-1[ rotn+f ]  mi-1[ mj(e2u un) ] 
     320      !!          voru = 1/e1u  mj-1[ (rvor+f)/e3f ]  mj-1[ mi(e1v*e3v vn) ] 
     321      !!          vorv = 1/e2v  mi-1[ (rvor+f)/e3f ]  mi-1[ mj(e2u*e3u un) ] 
    442322      !!      Add this trend to the general momentum trend (ua,va): 
    443323      !!          (ua,va) = (ua,va) + ( voru , vorv ) 
    444324      !! 
    445325      !! ** Action : - Update (ua,va) arrays with the now vorticity term trend 
    446       !!             - Save the trends in (ztrdu,ztrdv) in 2 parts (relative  
    447       !!               and planetary vorticity trends) ('key_trddyn') 
    448326      !! 
    449327      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
    450328      !!---------------------------------------------------------------------- 
    451       ! 
    452329      INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index 
    453330      INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ; 
    … …  
    456333      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend 
    457334      ! 
    458       INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    459       REAL(wp) ::   zfact1, zuav, zvau   ! temporary scalars 
    460       REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz, zww 
     335      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     336      REAL(wp) ::   zuav, zvau   ! local scalars 
     337      REAL(wp), POINTER, DIMENSION(:,:) ::   zwx, zwy, zwz, zww   ! 2D workspace 
    461338      !!---------------------------------------------------------------------- 
    462339      ! 
    … …  
    470347         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    471348      ENDIF 
    472  
    473       zfact1 = 0.5 * 0.25      ! Local constant initialization 
    474  
    475 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz ) 
    476349      !                                                ! =============== 
    477350      DO jk = 1, jpkm1                                 ! Horizontal slab 
    478351         !                                             ! =============== 
    479          ! 
    480          ! Potential vorticity and horizontal fluxes 
    481          ! ----------------------------------------- 
    482          SELECT CASE( kvor )      ! vorticity considered 
    483          CASE ( 1 )   ;   zwz(:,:) =                  ff(:,:)      ! planetary vorticity (Coriolis) 
    484          CASE ( 2 )   ;   zwz(:,:) =   rotn(:,:,jk)                ! relative  vorticity 
    485          CASE ( 3 )                                                ! metric term 
     352         SELECT CASE( kvor )                 !==  vorticity considered  ==! 
     353         CASE ( 1 )                                         ! planetary vorticity (Coriolis) 
     354            zwz(:,:) = ff(:,:)  
     355         CASE ( 2 )                                         ! relative  vorticity (no fmask) 
     356            DO jj = 1, jpjm1 
     357               DO ji = 1, fs_jpim1   ! vector opt. 
     358                  zwz(ji,jj) = (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    & 
     359                     &          - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) & 
     360                     &       / ( e1f(ji,jj) * e2f(ji,jj) ) 
     361               END DO 
     362            END DO 
     363         CASE ( 3 )                                         ! metric term 
    486364            DO jj = 1, jpjm1 
    487365               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    491369               END DO 
    492370            END DO 
    493          CASE ( 4 )   ;   zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) )    ! total (relative + planetary vorticity) 
    494          CASE ( 5 )                                                ! total (coriolis + metric) 
    495             DO jj = 1, jpjm1 
    496                DO ji = 1, fs_jpim1   ! vector opt. 
    497                   zwz(ji,jj) = ( ff (ji,jj)                                                                       & 
    498                        &       + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
    499                        &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
    500                        &       * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )                                                & 
    501                        &       ) 
    502                END DO 
    503             END DO 
     371         CASE ( 4 )                                         ! total ( planetary + relative vorticity)   (no fmask) 
     372            DO jj = 1, jpjm1 
     373               DO ji = 1, fs_jpim1   ! vector opt. 
     374                  zwz(ji,jj) = ff(ji,jj) + (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    & 
     375                     &                      - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) & 
     376                     &                   / ( e1f(ji,jj) * e2f(ji,jj) ) 
     377               END DO 
     378            END DO 
     379         CASE ( 5 )                                         ! total (coriolis + metric) 
     380            DO jj = 1, jpjm1 
     381               DO ji = 1, fs_jpim1   ! vector opt. 
     382                  zwz(ji,jj) = ff(ji,jj)                                                                       & 
     383                       &     + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
     384                       &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
     385                       &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) 
     386               END DO 
     387            END DO 
     388         CASE DEFAULT                                             ! error 
     389            CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  ) 
    504390         END SELECT 
    505391         ! 
    506          IF( ln_sco ) THEN 
    507             DO jj = 1, jpj                      ! caution: don't use (:,:) for this loop  
    508                DO ji = 1, jpi                   ! it causes optimization problems on NEC in auto-tasking 
    509                   zwz(ji,jj) = zwz(ji,jj) / fse3f(ji,jj,jk) 
    510                   zwx(ji,jj) = e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk) 
    511                   zwy(ji,jj) = e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk) 
    512                END DO 
    513             END DO 
     392         IF( ln_sco ) THEN                   !==  horizontal fluxes  ==! 
     393            zwz(:,:) = zwz(:,:) / fse3f(:,:,jk) 
     394            zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) 
     395            zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
    514396         ELSE 
    515             DO jj = 1, jpj                      ! caution: don't use (:,:) for this loop  
    516                DO ji = 1, jpi                   ! it causes optimization problems on NEC in auto-tasking 
    517                   zwx(ji,jj) = e2u(ji,jj) * un(ji,jj,jk) 
    518                   zwy(ji,jj) = e1v(ji,jj) * vn(ji,jj,jk) 
    519                END DO 
    520             END DO 
     397            zwx(:,:) = e2u(:,:) * un(:,:,jk) 
     398            zwy(:,:) = e1v(:,:) * vn(:,:,jk) 
    521399         ENDIF 
    522          ! 
    523          ! Compute and add the vorticity term trend 
    524          ! ---------------------------------------- 
     400         !                                   !==  compute and add the vorticity term trend  =! 
    525401         DO jj = 2, jpjm1 
    526402            DO ji = fs_2, fs_jpim1   ! vector opt. 
    527                zuav = zfact1 / e1u(ji,jj) * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1)   & 
    528                   &                         + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) 
    529                zvau =-zfact1 / e2v(ji,jj) * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1)   & 
    530                   &                         + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) 
     403               zuav = r1_8 / e1u(ji,jj) * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1)   & 
     404                  &                       + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) 
     405               zvau =-r1_8 / e2v(ji,jj) * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1)   & 
     406                  &                       + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) 
    531407               pua(ji,jj,jk) = pua(ji,jj,jk) + zuav * ( zwz(ji  ,jj-1) + zwz(ji,jj) ) 
    532408               pva(ji,jj,jk) = pva(ji,jj,jk) + zvau * ( zwz(ji-1,jj  ) + zwz(ji,jj) ) 
    … …  
    557433      !! 
    558434      !! ** Action : - Update (ua,va) with the now vorticity term trend 
    559       !!             - save the trends in (ztrdu,ztrdv) in 2 parts (relative 
    560       !!               and planetary vorticity trends) ('key_trddyn') 
    561435      !! 
    562436      !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36 
    563437      !!---------------------------------------------------------------------- 
    564       ! 
    565438      INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index 
    566439      INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ; 
    … …  
    569442      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend 
    570443      !! 
    571       INTEGER  ::   ji, jj, jk                                    ! dummy loop indices 
    572       INTEGER  ::   ierr                                          ! local integer 
    573       REAL(wp) ::   zfac12, zua, zva                              ! local scalars 
    574       REAL(wp) ::   zmsk, ze3                                     ! local scalars 
    575       !                                                           !  3D workspace  
    576       REAL(wp), POINTER    , DIMENSION(:,:  )         :: zwx, zwy, zwz 
    577       REAL(wp), POINTER    , DIMENSION(:,:  )         :: ztnw, ztne, ztsw, ztse 
     444      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     445      INTEGER  ::   ierr         ! local integer 
     446      REAL(wp) ::   zua, zva     ! local scalars 
     447      !                                                           !  2D workspace  
     448      REAL(wp), POINTER    , DIMENSION(:,:  )         ::   zwx, zwy, zwz 
     449      REAL(wp), POINTER    , DIMENSION(:,:  )         ::   ztnw, ztne, ztsw, ztse 
    578450#if defined key_vvl 
    579       REAL(wp), POINTER    , DIMENSION(:,:,:)         :: ze3f     !  3D workspace (lk_vvl=T) 
    580 #else 
    581       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE   :: ze3f     ! lk_vvl=F, ze3f=1/e3f saved one for all 
     451      REAL(wp), POINTER    , DIMENSION(:,:,:)         ::   r1_e3f     !  3D workspace (lk_vvl=T) 
     452#endif 
     453#if ! defined key_vvl 
     454      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE   ::   r1_e3f     ! lk_vvl=F, r1_e3f=1/e3f saved one for all 
    582455#endif 
    583456      !!---------------------------------------------------------------------- 
    … …  
    588461      CALL wrk_alloc( jpi, jpj,      ztnw, ztne, ztsw, ztse )  
    589462#if defined key_vvl 
    590       CALL wrk_alloc( jpi, jpj, jpk, ze3f                   ) 
     463      CALL wrk_alloc( jpi, jpj, jpk, r1_e3f                 ) 
    591464#endif 
    592465      ! 
    … …  
    596469         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    597470#if ! defined key_vvl 
    598          IF( .NOT.ALLOCATED(ze3f) ) THEN 
    599             ALLOCATE( ze3f(jpi,jpj,jpk) , STAT=ierr ) 
     471         IF( .NOT.ALLOCATED(r1_e3f) ) THEN 
     472            ALLOCATE( r1_e3f(jpi,jpj,jpk) , STAT=ierr ) 
    600473            IF( lk_mpp    )   CALL mpp_sum ( ierr ) 
    601474            IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'dyn:vor_een : unable to allocate arrays' ) 
    … …  
    604477      ENDIF 
    605478 
    606       IF( kt == nit000 .OR. lk_vvl ) THEN      ! reciprocal of e3 at F-point (masked averaging of e3t over ocean points) 
     479      IF( kt == nit000 .OR. lk_vvl ) THEN      ! reciprocal of e3 at F-point (masked averaging of e3t) 
    607480         DO jk = 1, jpk 
    608481            DO jj = 1, jpjm1 
    609482               DO ji = 1, jpim1 
    610                   ze3  = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
    611                      &   + fse3t(ji,jj  ,jk)*tmask(ji,jj  ,jk) + fse3t(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) ) 
    612                   zmsk = (                   tmask(ji,jj+1,jk) +                     tmask(ji+1,jj+1,jk)   & 
    613                      &                     + tmask(ji,jj  ,jk) +                     tmask(ji+1,jj  ,jk) ) 
    614                   IF( ze3 /= 0._wp )   ze3f(ji,jj,jk) = zmsk / ze3 
     483                  r1_e3f(ji,jj,jk) = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
     484                     &               + fse3t(ji,jj  ,jk)*tmask(ji,jj  ,jk) + fse3t(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) ) * r1_4 
     485                  IF( r1_e3f(ji,jj,jk) /= 0._wp )   r1_e3f(ji,jj,jk) = 1._wp / r1_e3f(ji,jj,jk) 
    615486               END DO 
    616487            END DO 
    617488         END DO 
    618          CALL lbc_lnk( ze3f, 'F', 1. ) 
    619       ENDIF 
    620  
    621       zfac12 = 1._wp / 12._wp    ! Local constant initialization 
    622  
    623        
    624 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz, ztnw, ztne, ztsw, ztse ) 
     489         CALL lbc_lnk( r1_e3f, 'F', 1. ) 
     490      ENDIF 
    625491      !                                                ! =============== 
    626492      DO jk = 1, jpkm1                                 ! Horizontal slab 
    627493         !                                             ! =============== 
    628           
    629          ! Potential vorticity and horizontal fluxes 
    630          ! ----------------------------------------- 
    631          SELECT CASE( kvor )      ! vorticity considered 
    632          CASE ( 1 )                                                ! planetary vorticity (Coriolis) 
    633             zwz(:,:) = ff(:,:)      * ze3f(:,:,jk) 
    634          CASE ( 2 )                                                ! relative  vorticity 
    635             zwz(:,:) = rotn(:,:,jk) * ze3f(:,:,jk) 
    636          CASE ( 3 )                                                ! metric term 
     494         ! 
     495         SELECT CASE( kvor )                 !==  vorticity considered  ==! 
     496         CASE ( 1 )                                         ! planetary vorticity (Coriolis) 
     497            zwz(:,:) = ff(:,:) * r1_e3f(:,:,jk) 
     498         CASE ( 2 )                                         ! relative  vorticity (no fmask) 
     499            DO jj = 1, jpjm1 
     500               DO ji = 1, fs_jpim1   ! vector opt. 
     501                  zwz(ji,jj) = (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    & 
     502                     &          - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) & 
     503                     &       / ( e1f(ji,jj) * e2f(ji,jj) ) * r1_e3f(ji,jj,jk) 
     504               END DO 
     505            END DO 
     506            CALL lbc_lnk( zwz, 'F', 1. ) 
     507         CASE ( 3 )                                         ! metric term 
    637508            DO jj = 1, jpjm1 
    638509               DO ji = 1, fs_jpim1   ! vector opt. 
    639510                  zwz(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
    640511                       &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
    641                        &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) * ze3f(ji,jj,jk) 
     512                       &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) * r1_e3f(ji,jj,jk) 
    642513               END DO 
    643514            END DO 
    644515            CALL lbc_lnk( zwz, 'F', 1. ) 
    645         CASE ( 4 )                                                ! total (relative + planetary vorticity) 
    646             zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) ) * ze3f(:,:,jk) 
    647          CASE ( 5 )                                                ! total (coriolis + metric) 
    648             DO jj = 1, jpjm1 
    649                DO ji = 1, fs_jpim1   ! vector opt. 
    650                   zwz(ji,jj) = ( ff (ji,jj)                                                                       & 
    651                        &       + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
    652                        &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
    653                        &       * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )                                                & 
    654                        &       ) * ze3f(ji,jj,jk) 
     516         CASE ( 4 )                                         ! total ( planetary + relative vorticity)   (no fmask) 
     517            DO jj = 1, jpjm1 
     518               DO ji = 1, fs_jpim1   ! vector opt. 
     519                  zwz(ji,jj) = (  ff(ji,jj) + (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    & 
     520                     &                      - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) & 
     521                     &                      / ( e1f(ji,jj) * e2f(ji,jj) )    ) * r1_e3f(ji,jj,jk) 
    655522               END DO 
    656523            END DO 
    657524            CALL lbc_lnk( zwz, 'F', 1. ) 
     525         CASE ( 5 )                                         ! total (coriolis + metric) 
     526            DO jj = 1, jpjm1 
     527               DO ji = 1, fs_jpim1   ! vector opt. 
     528                  zwz(ji,jj) = (  ff(ji,jj)                                                                        & 
     529                       &        + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
     530                       &            - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
     531                       &        * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )   ) * r1_e3f(ji,jj,jk) 
     532               END DO 
     533            END DO 
     534            CALL lbc_lnk( zwz, 'F', 1. ) 
     535         CASE DEFAULT                                             ! error 
     536            CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  ) 
    658537         END SELECT 
    659  
     538         ! 
     539         !                                   !==  horizontal fluxes  ==! 
    660540         zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) 
    661541         zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
    662542 
    663          ! Compute and add the vorticity term trend 
    664          ! ---------------------------------------- 
     543         !                                   !==  compute and add the vorticity term trend  =! 
    665544         jj = 2 
    666545         ztne(1,:) = 0   ;   ztnw(1,:) = 0   ;   ztse(1,:) = 0   ;   ztsw(1,:) = 0 
    … …  
    681560         DO jj = 2, jpjm1 
    682561            DO ji = fs_2, fs_jpim1   ! vector opt. 
    683                zua = + zfac12 / e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   & 
    684                   &                           + ztse(ji,jj  ) * zwy(ji  ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) ) 
    685                zva = - zfac12 / e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   & 
    686                   &                           + ztnw(ji,jj  ) * zwx(ji-1,jj  ) + ztne(ji,jj  ) * zwx(ji  ,jj  ) ) 
     562               zua = + r1_12 / e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   & 
     563                  &                          + ztse(ji,jj  ) * zwy(ji  ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) ) 
     564               zva = - r1_12 / e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   & 
     565                  &                          + ztnw(ji,jj  ) * zwx(ji-1,jj  ) + ztne(ji,jj  ) * zwx(ji  ,jj  ) ) 
    687566               pua(ji,jj,jk) = pua(ji,jj,jk) + zua 
    688567               pva(ji,jj,jk) = pva(ji,jj,jk) + zva 
    … …  
    695574      CALL wrk_dealloc( jpi, jpj,      ztnw, ztne, ztsw, ztse )  
    696575#if defined key_vvl 
    697       CALL wrk_dealloc( jpi, jpj, jpk, ze3f                   ) 
     576      CALL wrk_dealloc( jpi, jpj, jpk, r1_e3f                 ) 
    698577#endif 
    699578      ! 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90

    r3294 r4596  
    99 
    1010   !!---------------------------------------------------------------------- 
    11    !!   dyn_zdf      : Update the momentum trend with the vertical diffusion 
    12    !!   dyn_zdf_init : initializations of the vertical diffusion scheme 
     11   !!   dyn_zdf       : Update the momentum trend with the vertical diffusion 
     12   !!   dyn_zdf_init  : initializations of the vertical diffusion scheme 
    1313   !!---------------------------------------------------------------------- 
    14    USE oce             ! ocean dynamics and tracers variables 
    15    USE dom_oce         ! ocean space and time domain variables  
    16    USE zdf_oce         ! ocean vertical physics variables 
     14   USE oce            ! ocean dynamics and tracers variables 
     15   USE dom_oce        ! ocean space and time domain variables  
     16   USE zdf_oce        ! ocean vertical physics variables 
    1717 
    18    USE dynzdf_exp      ! vertical diffusion: explicit (dyn_zdf_exp     routine) 
    19    USE dynzdf_imp      ! vertical diffusion: implicit (dyn_zdf_imp     routine) 
     18   USE dynzdf_exp     ! vertical diffusion: explicit (dyn_zdf_exp     routine) 
     19   USE dynzdf_imp     ! vertical diffusion: implicit (dyn_zdf_imp     routine) 
    2020 
    21    USE ldfdyn_oce      ! ocean dynamics: lateral physics 
    22    USE trdmod          ! ocean active dynamics and tracers trends  
    23    USE trdmod_oce      ! ocean variables trends 
    24    USE in_out_manager  ! I/O manager 
    25    USE lib_mpp         ! MPP library 
    26    USE prtctl          ! Print control 
    27    USE wrk_nemo        ! Memory Allocation 
    28    USE timing          ! Timing 
     21   USE ldfdyn         ! lateral diffusion: eddy viscosity coef. 
     22   USE trdmod         ! ocean active dynamics and tracers trends  
     23   USE trdmod_oce     ! ocean variables trends 
     24   USE in_out_manager ! I/O manager 
     25   USE lib_mpp        ! MPP library 
     26   USE prtctl         ! Print control 
     27   USE wrk_nemo       ! Memory Allocation 
     28   USE timing         ! Timing 
    2929 
    3030   IMPLICIT NONE 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r4486 r4596  
    1919   USE dom_oce         ! ocean space and time domain variables  
    2020   USE sbc_oce         ! surface boundary condition: ocean 
    21    USE domvvl          ! Variable volume 
    22    USE divcur          ! hor. divergence and curl      (div & cur routines) 
    23    USE iom             ! I/O library 
    24    USE restart         ! only for lrst_oce 
    25    USE in_out_manager  ! I/O manager 
    26    USE prtctl          ! Print control 
    27    USE phycst 
    28    USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    29    USE lib_mpp         ! MPP library 
    30    USE bdy_oce 
    31    USE bdy_par          
     21   USE domvvl          ! variable volume 
     22   USE divhor          ! hor. divergence 
     23   USE phycst          ! physical constants 
     24   USE bdy_oce         ! boundary 
     25   USE bdy_par         !  
    3226   USE bdydyn2d        ! bdy_ssh routine 
    33    USE diaar5, ONLY:   lk_diaar5 
    34    USE iom 
    3527#if defined key_agrif 
    3628   USE agrif_opa_update 
    … …  
    4032   USE asminc          ! Assimilation increment 
    4133#endif 
     34   ! 
     35   USE diaar5, ONLY:   lk_diaar5 
     36   USE in_out_manager  ! I/O manager 
     37   USE iom             ! I/O library 
     38   USE restart         ! only for lrst_oce 
     39   USE prtctl          ! Print control 
     40   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
     41   USE lib_mpp         ! MPP library 
    4242   USE wrk_nemo        ! Memory Allocation 
    4343   USE timing          ! Timing 
    … …  
    7070      !!      by the time step. 
    7171      !! 
    72       !! ** action  :   ssha    : after sea surface height 
     72      !! ** action  :   ssha, after sea surface height 
    7373      !! 
    7474      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling. 
    7575      !!---------------------------------------------------------------------- 
    76       ! 
    77       REAL(wp), POINTER, DIMENSION(:,:  ) ::  zhdiv 
    78       INTEGER, INTENT(in) ::   kt                      ! time step 
     76      INTEGER, INTENT(in) ::   kt   ! time step 
    7977      !  
    80       INTEGER             ::   jk                      ! dummy loop indice 
    81       REAL(wp)            ::   z2dt, z1_rau0           ! local scalars 
    82       !!---------------------------------------------------------------------- 
    83       ! 
    84       IF( nn_timing == 1 )  CALL timing_start('ssh_nxt') 
     78      INTEGER  ::   jk              ! dummy loop indice 
     79      REAL(wp) ::   z2dt, z1_rau0   ! local scalars 
     80      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zhdiv   ! 2D workspace 
     81      !!---------------------------------------------------------------------- 
     82      ! 
     83      IF( nn_timing == 1 )   CALL timing_start('ssh_nxt') 
    8584      ! 
    8685      CALL wrk_alloc( jpi, jpj, zhdiv )  
    8786      ! 
    8887      IF( kt == nit000 ) THEN 
    89          ! 
    9088         IF(lwp) WRITE(numout,*) 
    9189         IF(lwp) WRITE(numout,*) 'ssh_nxt : after sea surface height' 
    9290         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    93          ! 
    94       ENDIF 
    95       ! 
    96       CALL div_cur( kt )                              ! Horizontal divergence & Relative vorticity 
     91      ENDIF 
     92      ! 
     93      CALL div_hor( kt )                              ! Horizontal divergence 
    9794      ! 
    9895      z2dt = 2._wp * rdt                              ! set time step size (Euler/Leapfrog) 
    … …  
    103100      !                                           !------------------------------! 
    104101      zhdiv(:,:) = 0._wp 
    105       DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports 
     102      DO jk = 1, jpkm1                                 ! barotropic transport divergence 
    106103        zhdiv(:,:) = zhdiv(:,:) + fse3t_n(:,:,jk) * hdivn(:,:,jk) 
    107104      END DO 
    … …  
    116113      ! These lines are not necessary with time splitting since 
    117114      ! boundary condition on sea level is set during ts loop 
    118 #if defined key_agrif 
     115# if defined key_agrif 
    119116      CALL agrif_ssh( kt ) 
    120 #endif 
    121 #if defined key_bdy 
    122       IF (lk_bdy) THEN 
    123          CALL lbc_lnk( ssha, 'T', 1. ) ! Not sure that's necessary 
    124          CALL bdy_ssh( ssha ) ! Duplicate sea level across open boundaries 
    125       ENDIF 
    126 #endif 
     117# endif 
     118# if defined key_bdy 
     119      IF( lk_bdy ) THEN 
     120         CALL lbc_lnk( ssha, 'T', 1. )    ! Not sure that's necessary 
     121         CALL bdy_ssh( ssha )             ! Duplicate sea level across open boundaries 
     122      ENDIF 
     123# endif 
    127124#endif 
    128125 
    129126#if defined key_asminc 
    130       !                                                ! Include the IAU weighted SSH increment 
    131       IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 
     127      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN     ! Include the IAU weighted SSH increment 
    132128         CALL ssh_asm_inc( kt ) 
    133129         ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:) 
    134130      ENDIF 
    135131#endif 
    136  
    137132      !                                           !------------------------------! 
    138133      !                                           !           outputs            ! 
    … …  
    248243      ! 
    249244      IF( nn_timing == 1 )  CALL timing_stop('wzv') 
    250  
    251  
     245      ! 
    252246   END SUBROUTINE wzv 
     247 
    253248 
    254249   SUBROUTINE ssh_swp( kt ) 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90

    r3294 r4596  
    44   !! Ocean floats :   domain 
    55   !!====================================================================== 
    6    !! History :  OPA          ! 1998-07 (Y.Drillet, CLIPPER)  Original code 
    7    !!            NEMO_3.3.1   ! 2011-09 (C.Bricaud,S.Law-Chune Mercator-Ocean):  
    8                               ! add Ariane convention, Comsecitc changes 
     6   !! History :  OPA    ! 1998-07 (Y.Drillet, CLIPPER)  Original code 
     7   !!   NEMO     3.3.1  ! 2011-09 (C.Bricaud,S.Law-Chune Mercator-Ocean): add Ariane convention, Comsecitc changes 
    98   !!---------------------------------------------------------------------- 
    109#if   defined key_floats   ||   defined key_esopa 
    … …  
    438437      dlx = SIN(dly1) * SIN(dly2) + COS(dly1) * COS(dly2) * COS(dlx2-dlx1) 
    439438      ! 
    440       IF( ABS(dlx) > 1.0_wp ) dlx = 1.0_wp 
    441       ! 
    442       dld = ATAN(DSQRT( 1._wp * ( 1._wp-dlx )/( 1._wp+dlx ) )) * 222.24_wp / dls 
     439      IF( ABS(dlx) > 1.0_wp )   dlx = 1.0_wp 
     440      ! 
     441      dld = ATAN(  SQRT( 1._wp * ( 1._wp-dlx )/( 1._wp+dlx ) )  ) * 222.24_wp / dls 
    443442      flo_dstnce = dld * 1000._wp 
    444443      ! 
    445444   END FUNCTION flo_dstnce 
     445 
    446446 
    447447   INTEGER FUNCTION flo_dom_alloc() 
    … …  
    457457      IF( flo_dom_alloc /= 0 )   CALL ctl_warn('flo_dom_alloc: failed to allocate arrays') 
    458458   END FUNCTION flo_dom_alloc 
    459  
    460459 
    461460#else 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r4334 r4596  
    99   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  modified LF-RA 
    1010   !!            - -  !  2010-10  (C. Ethe, G. Madec) TRC-TRA merge (T-S in 4D) 
     11   !!            3.7  !  2014-01  (G. Madec) suppression of curl and hdiv from the restart 
    1112   !!---------------------------------------------------------------------- 
    1213 
    … …  
    1819   USE oce             ! ocean dynamics and tracers  
    1920   USE dom_oce         ! ocean space and time domain 
     21   USE sbc_ice         ! only lk_lim3  
    2022   USE phycst          ! physical constants 
     23   USE eosbn2          ! equation of state            (eos bn2 routine) 
     24   USE trdmld_oce      ! ocean active mixed layer tracers trends variables 
     25   ! 
    2126   USE in_out_manager  ! I/O manager 
    2227   USE iom             ! I/O module 
    23    USE eosbn2          ! equation of state            (eos bn2 routine) 
    24    USE trdmld_oce      ! ocean active mixed layer tracers trends variables 
    25    USE divcur          ! hor. divergence and curl      (div & cur routines) 
    26    USE sbc_ice, ONLY : lk_lim3 
    2728 
    2829   IMPLICIT NONE 
    … …  
    117118                     CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tsb(:,:,:,jp_tem) ) 
    118119                     CALL iom_rstput( kt, nitrst, numrow, 'sb'     , tsb(:,:,:,jp_sal) ) 
    119                      CALL iom_rstput( kt, nitrst, numrow, 'rotb'   , rotb      ) 
    120                      CALL iom_rstput( kt, nitrst, numrow, 'hdivb'  , hdivb     ) 
    121120                     CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb      ) 
    122121                     ! 
    … …  
    125124                     CALL iom_rstput( kt, nitrst, numrow, 'tn'     , tsn(:,:,:,jp_tem) ) 
    126125                     CALL iom_rstput( kt, nitrst, numrow, 'sn'     , tsn(:,:,:,jp_sal) ) 
    127                      CALL iom_rstput( kt, nitrst, numrow, 'rotn'   , rotn      ) 
    128                      CALL iom_rstput( kt, nitrst, numrow, 'hdivn'  , hdivn     ) 
    129126                     CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn      ) 
    130127                     CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop      ) 
    … …  
    177174   END SUBROUTINE rst_read_open 
    178175 
     176 
    179177   SUBROUTINE rst_read 
    180178      !!----------------------------------------------------------------------  
    … …  
    207205         CALL iom_get( numror, jpdom_autoglo, 'tb'     , tsb(:,:,:,jp_tem) ) 
    208206         CALL iom_get( numror, jpdom_autoglo, 'sb'     , tsb(:,:,:,jp_sal) ) 
    209          CALL iom_get( numror, jpdom_autoglo, 'rotb'   , rotb    ) 
    210          CALL iom_get( numror, jpdom_autoglo, 'hdivb'  , hdivb   ) 
    211207         CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb    ) 
    212208      ELSE 
    … …  
    219215      CALL iom_get( numror, jpdom_autoglo, 'sn'     , tsn(:,:,:,jp_sal) ) 
    220216      CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn    ) 
    221       IF( iom_varid( numror, 'rotn', ldstop = .FALSE. ) > 0 ) THEN 
    222          CALL iom_get( numror, jpdom_autoglo, 'rotn'   , rotn    ) 
    223          CALL iom_get( numror, jpdom_autoglo, 'hdivn'  , hdivn   ) 
    224       ELSE 
    225          CALL div_cur( 0 )                              ! Horizontal divergence & Relative vorticity 
    226       ENDIF 
    227217      IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN 
    228218         CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop    )   ! now    potential density 
    … …  
    242232         ub   (:,:,:)   = un   (:,:,:) 
    243233         vb   (:,:,:)   = vn   (:,:,:) 
    244          rotb (:,:,:)   = rotn (:,:,:) 
    245          hdivb(:,:,:)   = hdivn(:,:,:) 
    246234         sshb (:,:)     = sshn (:,:) 
    247235      ENDIF 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90

    r4147 r4596  
    182182      IF(lwp) WRITE(numout,*) '~~~~~~~~~' 
    183183      ! 
     184      ! Cross land advection hard coded only for ORCA_R2 with 31 levels linear filtred free surface 
     185      ! 
     186      IF( cp_cfg /= 'orca'   )   CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2_L31' ) 
     187      IF( jp_cfg /= 2        )   CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2_L31' ) 
     188      IF( .NOT.lk_dynspg_flt )   CALL ctl_stop( 'cla_init: Cross Land Advection works only with lk_dynspg_flt=T ' ) 
     189      IF( lk_vvl             )   CALL ctl_stop( 'cla_init: Cross Land Advection does not work with lk_vvl=T option' ) 
     190      IF( jpk /= 31          )   CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2_L31' )          
     191      ! 
    184192      !                           ! Allocate arrays for this module 
    185193      ALLOCATE( hdiv_139_101(jpk) , hdiv_139_101_kt(jpk) ,     &    ! Gibraltar 
    … …  
    193201      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
    194202      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'cla_init: unable to allocate arrays' ) 
    195       ! 
    196       IF( .NOT.lk_dynspg_flt )   CALL ctl_stop( 'cla_init: Cross Land Advection works only with lk_dynspg_flt=T ' ) 
    197       ! 
    198       IF( lk_vvl             )   CALL ctl_stop( 'cla_init: Cross Land Advection does not work with lk_vvl=T option' ) 
    199       ! 
    200       IF( jpk /= 31          )   CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2_L31' ) 
    201203      ! 
    202204      !                                        _|_______|_______|_ 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r4328 r4596  
    32163216         STOP 'ctl_opn bad opening' 
    32173217      ENDIF 
    3218  
     3218      ! 
    32193219   END SUBROUTINE ctl_opn 
    32203220 
    3221    SUBROUTINE ctl_nam ( kios, cdnam, ldwp ) 
     3221 
     3222   SUBROUTINE ctl_nam( kios, cdnam, ldwp ) 
    32223223      !!---------------------------------------------------------------------- 
    32233224      !!                  ***  ROUTINE ctl_nam  *** 
    … …  
    32323233      LOGICAL          , INTENT(in   ) ::   ldwp      ! boolean term for print 
    32333234      !!---------------------------------------------------------------------- 
    3234  
    32353235      !  
    3236       ! ---------------- 
    32373236      WRITE (clios, '(I4.0)') kios 
    3238       IF( kios < 0 ) THEN          
    3239          CALL ctl_warn( 'W A R N I N G:  end of record or file while reading namelist ' & 
    3240  &           // TRIM(cdnam) // ' iostat = ' // TRIM(clios) ) 
    3241       ENDIF 
    3242  
    3243       IF( kios > 0 ) THEN 
    3244          CALL ctl_stop( 'E R R O R :   misspelled variable in namelist ' & 
    3245  &           // TRIM(cdnam) // ' iostat = ' // TRIM(clios) ) 
    3246       ENDIF 
     3237      IF( kios < 0 )   CALL ctl_warn( 'W A R N I N G:  end of record or file while reading namelist ' & 
     3238         &                            // TRIM(cdnam) // ' iostat = ' // TRIM(clios) ) 
     3239      IF( kios > 0 )   CALL ctl_stop( 'E R R O R :   misspelled variable in namelist ' & 
     3240         &                            // TRIM(cdnam) // ' iostat = ' // TRIM(clios) ) 
    32473241      kios = 0 
    3248       RETURN 
    3249        
     3242      ! 
    32503243   END SUBROUTINE ctl_nam 
     3244 
    32513245 
    32523246   INTEGER FUNCTION get_unit() 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90

    r4292 r4596  
    66   !! History :  OPA  ! 1997-07  (G. Madec)  multi dimensional coefficients 
    77   !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module 
     8   !!            3.7  ! 2014-01  (F. Lemarie, G. Madec)  restructuration/simplification of ahm specification, 
     9   !!                 !                                  add velocity dependent coefficient and optional read in file 
    810   !!---------------------------------------------------------------------- 
    911 
    … …  
    1618   USE oce             ! ocean dynamics and tracers    
    1719   USE dom_oce         ! ocean space and time domain  
    18    USE ldfdyn_oce      ! ocean dynamics lateral physics 
    1920   USE phycst          ! physical constants 
    20    USE ldfslp          ! ??? 
    21    USE ioipsl 
     21   USE ldfc1d          ! lateral diffusion: 1D case  
     22   USE ldfc2d          ! lateral diffusion: 2D case  
     23!   USE ldfc3d          ! lateral diffusion: 3D case  
     24   ! 
    2225   USE in_out_manager  ! I/O manager 
     26   USE iom             ! I/O module for ehanced bottom friction file 
     27   USE timing          ! Timing 
    2328   USE lib_mpp         ! distribued memory computing library 
    2429   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    … …  
    3035   PUBLIC   ldf_dyn_init   ! called by opa.F90 
    3136 
    32   INTERFACE ldf_zpf 
    33      MODULE PROCEDURE ldf_zpf_1d, ldf_zpf_1d_3d, ldf_zpf_3d 
    34   END INTERFACE 
     37   !                                                !!* Namelist namdyn_ldf : lateral mixing on momentum * 
     38   LOGICAL , PUBLIC ::   ln_dynldf_lap = .TRUE.      !: laplacian operator 
     39   LOGICAL , PUBLIC ::   ln_dynldf_blp = .FALSE.     !: bilaplacian operator 
     40   LOGICAL , PUBLIC ::   ln_dynldf_lev = .FALSE.     !: iso-level direction 
     41   LOGICAL , PUBLIC ::   ln_dynldf_hor = .TRUE.      !: horizontal (geopotential) direction 
     42   LOGICAL , PUBLIC ::   ln_dynldf_iso = .FALSE.     !: iso-neutral direction 
     43   INTEGER , PUBLIC ::   nn_ahm_ijk_t  = 0           !:   ??????  !!gm 
     44   REAL(wp), PUBLIC ::   rn_ahm_0      = 40000._wp   !: lateral laplacian eddy viscosity            [m2/s] 
     45   REAL(wp), PUBLIC ::   rn_ahm_b      =     0._wp   !: lateral laplacian background eddy viscosity [m2/s] 
     46   REAL(wp), PUBLIC ::   rn_bhm_0      = 5.0e+11_wp  !: lateral bilaplacian eddy viscosity          [m4/s] 
     47 
     48   LOGICAL , PUBLIC ::   l_ldfdyn_time = .FALSE.     !: flag for time variation of the lateral eddy viscosity coef. 
     49 
     50   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ahmt, ahmf   !: eddy diffusivity coef. at U- and V-points   [m2/s or m4/s] 
     51 
     52   REAL(wp) ::   r1_12   = 1._wp / 12._wp    ! =1/12 
     53   REAL(wp) ::   r1_4    = 0.25_wp           ! =1/4 
     54   REAL(wp) ::   r1_288  = 1._wp / 288._wp   ! =1/( 12^2 * 2 ) 
    3555 
    3656   !! * Substitutions 
    3757#  include "domzgr_substitute.h90" 
    38    !!---------------------------------------------------------------------- 
    39    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     58#  include "vectopt_loop_substitute.h90" 
     59   !!---------------------------------------------------------------------- 
     60   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    4061   !! $Id$  
    4162   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    4970      !! ** Purpose :   set the horizontal ocean dynamics physics 
    5071      !! 
    51       !! ** Method  :   
    52       !!      -  default option : ahm = constant coef. = rn_ahm_0 (namelist) 
    53       !!      - 'key_dynldf_c1d': ahm = F(depth)                     see ldf_dyn_c1d.h90 
    54       !!      - 'key_dynldf_c2d': ahm = F(latitude,longitude)        see ldf_dyn_c2d.h90 
    55       !!      - 'key_dynldf_c3d': ahm = F(latitude,longitude,depth)  see ldf_dyn_c3d.h90 
    56       !! 
    57       !!      N.B. User defined include files.  By default, 3d and 2d coef. 
    58       !!      are set to a constant value given in the namelist and the 1d 
    59       !!      coefficients are initialized to a hyperbolic tangent vertical 
    60       !!      profile. 
    61       !! 
    62       !! Reference :   Madec, G. and M. Imbard, 1996: Climate Dynamics, 12, 381-388. 
    63       !!---------------------------------------------------------------------- 
    64       INTEGER ::   ioptio         ! ??? 
    65       INTEGER ::   ios            ! Local : output status for namelist read 
    66       LOGICAL ::   ll_print = .FALSE.    ! Logical flag for printing viscosity coef. 
    67       !!  
    68       NAMELIST/namdyn_ldf/ ln_dynldf_lap  , ln_dynldf_bilap,                  & 
    69          &                 ln_dynldf_level, ln_dynldf_hor  , ln_dynldf_iso,   & 
    70          &                 rn_ahm_0_lap   , rn_ahmb_0      , rn_ahm_0_blp ,   & 
    71          &                 rn_cmsmag_1    , rn_cmsmag_2    , rn_cmsh,         & 
    72          &                 rn_ahm_m_lap   , rn_ahm_m_blp 
    73  
     72      !! ** Method  :   the eddy viscosity coef. specification depends on: 
     73      !! 
     74      !!    ln_dynldf_lap = T     laplacian operator 
     75      !!    ln_dynldf_blp = T   bilaplacian operator 
     76      !! 
     77      !!    nn_ahm_ijk_t  =  0 => = constant 
     78      !!                  ! 
     79      !!                  = 10 => = F(z) : constant with a reduction of 1/4 with depth  
     80      !!                  ! 
     81      !!                  =-20 => = F(i,j)   = shape read in 'eddy_viscosity.nc' file 
     82      !!                  = 20    = F(i,j)   = F(e1,e2) or F(e1^3,e2^3) (lap or bilap case) 
     83      !!                  ! 
     84      !!                  =-30 => = F(i,j,k)   = shape read in 'eddy_viscosity.nc'  file 
     85      !!                  = 30    = F(i,j,k)   = 2D (case 20) + decrease with depth (case 10) 
     86      !!                  = 31    = F(i,j,k,t) = F(local velocity) (  |u|e  /12   laplacian operator 
     87      !!                                                           or |u|e^3/12 bilaplacian operator ) 
     88      !! 
     89      !!---------------------------------------------------------------------- 
     90      INTEGER  ::   jk                ! dummy loop indices 
     91      INTEGER  ::   ierr, inum, ios   ! local integer 
     92      REAL(wp) ::   zah0              ! local scalar 
     93      ! 
     94      NAMELIST/namdyn_ldf/ ln_dynldf_lap, ln_dynldf_blp,                  & 
     95         &                 ln_dynldf_lev, ln_dynldf_hor, ln_dynldf_iso,   & 
     96         &                 nn_ahm_ijk_t , rn_ahm_0, rn_ahm_b, rn_bhm_0 
     97      !!---------------------------------------------------------------------- 
     98!!      NAMELIST/namdyn_ldf/ ln_dynldf_lap  , ln_dynldf_bilap,                  & 
     99!!         &                 ln_dynldf_level, ln_dynldf_hor  , ln_dynldf_iso,   & 
     100!!         &                 rn_ahm_0_lap   , rn_ahmb_0      , rn_ahm_0_blp ,   & 
     101! 
     102!!         &                 rn_cmsmag_1    , rn_cmsmag_2    , rn_cmsh,         & 
     103! 
     104!!         &                 rn_ahm_m_lap   , rn_ahm_m_blp 
    74105   !!---------------------------------------------------------------------- 
    75106 
    … …  
    87118         WRITE(numout,*) 'ldf_dyn : lateral momentum physics' 
    88119         WRITE(numout,*) '~~~~~~~' 
    89          WRITE(numout,*) '   Namelist namdyn_ldf : set lateral mixing parameters' 
    90          WRITE(numout,*) '      laplacian operator                      ln_dynldf_lap   = ', ln_dynldf_lap 
    91          WRITE(numout,*) '      bilaplacian operator                    ln_dynldf_bilap = ', ln_dynldf_bilap 
    92          WRITE(numout,*) '      iso-level                               ln_dynldf_level = ', ln_dynldf_level 
    93          WRITE(numout,*) '      horizontal (geopotential)               ln_dynldf_hor   = ', ln_dynldf_hor 
    94          WRITE(numout,*) '      iso-neutral                             ln_dynldf_iso   = ', ln_dynldf_iso 
    95          WRITE(numout,*) '      horizontal laplacian eddy viscosity     rn_ahm_0_lap    = ', rn_ahm_0_lap 
    96          WRITE(numout,*) '      background viscosity                    rn_ahmb_0       = ', rn_ahmb_0 
    97          WRITE(numout,*) '      horizontal bilaplacian eddy viscosity   rn_ahm_0_blp    = ', rn_ahm_0_blp 
    98          WRITE(numout,*) '      upper limit for laplacian eddy visc     rn_ahm_m_lap    = ', rn_ahm_m_lap 
    99          WRITE(numout,*) '      upper limit for bilap eddy viscosity    rn_ahm_m_blp    = ', rn_ahm_m_blp 
    100  
    101       ENDIF 
    102  
    103       ahm0     = rn_ahm_0_lap              ! OLD namelist variables defined from DOCTOR namelist variables 
    104       ahmb0    = rn_ahmb_0 
    105       ahm0_blp = rn_ahm_0_blp 
    106  
    107       ! ... check of lateral diffusive operator on tracers 
    108       !           ==> will be done in trazdf module 
    109  
    110       ! ... Space variation of eddy coefficients 
    111       ioptio = 0 
    112 #if defined key_dynldf_c3d 
    113       IF(lwp) WRITE(numout,*) '   momentum mixing coef. = F( latitude, longitude, depth)' 
    114       ioptio = ioptio+1 
    115 #endif 
    116 #if defined key_dynldf_c2d 
    117       IF(lwp) WRITE(numout,*) '   momentum mixing coef. = F( latitude, longitude)' 
    118       ioptio = ioptio+1 
    119 #endif 
    120 #if defined key_dynldf_c1d 
    121       IF(lwp) WRITE(numout,*) '   momentum mixing coef. = F( depth )' 
    122       ioptio = ioptio+1 
    123       IF( ln_sco ) CALL ctl_stop( 'key_dynldf_c1d cannot be used in s-coordinate (ln_sco)' ) 
    124 #endif 
    125       IF( ioptio == 0 ) THEN 
    126           IF(lwp) WRITE(numout,*) '   momentum mixing coef. = constant  (default option)' 
    127         ELSEIF( ioptio > 1 ) THEN 
    128            CALL ctl_stop( 'use only one of the following keys: key_dynldf_c3d, key_dynldf_c2d, key_dynldf_c1d' ) 
    129       ENDIF 
    130  
    131  
    132       IF( ln_dynldf_bilap ) THEN 
    133          IF(lwp) WRITE(numout,*) '   biharmonic momentum diffusion' 
    134          IF( .NOT. ln_dynldf_lap ) ahm0 = ahm0_blp   ! Allow spatially varying coefs, which use ahm0 as input 
    135          IF( ahm0_blp > 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal viscosity coef. ahm0 must be negative' ) 
    136       ELSE 
    137          IF(lwp) WRITE(numout,*) '   harmonic momentum diff. (default)' 
    138          IF( ahm0 < 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal viscosity coef. ahm0 must be positive' ) 
    139       ENDIF 
    140  
    141  
    142       ! Lateral eddy viscosity 
    143       ! ====================== 
    144 #if defined key_dynldf_c3d 
    145       CALL ldf_dyn_c3d( ll_print )   ! ahm = 3D coef. = F( longitude, latitude, depth ) 
    146 #elif defined key_dynldf_c2d 
    147       CALL ldf_dyn_c2d( ll_print )   ! ahm = 1D coef. = F( longitude, latitude ) 
    148 #elif defined key_dynldf_c1d 
    149       CALL ldf_dyn_c1d( ll_print )   ! ahm = 1D coef. = F( depth ) 
    150 #else 
    151                                      ! Constant coefficients 
    152       IF(lwp) WRITE(numout,*) 
    153       IF(lwp) WRITE(numout,*) 'inildf: constant eddy viscosity coef. ' 
    154       IF(lwp) WRITE(numout,*) '~~~~~~' 
    155       IF(lwp) WRITE(numout,*) '        ahm1 = ahm2 = ahm0 =  ',ahm0 
    156 #endif 
    157      nkahm_smag = 0 
    158 #if defined key_dynldf_smag 
    159      nkahm_smag = 1 
    160 #endif 
    161  
     120         WRITE(numout,*) '   Namelist nam_dynldf : set lateral mixing parameters' 
     121         ! 
     122         WRITE(numout,*) '      type :' 
     123         WRITE(numout,*) '         laplacian operator                   ln_dynldf_lap = ', ln_dynldf_lap 
     124         WRITE(numout,*) '         bilaplacian operator                 ln_dynldf_blp = ', ln_dynldf_blp 
     125         ! 
     126         WRITE(numout,*) '      direction of action :' 
     127         WRITE(numout,*) '         iso-level                            ln_dynldf_lev = ', ln_dynldf_lev 
     128         WRITE(numout,*) '         horizontal (geopotential)            ln_dynldf_hor = ', ln_dynldf_hor 
     129         WRITE(numout,*) '         iso-neutral                          ln_dynldf_iso = ', ln_dynldf_iso 
     130         ! 
     131         WRITE(numout,*) '      coefficients :' 
     132         WRITE(numout,*) '         type of time-space variation         nn_ahm_ijk_t  = ', nn_ahm_ijk_t 
     133         WRITE(numout,*) '         lateral laplacian eddy viscosity     rn_ahm_0_lap  = ', rn_ahm_0, ' m2/s' 
     134         WRITE(numout,*) '         background viscosity (iso case)      rn_ahm_b      = ', rn_ahm_b, ' m2/s' 
     135         WRITE(numout,*) '         lateral bilaplacian eddy viscosity   rn_ahm_0_blp  = ', rn_bhm_0, ' m4/s' 
     136      ENDIF 
     137 
     138      !                                ! Parameter control 
     139      IF( ln_dynldf_blp .AND. ln_dynldf_iso ) THEN     ! iso-neutral bilaplacian not implemented 
     140         CALL ctl_stop( 'dyn_ldf_init: iso-neutral bilaplacian not coded yet' )  
     141      ENDIF 
     142 
     143      ! ... Space/Time variation of eddy coefficients 
     144      !                                               ! allocate the ahm arrays 
     145      ALLOCATE( ahmt(jpi,jpj,jpk) , ahmf(jpi,jpj,jpk) , STAT=ierr ) 
     146      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_dyn_init: failed to allocate arrays') 
     147      ! 
     148      ahmt(:,:,jpk) = 0._wp                           ! last level always 0   
     149      ahmf(:,:,jpk) = 0._wp 
     150      ! 
     151      !                                               ! value of eddy mixing coef. 
     152      IF    ( ln_dynldf_lap ) THEN   ;   zah0 =            rn_ahm_0         !   laplacian operator 
     153      ELSEIF( ln_dynldf_blp ) THEN   ;   zah0 = SQRT( ABS( rn_bhm_0 ) )     ! bilaplacian operator 
     154      ELSE                                                                  ! NO viscous  operator 
     155         CALL ctl_warn( 'ldf_dyn_init: No lateral viscous operator used ' ) 
     156      ENDIF 
     157      ! 
     158      l_ldfdyn_time = .FALSE.                         ! no time variation except in case defined below 
     159      ! 
     160      IF( ln_dynldf_lap .OR. ln_dynldf_blp ) THEN     ! only if a lateral diffusion operator is used 
     161         ! 
     162         SELECT CASE(  nn_ahm_ijk_t  )                ! Specification of space time variations of ahmt, ahmf 
     163         ! 
     164         CASE(   0  )      !==  constant  ==! 
     165            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = constant ' 
     166            ahmt(:,:,:) = zah0 * tmask(:,:,:) 
     167            ahmf(:,:,:) = zah0 * fmask(:,:,:) 
     168            ! 
     169         CASE(  10  )      !==  fixed profile  ==! 
     170            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( depth )' 
     171            ahmt(:,:,1) = zah0 * tmask(:,:,1)                      ! constant surface value 
     172            ahmf(:,:,1) = zah0 * fmask(:,:,1) 
     173            CALL ldf_c1d( 'DYN', r1_4, ahmt(:,:,1), ahmf(:,:,1), ahmt, ahmf ) 
     174            ! 
     175         CASE ( -20 )      !== fixed horizontal shape read in file  ==! 
     176            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F(i,j) read in eddy_viscosity.nc file' 
     177            CALL iom_open( 'eddy_viscosity.nc', inum ) 
     178            CALL iom_get ( inum, jpdom_data, 'ahmt_2D', ahmt(:,:,1) ) 
     179            CALL iom_get ( inum, jpdom_data, 'ahmf_2D', ahmf(:,:,1) ) 
     180            CALL iom_close( inum ) 
     181            DO jk = 2, jpkm1 
     182               ahmt(:,:,jk) = ahmt(:,:,1) * tmask(:,:,jk) 
     183               ahmf(:,:,jk) = ahmf(:,:,1) * fmask(:,:,jk) 
     184            END DO 
     185            ! 
     186         CASE(  20  )      !== fixed horizontal shape  ==! 
     187            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap. or blp. case)' 
     188            IF( ln_dynldf_lap )   CALL ldf_c2d( 'DYN', 'LAP', zah0, ahmt, ahmf )    ! surface value proportional to scale factor 
     189            IF( ln_dynldf_blp )   CALL ldf_c2d( 'DYN', 'BiL', zah0, ahmt, ahmf )    ! surface value proportional to scale factor^3 
     190            ! 
     191         CASE( -30  )      !== fixed 3D shape read in file  ==! 
     192            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F(i,j,k) read in eddy_diffusivity_3D.nc file' 
     193            CALL iom_open( 'eddy_diffusivity_3D.nc', inum ) 
     194            CALL iom_get ( inum, jpdom_data, 'ahmt', ahmt ) 
     195            CALL iom_get ( inum, jpdom_data, 'ahmf', ahmf ) 
     196            CALL iom_close( inum ) 
     197            DO jk = 1, jpkm1 
     198               ahmt(:,:,jk) = ahmt(:,:,jk) * tmask(:,:,jk) 
     199               ahmf(:,:,jk) = ahmf(:,:,jk) * fmask(:,:,jk) 
     200            END DO 
     201            ! 
     202         CASE(  30  )       !==  fixed 3D shape  ==! 
     203            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( latitude, longitude, depth )' 
     204            IF( ln_dynldf_lap )   CALL ldf_c2d( 'DYN', 'LAP', zah0, ahmt, ahmf )    ! surface value proportional to scale factor 
     205            IF( ln_dynldf_blp )   CALL ldf_c2d( 'DYN', 'BiL', zah0, ahmt, ahmf )    ! surface value proportional to scale factor 
     206            !                                                    ! reduction with depth 
     207            CALL ldf_c1d( 'DYN', r1_4, ahmt(:,:,1), ahmf(:,:,1), ahmt, ahmf ) 
     208            ! 
     209         CASE(  31  )       !==  time varying 3D field  ==! 
     210            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( latitude, longitude, depth , time )' 
     211            IF(lwp) WRITE(numout,*) '                                proportional to the velocity : |u|e/12 or |u|e^3/12' 
     212            ! 
     213            l_ldfdyn_time = .TRUE.     ! will be calculated by call to ldf_dyn routine in step.F90 
     214            ! 
     215            CALL ctl_stop( 'STOP', 'ldf_dyn_init: ahm=F(velocity) not yet implemented') 
     216            ! 
     217         CASE DEFAULT 
     218            CALL ctl_stop('ldf_dyn_init: wrong choice for nn_ahm_ijk_t, the type of space-time variation of ahm') 
     219         END SELECT 
     220         ! 
     221      ENDIF 
    162222      ! 
    163223   END SUBROUTINE ldf_dyn_init 
    164224 
    165 #if defined key_dynldf_c3d 
    166 #   include "ldfdyn_c3d.h90" 
    167 #elif defined key_dynldf_c2d 
    168 #   include "ldfdyn_c2d.h90" 
    169 #elif defined key_dynldf_c1d 
    170 #   include "ldfdyn_c1d.h90" 
    171 #endif 
    172  
    173  
    174    SUBROUTINE ldf_zpf_1d( ld_print, pdam, pwam, pbot, pdep, pah ) 
    175       !!---------------------------------------------------------------------- 
    176       !!                  ***  ROUTINE ldf_zpf  *** 
    177       !!                    
    178       !! ** Purpose :   vertical adimensional profile for eddy coefficient 
    179       !! 
    180       !! ** Method  :   1D eddy viscosity coefficients ( depth ) 
    181       !!---------------------------------------------------------------------- 
    182       LOGICAL , INTENT(in   )                 ::   ld_print   ! If true, output arrays on numout 
    183       REAL(wp), INTENT(in   )                 ::   pdam       ! depth of the inflection point 
    184       REAL(wp), INTENT(in   )                 ::   pwam       ! width of inflection 
    185       REAL(wp), INTENT(in   )                 ::   pbot       ! bottom value (0<pbot<= 1) 
    186       REAL(wp), INTENT(in   ), DIMENSION(jpk) ::   pdep       ! depth of the gridpoint (T, U, V, F) 
    187       REAL(wp), INTENT(inout), DIMENSION(jpk) ::   pah        ! adimensional vertical profile 
    188       !! 
    189       INTEGER  ::   jk           ! dummy loop indices 
    190       REAL(wp) ::   zm00, zm01, zmhb, zmhs       ! temporary scalars 
    191       !!---------------------------------------------------------------------- 
    192  
    193       zm00 = TANH( ( pdam - gdept_1d(1    ) ) / pwam ) 
    194       zm01 = TANH( ( pdam - gdept_1d(jpkm1) ) / pwam ) 
    195       zmhs = zm00 / zm01 
    196       zmhb = ( 1.e0 - pbot ) / ( 1.e0 - zmhs ) / zm01 
    197  
    198       DO jk = 1, jpk 
    199          pah(jk) = 1.e0 + zmhb * ( zm00 - TANH( ( pdam - pdep(jk) ) / pwam )  ) 
    200       END DO 
    201  
    202       IF(lwp .AND. ld_print ) THEN      ! Control print 
    203          WRITE(numout,*) 
    204          WRITE(numout,*) '         ahm profile : ' 
    205          WRITE(numout,*) 
    206          WRITE(numout,'("  jk      ahm       ","  depth t-level " )') 
    207          DO jk = 1, jpk 
    208             WRITE(numout,'(i6,2f12.4,3x,2f12.4)') jk, pah(jk), pdep(jk) 
    209          END DO 
    210       ENDIF 
    211       ! 
    212    END SUBROUTINE ldf_zpf_1d 
    213  
    214  
    215    SUBROUTINE ldf_zpf_1d_3d( ld_print, pdam, pwam, pbot, pdep, pah ) 
    216       !!---------------------------------------------------------------------- 
    217       !!                  ***  ROUTINE ldf_zpf  *** 
    218       !! 
    219       !! ** Purpose :   vertical adimensional profile for eddy coefficient 
    220       !! 
    221       !! ** Method  :   1D eddy viscosity coefficients ( depth ) 
    222       !!---------------------------------------------------------------------- 
    223       LOGICAL , INTENT(in   )                         ::   ld_print   ! If true, output arrays on numout 
    224       REAL(wp), INTENT(in   )                         ::   pdam       ! depth of the inflection point 
    225       REAL(wp), INTENT(in   )                         ::   pwam       ! width of inflection 
    226       REAL(wp), INTENT(in   )                         ::   pbot       ! bottom value (0<pbot<= 1) 
    227       REAL(wp), INTENT(in   ), DIMENSION          (:) ::   pdep       ! depth of the gridpoint (T, U, V, F) 
    228       REAL(wp), INTENT(inout), DIMENSION      (:,:,:) ::   pah        ! adimensional vertical profile 
    229       !! 
    230       INTEGER  ::   jk           ! dummy loop indices 
    231       REAL(wp) ::   zm00, zm01, zmhb, zmhs, zcf  ! temporary scalars 
    232       !!---------------------------------------------------------------------- 
    233  
    234       zm00 = TANH( ( pdam - gdept_1d(1    ) ) / pwam ) 
    235       zm01 = TANH( ( pdam - gdept_1d(jpkm1) ) / pwam ) 
    236       zmhs = zm00 / zm01 
    237       zmhb = ( 1.e0 - pbot ) / ( 1.e0 - zmhs ) / zm01 
    238  
    239       DO jk = 1, jpk 
    240          zcf = 1.e0 + zmhb * ( zm00 - TANH( ( pdam - pdep(jk) ) / pwam )  ) 
    241          pah(:,:,jk) = zcf 
    242       END DO 
    243  
    244       IF(lwp .AND. ld_print ) THEN      ! Control print 
    245          WRITE(numout,*) 
    246          WRITE(numout,*) '         ahm profile : ' 
    247          WRITE(numout,*) 
    248          WRITE(numout,'("  jk      ahm       ","  depth t-level " )') 
    249          DO jk = 1, jpk 
    250             WRITE(numout,'(i6,2f12.4,3x,2f12.4)') jk, pah(1,1,jk), pdep(jk) 
    251          END DO 
    252       ENDIF 
    253       ! 
    254    END SUBROUTINE ldf_zpf_1d_3d 
    255  
    256  
    257    SUBROUTINE ldf_zpf_3d( ld_print, pdam, pwam, pbot, pdep, pah ) 
    258       !!---------------------------------------------------------------------- 
    259       !!                  ***  ROUTINE ldf_zpf  *** 
    260       !! 
    261       !! ** Purpose :   vertical adimensional profile for eddy coefficient 
    262       !! 
    263       !! ** Method  :   3D for partial step or s-coordinate 
    264       !!---------------------------------------------------------------------- 
    265       LOGICAL , INTENT(in   )                         ::   ld_print   ! If true, output arrays on numout 
    266       REAL(wp), INTENT(in   )                         ::   pdam       ! depth of the inflection point 
    267       REAL(wp), INTENT(in   )                         ::   pwam       ! width of inflection 
    268       REAL(wp), INTENT(in   )                         ::   pbot       ! bottom value (0<pbot<= 1) 
    269       REAL(wp), INTENT(in   ), DIMENSION      (:,:,:) ::   pdep       ! dep of the gridpoint (T, U, V, F) 
    270       REAL(wp), INTENT(inout), DIMENSION      (:,:,:) ::   pah        ! adimensional vertical profile 
    271       !! 
    272       INTEGER  ::   jk           ! dummy loop indices 
    273       REAL(wp) ::   zm00, zm01, zmhb, zmhs       ! temporary scalars 
    274       !!---------------------------------------------------------------------- 
    275  
    276       zm00 = TANH( ( pdam - gdept_1d(1    ) ) / pwam )    
    277       zm01 = TANH( ( pdam - gdept_1d(jpkm1) ) / pwam ) 
    278       zmhs = zm00 / zm01 
    279       zmhb = ( 1.e0 - pbot ) / ( 1.e0 - zmhs ) / zm01 
    280  
    281       DO jk = 1, jpk 
    282          pah(:,:,jk) = 1.e0 + zmhb * ( zm00 - TANH( ( pdam - pdep(:,:,jk) ) / pwam )  ) 
    283       END DO 
    284  
    285       IF(lwp .AND. ld_print ) THEN      ! Control print 
    286          WRITE(numout,*) 
    287          WRITE(numout,*) '         ahm profile : ' 
    288          WRITE(numout,*) 
    289          WRITE(numout,'("  jk      ahm       ","  depth t-level " )') 
    290          DO jk = 1, jpk 
    291             WRITE(numout,'(i6,2f12.4,3x,2f12.4)') jk, pah(1,1,jk), pdep(1,1,jk) 
    292          END DO 
    293       ENDIF 
    294       ! 
    295    END SUBROUTINE ldf_zpf_3d 
     225 
     226   SUBROUTINE ldf_dyn( kt ) 
     227      !!---------------------------------------------------------------------- 
     228      !!                  ***  ROUTINE ldf_dyn_init  *** 
     229      !!  
     230      !! ** Purpose :   update at kt the momentum lateral mixing coeff. (ahmt and ahmf) 
     231      !! 
     232      !! ** Method  :   time varying eddy viscosity coefficients: 
     233      !! 
     234      !!    nn_ahm_ijk_t = 31    ahmt, ahmf = F(i,j,k,t) = F(local velocity)  
     235      !!                         ( |u|e /12  or  |u|e^3/12 for laplacian or bilaplacian operator ) 
     236      !! 
     237      !! ** action  :    ahmt, ahmf   update at each time step 
     238      !!---------------------------------------------------------------------- 
     239      INTEGER, INTENT(in) ::   kt   ! time step index 
     240      ! 
     241      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     242      REAL(wp) ::   zu2pv2_i_j_p1, zu2pv2_i_j, zu2pv2_i_j_m1, zetmax, zefmax   ! local scalar 
     243      !!---------------------------------------------------------------------- 
     244      ! 
     245      IF( nn_timing == 1 )  CALL timing_start('ldf_dyn') 
     246      ! 
     247      SELECT CASE(  nn_ahm_ijk_t  )       !== Eddy vicosity coefficients ==! 
     248      ! 
     249      CASE(  31  )       !==  time varying 3D field  ==!   = F( local velocity ) 
     250         ! 
     251         IF( ln_dynldf_lap   ) THEN          !   laplacian operator : |u| e /12 
     252            DO jk = 1, jpkm1 
     253               DO jj = 2, jpjm1 
     254                  DO ji = fs_2, fs_jpim1 
     255!!gm should probably be defined as an average of " e1u*u + e2v*v " not the  
     256                     zu2pv2_i_j_p1 = ub(ji+1,jj,jk) * ub(ji+1,jj,jk) + vb(ji,jj+1,jk) * vb(ji,jj+1,jk) 
     257                     zu2pv2_i_j    = ub(ji  ,jj,jk) * ub(ji  ,jj,jk) + vb(ji,jj  ,jk) * vb(ji,jj  ,jk) 
     258                     zu2pv2_i_j_m1 = ub(ji-1,jj,jk) * ub(ji-1,jj,jk) + vb(ji,jj-1,jk) * vb(ji,jj-1,jk) 
     259                     zetmax = MAX( e1t(ji,jj) , e2t(ji,jj) ) 
     260                     zefmax = MAX( e1f(ji,jj) , e2f(ji,jj) ) 
     261                     ahmt(ji,jj,jk) = SQRT( zu2pv2_i_j + zu2pv2_i_j_m1 * r1_288 ) * zetmax * tmask(ji,jj,jk)      ! 288= 12*12 * 2 
     262                     ahmf(ji,jj,jk) = SQRT( zu2pv2_i_j + zu2pv2_i_j_p1 * r1_288 ) * zefmax * fmask(ji,jj,jk) 
     263                  END DO 
     264               END DO 
     265            END DO 
     266         ELSEIF( ln_dynldf_blp ) THEN      ! bilaplacian operator : sqrt( |u| e^3 /12 ) 
     267            DO jk = 1, jpkm1 
     268               DO jj = 2, jpjm1 
     269                  DO ji = fs_2, fs_jpim1 
     270                     zu2pv2_i_j_p1 = ub(ji+1,jj,jk) * ub(ji+1,jj,jk) + vb(ji,jj+1,jk) * vb(ji,jj+1,jk) 
     271                     zu2pv2_i_j    = ub(ji  ,jj,jk) * ub(ji  ,jj,jk) + vb(ji,jj  ,jk) * vb(ji,jj  ,jk) 
     272                     zu2pv2_i_j_m1 = ub(ji-1,jj,jk) * ub(ji-1,jj,jk) + vb(ji,jj-1,jk) * vb(ji,jj-1,jk) 
     273                     zetmax = MAX( e1t(ji,jj) , e2t(ji,jj) ) 
     274                     zefmax = MAX( e1f(ji,jj) , e2f(ji,jj) ) 
     275                     ahmt(ji,jj,jk) = SQRT(  SQRT( zu2pv2_i_j + zu2pv2_i_j_m1 * r1_288 ) * zetmax  ) * zetmax * tmask(ji,jj,jk) 
     276                     ahmf(ji,jj,jk) = SQRT(  SQRT( zu2pv2_i_j + zu2pv2_i_j_p1 * r1_288 ) * zefmax  ) * zefmax * fmask(ji,jj,jk) 
     277                  END DO 
     278               END DO 
     279            END DO 
     280         ENDIF 
     281         ! 
     282         CALL lbc_lnk( ahmt, 'U', 1. )   ;   CALL lbc_lnk( ahmf, 'V', 1. ) 
     283         ! 
     284      END SELECT 
     285      ! 
     286      IF( nn_timing == 1 )  CALL timing_stop('ldf_dyn') 
     287     ! 
     288   END SUBROUTINE ldf_dyn 
    296289 
    297290   !!====================================================================== 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_smag.F90

    r3634 r4596  
    8282      !!  last modified : Maria Luneva, September 2011 
    8383      !!---------------------------------------------------------------------- 
    84       !! * Modules used 
    8584      !! ahm0 here is a background viscosity 
    86  
    87       !! * Arguments 
    88  
    89       !! * local variables 
    9085 
    9186      INTEGER              :: kt                   ! timestep 
    … …  
    9590      REAL (wp), POINTER, DIMENSION (:,:) ::   zux, zuy , zvx ,zvy, zue1, zue2, zve1, zve2  
    9691      REAL (wp)::  zcmsmag_1, zcmsmag_2 , zcmsh 
    97  
    98  
    9992      !!---------------------------------------------------------------------- 
    10093 
    … …  
    188181      ! ahm3 and ahm4 at U- and V-points (used for bilaplacian operator 
    189182      ! ================================  whatever its orientation is) 
    190       ! Here: ahm is proportional to the cube of the maximum of the grid spacing 
    191       !       in the to horizontal direction 
    192183 
    193184      IF( ln_dynldf_bilap ) THEN 
    … …  
    286277   ENDIF 
    287278      ! 
    288  
    289279END SUBROUTINE ldf_dyn_smag 
     280 
    290281#else 
    291282   !!---------------------------------------------------------------------- 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r4488 r4596  
    1111   !!            3.3  ! 2010-10  (G. Nurser, C. Harris, G. Madec)  add Griffies operator 
    1212   !!             -   ! 2010-11  (F. Dupond, G. Madec)  bug correction in slopes just below the ML 
     13   !!            3.7  ! 2013-12  (F. Lemarie, G. Madec)  add limiter on triad slopes 
    1314   !!---------------------------------------------------------------------- 
    14 #if   defined key_ldfslp   ||   defined key_esopa 
     15 
    1516   !!---------------------------------------------------------------------- 
    16    !!   'key_ldfslp'                      Rotation of lateral mixing tensor 
    17    !!---------------------------------------------------------------------- 
     17   !!   ldf_slp       : calculates the slopes of neutral surface   (Madec operator) 
    1818   !!   ldf_slp_grif  : calculates the triads of isoneutral slopes (Griffies operator) 
    19    !!   ldf_slp       : calculates the slopes of neutral surface   (Madec operator) 
    2019   !!   ldf_slp_mxl   : calculates the slopes at the base of the mixed layer (Madec operator) 
    2120   !!   ldf_slp_init  : initialization of the slopes computation 
    … …  
    2322   USE oce            ! ocean dynamics and tracers 
    2423   USE dom_oce        ! ocean space and time domain 
    25    USE ldftra_oce     ! lateral diffusion: traceur 
    26    USE ldfdyn_oce     ! lateral diffusion: dynamics 
     24   USE ldfdyn         ! lateral diffusion: eddy viscosity coef. 
    2725   USE phycst         ! physical constants 
    2826   USE zdfmxl         ! mixed layer depth 
    2927   USE eosbn2         ! equation of states 
    30    USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     28   ! 
    3129   USE in_out_manager ! I/O manager 
    3230   USE prtctl         ! Print control 
     31   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     32   USE lib_mpp        ! distribued memory computing library 
     33   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    3334   USE wrk_nemo       ! work arrays 
    3435   USE timing         ! Timing 
    35    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    3636 
    3737   IMPLICIT NONE 
    … …  
    4040   PUBLIC   ldf_slp        ! routine called by step.F90 
    4141   PUBLIC   ldf_slp_grif   ! routine called by step.F90 
    42    PUBLIC   ldf_slp_init   ! routine called by opa.F90 
    43  
    44    LOGICAL , PUBLIC, PARAMETER ::   lk_ldfslp = .TRUE.     !: slopes flag 
    45    !                                                                             !! Madec operator 
    46    !  Arrays allocated in ldf_slp_init() routine once we know whether we're using the Griffies or Madec operator 
     42   PUBLIC   ldf_slp_init   ! routine called by nemogcm.F90 
     43 
     44   LOGICAL , PUBLIC ::   l_ldfslp = .FALSE.     !: slopes flag 
     45 
     46   LOGICAL , PUBLIC ::   ln_traldf_iso   = .TRUE.       !: iso-neutral direction 
     47   LOGICAL , PUBLIC ::   ln_traldf_triad = .FALSE.      !: griffies triad scheme 
     48 
     49   LOGICAL , PUBLIC ::   ln_triad_iso    = .FALSE.      !: pure horizontal mixing in ML 
     50   LOGICAL , PUBLIC ::   ln_botmix_triad = .FALSE.      !: mixing on bottom 
     51   REAL(wp), PUBLIC ::   rn_slpmax       = 0.01_wp      !: slope limit 
     52 
     53   LOGICAL , PUBLIC ::   l_grad_zps = .FALSE.           !: special treatment for Horz Tgradients w partial steps (triad operator) 
     54    
     55   !                                                     !! Classic operator (Madec) 
    4756   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   uslp, wslpi          !: i_slope at U- and W-points 
    4857   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   vslp, wslpj          !: j-slope at V- and W-points 
    49    !                                                                !! Griffies operator 
     58   !                                                     !! triad operator (Griffies) 
    5059   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   wslp2                !: wslp**2 from Griffies quarter cells 
    5160   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   triadi_g, triadj_g   !: skew flux  slopes relative to geopotentials 
    5261   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   triadi  , triadj     !: isoneutral slopes relative to model-coordinate 
    53  
    54    !                                                              !! Madec operator 
    55    !  Arrays allocated in ldf_slp_init() routine once we know whether we're using the Griffies or Madec operator 
     62   !                                                     !! both operators 
     63   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   ah_wslp2             !: ah * slope^2 at w-point 
     64   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   akz                  !: stabilizing vertical diffusivity 
     65    
     66   !                                                     !! Madec operator 
    5667   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   omlmask           ! mask of the surface mixed layer at T-pt 
    5768   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   uslpml, wslpiml   ! i_slope at U- and W-points just below the mixed layer 
    … …  
    6273   !! * Substitutions 
    6374#  include "domzgr_substitute.h90" 
    64 #  include "ldftra_substitute.h90" 
    65 #  include "ldfeiv_substitute.h90" 
    6675#  include "vectopt_loop_substitute.h90" 
    6776   !!---------------------------------------------------------------------- 
    68    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     77   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    6978   !! $Id$ 
    7079   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    104113      INTEGER  ::   ii0, ii1, iku   ! temporary integer 
    105114      INTEGER  ::   ij0, ij1, ikv   ! temporary integer 
    106       REAL(wp) ::   zeps, zm1_g, zm1_2g, z1_16, zcofw ! local scalars 
     115      REAL(wp) ::   zeps, zm1_g, zm1_2g, z1_16, zcofw, z1_slpmax ! local scalars 
    107116      REAL(wp) ::   zci, zfi, zau, zbu, zai, zbi   !   -      - 
    108117      REAL(wp) ::   zcj, zfj, zav, zbv, zaj, zbj   !   -      - 
    … …  
    117126      CALL wrk_alloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 
    118127 
    119       IF ( ln_traldf_iso .OR. ln_dynldf_iso ) THEN  
    120       
    121          zeps   =  1.e-20_wp        !==   Local constant initialization   ==! 
    122          z1_16  =  1.0_wp / 16._wp 
    123          zm1_g  = -1.0_wp / grav 
    124          zm1_2g = -0.5_wp / grav 
     128      zeps   =  1.e-20_wp        !==   Local constant initialization   ==! 
     129      z1_16  =  1.0_wp / 16._wp 
     130      zm1_g  = -1.0_wp / grav 
     131      zm1_2g = -0.5_wp / grav 
     132      z1_slpmax = 1._wp / rn_slpmax 
     133      ! 
     134      zww(:,:,:) = 0._wp 
     135      zwz(:,:,:) = 0._wp 
     136      ! 
     137      DO jk = 1, jpk             !==   i- & j-gradient of density   ==! 
     138         DO jj = 1, jpjm1 
     139            DO ji = 1, fs_jpim1   ! vector opt. 
     140               zgru(ji,jj,jk) = umask(ji,jj,jk) * ( prd(ji+1,jj  ,jk) - prd(ji,jj,jk) ) 
     141               zgrv(ji,jj,jk) = vmask(ji,jj,jk) * ( prd(ji  ,jj+1,jk) - prd(ji,jj,jk) ) 
     142            END DO 
     143         END DO 
     144      END DO 
     145      IF( ln_zps ) THEN                           ! partial steps correction at the bottom ocean level 
     146# if defined key_vectopt_loop 
     147         DO jj = 1, 1 
     148            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     149# else 
     150         DO jj = 1, jpjm1 
     151            DO ji = 1, jpim1 
     152# endif 
     153               zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) 
     154               zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj) 
     155            END DO 
     156         END DO 
     157      ENDIF 
     158      ! 
     159      zdzr(:,:,1) = 0._wp        !==   Local vertical density gradient at T-point   == !   (evaluated from N^2) 
     160      DO jk = 2, jpkm1 
     161         !                                ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point 
     162         !                                !   trick: tmask(ik  )  = 0   =>   all pn2   = 0   =>   zdzr = 0 
     163         !                                !    else  tmask(ik+1)  = 0   =>   pn2(ik+1) = 0   =>   zdzr divides by 1 
     164         !                                !          umask(ik+1) /= 0   =>   all pn2  /= 0   =>   zdzr divides by 2 
     165         !                                ! NB: 1/(tmask+1) = (1-.5*tmask)  substitute a / by a *  ==> faster 
     166         zdzr(:,:,jk) = zm1_g * ( prd(:,:,jk) + 1._wp )              & 
     167            &                 * ( pn2(:,:,jk) + pn2(:,:,jk+1) ) * ( 1._wp - 0.5_wp * tmask(:,:,jk+1) ) 
     168      END DO 
     169      ! 
     170      !                          !==   Slopes just below the mixed layer   ==! 
     171      CALL ldf_slp_mxl( prd, pn2, zgru, zgrv, zdzr )        ! output: uslpml, vslpml, wslpiml, wslpjml 
     172 
     173 
     174      ! I.  slopes at u and v point      | uslp = d/di( prd ) / d/dz( prd ) 
     175      ! ===========================      | vslp = d/dj( prd ) / d/dz( prd ) 
     176      ! 
     177      DO jk = 2, jpkm1                            !* Slopes at u and v points 
     178         DO jj = 2, jpjm1 
     179            DO ji = fs_2, fs_jpim1   ! vector opt. 
     180               !                                      ! horizontal and vertical density gradient at u- and v-points 
     181               zau = zgru(ji,jj,jk) / e1u(ji,jj) 
     182               zav = zgrv(ji,jj,jk) / e2v(ji,jj) 
     183               zbu = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji+1,jj  ,jk) ) 
     184               zbv = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji  ,jj+1,jk) ) 
     185               !                                      ! bound the slopes: abs(zw.)<= 1/100 and zb..<0 
     186               !                                      ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
     187               zbu = MIN(  zbu, - z1_slpmax * ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,jk)* ABS( zau )  ) 
     188               zbv = MIN(  zbv, - z1_slpmax * ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,jk)* ABS( zav )  ) 
     189               !                                      ! uslp and vslp output in zwz and zww, resp. 
     190               zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) 
     191               zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) ) 
     192               zwz(ji,jj,jk) = ( ( 1. - zfi) * zau / ( zbu - zeps )                                              & 
     193                  &                   + zfi  * uslpml(ji,jj)                                                     & 
     194                  &                          * 0.5_wp * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk)-fse3u(ji,jj,1) )   & 
     195                  &                          / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5._wp ) ) * umask(ji,jj,jk) 
     196               zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps )                                              & 
     197                  &                   + zfj  * vslpml(ji,jj)                                                     & 
     198                  &                          * 0.5_wp * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk)-fse3v(ji,jj,1) )   & 
     199                  &                          / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) * vmask(ji,jj,jk) 
     200!!gm  modif to suppress omlmask.... (as in Griffies case) 
     201!               !                                         ! jk must be >= ML level for zf=1. otherwise  zf=0. 
     202!               zfi = REAL( 1 - 1/(1 + jk / MAX( nmln(ji+1,jj), nmln(ji,jj) ) ), wp ) 
     203!               zfj = REAL( 1 - 1/(1 + jk / MAX( nmln(ji,jj+1), nmln(ji,jj) ) ), wp ) 
     204!               zci = 0.5 * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 10. ) ) 
     205!               zcj = 0.5 * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 10. ) ) 
     206!               zwz(ji,jj,jk) = ( zfi * zai / ( zbi - zeps ) + ( 1._wp - zfi ) * wslpiml(ji,jj) * zci ) * tmask(ji,jj,jk) 
     207!               zww(ji,jj,jk) = ( zfj * zaj / ( zbj - zeps ) + ( 1._wp - zfj ) * wslpjml(ji,jj) * zcj ) * tmask(ji,jj,jk) 
     208!!gm end modif 
     209            END DO 
     210         END DO 
     211      END DO 
     212      CALL lbc_lnk( zwz, 'U', -1. )   ;   CALL lbc_lnk( zww, 'V', -1. )      ! lateral boundary conditions 
     213      ! 
     214      !                                            !* horizontal Shapiro filter 
     215      DO jk = 2, jpkm1 
     216         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only 
     217            DO ji = 2, jpim1 
     218               uslp(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      & 
     219                  &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      & 
     220                  &                       + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      & 
     221                  &                       +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    & 
     222                  &                       + 4.*  zwz(ji  ,jj  ,jk)                       ) 
     223               vslp(ji,jj,jk) = z1_16 * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      & 
     224                  &                       +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      & 
     225                  &                       + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)      & 
     226                  &                       +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )    & 
     227                  &                       + 4.*  zww(ji,jj    ,jk)                       ) 
     228            END DO 
     229         END DO 
     230         DO jj = 3, jpj-2                               ! other rows 
     231            DO ji = fs_2, fs_jpim1   ! vector opt. 
     232               uslp(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      & 
     233                  &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      & 
     234                  &                       + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      & 
     235                  &                       +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    & 
     236                  &                       + 4.*  zwz(ji  ,jj  ,jk)                       ) 
     237               vslp(ji,jj,jk) = z1_16 * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      & 
     238                  &                       +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      & 
     239                  &                       + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)      & 
     240                  &                       +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )    & 
     241                  &                       + 4.*  zww(ji,jj    ,jk)                       ) 
     242            END DO 
     243         END DO 
     244         !                                        !* decrease along coastal boundaries 
     245         DO jj = 2, jpjm1 
     246            DO ji = fs_2, fs_jpim1   ! vector opt. 
     247               uslp(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk  ) ) * 0.5_wp   & 
     248                  &                            * ( umask(ji,jj  ,jk) + umask(ji,jj  ,jk+1) ) * 0.5_wp 
     249               vslp(ji,jj,jk) = vslp(ji,jj,jk) * ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk  ) ) * 0.5_wp   & 
     250                  &                            * ( vmask(ji  ,jj,jk) + vmask(ji  ,jj,jk+1) ) * 0.5_wp 
     251            END DO 
     252         END DO 
     253      END DO 
     254 
     255 
     256      ! II.  slopes at w point           | wslpi = mij( d/di( prd ) / d/dz( prd ) 
     257      ! ===========================      | wslpj = mij( d/dj( prd ) / d/dz( prd ) 
     258      ! 
     259      DO jk = 2, jpkm1 
     260         DO jj = 2, jpjm1 
     261            DO ji = fs_2, fs_jpim1   ! vector opt. 
     262               !                                  !* Local vertical density gradient evaluated from N^2 
     263               zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. ) 
     264               !                                  !* Slopes at w point 
     265               !                                        ! i- & j-gradient of density at w-points 
     266               zci = MAX(  umask(ji-1,jj,jk  ) + umask(ji,jj,jk  )           & 
     267                  &      + umask(ji-1,jj,jk-1) + umask(ji,jj,jk-1) , zeps  ) * e1t(ji,jj) 
     268               zcj = MAX(  vmask(ji,jj-1,jk  ) + vmask(ji,jj,jk-1)           & 
     269                  &      + vmask(ji,jj-1,jk-1) + vmask(ji,jj,jk  ) , zeps  ) *  e2t(ji,jj) 
     270               zai =    (  zgru (ji-1,jj,jk  ) + zgru (ji,jj,jk-1)           & 
     271                  &      + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk  )   ) / zci * tmask (ji,jj,jk) 
     272               zaj =    (  zgrv (ji,jj-1,jk  ) + zgrv (ji,jj,jk-1)           & 
     273                  &      + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk  )   ) / zcj * tmask (ji,jj,jk) 
     274               !                                        ! bound the slopes: abs(zw.)<= 1/100 and zb..<0. 
     275               !                                        ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
     276               zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zai )  ) 
     277               zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zaj )  ) 
     278               !                                        ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.) 
     279               zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) )   ! zfk=1 in the ML otherwise zfk=0 
     280               zck = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10._wp ) 
     281               zwz(ji,jj,jk) = (  zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk  ) * tmask(ji,jj,jk) 
     282               zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk  ) * tmask(ji,jj,jk) 
     283 
     284!!gm  modif to suppress omlmask....  (as in Griffies operator) 
     285!               !                                         ! jk must be >= ML level for zfk=1. otherwise  zfk=0. 
     286!               zfk = REAL( 1 - 1/(1 + jk / nmln(ji+1,jj)), wp ) 
     287!               zck = fsdepw(ji,jj,jk)    / MAX( hmlp(ji,jj), 10. ) 
     288!               zwz(ji,jj,jk) = ( zfk * zai / ( zbi - zeps ) + ( 1._wp - zfk ) * wslpiml(ji,jj) * zck ) * tmask(ji,jj,jk) 
     289!               zww(ji,jj,jk) = ( zfk * zaj / ( zbj - zeps ) + ( 1._wp - zfk ) * wslpjml(ji,jj) * zck ) * tmask(ji,jj,jk) 
     290!!gm end modif 
     291            END DO 
     292         END DO 
     293      END DO 
     294      CALL lbc_lnk( zwz, 'T', -1. )   ;    CALL lbc_lnk( zww, 'T', -1. )      ! lateral boundary conditions 
     295      ! 
     296      !                                           !* horizontal Shapiro filter 
     297      DO jk = 2, jpkm1 
     298         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only 
     299            DO ji = 2, jpim1 
     300               zcofw = tmask(ji,jj,jk) * z1_16 
     301               wslpi(ji,jj,jk) = (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     & 
     302                    &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     & 
     303                    &                + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     & 
     304                    &                +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   & 
     305                    &                + 4.*  zwz(ji  ,jj  ,jk)                         ) * zcofw 
     306 
     307               wslpj(ji,jj,jk) = (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     & 
     308                    &                +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     & 
     309                    &                + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     & 
     310                    &                +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   & 
     311                    &                + 4.*  zww(ji  ,jj  ,jk)                         ) * zcofw 
     312            END DO 
     313         END DO 
     314         DO jj = 3, jpj-2                               ! other rows 
     315            DO ji = fs_2, fs_jpim1   ! vector opt. 
     316               zcofw = tmask(ji,jj,jk) * z1_16 
     317               wslpi(ji,jj,jk) = (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     & 
     318                    &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     & 
     319                    &                + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     & 
     320                    &                +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   & 
     321                    &                + 4.*  zwz(ji  ,jj  ,jk)                         ) * zcofw 
     322 
     323               wslpj(ji,jj,jk) = (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     & 
     324                    &                +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     & 
     325                    &                + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     & 
     326                    &                +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   & 
     327                    &                + 4.*  zww(ji  ,jj  ,jk)                         ) * zcofw 
     328            END DO 
     329         END DO 
     330         !                                        !* decrease along coastal boundaries 
     331         DO jj = 2, jpjm1 
     332            DO ji = fs_2, fs_jpim1   ! vector opt. 
     333               zck =   ( umask(ji,jj,jk) + umask(ji-1,jj,jk) )   & 
     334                  &  * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25 
     335               wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck 
     336               wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck 
     337            END DO 
     338         END DO 
     339      END DO 
     340 
     341      ! III.  Specific grid points 
     342      ! =========================== 
     343      ! 
     344      IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN     !  ORCA_R4 configuration: horizontal diffusion in specific area 
     345         !                                                    ! Gibraltar Strait 
     346         ij0 =  50   ;   ij1 =  53 
     347         ii0 =  69   ;   ii1 =  71   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
     348         ij0 =  51   ;   ij1 =  53 
     349         ii0 =  68   ;   ii1 =  71   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
     350         ii0 =  69   ;   ii1 =  71   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
     351         ii0 =  69   ;   ii1 =  71   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    125352         ! 
    126          zww(:,:,:) = 0._wp 
    127          zwz(:,:,:) = 0._wp 
    128          ! 
    129          DO jk = 1, jpk             !==   i- & j-gradient of density   ==! 
    130             DO jj = 1, jpjm1 
    131                DO ji = 1, fs_jpim1   ! vector opt. 
    132                   zgru(ji,jj,jk) = umask(ji,jj,jk) * ( prd(ji+1,jj  ,jk) - prd(ji,jj,jk) ) 
    133                   zgrv(ji,jj,jk) = vmask(ji,jj,jk) * ( prd(ji  ,jj+1,jk) - prd(ji,jj,jk) ) 
    134                END DO 
    135             END DO 
    136          END DO 
    137          IF( ln_zps ) THEN                           ! partial steps correction at the bottom ocean level 
    138 # if defined key_vectopt_loop 
    139             DO jj = 1, 1 
    140                DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    141 # else 
    142             DO jj = 1, jpjm1 
    143                DO ji = 1, jpim1 
    144 # endif 
    145                   zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) 
    146                   zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj) 
    147                END DO 
    148             END DO 
    149          ENDIF 
    150          ! 
    151          zdzr(:,:,1) = 0._wp        !==   Local vertical density gradient at T-point   == !   (evaluated from N^2) 
    152          DO jk = 2, jpkm1 
    153             !                                ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point 
    154             !                                !   trick: tmask(ik  )  = 0   =>   all pn2   = 0   =>   zdzr = 0 
    155             !                                !    else  tmask(ik+1)  = 0   =>   pn2(ik+1) = 0   =>   zdzr divides by 1 
    156             !                                !          umask(ik+1) /= 0   =>   all pn2  /= 0   =>   zdzr divides by 2 
    157             !                                ! NB: 1/(tmask+1) = (1-.5*tmask)  substitute a / by a *  ==> faster 
    158             zdzr(:,:,jk) = zm1_g * ( prd(:,:,jk) + 1._wp )              & 
    159                &                 * ( pn2(:,:,jk) + pn2(:,:,jk+1) ) * ( 1._wp - 0.5_wp * tmask(:,:,jk+1) ) 
    160          END DO 
    161          ! 
    162          !                          !==   Slopes just below the mixed layer   ==! 
    163          CALL ldf_slp_mxl( prd, pn2, zgru, zgrv, zdzr )        ! output: uslpml, vslpml, wslpiml, wslpjml 
    164  
    165  
    166          ! I.  slopes at u and v point      | uslp = d/di( prd ) / d/dz( prd ) 
    167          ! ===========================      | vslp = d/dj( prd ) / d/dz( prd ) 
    168          ! 
    169          DO jk = 2, jpkm1                            !* Slopes at u and v points 
    170             DO jj = 2, jpjm1 
    171                DO ji = fs_2, fs_jpim1   ! vector opt. 
    172                   !                                      ! horizontal and vertical density gradient at u- and v-points 
    173                   zau = zgru(ji,jj,jk) / e1u(ji,jj) 
    174                   zav = zgrv(ji,jj,jk) / e2v(ji,jj) 
    175                   zbu = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji+1,jj  ,jk) ) 
    176                   zbv = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji  ,jj+1,jk) ) 
    177                   !                                      ! bound the slopes: abs(zw.)<= 1/100 and zb..<0 
    178                   !                                      ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
    179                   zbu = MIN(  zbu, -100._wp* ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,jk)* ABS( zau )  ) 
    180                   zbv = MIN(  zbv, -100._wp* ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,jk)* ABS( zav )  ) 
    181                   !                                      ! uslp and vslp output in zwz and zww, resp. 
    182                   zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) 
    183                   zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) ) 
    184                   zwz(ji,jj,jk) = ( ( 1. - zfi) * zau / ( zbu - zeps )                                              & 
    185                      &                   + zfi  * uslpml(ji,jj)                                                     & 
    186                      &                          * 0.5_wp * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk)-fse3u(ji,jj,1) )   & 
    187                      &                          / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5._wp ) ) * umask(ji,jj,jk) 
    188                   zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps )                                              & 
    189                      &                   + zfj  * vslpml(ji,jj)                                                     & 
    190                      &                          * 0.5_wp * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk)-fse3v(ji,jj,1) )   & 
    191                      &                          / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) * vmask(ji,jj,jk) 
    192 !!gm  modif to suppress omlmask.... (as in Griffies case) 
    193 !                  !                                         ! jk must be >= ML level for zf=1. otherwise  zf=0. 
    194 !                  zfi = REAL( 1 - 1/(1 + jk / MAX( nmln(ji+1,jj), nmln(ji,jj) ) ), wp ) 
    195 !                  zfj = REAL( 1 - 1/(1 + jk / MAX( nmln(ji,jj+1), nmln(ji,jj) ) ), wp ) 
    196 !                  zci = 0.5 * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 10. ) ) 
    197 !                  zcj = 0.5 * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 10. ) ) 
    198 !                  zwz(ji,jj,jk) = ( zfi * zai / ( zbi - zeps ) + ( 1._wp - zfi ) * wslpiml(ji,jj) * zci ) * tmask(ji,jj,jk) 
    199 !                  zww(ji,jj,jk) = ( zfj * zaj / ( zbj - zeps ) + ( 1._wp - zfj ) * wslpjml(ji,jj) * zcj ) * tmask(ji,jj,jk) 
    200 !!gm end modif 
    201                END DO 
    202             END DO 
    203          END DO 
    204          CALL lbc_lnk( zwz, 'U', -1. )   ;   CALL lbc_lnk( zww, 'V', -1. )      ! lateral boundary conditions 
    205          ! 
    206          !                                            !* horizontal Shapiro filter 
    207          DO jk = 2, jpkm1 
    208             DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only 
    209                DO ji = 2, jpim1 
    210                   uslp(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      & 
    211                      &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      & 
    212                      &                       + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      & 
    213                      &                       +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    & 
    214                      &                       + 4.*  zwz(ji  ,jj  ,jk)                       ) 
    215                   vslp(ji,jj,jk) = z1_16 * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      & 
    216                      &                       +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      & 
    217                      &                       + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)      & 
    218                      &                       +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )    & 
    219                      &                       + 4.*  zww(ji,jj    ,jk)                       ) 
    220                END DO 
    221             END DO 
    222             DO jj = 3, jpj-2                               ! other rows 
    223                DO ji = fs_2, fs_jpim1   ! vector opt. 
    224                   uslp(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      & 
    225                      &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      & 
    226                      &                       + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      & 
    227                      &                       +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    & 
    228                      &                       + 4.*  zwz(ji  ,jj  ,jk)                       ) 
    229                   vslp(ji,jj,jk) = z1_16 * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      & 
    230                      &                       +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      & 
    231                      &                       + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)         & 
    232                      &                       +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )    & 
    233                      &                       + 4.*  zww(ji,jj    ,jk)                       ) 
    234                END DO 
    235             END DO 
    236             !                                        !* decrease along coastal boundaries 
    237             DO jj = 2, jpjm1 
    238                DO ji = fs_2, fs_jpim1   ! vector opt. 
    239                   uslp(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk  ) ) * 0.5_wp   & 
    240                      &                            * ( umask(ji,jj  ,jk) + umask(ji,jj  ,jk+1) ) * 0.5_wp 
    241                   vslp(ji,jj,jk) = vslp(ji,jj,jk) * ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk  ) ) * 0.5_wp   & 
    242                      &                            * ( vmask(ji  ,jj,jk) + vmask(ji  ,jj,jk+1) ) * 0.5_wp 
    243                END DO 
    244             END DO 
    245          END DO 
    246  
    247  
    248          ! II.  slopes at w point           | wslpi = mij( d/di( prd ) / d/dz( prd ) 
    249          ! ===========================      | wslpj = mij( d/dj( prd ) / d/dz( prd ) 
    250          ! 
    251          DO jk = 2, jpkm1 
    252             DO jj = 2, jpjm1 
    253                DO ji = fs_2, fs_jpim1   ! vector opt. 
    254                   !                                  !* Local vertical density gradient evaluated from N^2 
    255                   zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. ) 
    256                   !                                  !* Slopes at w point 
    257                   !                                        ! i- & j-gradient of density at w-points 
    258                   zci = MAX(  umask(ji-1,jj,jk  ) + umask(ji,jj,jk  )           & 
    259                      &      + umask(ji-1,jj,jk-1) + umask(ji,jj,jk-1) , zeps  ) * e1t(ji,jj) 
    260                   zcj = MAX(  vmask(ji,jj-1,jk  ) + vmask(ji,jj,jk-1)           & 
    261                      &      + vmask(ji,jj-1,jk-1) + vmask(ji,jj,jk  ) , zeps  ) *  e2t(ji,jj) 
    262                   zai =    (  zgru (ji-1,jj,jk  ) + zgru (ji,jj,jk-1)           & 
    263                      &      + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk  )   ) / zci * tmask (ji,jj,jk) 
    264                   zaj =    (  zgrv (ji,jj-1,jk  ) + zgrv (ji,jj,jk-1)           & 
    265                      &      + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk  )   ) / zcj * tmask (ji,jj,jk) 
    266                   !                                        ! bound the slopes: abs(zw.)<= 1/100 and zb..<0. 
    267                   !                                        ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
    268                   zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zai )  ) 
    269                   zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zaj )  ) 
    270                   !                                        ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.) 
    271                   zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) )   ! zfk=1 in the ML otherwise zfk=0 
    272                   zck = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10._wp ) 
    273                   zwz(ji,jj,jk) = (  zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk  ) * tmask(ji,jj,jk) 
    274                   zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk  ) * tmask(ji,jj,jk) 
    275  
    276 !!gm  modif to suppress omlmask....  (as in Griffies operator) 
    277 !                  !                                         ! jk must be >= ML level for zfk=1. otherwise  zfk=0. 
    278 !                  zfk = REAL( 1 - 1/(1 + jk / nmln(ji+1,jj)), wp ) 
    279 !                  zck = fsdepw(ji,jj,jk)    / MAX( hmlp(ji,jj), 10. ) 
    280 !                  zwz(ji,jj,jk) = ( zfk * zai / ( zbi - zeps ) + ( 1._wp - zfk ) * wslpiml(ji,jj) * zck ) * tmask(ji,jj,jk) 
    281 !                  zww(ji,jj,jk) = ( zfk * zaj / ( zbj - zeps ) + ( 1._wp - zfk ) * wslpjml(ji,jj) * zck ) * tmask(ji,jj,jk) 
    282 !!gm end modif 
    283                END DO 
    284             END DO 
    285          END DO 
    286          CALL lbc_lnk( zwz, 'T', -1. )   ;    CALL lbc_lnk( zww, 'T', -1. )      ! lateral boundary conditions 
    287          ! 
    288          !                                           !* horizontal Shapiro filter 
    289          DO jk = 2, jpkm1 
    290             DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only 
    291                DO ji = 2, jpim1 
    292                   zcofw = tmask(ji,jj,jk) * z1_16 
    293                   wslpi(ji,jj,jk) = (          zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     & 
    294                        &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     & 
    295                        &                + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     & 
    296                        &                +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   & 
    297                        &                + 4.*  zwz(ji  ,jj  ,jk)                         ) * zcofw 
    298  
    299                   wslpj(ji,jj,jk) = (          zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     & 
    300                        &                +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     & 
    301                        &                + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     & 
    302                        &                +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   & 
    303                        &                + 4.*  zww(ji  ,jj  ,jk)                         ) * zcofw 
    304                END DO 
    305             END DO 
    306             DO jj = 3, jpj-2                               ! other rows 
    307                DO ji = fs_2, fs_jpim1   ! vector opt. 
    308                   zcofw = tmask(ji,jj,jk) * z1_16 
    309                   wslpi(ji,jj,jk) = (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     & 
    310                        &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     & 
    311                        &                + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     & 
    312                        &                +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   & 
    313                        &                + 4.*  zwz(ji  ,jj  ,jk)                         ) * zcofw 
    314  
    315                   wslpj(ji,jj,jk) = (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     & 
    316                        &                +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     & 
    317                        &                + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     & 
    318                        &                +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   & 
    319                        &                + 4.*  zww(ji  ,jj  ,jk)                         ) * zcofw 
    320                END DO 
    321             END DO 
    322             !                                        !* decrease along coastal boundaries 
    323             DO jj = 2, jpjm1 
    324                DO ji = fs_2, fs_jpim1   ! vector opt. 
    325                   zck =   ( umask(ji,jj,jk) + umask(ji-1,jj,jk) )   & 
    326                      &  * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25 
    327                   wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck 
    328                   wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck 
    329                END DO 
    330             END DO 
    331          END DO 
    332  
    333          ! III.  Specific grid points 
    334          ! =========================== 
    335          ! 
    336          IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN     !  ORCA_R4 configuration: horizontal diffusion in specific area 
    337             !                                                    ! Gibraltar Strait 
    338             ij0 =  50   ;   ij1 =  53 
    339             ii0 =  69   ;   ii1 =  71   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    340             ij0 =  51   ;   ij1 =  53 
    341             ii0 =  68   ;   ii1 =  71   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    342             ii0 =  69   ;   ii1 =  71   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    343             ii0 =  69   ;   ii1 =  71   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    344             ! 
    345             !                                                    ! Mediterrannean Sea 
    346             ij0 =  49   ;   ij1 =  56 
    347             ii0 =  71   ;   ii1 =  90   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    348             ij0 =  50   ;   ij1 =  56 
    349             ii0 =  70   ;   ii1 =  90   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    350             ii0 =  71   ;   ii1 =  90   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    351             ii0 =  71   ;   ii1 =  90   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    352          ENDIF 
    353  
    354  
    355          ! IV. Lateral boundary conditions 
    356          ! =============================== 
    357          CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. ) 
    358          CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. ) 
    359  
    360  
    361          IF(ln_ctl) THEN 
    362             CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp  - u : ', tab3d_2=vslp,  clinfo2=' v : ', kdim=jpk) 
    363             CALL prt_ctl(tab3d_1=wslpi, clinfo1=' slp  - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk) 
    364          ENDIF 
    365          ! 
    366  
    367       ELSEIF ( lk_vvl ) THEN  
    368   
    369          IF(lwp) THEN  
    370             WRITE(numout,*) '          Horizontal mixing in s-coordinate: slope = slope of s-surfaces'  
    371          ENDIF  
    372  
    373          ! geopotential diffusion in s-coordinates on tracers and/or momentum  
    374          ! The slopes of s-surfaces are computed at each time step due to vvl  
    375          ! The slopes for momentum diffusion are i- or j- averaged of those on tracers  
    376  
    377          ! set the slope of diffusion to the slope of s-surfaces  
    378          !      ( c a u t i o n : minus sign as fsdep has positive value )  
    379          DO jk = 1, jpk  
    380             DO jj = 2, jpjm1  
    381                DO ji = fs_2, fs_jpim1   ! vector opt.  
    382                   uslp(ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk)  
    383                   vslp(ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk)  
    384                   wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5  
    385                   wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5  
    386                END DO  
    387             END DO  
    388          END DO  
    389  
    390          ! Lateral boundary conditions on the slopes  
    391          CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. )  
    392          CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. )  
    393    
    394          if( kt == nit000 ) then  
    395             IF(lwp) WRITE(numout,*) ' max slop: u',SQRT( MAXVAL(uslp*uslp)), ' v ', SQRT(MAXVAL(vslp)),  &  
    396                &                             ' wi', sqrt(MAXVAL(wslpi)), ' wj', sqrt(MAXVAL(wslpj))  
    397          endif  
    398    
    399          IF(ln_ctl) THEN  
    400             CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp  - u : ', tab3d_2=vslp,  clinfo2=' v : ', kdim=jpk)  
    401             CALL prt_ctl(tab3d_1=wslpi, clinfo1=' slp  - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk)  
    402          ENDIF  
    403  
     353         !                                                    ! Mediterrannean Sea 
     354         ij0 =  49   ;   ij1 =  56 
     355         ii0 =  71   ;   ii1 =  90   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
     356         ij0 =  50   ;   ij1 =  56 
     357         ii0 =  70   ;   ii1 =  90   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
     358         ii0 =  71   ;   ii1 =  90   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
     359         ii0 =  71   ;   ii1 =  90   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 
    404360      ENDIF 
    405        
     361 
     362 
     363      ! IV. Lateral boundary conditions 
     364      ! =============================== 
     365      CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. ) 
     366      CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. ) 
     367 
     368 
     369      IF(ln_ctl) THEN 
     370         CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp  - u : ', tab3d_2=vslp,  clinfo2=' v : ', kdim=jpk) 
     371         CALL prt_ctl(tab3d_1=wslpi, clinfo1=' slp  - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk) 
     372      ENDIF 
     373      ! 
    406374      CALL wrk_dealloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 
    407375      ! 
    … …  
    416384      !! 
    417385      !! ** Purpose :   Compute the squared slopes of neutral surfaces (slope 
    418       !!      of iso-pycnal surfaces referenced locally) (ln_traldf_grif=T) 
     386      !!      of iso-pycnal surfaces referenced locally) (ln_traldf_triad=T) 
    419387      !!      at W-points using the Griffies quarter-cells. 
    420388      !! 
    … …  
    435403      REAL(wp) ::   zdyrho_raw, ztj_coord, ztj_raw, ztj_lim, ztj_g_raw, ztj_g_lim 
    436404      REAL(wp) ::   zdzrho_raw 
    437       REAL(wp) ::   zbeta0 
     405      REAL(wp) ::   zbeta0, ze3_e1, ze3_e2 
    438406      REAL(wp), POINTER, DIMENSION(:,:)     ::   z1_mlbw 
    439407      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalbet 
    … …  
    467435                  zdxrho_raw = ( - zalbet(ji+ip,jj   ,jk) * zdit + zbeta0*zdis ) / e1u(ji,jj) 
    468436                  zdyrho_raw = ( - zalbet(ji   ,jj+jp,jk) * zdjt + zbeta0*zdjs ) / e2v(ji,jj) 
    469                   zdxrho(ji+ip,jj   ,jk,1-ip) = SIGN( MAX(   repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign 
    470                   zdyrho(ji   ,jj+jp,jk,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 
     437                  zdxrho(ji+ip,jj   ,jk,1-ip) = SIGN(  MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign 
     438                  zdyrho(ji   ,jj+jp,jk,1-jp) = SIGN(  MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 
    471439               END DO 
    472440            END DO 
    473441         END DO 
    474442         ! 
    475          IF( ln_zps.and.l_grad_zps ) THEN     ! partial steps: correction of i- & j-grad on bottom 
    476 # if defined key_vectopt_loop 
    477             DO jj = 1, 1 
    478                DO ji = 1, jpij-jpi            ! vector opt. (forced unrolling) 
    479 # else 
     443         IF( ln_zps .AND. l_grad_zps ) THEN     ! partial steps: correction of i- & j-grad on bottom 
    480444            DO jj = 1, jpjm1 
    481445               DO ji = 1, jpim1 
    482 # endif 
    483446                  iku  = mbku(ji,jj)          ;   ikv  = mbkv(ji,jj)             ! last ocean level (u- & v-points) 
    484447                  zdit = gtsu(ji,jj,jp_tem)   ;   zdjt = gtsv(ji,jj,jp_tem)      ! i- & j-gradient of Temperature 
    … …  
    539502                  ! 
    540503                  jk = nmln(ji+ip,jj) + 1 
    541                   IF( jk .GT. mbkt(ji+ip,jj) ) THEN  !ML reaches bottom 
    542                     zti_mlb(ji+ip,jj   ,1-ip,kp) = 0.0_wp 
    543                   ELSE 
    544                     ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth) 
    545                     zti_g_raw = (  zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp)      & 
    546                        &      - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) / e1u(ji,jj)  ) * umask(ji,jj,jk) 
    547                     zti_mlb(ji+ip,jj   ,1-ip,kp) = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw ) 
     504                  IF( jk > mbkt(ji+ip,jj) ) THEN   ! ML reaches bottom 
     505                     zti_mlb(ji+ip,jj   ,1-ip,kp) = 0.0_wp 
     506                  ELSE                              
     507                     ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth) 
     508                     zti_g_raw = (  zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp)      & 
     509                        &          - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) / e1u(ji,jj)  ) * umask(ji,jj,jk) 
     510                     ze3_e1    =  fse3w(ji+ip,jj,jk-kp) / e1u(ji,jj)  
     511                     zti_mlb(ji+ip,jj   ,1-ip,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1  , ABS( zti_g_raw ) ), zti_g_raw ) 
    548512                  ENDIF 
    549513                  ! 
    550514                  jk = nmln(ji,jj+jp) + 1 
    551515                  IF( jk .GT. mbkt(ji,jj+jp) ) THEN  !ML reaches bottom 
    552                     ztj_mlb(ji   ,jj+jp,1-jp,kp) = 0.0_wp 
     516                     ztj_mlb(ji   ,jj+jp,1-jp,kp) = 0.0_wp 
    553517                  ELSE 
    554                     ztj_g_raw = (  zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp)      & 
    555                        &      - ( fsdept(ji,jj+1,jk-kp) - fsdept(ji,jj,jk-kp) ) / e2v(ji,jj)  ) * vmask(ji,jj,jk) 
    556                     ztj_mlb(ji   ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw ) 
     518                     ztj_g_raw = (  zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp)      & 
     519                        &      - ( fsdept(ji,jj+1,jk-kp) - fsdept(ji,jj,jk-kp) ) / e2v(ji,jj)  ) * vmask(ji,jj,jk) 
     520                     ze3_e2    =  fse3w(ji,jj+jp,jk-kp) / e2v(ji,jj) 
     521                     ztj_mlb(ji   ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e2  , ABS( ztj_g_raw ) ), ztj_g_raw ) 
    557522                  ENDIF 
    558523               END DO 
    … …  
    583548                     zti_raw   = zdxrho(ji+ip,jj   ,jk,1-ip) / zdzrho(ji+ip,jj   ,jk,kp)                   ! unmasked 
    584549                     ztj_raw   = zdyrho(ji   ,jj+jp,jk,1-jp) / zdzrho(ji   ,jj+jp,jk,kp) 
    585  
     550                     ! 
    586551                     ! Must mask contribution to slope for triad jk=1,kp=0 that poke up though ocean surface 
    587552                     zti_coord = znot_thru_surface * ( fsdept(ji+1,jj  ,jk) - fsdept(ji,jj,jk) ) / e1u(ji,jj) 
    … …  
    589554                     zti_g_raw = zti_raw - zti_coord      ! ref to geopot surfaces 
    590555                     ztj_g_raw = ztj_raw - ztj_coord 
    591                      zti_g_lim = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw ) 
    592                      ztj_g_lim = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw ) 
     556                     ! additional limit required in bilaplacian case 
     557                     ze3_e1    = fse3w(ji+ip,jj   ,jk+kp) / e1u(ji,jj) 
     558                     ze3_e2    = fse3w(ji   ,jj+jp,jk+kp) / e2v(ji,jj) 
     559                     ! NB: hard coded factor 5 (can be a namelist parameter...) 
     560                     zti_g_lim = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1, ABS( zti_g_raw ) ), zti_g_raw ) 
     561                     ztj_g_lim = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e2, ABS( ztj_g_raw ) ), ztj_g_raw ) 
    593562                     ! 
    594563                     ! Below  ML use limited zti_g as is & mask 
    … …  
    619588                     ! 
    620589                     IF( ln_triad_iso ) THEN 
    621                         zti_raw = zti_lim**2 / zti_raw 
    622                         ztj_raw = ztj_lim**2 / ztj_raw 
     590                        zti_raw = zti_lim*zti_lim / zti_raw 
     591                        ztj_raw = ztj_lim*ztj_lim / ztj_raw 
    623592                        zti_raw = SIGN( MIN( ABS(zti_lim), ABS( zti_raw ) ), zti_raw ) 
    624593                        ztj_raw = SIGN( MIN( ABS(ztj_lim), ABS( ztj_raw ) ), ztj_raw ) 
    625                         zti_lim =           zfacti   * zti_lim                       & 
    626                         &      + ( 1._wp - zfacti ) * zti_raw 
    627                         ztj_lim =           zfactj   * ztj_lim                       & 
    628                         &      + ( 1._wp - zfactj ) * ztj_raw 
     594                        zti_lim = zfacti * zti_lim + ( 1._wp - zfacti ) * zti_raw 
     595                        ztj_lim = zfactj * ztj_lim + ( 1._wp - zfactj ) * ztj_raw 
    629596                     ENDIF 
    630                      triadi(ji+ip,jj   ,jk,1-ip,kp) = zti_lim 
    631                      triadj(ji   ,jj+jp,jk,1-jp,kp) = ztj_lim 
    632                     ! 
    633                      zbu = e1u(ji    ,jj) * e2u(ji   ,jj) * fse3u(ji   ,jj,jk   ) 
    634                      zbv = e1v(ji    ,jj) * e2v(ji   ,jj) * fse3v(ji   ,jj,jk   ) 
    635                      zbti = e1t(ji+ip,jj) * e2t(ji+ip,jj) * fse3w(ji+ip,jj,jk+kp) 
    636                      zbtj = e1t(ji,jj+jp) * e2t(ji,jj+jp) * fse3w(ji,jj+jp,jk+kp) 
     597#if defined key_switch_triad 
     598                     triadi(ji+ip,jj   ,jk,1-ip,kp) = zti_lim   & 
     599                          &   * 2._wp * ABS( 0.5_wp - kp - ( 0.5_wp - ip ) * SIGN( 1._wp , zdxrho(ji+ip,jj,jk,1-ip) )  ) 
     600                     triadj(ji   ,jj+jp,jk,1-jp,kp) = ztj_lim   & 
     601                          &   * 2._wp * ABS( 0.5_wp - kp - ( 0.5_wp - jp ) * SIGN( 1._wp , zdyrho(ji,jj+jp,jk,1-jp) )  ) 
     602#endif 
     603                     ! 
     604                     zbu  = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji   ,jj   ,jk   ) 
     605                     zbv  = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji   ,jj   ,jk   ) 
     606                     zbti = e1e2t(ji+ip,jj   )      * fse3w(ji+ip,jj   ,jk+kp) 
     607                     zbtj = e1e2t(ji   ,jj+jp)      * fse3w(ji   ,jj+jp,jk+kp) 
    637608                     ! 
    638609                     !!gm this may inhibit vectorization on Vect Computers, and even on scalar computers....  ==> to be checked 
    639                      wslp2 (ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_g_lim**2      ! masked 
    640                      wslp2 (ji,jj+jp,jk+kp) = wslp2(ji,jj+jp,jk+kp) + 0.25_wp * zbv / zbtj * ztj_g_lim**2 
     610                     wslp2(ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_g_lim*zti_g_lim      ! masked 
     611                     wslp2(ji,jj+jp,jk+kp) = wslp2(ji,jj+jp,jk+kp) + 0.25_wp * zbv / zbtj * ztj_g_lim*ztj_g_lim 
    641612                  END DO 
    642613               END DO 
    … …  
    682653      INTEGER  ::   ji , jj , jk                   ! dummy loop indices 
    683654      INTEGER  ::   iku, ikv, ik, ikm1             ! local integers 
    684       REAL(wp) ::   zeps, zm1_g, zm1_2g            ! local scalars 
     655      REAL(wp) ::   zeps, zm1_g, zm1_2g, z1_slpmax ! local scalars 
    685656      REAL(wp) ::   zci, zfi, zau, zbu, zai, zbi   !   -      - 
    686657      REAL(wp) ::   zcj, zfj, zav, zbv, zaj, zbj   !   -      - 
    … …  
    693664      zm1_g  = -1.0_wp / grav 
    694665      zm1_2g = -0.5_wp / grav 
     666      z1_slpmax = 1._wp / rn_slpmax 
    695667      ! 
    696668      uslpml (1,:) = 0._wp      ;      uslpml (jpi,:) = 0._wp 
    … …  
    746718            !                        !- bound the slopes: abs(zw.)<= 1/100 and zb..<0 
    747719            !                           kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
    748             zbu = MIN(  zbu , -100._wp* ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,iku)* ABS( zau )  ) 
    749             zbv = MIN(  zbv , -100._wp* ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,ikv)* ABS( zav )  ) 
     720            zbu = MIN(  zbu , - z1_slpmax * ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,iku)* ABS( zau )  ) 
     721            zbv = MIN(  zbv , - z1_slpmax * ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,ikv)* ABS( zav )  ) 
    750722            !                        !- Slope at u- & v-points (uslpml, vslpml) 
    751723            uslpml(ji,jj) = zau / ( zbu - zeps ) * umask(ji,jj,iku) 
    … …  
    805777         WRITE(numout,*) '~~~~~~~~~~~~' 
    806778      ENDIF 
    807  
    808       IF( ln_traldf_grif ) THEN        ! Griffies operator : triad of slopes 
    809          ALLOCATE( triadi_g(jpi,jpj,jpk,0:1,0:1) , triadj_g(jpi,jpj,jpk,0:1,0:1) , wslp2(jpi,jpj,jpk) , STAT=ierr ) 
    810          ALLOCATE( triadi  (jpi,jpj,jpk,0:1,0:1) , triadj  (jpi,jpj,jpk,0:1,0:1)                      , STAT=ierr ) 
    811          IF( ierr > 0             )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Griffies operator slope' ) 
    812          ! 
     779      ! 
     780      ALLOCATE( ah_wslp2(jpi,jpj,jpk) , akz(jpi,jpj,jpk) , STAT=ierr ) 
     781      IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate ah_slp2 or akz' ) 
     782      ! 
     783      IF( ln_traldf_triad ) THEN        ! Griffies operator : triad of slopes 
     784         IF(lwp) WRITE(numout,*) '              Griffies (triad) operator initialisation' 
     785         ALLOCATE( triadi_g(jpi,jpj,jpk,0:1,0:1) , triadj_g(jpi,jpj,jpk,0:1,0:1) ,     & 
     786            &      triadi  (jpi,jpj,jpk,0:1,0:1) , triadj  (jpi,jpj,jpk,0:1,0:1) ,     & 
     787            &      wslp2   (jpi,jpj,jpk)                                         , STAT=ierr ) 
     788         IF( ierr > 0      )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Griffies operator slope' ) 
    813789         IF( ln_dynldf_iso )   CALL ctl_stop( 'ldf_slp_init: Griffies operator on momentum not supported' ) 
    814790         ! 
    815791      ELSE                             ! Madec operator : slopes at u-, v-, and w-points 
    816          ALLOCATE( uslp(jpi,jpj,jpk) , vslp(jpi,jpj,jpk) , wslpi(jpi,jpj,jpk) , wslpj(jpi,jpj,jpk) ,                & 
    817             &   omlmask(jpi,jpj,jpk) , uslpml(jpi,jpj)   , vslpml(jpi,jpj)    , wslpiml(jpi,jpj)   , wslpjml(jpi,jpj) , STAT=ierr ) 
     792         IF(lwp) WRITE(numout,*) '              Madec operator initialisation' 
     793         ALLOCATE( omlmask(jpi,jpj,jpk) ,                                                                        & 
     794            &      uslp(jpi,jpj,jpk) , uslpml(jpi,jpj) , wslpi(jpi,jpj,jpk) , wslpiml(jpi,jpj) ,     & 
     795            &      vslp(jpi,jpj,jpk) , vslpml(jpi,jpj) , wslpj(jpi,jpj,jpk) , wslpjml(jpi,jpj) , STAT=ierr ) 
    818796         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Madec operator slope ' ) 
    819797 
    … …  
    825803         wslpj(:,:,:) = 0._wp   ;   wslpjml(:,:) = 0._wp 
    826804 
    827          IF( ln_traldf_hor .OR. ln_dynldf_hor ) THEN 
    828             IF(lwp)   WRITE(numout,*) '          Horizontal mixing in s-coordinate: slope = slope of s-surfaces' 
    829  
    830             ! geopotential diffusion in s-coordinates on tracers and/or momentum 
    831             ! The slopes of s-surfaces are computed once (no call to ldfslp in step) 
    832             ! The slopes for momentum diffusion are i- or j- averaged of those on tracers 
    833  
    834             ! set the slope of diffusion to the slope of s-surfaces 
    835             !      ( c a u t i o n : minus sign as fsdep has positive value ) 
    836             DO jk = 1, jpk 
    837                DO jj = 2, jpjm1 
    838                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    839                      uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk) 
    840                      vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk) 
    841                      wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5 
    842                      wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5 
    843                   END DO 
    844                END DO 
    845             END DO 
    846             CALL lbc_lnk( uslp , 'U', -1. )   ;   CALL lbc_lnk( vslp , 'V', -1. )      ! Lateral boundary conditions 
    847             CALL lbc_lnk( wslpi, 'W', -1. )   ;   CALL lbc_lnk( wslpj, 'W', -1. ) 
    848          ENDIF 
     805         !!gm I no longer understand this..... 
     806!!gm         IF( (ln_traldf_hor .OR. ln_dynldf_hor) .AND. .NOT. (lk_vvl .AND. ln_rstart) ) THEN 
     807!            IF(lwp)   WRITE(numout,*) '          Horizontal mixing in s-coordinate: slope = slope of s-surfaces' 
     808! 
     809!            ! geopotential diffusion in s-coordinates on tracers and/or momentum 
     810!            ! The slopes of s-surfaces are computed once (no call to ldfslp in step) 
     811!            ! The slopes for momentum diffusion are i- or j- averaged of those on tracers 
     812! 
     813!            ! set the slope of diffusion to the slope of s-surfaces 
     814!            !      ( c a u t i o n : minus sign as fsdep has positive value ) 
     815!            DO jk = 1, jpk 
     816!               DO jj = 2, jpjm1 
     817!                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     818!                     uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * umask(ji,jj,jk) 
     819!                     vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept(ji,jj+1,jk) - fsdept(ji ,jj ,jk) ) * vmask(ji,jj,jk) 
     820!                     wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw(ji+1,jj,jk) - fsdepw(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5 
     821!                     wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw(ji,jj+1,jk) - fsdepw(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5 
     822!                  END DO 
     823!               END DO 
     824!            END DO 
     825!            CALL lbc_lnk( uslp , 'U', -1. )   ;   CALL lbc_lnk( vslp , 'V', -1. )      ! Lateral boundary conditions 
     826!            CALL lbc_lnk( wslpi, 'W', -1. )   ;   CALL lbc_lnk( wslpj, 'W', -1. ) 
     827!!gm         ENDIF 
    849828      ENDIF 
    850829      ! 
    … …  
    852831      ! 
    853832   END SUBROUTINE ldf_slp_init 
    854  
    855 #else 
    856    !!------------------------------------------------------------------------ 
    857    !!   Dummy module :                 NO Rotation of lateral mixing tensor 
    858    !!------------------------------------------------------------------------ 
    859    LOGICAL, PUBLIC, PARAMETER ::   lk_ldfslp = .FALSE.    !: slopes flag 
    860 CONTAINS 
    861    SUBROUTINE ldf_slp( kt, prd, pn2 )   ! Dummy routine 
    862       INTEGER, INTENT(in) :: kt 
    863       REAL, DIMENSION(:,:,:), INTENT(in) :: prd, pn2 
    864       WRITE(*,*) 'ldf_slp: You should not have seen this print! error?', kt, prd(1,1,1), pn2(1,1,1) 
    865    END SUBROUTINE ldf_slp 
    866    SUBROUTINE ldf_slp_grif( kt )        ! Dummy routine 
    867       INTEGER, INTENT(in) :: kt 
    868       WRITE(*,*) 'ldf_slp_grif: You should not have seen this print! error?', kt 
    869    END SUBROUTINE ldf_slp_grif 
    870    SUBROUTINE ldf_slp_init              ! Dummy routine 
    871    END SUBROUTINE ldf_slp_init 
    872 #endif 
    873833 
    874834   !!====================================================================== 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90

    r4147 r4596  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  ldftra  *** 
    4    !! Ocean physics:  lateral diffusivity coefficient  
     4   !! Ocean physics:  lateral diffusivity coefficients  
    55   !!===================================================================== 
    6    !! History :        ! 1997-07  (G. Madec)  from inimix.F split in 2 routines 
    7    !!   NEMO      1.0  ! 2002-09  (G. Madec)  F90: Free form and module 
    8    !!             2.0  ! 2005-11  (G. Madec)   
     6   !! History :       ! 1997-07  (G. Madec)  from inimix.F split in 2 routines 
     7   !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module 
     8   !!            2.0  ! 2005-11  (G. Madec)   
     9   !!            3.7  ! 2013-12  (F. Lemarie, G. Madec)  restructuration/simplification of aht/aeiv specification, 
     10   !!                 !                                  add velocity dependent coefficient and optional read in file 
    911   !!---------------------------------------------------------------------- 
    1012 
    1113   !!---------------------------------------------------------------------- 
    1214   !!   ldf_tra_init : initialization, namelist read, and parameters control 
    13    !!   ldf_tra_c3d   : 3D eddy viscosity coefficient initialization 
    14    !!   ldf_tra_c2d   : 2D eddy viscosity coefficient initialization 
    15    !!   ldf_tra_c1d   : 1D eddy viscosity coefficient initialization 
     15   !!   ldf_tra      : update lateral eddy diffusivity coefficients at each time step  
     16   !!   ldf_eiv_init : initialization of the eiv coeff. from namelist choices  
     17   !!   ldf_eiv      : time evolution of the eiv coefficients (function of the growth rate of baroclinic instability) 
     18   !!   ldf_eiv_trp  : add to the input ocean transport the contribution of the EIV parametrization 
     19   !!   ldf_eiv_dia  : diagnose the eddy induced velocity from the eiv streamfunction 
    1620   !!---------------------------------------------------------------------- 
    1721   USE oce             ! ocean dynamics and tracers 
    1822   USE dom_oce         ! ocean space and time domain 
    1923   USE phycst          ! physical constants 
    20    USE ldftra_oce      ! ocean tracer   lateral physics 
    21    USE ldfslp          ! ??? 
     24   USE ldfslp          ! lateral diffusion: slope of iso-neutral surfaces 
     25   USE ldfc1d          ! lateral diffusion: 1D case  
     26   USE ldfc2d          ! lateral diffusion: 2D case  
     27   USE diaar5, ONLY:   lk_diaar5 
     28   ! 
    2229   USE in_out_manager  ! I/O manager 
    23    USE ioipsl 
     30   USE iom             ! I/O module for ehanced bottom friction file 
    2431   USE lib_mpp         ! distribued memory computing library 
    2532   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     33   USE wrk_nemo        ! work arrays 
     34   USE timing          ! timing 
    2635 
    2736   IMPLICIT NONE 
    2837   PRIVATE 
    2938 
    30    PUBLIC   ldf_tra_init   ! called by opa.F90 
     39   PUBLIC   ldf_tra_init   ! called by nemogcm.F90 
     40   PUBLIC   ldf_tra        ! called by step.F90 
     41   PUBLIC   ldf_eiv_init   ! called by nemogcm.F90 
     42   PUBLIC   ldf_eiv        ! called by step.F90 
     43   PUBLIC   ldf_eiv_trp    ! called by traadv.F90 
     44   PUBLIC   ldf_eiv_dia    ! called by traldf_iso and traldf_iso_triad.F90 
     45    
     46   !                                            !!* Namelist namtra_ldf : lateral mixing on tracers *  
     47   !                                                 != Operator type =! 
     48   LOGICAL , PUBLIC ::   ln_traldf_lap   = .TRUE.        !: laplacian operator 
     49   LOGICAL , PUBLIC ::   ln_traldf_blp   = .FALSE.       !: bilaplacian operator 
     50   !                                                 !=  Direction of action =! 
     51   LOGICAL , PUBLIC ::   ln_traldf_lev   = .FALSE.       !: iso-level direction 
     52   LOGICAL , PUBLIC ::   ln_traldf_hor   = .FALSE.       !: horizontal (geopotential) direction 
     53!   LOGICAL , PUBLIC ::   ln_traldf_iso   = .TRUE.       !: iso-neutral direction            (see ldfslp) 
     54!   LOGICAL , PUBLIC ::   ln_traldf_triad = .FALSE.      !: griffies triad scheme            (see ldfslp) 
     55   LOGICAL , PUBLIC ::   ln_traldf_msc   = .FALSE.       !: Method of Stabilizing Correction  
     56!   LOGICAL , PUBLIC ::   ln_triad_iso    = .FALSE.      !: pure horizontal mixing in ML     (see ldfslp) 
     57!   LOGICAL , PUBLIC ::   ln_botmix_triad = .FALSE.      !: mixing on bottom                 (see ldfslp) 
     58!   REAL(wp), PUBLIC ::   rn_slpmax       = 0.01_wp      !: slope limit                      (see ldfslp) 
     59   !                                                 !=  Coefficients =! 
     60   INTEGER , PUBLIC ::   nn_aht_ijk_t    = 0             !:   ??????  !!gm 
     61   REAL(wp), PUBLIC ::   rn_aht_0        = 2000._wp      !:   laplacian lateral eddy diffusivity [m2/s] 
     62   REAL(wp), PUBLIC ::   rn_bht_0        = 5.e+11_wp     !: bilaplacian lateral eddy diffusivity [m4/s] 
     63 
     64   !                                            !!* Namelist namtra_ldfeiv : eddy induced velocity param. * 
     65   !                                                 != Use/diagnose eiv =! 
     66   LOGICAL , PUBLIC ::   ln_ldfeiv     = .FALSE.         !: eddy induced velocity flag 
     67   LOGICAL , PUBLIC ::   ln_ldfeiv_dia = .FALSE.         !: diagnose & output eiv streamfunction and velocity (IOM) 
     68   !                                                 !=  Coefficients =! 
     69   INTEGER , PUBLIC ::   nn_aei_ijk_t  = 0               !: choice of time/space variation of the eiv coeff. 
     70   REAL(wp), PUBLIC ::   rn_aeiv_0     = 2000._wp        !: eddy induced velocity coefficient [m2/s] 
     71    
     72   LOGICAL , PUBLIC ::   l_ldftra_time = .FALSE.   !: flag for time variation of the lateral eddy diffusivity coef. 
     73   LOGICAL , PUBLIC ::   l_ldfeiv_time = .FALSE.   ! flag for time variation of the eiv coef. 
     74   REAL(wp), PUBLIC ::   rldf                      !: multiplicative factor of diffusive coefficient 
     75                                                   !  Needed to define the ratio between passive and active tracer diffusion coef.  
     76 
     77   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ahtu, ahtv   !: eddy diffusivity coef. at U- and V-points   [m2/s] 
     78   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aeiu, aeiv   !: eddy induced velocity coeff.                [m2/s] 
     79 
     80   REAL(wp) ::   r1_4  = 0.25_wp          ! =1/4 
     81   REAL(wp) ::   r1_12 = 1._wp / 12._wp   ! =1/12 
    3182 
    3283   !! * Substitutions 
    … …  
    3485#  include "vectopt_loop_substitute.h90" 
    3586   !!---------------------------------------------------------------------- 
    36    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     87   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    3788   !! $Id$ 
    3889   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    4697      !! ** Purpose :   initializations of the tracer lateral mixing coeff. 
    4798      !! 
    48       !! ** Method  :   the Eddy diffusivity and eddy induced velocity ceoff. 
    49       !!      are defined as follows: 
    50       !!         default option   : constant coef. aht0, aeiv0 (namelist) 
    51       !!        'key_traldf_c1d': depth dependent coef. defined in  
    52       !!                            in ldf_tra_c1d routine 
    53       !!        'key_traldf_c2d': latitude and longitude dependent coef. 
    54       !!                            defined in ldf_tra_c2d routine 
    55       !!        'key_traldf_c3d': latitude, longitude, depth dependent coef. 
    56       !!                            defined in ldf_tra_c3d routine 
    57       !! 
    58       !!      N.B. User defined include files.  By default, 3d and 2d coef. 
    59       !!      are set to a constant value given in the namelist and the 1d 
    60       !!      coefficients are initialized to a hyperbolic tangent vertical 
    61       !!      profile. 
    62       !!---------------------------------------------------------------------- 
    63       INTEGER ::   ioptio               ! temporary integer 
    64       INTEGER ::   ios                  ! temporary integer 
    65       LOGICAL ::   ll_print = .FALSE.   ! =T print eddy coef. in numout 
    66       !!  
    67       NAMELIST/namtra_ldf/ ln_traldf_lap  , ln_traldf_bilap,                  & 
    68          &                 ln_traldf_level, ln_traldf_hor  , ln_traldf_iso,   & 
    69          &                 ln_traldf_grif , ln_traldf_gdia ,                  & 
    70          &                 ln_triad_iso   , ln_botmix_grif ,                  & 
    71          &                 rn_aht_0       , rn_ahtb_0      , rn_aeiv_0,       & 
    72          &                 rn_slpmax      , rn_chsmag      ,    rn_smsh,      & 
    73          &                 rn_aht_m 
    74       !!---------------------------------------------------------------------- 
    75  
    76       !  Define the lateral tracer physics parameters 
    77       ! ============================================= 
    78      
    79  
     99      !! ** Method  : * the eddy diffusivity coef. specification depends on: 
     100      !! 
     101      !!    ln_traldf_lap = T     laplacian operator 
     102      !!    ln_traldf_blp = T   bilaplacian operator 
     103      !! 
     104      !!    nn_aht_ijk_t  =  0 => = constant 
     105      !!                  ! 
     106      !!                  = 10 => = F(z) : constant with a reduction of 1/4 with depth  
     107      !!                  ! 
     108      !!                  =-20 => = F(i,j)   = shape read in 'eddy_diffusivity.nc' file 
     109      !!                  = 20    = F(i,j)   = F(e1,e2) or F(e1^3,e2^3) (lap or bilap case) 
     110      !!                  = 21    = F(i,j,t) = F(growth rate of baroclinic instability) 
     111      !!                  ! 
     112      !!                  =-30 => = F(i,j,k)   = shape read in 'eddy_diffusivity.nc' file 
     113      !!                  = 30    = F(i,j,k)   = 2D (case 20) + decrease with depth (case 10) 
     114      !!                  = 31    = F(i,j,k,t) = F(local velocity) (  |u|e  /12   laplacian operator 
     115      !!                                                          or |u|e^3/12 bilaplacian operator ) 
     116      !!              * initialisation of the eddy induced velocity coefficient by a call to ldf_eiv_init  
     117      !!             
     118      !! ** action  : ahtu, ahtv initialized once for all or l_ldftra_time set to true 
     119      !!              aeiu, aeiv initialized once for all or l_ldfeiv_time set to true 
     120      !!---------------------------------------------------------------------- 
     121      INTEGER  ::   jk                ! dummy loop indices 
     122      INTEGER  ::   ierr, inum, ios   ! local integer 
     123      REAL(wp) ::   zah0              ! local scalar 
     124      ! 
     125      NAMELIST/namtra_ldf/ ln_traldf_lap, ln_traldf_blp,                   &   ! type of operator 
     126         &                 ln_traldf_lev, ln_traldf_hor, ln_traldf_triad,  &   ! acting direction of the operator 
     127         &                 ln_traldf_iso, ln_traldf_msc,                   &   ! option for iso-neutral operator 
     128         &                 ln_triad_iso , ln_botmix_triad, rn_slpmax    ,  &   !  
     129         &                 rn_aht_0     , rn_bht_0     , nn_aht_ijk_t          ! lateral eddy coefficient 
     130      !!---------------------------------------------------------------------- 
     131      ! 
     132      !  Choice of lateral tracer physics 
     133      ! ================================= 
     134      ! 
    80135      REWIND( numnam_ref )              ! Namelist namtra_ldf in reference namelist : Lateral physics on tracers 
    81136      READ  ( numnam_ref, namtra_ldf, IOSTAT = ios, ERR = 901) 
    82137901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldf in reference namelist', lwp ) 
    83  
     138      ! 
    84139      REWIND( numnam_cfg )              ! Namelist namtra_ldf in configuration namelist : Lateral physics on tracers 
    85140      READ  ( numnam_cfg, namtra_ldf, IOSTAT = ios, ERR = 902 ) 
    86141902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldf in configuration namelist', lwp ) 
    87142      WRITE ( numond, namtra_ldf ) 
    88  
     143      ! 
    89144      IF(lwp) THEN                      ! control print 
    90145         WRITE(numout,*) 
    … …  
    92147         WRITE(numout,*) '~~~~~~~~~~~~ ' 
    93148         WRITE(numout,*) '   Namelist namtra_ldf : lateral mixing parameters (type, direction, coefficients)' 
    94          WRITE(numout,*) '      laplacian operator            ln_traldf_lap   = ', ln_traldf_lap 
    95          WRITE(numout,*) '      bilaplacian operator          ln_traldf_bilap = ', ln_traldf_bilap 
    96          WRITE(numout,*) '      iso-level                     ln_traldf_level = ', ln_traldf_level 
    97          WRITE(numout,*) '      horizontal (geopotential)     ln_traldf_hor   = ', ln_traldf_hor 
    98          WRITE(numout,*) '      iso-neutral                   ln_traldf_iso   = ', ln_traldf_iso 
    99          WRITE(numout,*) '      iso-neutral (Griffies)        ln_traldf_grif  = ', ln_traldf_grif 
    100          WRITE(numout,*) '      Griffies strmfn diagnostics   ln_traldf_gdia  = ', ln_traldf_gdia 
    101          WRITE(numout,*) '      lateral eddy diffusivity      rn_aht_0        = ', rn_aht_0 
    102          WRITE(numout,*) '      background hor. diffusivity   rn_ahtb_0       = ', rn_ahtb_0 
    103          WRITE(numout,*) '      eddy induced velocity coef.   rn_aeiv_0       = ', rn_aeiv_0 
    104          WRITE(numout,*) '      maximum isoppycnal slope      rn_slpmax       = ', rn_slpmax 
    105          WRITE(numout,*) '      pure lateral mixing in ML     ln_triad_iso    = ', ln_triad_iso 
    106          WRITE(numout,*) '      lateral mixing on bottom      ln_botmix_grif  = ', ln_botmix_grif 
     149         ! 
     150         WRITE(numout,*) '      type :' 
     151         WRITE(numout,*) '         laplacian operator                      ln_traldf_lap   = ', ln_traldf_lap 
     152         WRITE(numout,*) '         bilaplacian operator                    ln_traldf_blp   = ', ln_traldf_blp 
     153         ! 
     154         WRITE(numout,*) '      direction of action :' 
     155         WRITE(numout,*) '         iso-level                               ln_traldf_lev   = ', ln_traldf_lev 
     156         WRITE(numout,*) '         horizontal (geopotential)               ln_traldf_hor   = ', ln_traldf_hor 
     157         WRITE(numout,*) '         iso-neutral Madec operator              ln_traldf_iso   = ', ln_traldf_iso 
     158         WRITE(numout,*) '         iso-neutral triad operator              ln_traldf_triad = ', ln_traldf_triad 
     159         WRITE(numout,*) '            iso-neutral (Method of Stab. Corr.)  ln_traldf_msc   = ', ln_traldf_msc 
     160         WRITE(numout,*) '            maximum isoppycnal slope             rn_slpmax       = ', rn_slpmax 
     161         WRITE(numout,*) '            pure lateral mixing in ML            ln_triad_iso    = ', ln_triad_iso 
     162         WRITE(numout,*) '            lateral mixing on bottom             ln_botmix_triad = ', ln_botmix_triad 
     163         ! 
     164         WRITE(numout,*) '      coefficients :' 
     165         WRITE(numout,*) '         lateral eddy diffusivity   (lap case)   rn_aht_0        = ', rn_aht_0 
     166         WRITE(numout,*) '         lateral eddy diffusivity (bilap case)   rn_bht_0        = ', rn_bht_0 
     167         WRITE(numout,*) '         type of time-space variation            nn_aht_ijk_t    = ', nn_aht_ijk_t 
     168      ENDIF 
     169      ! 
     170      !                                ! Parameter control 
     171      ! 
     172      IF( ln_traldf_blp .AND. ( ln_traldf_iso .OR. ln_traldf_triad) ) THEN     ! iso-neutral bilaplacian need MSC 
     173         IF( .NOT.ln_traldf_msc )   CALL ctl_stop( 'tra_ldf_init: iso-neutral bilaplacian requires ln_traldf_msc=.true.' )  
     174      ENDIF 
     175      ! 
     176      ! 
     177      !  Space/time variation of eddy coefficients  
     178      ! =========================================== 
     179      !                                               ! allocate the aht arrays 
     180      ALLOCATE( ahtu(jpi,jpj,jpk) , ahtv(jpi,jpj,jpk) , STAT=ierr ) 
     181      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_tra_init: failed to allocate arrays') 
     182      ! 
     183      ahtu(:,:,jpk) = 0._wp                           ! last level always 0   
     184      ahtv(:,:,jpk) = 0._wp 
     185      ! 
     186      !                                               ! value of eddy mixing coef. 
     187      IF    ( ln_traldf_lap ) THEN   ;   zah0 =            rn_aht_0         !   laplacian operator 
     188      ELSEIF( ln_traldf_blp ) THEN   ;   zah0 = SQRT( ABS( rn_bht_0 ) )     ! bilaplacian operator 
     189      ELSE                                                                  ! NO diffusion/viscosity operator 
     190         CALL ctl_warn( 'ldf_tra_init: No lateral diffusive operator used ' ) 
     191      ENDIF 
     192      ! 
     193      l_ldftra_time = .FALSE.                         ! no time variation except in case defined below 
     194      ! 
     195      IF( ln_traldf_lap .OR. ln_traldf_blp ) THEN     ! only if a lateral diffusion operator is used 
     196         ! 
     197         SELECT CASE(  nn_aht_ijk_t  )                   ! Specification of space time variations of ehtu, ahtv 
     198         ! 
     199         CASE(   0  )      !==  constant  ==! 
     200            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = constant = ', rn_aht_0 
     201            ahtu(:,:,:) = zah0 * umask(:,:,:) 
     202            ahtv(:,:,:) = zah0 * vmask(:,:,:) 
     203            ! 
     204         CASE(  10  )      !==  fixed profile  ==! 
     205            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( depth )' 
     206            ahtu(:,:,1) = zah0 * umask(:,:,1)                      ! constant surface value 
     207            ahtv(:,:,1) = zah0 * vmask(:,:,1) 
     208            CALL ldf_c1d( 'TRA', r1_4, ahtu(:,:,1), ahtv(:,:,1), ahtu, ahtv ) 
     209            ! 
     210         CASE ( -20 )      !== fixed horizontal shape read in file  ==! 
     211            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F(i,j) read in eddy_diffusivity.nc file' 
     212            CALL iom_open( 'eddy_diffusivity.nc', inum ) 
     213            CALL iom_get ( inum, jpdom_data, 'ahtu_2D', ahtu(:,:,1) ) 
     214            CALL iom_get ( inum, jpdom_data, 'ahtv_2D', ahtv(:,:,1) ) 
     215            CALL iom_close( inum ) 
     216            DO jk = 2, jpkm1 
     217               ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk) 
     218               ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk) 
     219            END DO 
     220            ! 
     221         CASE(  20  )      !== fixed horizontal shape  ==! 
     222            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap or blp case)' 
     223            IF( ln_traldf_lap )   CALL ldf_c2d( 'TRA', 'LAP', zah0, ahtu, ahtv )    ! surface value proportional to scale factor 
     224            IF( ln_traldf_blp )   CALL ldf_c2d( 'TRA', 'BLP', zah0, ahtu, ahtv )    ! surface value proportional to scale factor 
     225            ! 
     226         CASE(  21  )      !==  time varying 2D field  ==! 
     227            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, time )' 
     228            IF(lwp) WRITE(numout,*) '                              = F( growth rate of baroclinic instability )' 
     229            IF(lwp) WRITE(numout,*) '                              min value = 0.1 * rn_aht_0' 
     230            IF(lwp) WRITE(numout,*) '                              max value = rn_aht_0 (rn_aeiv_0 if nn_aei_ijk_t=21)' 
     231            IF(lwp) WRITE(numout,*) '                              increased to rn_aht_0 within 20N-20S' 
     232            ! 
     233            l_ldftra_time = .TRUE.     ! will be calculated by call to ldf_tra routine in step.F90 
     234            ! 
     235            IF( ln_traldf_blp ) THEN 
     236               CALL ctl_stop( 'ldf_tra_init: aht=F(growth rate of baroc. insta.) incompatible with bilaplacian operator' ) 
     237            ENDIF 
     238            ! 
     239         CASE( -30  )      !== fixed 3D shape read in file  ==! 
     240            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F(i,j,k) read in eddy_diffusivity.nc file' 
     241            CALL iom_open( 'eddy_diffusivity.nc', inum ) 
     242            CALL iom_get ( inum, jpdom_data, 'ahtu_3D', ahtu ) 
     243            CALL iom_get ( inum, jpdom_data, 'ahtv_3D', ahtv ) 
     244            CALL iom_close( inum ) 
     245            DO jk = 1, jpkm1 
     246               ahtu(:,:,jk) = ahtu(:,:,jk) * umask(:,:,jk) 
     247               ahtv(:,:,jk) = ahtv(:,:,jk) * vmask(:,:,jk) 
     248            END DO 
     249            ! 
     250         CASE(  30  )      !==  fixed 3D shape  ==! 
     251            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, depth )' 
     252            IF( ln_traldf_lap )   CALL ldf_c2d( 'TRA', 'LAP', zah0, ahtu, ahtv )    ! surface value proportional to scale factor 
     253            IF( ln_traldf_blp )   CALL ldf_c2d( 'TRA', 'BLP', zah0, ahtu, ahtv )    ! surface value proportional to scale factor 
     254            !                                                    ! reduction with depth 
     255            CALL ldf_c1d( 'TRA', r1_4, ahtu(:,:,1), ahtv(:,:,1), ahtu, ahtv ) 
     256            ! 
     257         CASE(  31  )      !==  time varying 3D field  ==! 
     258            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, depth , time )' 
     259            IF(lwp) WRITE(numout,*) '                                proportional to the velocity : |u|e/12 or |u|e^3/12' 
     260            ! 
     261            l_ldftra_time = .TRUE.     ! will be calculated by call to ldf_tra routine in step.F90 
     262            ! 
     263         CASE DEFAULT 
     264            CALL ctl_stop('ldf_tra_init: wrong choice for nn_aht_ijk_t, the type of space-time variation of aht') 
     265         END SELECT 
     266         ! 
     267      ENDIF 
     268      ! 
     269   END SUBROUTINE ldf_tra_init 
     270 
     271 
     272   SUBROUTINE ldf_tra( kt ) 
     273      !!---------------------------------------------------------------------- 
     274      !!                  ***  ROUTINE ldf_tra  *** 
     275      !!  
     276      !! ** Purpose :   update at kt the tracer lateral mixing coeff. (aht and aeiv) 
     277      !! 
     278      !! ** Method  :   time varying eddy diffusivity coefficients: 
     279      !! 
     280      !!    nn_aei_ijk_t = 21    aeiu, aeiv = F(i,j,t)   = F(growth rate of baroclinic instability) 
     281      !!                                                   with a reduction to 0 in vicinity of the Equator 
     282      !!    nn_aht_ijk_t = 21    ahtu, ahtv = F(i,j,t)   = F(growth rate of baroclinic instability) 
     283      !! 
     284      !!                 = 31    ahtu, ahtv = F(i,j,k,t) = F(local velocity) (  |u|e  /12   laplacian operator 
     285      !!                                                                     or |u|e^3/12 bilaplacian operator ) 
     286      !! 
     287      !! ** action  :          ahtu, ahtv   update at each time step    
     288      !!              and/or   aeiu, aeiv      -       -     -    -     
     289      !!---------------------------------------------------------------------- 
     290      INTEGER, INTENT(in) ::   kt   ! time step 
     291      ! 
     292      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     293      REAL(wp) ::   zaht, zaht_min, z1_f20       ! local scalar 
     294      !!---------------------------------------------------------------------- 
     295      ! 
     296      IF( nn_aei_ijk_t == 21 ) THEN       ! eddy induced velocity coefficients 
     297         !                                ! =F(growth rate of baroclinic instability) 
     298         !                                ! max value rn_aeiv_0 ; decreased to 0 within 20N-20S 
     299         CALL ldf_eiv( kt, rn_aeiv_0, aeiu, aeiv ) 
     300      IF(lwp .AND. kt<=nit000+20 ) write(numout,*) ' kt , ldf_eiv appel', kt 
     301      ENDIF 
     302      ! 
     303      SELECT CASE(  nn_aht_ijk_t  )       ! Eddy diffusivity coefficients 
     304      ! 
     305      CASE(  21  )       !==  time varying 2D field  ==!   = F( growth rate of baroclinic instability ) 
     306         !                                             !   min value rn_aht_0 / 10  
     307         !                                             !   max value rn_aht_0 (rn_aeiv_0 if nn_aei_ijk_t=21) 
     308         !                                             !   increase to rn_aht_0 within 20N-20S 
     309 
     310 
     311      IF(lwp .AND. kt<=nit000+20 ) write(numout,*) ' kt ,nn_aei_ijk_t,  aeiuv max', kt,   & 
     312            &           nn_aei_ijk_t, MAXVAL( aeiu(:,:,1) ), MAXVAL( aeiv(:,:,1) ) 
     313 
     314 
     315         IF( nn_aei_ijk_t /= 21 ) THEN 
     316            CALL ldf_eiv( kt, rn_aht_0, ahtu, ahtv ) 
     317      IF(lwp .AND. kt<=nit000+20 ) write(numout,*) ' kt , ldf_eiv appel  2', kt 
     318         ELSE 
     319            ahtu(:,:,1) = aeiu(:,:,1) 
     320            ahtv(:,:,1) = aeiv(:,:,1) 
     321      IF(lwp .AND. kt<=nit000+20 ) write(numout,*) ' kt , ahtu=aeiu', kt 
     322         ENDIF 
     323 
     324      IF(lwp .AND. kt<=nit000+20 ) write(numout,*) ' kt , ahtuv max ', kt, MAXVAL( ahtu(:,:,1) ), MAXVAL( ahtv(:,:,1) ) 
     325 
     326         ! 
     327         z1_f20   = 1._wp / (  2._wp * omega * SIN( rad * 20._wp )  )      ! 1 / ff(20 degrees)    
     328         zaht_min = 0.2_wp * rn_aht_0                                      ! minimum value for aht 
     329 
     330      IF(lwp .AND. kt<=nit000+20 ) write(numout,*) ' kt , aht0 et ahtmin', kt, rn_aht_0, zaht_min 
     331 
     332         DO jj = 1, jpj 
     333            DO ji = 1, jpi 
     334               zaht = ( 1._wp -  MIN( 1._wp , ABS( ff(ji,jj) * z1_f20 ) ) ) * ( rn_aht_0 - zaht_min ) 
     335!!      IF(lwp .AND. kt<=nit000+20 ) write(numout,*) ' avant zaht, ahtuv', zaht, ahtu(ji,jj,1), ahtv(ji,jj,1), zaht_min, ji,jj 
     336!!      IF(lwp .AND. kt<=nit000+20 ) write(numout,*) ' avant zaht, aeiuv', zaht, aeiu(ji,jj,1), aeiv(ji,jj,1) 
     337               ahtu(ji,jj,1) = (  MAX( zaht_min, ahtu(ji,jj,1) ) + zaht  ) * umask(ji,jj,1)     ! min value zaht_min 
     338               ahtv(ji,jj,1) = (  MAX( zaht_min, ahtv(ji,jj,1) ) + zaht  ) * vmask(ji,jj,1)     ! increase within 20S-20N 
     339!!      IF(lwp .AND. kt<=nit000+20 ) write(numout,*) ' zaht et ahtu ahtv', zaht, ahtu(ji,jj,1), ahtv(ji,jj,1) 
     340            END DO 
     341         END DO 
     342!!      IF(lwp ) write(numout,*) ' max  ahtu ahtv', MAXVAL( ahtu(:,:,1) ), MAXVAL( ahtv(:,:,1) ) 
     343         DO jk = 2, jpkm1                             ! deeper value = surface value 
     344            ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk) 
     345            ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk) 
     346         END DO 
     347         ! 
     348      CASE(  31  )       !==  time varying 3D field  ==!   = F( local velocity ) 
     349         IF( ln_traldf_lap   ) THEN          !   laplacian operator 
     350            DO jk = 1, jpkm1 
     351               ahtu(:,:,jk) = ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12 
     352               ahtv(:,:,jk) = ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12 
     353            END DO 
     354         ELSEIF( ln_traldf_blp ) THEN      ! bilaplacian operator 
     355            DO jk = 1, jpkm1 
     356               ahtu(:,:,jk) = SQRT(  ABS( ub(:,:,jk) ) * e1u(:,:) * e1u(:,:) * e1u(:,:) * r1_12  ) 
     357               ahtv(:,:,jk) = SQRT(  ABS( vb(:,:,jk) ) * e2v(:,:) * e2v(:,:) * e2v(:,:) * r1_12  ) 
     358            END DO 
     359         ENDIF 
     360         ! 
     361      END SELECT 
     362      ! 
     363      CALL iom_put( "ahtu_2d", ahtu(:,:,1) )   ! surface u-eddy diffusivity coeff. 
     364      CALL iom_put( "ahtv_2d", ahtv(:,:,1) )   ! surface v-eddy diffusivity coeff. 
     365      CALL iom_put( "ahtu_3d", ahtu(:,:,:) )   ! 3D      u-eddy diffusivity coeff. 
     366      CALL iom_put( "ahtv_3d", ahtv(:,:,:) )   ! 3D      v-eddy diffusivity coeff. 
     367      ! 
     368      CALL iom_put( "aeiu_2d", aeiu(:,:,1) )   ! surface u-EIV coeff. 
     369      CALL iom_put( "aeiv_2d", aeiv(:,:,1) )   ! surface v-EIV coeff. 
     370      CALL iom_put( "aeiu_3d", aeiu(:,:,:) )   ! 3D      u-EIV coeff. 
     371      CALL iom_put( "aeiv_3d", aeiv(:,:,:) )   ! 3D      v-EIV coeff. 
     372      ! 
     373   END SUBROUTINE ldf_tra 
     374 
     375 
     376   SUBROUTINE ldf_eiv_init 
     377      !!---------------------------------------------------------------------- 
     378      !!                  ***  ROUTINE ldf_eiv_init  *** 
     379      !! 
     380      !! ** Purpose :   initialization of the eiv coeff. from namelist choices. 
     381      !! 
     382      !! ** Method : 
     383      !! 
     384      !! ** Action :   aeiu , aeiv   : EIV coeff. at u- & v-points 
     385      !!               l_ldfeiv_time : =T if EIV coefficients vary with time 
     386      !!---------------------------------------------------------------------- 
     387      INTEGER  ::   jk                ! dummy loop indices 
     388      INTEGER  ::   ierr, inum, ios   ! local integer 
     389      ! 
     390      NAMELIST/namtra_ldfeiv/ ln_ldfeiv   , ln_ldfeiv_dia,   &    ! eddy induced velocity (eiv) 
     391         &                    nn_aei_ijk_t, rn_aeiv_0             ! eiv  coefficient 
     392      !!---------------------------------------------------------------------- 
     393      ! 
     394      REWIND( numnam_ref )              ! Namelist namtra_ldfeiv in reference namelist : eddy induced velocity param. 
     395      READ  ( numnam_ref, namtra_ldfeiv, IOSTAT = ios, ERR = 901) 
     396901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldfeiv in reference namelist', lwp ) 
     397      ! 
     398      REWIND( numnam_cfg )              ! Namelist namtra_ldfeiv in configuration namelist : eddy induced velocity param. 
     399      READ  ( numnam_cfg, namtra_ldfeiv, IOSTAT = ios, ERR = 902 ) 
     400902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldfeiv in configuration namelist', lwp ) 
     401      WRITE ( numond, namtra_ldfeiv ) 
     402 
     403      IF(lwp) THEN                      ! control print 
    107404         WRITE(numout,*) 
    108       ENDIF 
    109  
    110       !                                ! convert DOCTOR namelist names into OLD names 
    111       aht0  = rn_aht_0 
    112       ahtb0 = rn_ahtb_0 
    113       aeiv0 = rn_aeiv_0 
    114  
    115       !                                ! Parameter control 
    116  
    117       ! ... Check consistency for type and direction : 
    118       !           ==> will be done in traldf module 
    119  
    120       ! ... Space variation of eddy coefficients 
    121       ioptio = 0 
    122 #if defined key_traldf_c3d 
    123       IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, depth)' 
    124       ioptio = ioptio + 1 
    125 #endif 
    126 #if defined key_traldf_c2d 
    127       IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude)' 
    128       ioptio = ioptio + 1 
    129 #endif 
    130 #if defined key_traldf_c1d 
    131       IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( depth )' 
    132       ioptio = ioptio + 1 
    133       IF( .NOT. ln_zco )   CALL ctl_stop( 'key_traldf_c1d can only be used in z-coordinate - full step' ) 
    134 #endif 
    135       IF( ioptio == 0 ) THEN 
    136           IF(lwp) WRITE(numout,*) '          tracer mixing coef. = constant (default option)' 
    137         ELSEIF( ioptio > 1 ) THEN 
    138            CALL ctl_stop('          use only one of the following keys:',   & 
    139              &           ' key_traldf_c3d, key_traldf_c2d, key_traldf_c1d' ) 
    140       ENDIF 
    141  
    142       IF( ln_traldf_bilap ) THEN 
    143          IF(lwp) WRITE(numout,*) '          biharmonic tracer diffusion' 
    144          IF( aht0 > 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal diffusivity coef. aht0 must be negative' ) 
     405         WRITE(numout,*) 'ldf_eiv_init : eddy induced velocity parametrization' 
     406         WRITE(numout,*) '~~~~~~~~~~~~ ' 
     407         WRITE(numout,*) '   Namelist namtra_ldfeiv : ' 
     408         WRITE(numout,*) '      Eddy Induced Velocity (eiv) param.      ln_ldfeiv     = ', ln_ldfeiv 
     409         WRITE(numout,*) '      eiv streamfunction & velocity diag.     ln_ldfeiv_dia = ', ln_ldfeiv_dia 
     410         WRITE(numout,*) '      eddy induced velocity coef.             rn_aeiv_0     = ', rn_aeiv_0 
     411         WRITE(numout,*) '      type of time-space variation            nn_aei_ijk_t  = ', nn_aei_ijk_t 
     412         WRITE(numout,*) 
     413      ENDIF 
     414      ! 
     415      IF( ln_traldf_blp )   CALL ctl_stop( 'ldf_eiv_init: bilaplacian and eddy induced velocity are not compatible' )  
     416 
     417      !                                 ! Parameter control 
     418      l_ldfeiv_time = .FALSE.     
     419      ! 
     420      IF( ln_ldfeiv ) THEN                         ! allocate the aei arrays 
     421         ALLOCATE( aeiu(jpi,jpj,jpk), aeiv(jpi,jpj,jpk), STAT=ierr ) 
     422         IF( ierr /= 0 )   CALL ctl_stop('STOP', 'ldf_eiv: failed to allocate arrays') 
     423         ! 
     424         SELECT CASE( nn_aei_ijk_t )               ! Specification of space time variations of eaiu, aeiv 
     425         ! 
     426         CASE(   0  )      !==  constant  ==! 
     427            IF(lwp) WRITE(numout,*) '          eddy induced velocity coef. = constant = ', rn_aeiv_0 
     428            aeiu(:,:,:) = rn_aeiv_0 
     429            aeiv(:,:,:) = rn_aeiv_0 
     430            ! 
     431         CASE(  10  )      !==  fixed profile  ==! 
     432            IF(lwp) WRITE(numout,*) '          eddy induced velocity coef. = F( depth )' 
     433            aeiu(:,:,1) = rn_aeiv_0                                ! constant surface value 
     434            aeiv(:,:,1) = rn_aeiv_0 
     435            CALL ldf_c1d( 'TRA', r1_4, aeiu(:,:,1), aeiv(:,:,1), aeiu, aeiv ) 
     436            ! 
     437         CASE ( -20 )      !== fixed horizontal shape read in file  ==! 
     438            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F(i,j) read in eddy_diffusivity_2D.nc file' 
     439            CALL iom_open ( 'eddy_induced_velocity_2D.nc', inum ) 
     440            CALL iom_get  ( inum, jpdom_data, 'aeiu', aeiu(:,:,1) ) 
     441            CALL iom_get  ( inum, jpdom_data, 'aeiv', aeiv(:,:,1) ) 
     442            CALL iom_close( inum ) 
     443            DO jk = 2, jpk 
     444               aeiu(:,:,jk) = aeiu(:,:,1) 
     445               aeiv(:,:,jk) = aeiv(:,:,1) 
     446            END DO 
     447            ! 
     448         CASE(  20  )      !== fixed horizontal shape  ==! 
     449            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap or bilap case)' 
     450            CALL ldf_c2d( 'TRA', 'LAP', rn_aeiv_0, aeiu, aeiv )    ! surface value proportional to scale factor 
     451            ! 
     452         CASE(  21  )       !==  time varying 2D field  ==! 
     453            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, time )' 
     454            IF(lwp) WRITE(numout,*) '                              = F( growth rate of baroclinic instability )' 
     455            ! 
     456            l_ldfeiv_time = .TRUE.     ! will be calculated by call to ldf_tra routine in step.F90 
     457            ! 
     458         CASE( -30  )      !== fixed 3D shape read in file  ==! 
     459            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F(i,j,k) read in eddy_diffusivity_3D.nc file' 
     460            CALL iom_open ( 'eddy_induced_velocity_3D.nc', inum ) 
     461            CALL iom_get  ( inum, jpdom_data, 'aeiu', aeiu ) 
     462            CALL iom_get  ( inum, jpdom_data, 'aeiv', aeiv ) 
     463            CALL iom_close( inum ) 
     464            ! 
     465         CASE(  30  )       !==  fixed 3D shape  ==! 
     466            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, depth )' 
     467            CALL ldf_c2d( 'TRA', 'LAP', rn_aeiv_0, aeiu, aeiv )    ! surface value proportional to scale factor 
     468            !                                                 ! reduction with depth 
     469            CALL ldf_c1d( 'TRA', r1_4, aeiu(:,:,1), aeiv(:,:,1), aeiu, aeiv ) 
     470            ! 
     471         CASE DEFAULT 
     472            CALL ctl_stop('ldf_tra_init: wrong choice for nn_aei_ijk_t, the type of space-time variation of aei') 
     473         END SELECT 
     474         ! 
    145475      ELSE 
    146          IF(lwp) WRITE(numout,*) '          harmonic tracer diffusion (default)' 
    147          IF( aht0 < 0 .AND. .NOT. lk_esopa )   CALL ctl_stop('The horizontal diffusivity coef. aht0 must be positive' ) 
    148       ENDIF 
    149  
    150  
    151       !  Lateral eddy diffusivity and eddy induced velocity coefficients 
    152       ! ================================================================ 
    153 #if defined key_traldf_c3d 
    154       CALL ldf_tra_c3d( ll_print )      ! aht = 3D coef. = F( longitude, latitude, depth ) 
    155 #elif defined key_traldf_c2d 
    156       CALL ldf_tra_c2d( ll_print )      ! aht = 2D coef. = F( longitude, latitude ) 
    157 #elif defined key_traldf_c1d 
    158       CALL ldf_tra_c1d( ll_print )      ! aht = 1D coef. = F( depth ) 
    159 #else 
    160                                         ! Constant coefficients 
    161       IF(lwp)WRITE(numout,*) 
    162       IF(lwp)WRITE(numout,*) '      constant eddy diffusivity coef.   ahtu = ahtv = ahtw = aht0 = ', aht0 
    163       IF( lk_traldf_eiv ) THEN 
    164          IF(lwp)WRITE(numout,*) '      constant eddy induced velocity coef.   aeiu = aeiv = aeiw = aeiv0 = ', aeiv0 
     476          IF(lwp) WRITE(numout,*) '   eddy induced velocity param is NOT used neither diagnosed' 
     477          ln_ldfeiv_dia = .FALSE. 
     478      ENDIF 
     479      !                     
     480   END SUBROUTINE ldf_eiv_init 
     481 
     482 
     483   SUBROUTINE ldf_eiv( kt, paei0, paeiu, paeiv ) 
     484      !!---------------------------------------------------------------------- 
     485      !!                  ***  ROUTINE ldf_eiv  *** 
     486      !! 
     487      !! ** Purpose :   Compute the eddy induced velocity coefficient from the 
     488      !!              growth rate of baroclinic instability. 
     489      !! 
     490      !! ** Method  :   coefficient function of the growth rate of baroclinic instability 
     491      !! 
     492      !! Reference : Treguier et al. JPO 1997   ; Held and Larichev JAS 1996 
     493      !!---------------------------------------------------------------------- 
     494      INTEGER                         , INTENT(in   ) ::   kt             ! ocean time-step index 
     495      REAL(wp)                        , INTENT(inout) ::   paei0          ! max value            [m2/s] 
     496      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   paeiu, paeiv   ! eiv coefficient      [m2/s] 
     497      ! 
     498      INTEGER  ::   ji, jj, jk    ! dummy loop indices 
     499      REAL(wp) ::   zfw, ze3w, zn2, z1_f20, zaht, zaht_min, zzaei   ! local scalars 
     500      REAL(wp), DIMENSION(:,:), POINTER ::   zn, zah, zhw, zross, zaeiw   ! 2D workspace 
     501      !!---------------------------------------------------------------------- 
     502      ! 
     503      IF( nn_timing == 1 )  CALL timing_start('ldf_eiv') 
     504      ! 
     505      CALL wrk_alloc( jpi,jpj, zn, zah, zhw, zross, zaeiw ) 
     506      !       
     507      zn   (:,:) = 0._wp      ! Local initialization 
     508      zhw  (:,:) = 5._wp 
     509      zah  (:,:) = 0._wp 
     510      zross(:,:) = 0._wp 
     511      !                       ! Compute lateral diffusive coefficient at T-point 
     512      IF( ln_traldf_triad ) THEN 
     513         DO jk = 1, jpk 
     514            DO jj = 2, jpjm1 
     515               DO ji = 2, jpim1 
     516                  ! Take the max of N^2 and zero then take the vertical sum  
     517                  ! of the square root of the resulting N^2 ( required to compute  
     518                  ! internal Rossby radius Ro = .5 * sum_jpk(N) / f  
     519                  zn2 = MAX( rn2b(ji,jj,jk), 0._wp ) 
     520                  zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk) 
     521                  ! Compute elements required for the inverse time scale of baroclinic 
     522                  ! eddies using the isopycnal slopes calculated in ldfslp.F :  
     523                  ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w)) 
     524                  ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk) 
     525                  zah(ji,jj) = zah(ji,jj) + zn2 * wslp2(ji,jj,jk) * ze3w 
     526                  zhw(ji,jj) = zhw(ji,jj) + ze3w 
     527               END DO 
     528            END DO 
     529         END DO 
     530      ELSE 
     531         DO jk = 1, jpk 
     532            DO jj = 2, jpjm1 
     533               DO ji = 2, jpim1 
     534                  ! Take the max of N^2 and zero then take the vertical sum  
     535                  ! of the square root of the resulting N^2 ( required to compute  
     536                  ! internal Rossby radius Ro = .5 * sum_jpk(N) / f  
     537                  zn2 = MAX( rn2b(ji,jj,jk), 0._wp ) 
     538                  zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk) 
     539                  ! Compute elements required for the inverse time scale of baroclinic 
     540                  ! eddies using the isopycnal slopes calculated in ldfslp.F :  
     541                  ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w)) 
     542                  ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk) 
     543                  zah(ji,jj) = zah(ji,jj) + zn2 * ( wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   & 
     544                     &                            + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) ) * ze3w 
     545                  zhw(ji,jj) = zhw(ji,jj) + ze3w 
     546               END DO 
     547            END DO 
     548         END DO 
     549      END IF 
     550 
     551      DO jj = 2, jpjm1 
     552         DO ji = fs_2, fs_jpim1   ! vector opt. 
     553            zfw = MAX( ABS( 2. * omega * SIN( rad * gphit(ji,jj) ) ) , 1.e-10 ) 
     554            ! Rossby radius at w-point taken < 40km and  > 2km 
     555            zross(ji,jj) = MAX( MIN( .4 * zn(ji,jj) / zfw, 40.e3 ), 2.e3 ) 
     556            ! Compute aeiw by multiplying Ro^2 and T^-1 
     557            zaeiw(ji,jj) = zross(ji,jj) * zross(ji,jj) * SQRT( zah(ji,jj) / zhw(ji,jj) ) * tmask(ji,jj,1) 
     558         END DO 
     559      END DO 
     560 
     561!!gm      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA R2 
     562!!gm         DO jj = 2, jpjm1 
     563!!gm            DO ji = fs_2, fs_jpim1   ! vector opt. 
     564!!gm               ! Take the minimum between aeiw and 1000 m2/s over shelves (depth shallower than 650 m) 
     565!!gm               IF( mbkt(ji,jj) <= 20 )   zaeiw(ji,jj) = MIN( zaeiw(ji,jj), 1000. ) 
     566!!gm            END DO 
     567!!gm         END DO 
     568!!gm      ENDIF 
     569 
     570      !                                         !==  Bound on eiv coeff.  ==! 
     571      z1_f20 = 1._wp / (  2._wp * omega * sin( rad * 20._wp )  ) 
     572      DO jj = 2, jpjm1 
     573         DO ji = fs_2, fs_jpim1   ! vector opt. 
     574            zzaei = MIN( 1._wp, ABS( ff(ji,jj) * z1_f20 ) ) * zaeiw(ji,jj)       ! tropical decrease 
     575            zaeiw(ji,jj) = MIN( zzaei , paei0 )                                  ! Max value = paei0 
     576         END DO 
     577      END DO 
     578      CALL lbc_lnk( zaeiw(:,:), 'W', 1. )       ! lateral boundary condition 
     579      !                
     580      DO jj = 2, jpjm1                          !== aei at u- and v-points  ==! 
     581         DO ji = fs_2, fs_jpim1   ! vector opt. 
     582            paeiu(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji+1,jj  ) ) * umask(ji,jj,1) 
     583            paeiv(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji  ,jj+1) ) * vmask(ji,jj,1) 
     584         END DO  
     585      END DO  
     586      CALL lbc_lnk( paeiu(:,:,1), 'U', 1. )   ;   CALL lbc_lnk( paeiv(:,:,1), 'V', 1. )      ! lateral boundary condition 
     587 
     588      DO jk = 2, jpkm1                          !==  deeper values equal the surface one  ==! 
     589         paeiu(:,:,jk) = paeiu(:,:,1) * umask(:,:,jk) 
     590         paeiv(:,:,jk) = paeiv(:,:,1) * vmask(:,:,jk) 
     591      END DO 
     592      !   
     593      CALL wrk_dealloc( jpi,jpj, zn, zah, zhw, zross, zaeiw ) 
     594      ! 
     595      IF( nn_timing == 1 )  CALL timing_stop('ldf_eiv') 
     596      ! 
     597   END SUBROUTINE ldf_eiv 
     598 
     599 
     600   SUBROUTINE ldf_eiv_trp( kt, kit000, pun, pvn, pwn, cdtype ) 
     601      !!---------------------------------------------------------------------- 
     602      !!                  ***  ROUTINE ldf_eiv_trp  *** 
     603      !!  
     604      !! ** Purpose :   add to the input ocean transport the contribution of  
     605      !!              the eddy induced velocity parametrization. 
     606      !! 
     607      !! ** Method  :   The eddy induced transport is computed from a flux stream- 
     608      !!              function which depends on the slope of iso-neutral surfaces 
     609      !!              (see ldf_slp). For example, in the i-k plan :  
     610      !!                   psi_uw = mk(aeiu) e2u mi(wslpi)   [in m3/s] 
     611      !!                   Utr_eiv = - dk[psi_uw] 
     612      !!                   Vtr_eiv = + di[psi_uw] 
     613      !!                ln_traldf_eiv_dia = T : output the associated streamfunction, 
     614      !!                                        velocity and heat transport (call ldf_eiv_dia) 
     615      !! 
     616      !! ** Action  : pun, pvn increased by the eiv transport 
     617      !!---------------------------------------------------------------------- 
     618      INTEGER                         , INTENT(in   ) ::   kt       ! ocean time-step index 
     619      INTEGER                         , INTENT(in   ) ::   kit000   ! first time step index 
     620      CHARACTER(len=3)                , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
     621      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun      ! in : 3 ocean transport components   [m3/s] 
     622      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvn      ! out: 3 ocean transport components   [m3/s] 
     623      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pwn      ! increased by the eiv                [m3/s] 
     624      !! 
     625      INTEGER  ::   ji, jj, jk                 ! dummy loop indices 
     626      REAL(wp) ::   zuwk, zuwk1, zuwi, zuwi1   ! local scalars 
     627      REAL(wp) ::   zvwk, zvwk1, zvwj, zvwj1   !   -      - 
     628      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zpsi_uw, zpsi_vw 
     629      !!---------------------------------------------------------------------- 
     630      ! 
     631      IF( nn_timing == 1 )  CALL timing_start( 'ldf_eiv_trp') 
     632      ! 
     633      CALL wrk_alloc( jpi, jpj, jpk, zpsi_uw, zpsi_vw ) 
     634 
     635      IF( kt == kit000 )  THEN 
     636         IF(lwp) WRITE(numout,*) 
     637         IF(lwp) WRITE(numout,*) 'ldf_eiv_trp : eddy induced advection on ', cdtype,' :' 
     638         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   add to velocity fields the eiv component' 
     639      ENDIF 
     640 
    165641       
    166       ENDIF 
    167 #endif 
    168  
    169 #if defined key_traldf_smag && ! defined key_traldf_c3d 
    170         CALL ctl_stop( 'key_traldf_smag can only be used with key_traldf_c3d' ) 
    171 #endif 
    172 #if defined key_traldf_smag 
    173         IF(lwp) WRITE(numout,*)' SMAGORINSKY DIFFUSION' 
    174         IF(lwp .AND. rn_smsh < 1)  WRITE(numout,*)' only  shear is used ' 
    175         IF(lwp.and.ln_traldf_bilap) CALL ctl_stop(' SMAGORINSKY + BILAPLACIAN - UNSTABLE OR NON_CONSERVATIVE' ) 
    176 #endif 
    177  
    178       ! 
    179    END SUBROUTINE ldf_tra_init 
    180  
    181 #if defined key_traldf_c3d 
    182 #   include "ldftra_c3d.h90" 
    183 #elif defined key_traldf_c2d 
    184 #   include "ldftra_c2d.h90" 
    185 #elif defined key_traldf_c1d 
    186 #   include "ldftra_c1d.h90" 
    187 #endif 
     642      zpsi_uw(:,:, 1 ) = 0._wp   ;   zpsi_vw(:,:, 1 ) = 0._wp 
     643      zpsi_uw(:,:,jpk) = 0._wp   ;   zpsi_vw(:,:,jpk) = 0._wp 
     644       
     645      DO jk = 2, jpkm1 
     646         DO jj = 1, jpjm1 
     647            DO ji = 1, fs_jpim1   ! vector opt. 
     648               zpsi_uw(ji,jj,jk) = - 0.25_wp * e2u(ji,jj) * ( wslpi(ji,jj,jk  ) + wslpi(ji+1,jj,jk) )   & 
     649                  &                                       * ( aeiu (ji,jj,jk-1) + aeiu (ji  ,jj,jk) ) * umask(ji,jj,jk) 
     650               zpsi_vw(ji,jj,jk) = - 0.25_wp * e1v(ji,jj) * ( wslpj(ji,jj,jk  ) + wslpj(ji,jj+1,jk) )   & 
     651                  &                                       * ( aeiv (ji,jj,jk-1) + aeiv (ji,jj  ,jk) ) * vmask(ji,jj,jk) 
     652            END DO 
     653         END DO 
     654      END DO 
     655 
     656      DO jk = 1, jpkm1 
     657         DO jj = 1, jpjm1 
     658            DO ji = 1, fs_jpim1   ! vector opt.                
     659               pun(ji,jj,jk) = pun(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) ) 
     660               pvn(ji,jj,jk) = pvn(ji,jj,jk) - ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) ) 
     661            END DO 
     662         END DO 
     663      END DO 
     664      DO jk = 1, jpkm1 
     665         DO jj = 2, jpjm1 
     666            DO ji = fs_2, fs_jpim1   ! vector opt. 
     667               pwn(ji,jj,jk) = pwn(ji,jj,jk) + (  zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj  ,jk)   & 
     668                  &                             + zpsi_vw(ji,jj,jk) - zpsi_vw(ji  ,jj-1,jk) ) 
     669            END DO 
     670         END DO 
     671      END DO 
     672       
     673      !                              ! diagnose the eddy induced velocity and associated heat transport 
     674      IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' )   CALL ldf_eiv_dia( zpsi_uw, zpsi_vw ) 
     675      ! 
     676      IF( nn_timing == 1 )  CALL timing_stop( 'ldf_eiv_trp') 
     677      ! 
     678    END SUBROUTINE ldf_eiv_trp 
     679 
     680 
     681   SUBROUTINE ldf_eiv_dia( psi_uw, psi_vw ) 
     682      !!---------------------------------------------------------------------- 
     683      !!                  ***  ROUTINE ldf_eiv_dia  *** 
     684      !! 
     685      !! ** Purpose :   diagnose the eddy induced velocity and its associated 
     686      !!              vertically integrated heat transport. 
     687      !! 
     688      !! ** Method : 
     689      !! 
     690      !!---------------------------------------------------------------------- 
     691      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   psi_uw, psi_vw   ! streamfunction   [m3/s] 
     692      ! 
     693      INTEGER  ::   ji, jj, jk    ! dummy loop indices 
     694      REAL(wp) ::   zztmp   ! local scalar 
     695      REAL(wp), DIMENSION(:,:)  , POINTER ::   zw2d   ! 2D workspace 
     696      REAL(wp), DIMENSION(:,:,:), POINTER ::   zw3d   ! 3D workspace 
     697      !!---------------------------------------------------------------------- 
     698      ! 
     699      IF( nn_timing == 1 )  CALL timing_start( 'ldf_eiv_dia') 
     700      ! 
     701      !                                                  !==  eiv stream function: output  ==! 
     702      CALL lbc_lnk( psi_uw, 'U', -1. )                         ! lateral boundary condition 
     703      CALL lbc_lnk( psi_vw, 'V', -1. ) 
     704      ! 
     705!!gm      CALL iom_put( "psi_eiv_uw", psi_uw )                 ! output 
     706!!gm      CALL iom_put( "psi_eiv_vw", psi_vw ) 
     707      ! 
     708      !                                                  !==  eiv velocities: calculate and output  ==! 
     709      CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 
     710      ! 
     711      zw3d(:,:,jpk) = 0._wp                                    ! bottom value always 0 
     712      ! 
     713      DO jk = 1, jpkm1                                         ! e2u e3u u_eiv = -dk[psi_uw] 
     714         zw3d(:,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * fse3u(:,:,jk) ) 
     715      END DO 
     716      CALL iom_put( "uoce_eiv", zw3d ) 
     717      ! 
     718      DO jk = 1, jpkm1                                         ! e1v e3v v_eiv = -dk[psi_vw] 
     719         zw3d(:,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * fse3v(:,:,jk) ) 
     720      END DO 
     721      CALL iom_put( "voce_eiv", zw3d ) 
     722      ! 
     723      DO jk = 1, jpkm1                                         ! e1 e2 w_eiv = dk[psix] + dk[psix] 
     724         DO jj = 2, jpjm1 
     725            DO ji = fs_2, fs_jpim1  ! vector opt. 
     726               zw3d(ji,jj,jk) = (  psi_vw(ji,jj,jk) - psi_vw(ji  ,jj-1,jk)    & 
     727                  &              + psi_uw(ji,jj,jk) - psi_uw(ji-1,jj  ,jk)  ) / e1e2t(ji,jj) 
     728            END DO 
     729         END DO 
     730      END DO 
     731      CALL lbc_lnk( zw3d, 'T', 1. )      ! lateral boundary condition 
     732      CALL iom_put( "woce_eiv", zw3d ) 
     733      ! 
     734      CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 
     735      !       
     736      ! 
     737      IF( lk_diaar5 ) THEN                               !==  eiv heat transport: calculate and output  ==! 
     738         CALL wrk_alloc( jpi, jpj, zw2d ) 
     739         ! 
     740         zztmp = 0.5_wp * rau0 * rcp  
     741         zw2d(:,:) = 0._wp  
     742         DO jk = 1, jpkm1 
     743            DO jj = 2, jpjm1 
     744               DO ji = fs_2, fs_jpim1   ! vector opt. 
     745                  zw2d(ji,jj) = zw2d(ji,jj) + zztmp * ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   & 
     746                     &                              * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji+1,jj,jk,jp_tem) )  
     747               END DO 
     748            END DO 
     749         END DO 
     750         CALL lbc_lnk( zw2d, 'U', -1. ) 
     751         CALL iom_put( "ueiv_heattr", zw2d )                  ! heat transport in i-direction 
     752         zw2d(:,:) = 0._wp  
     753         DO jk = 1, jpkm1 
     754            DO jj = 2, jpjm1 
     755               DO ji = fs_2, fs_jpim1   ! vector opt. 
     756                  zw2d(ji,jj) = zw2d(ji,jj) + zztmp * ( psi_vw(ji,jj,jk+1)      - psi_vw(ji,jj,jk)          )   & 
     757                     &                              * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji,jj+1,jk,jp_tem) )  
     758               END DO 
     759            END DO 
     760         END DO 
     761         CALL lbc_lnk( zw2d, 'V', -1. ) 
     762         CALL iom_put( "veiv_heattr", zw2d )                  !  heat transport in i-direction 
     763         ! 
     764         CALL wrk_dealloc( jpi, jpj, zw2d ) 
     765      ENDIF 
     766      ! 
     767      IF( nn_timing == 1 )  CALL timing_stop( 'ldf_eiv_dia')       
     768      ! 
     769   END SUBROUTINE ldf_eiv_dia 
    188770 
    189771   !!====================================================================== 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_smag.F90

    r3634 r4596  
    44   !! Ocean physics:  variable eddy induced velocity coefficients 
    55   !!====================================================================== 
    6 #if   defined key_traldf_smag   &&   defined key_traldf_c3d 
     6   !!  last modified : Maria Luneva, October 2012 
     7   !!---------------------------------------------------------------------- 
     8#if   defined key_traldf_smag 
    79   !!---------------------------------------------------------------------- 
    810   !!   'key_traldf_smag'      and           smagorinsky  diffusivity 
    9    !!   'key_traldf_c3d'                    3D tracer lateral  mixing coef. 
    1011   !!---------------------------------------------------------------------- 
    11    !!   ldf_eiv      : compute the eddy induced velocity coefficients 
     12   !!   ldf_tra_smag  : compute the smagorinski eddy coefficients 
    1213   !!---------------------------------------------------------------------- 
    13    !! * Modules used 
    14    USE oce             ! ocean dynamics and tracers 
    15    USE dom_oce         ! ocean space and time domain 
    16    USE sbc_oce         ! surface boundary condition: ocean 
    17    USE sbcrnf          ! river runoffs 
    18    USE ldftra_oce      ! ocean tracer   lateral physics 
    19    USE phycst          ! physical constants 
    20    USE ldfslp          ! iso-neutral slopes 
    21    USE in_out_manager  ! I/O manager 
    22    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    23    USE prtctl          ! Print control 
    24    USE iom 
    25    USE wrk_nemo 
     14   USE oce            ! ocean dynamics and tracers 
     15   USE dom_oce        ! ocean space and time domain 
     16   USE sbc_oce        ! surface boundary condition: ocean 
     17   USE sbcrnf         ! river runoffs 
     18   USE ldftra         ! ocean tracer   lateral physics 
     19   USE phycst         ! physical constants 
     20   USE ldfslp         ! iso-neutral slopes 
     21   ! 
     22   USE in_out_manager ! I/O manager 
     23   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     24   USE prtctl         ! Print control 
     25   USE iom            ! 
     26   USE ioipsl         ! 
     27   USE wrk_nemo       ! 
     28    
    2629   IMPLICIT NONE 
    2730   PRIVATE 
    2831 
    29    !! * Routine accessibility 
    3032   PUBLIC ldf_tra_smag               ! routine called by step.F90 
    31    !!---------------------------------------------------------------------- 
    32    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    33    !! $Id: ldf_tra_smag.F90 1482 2010-06-13 15:28:06Z  $ 
    34    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    35    !!---------------------------------------------------------------------- 
     33    
    3634   !! * Substitutions 
    3735#  include "domzgr_substitute.h90" 
    3836#  include "vectopt_loop_substitute.h90" 
    3937   !!---------------------------------------------------------------------- 
    40  
     38   !! NEMO/OPA 3.6 , LOCEAN-IPSL (2014)  
     39   !! $Id: ldf_tra_smag.F90 1482 2010-06-13 15:28:06Z  $ 
     40   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     41   !!---------------------------------------------------------------------- 
    4142CONTAINS 
    4243 
    43   
    44  
    45  
    46  
    47   !!---------------------------------------------------------------------- 
    48   !!                        ***  ldf_tra_smag.F90  *** 
    49   !!---------------------------------------------------------------------- 
    50  
    51  
    5244   SUBROUTINE ldf_tra_smag( kt ) 
    53       !!---------------------------------------------------------------------- 
    5445      !!---------------------------------------------------------------------- 
    5546      !!                  ***  ROUTINE ldf_tra_smag  *** 
    … …  
    7566      !!                           :  ahm3, ahm4 defined at U- and V-points 
    7667      !!       ??? explanation of the default is missing 
    77       !!  last modified : Maria Luneva, October 2012 
    7868      !!---------------------------------------------------------------------- 
    79       !! 
    80       !!---------------------------------------------------------------------- 
    81       !! * Modules used 
    82       USE ioipsl 
    83       REAL ( wp), POINTER , DIMENSION (:,:) :: zux, zvx , zuy , zvy  
    84       REAL ( wp), POINTER , DIMENSION (:,:) :: zue1, zue2 , zve1 , zve2  
    85       INTEGER, INTENT( in )                 ::   kt                             ! ocean time-step inedx 
    86       !! * Arguments 
    87       INTEGER                               :: ji,jj,jk 
    88  
    89       REAL (wp)                             ::     zdeltau, zdeltav, zhsmag ,zsmsh    ! temporary scalars 
     69      INTEGER, INTENT( in ) ::   kt   ! ocean time-step inedx 
     70      ! 
     71      INTEGER  ::   ji, jj, jk               ! dummy loop indices 
     72      REAL(wp) ::   zdeltau, zhsmag          ! local scalars 
     73      REAL(wp) ::   zdeltav, zsmsh , zcoef   !   -      - 
     74      REAL(wp), POINTER , DIMENSION (:,:) ::   zux, zvx , zuy , zvy  
     75      REAL(wp), POINTER , DIMENSION (:,:) ::   zue1, zue2 , zve1 , zve2  
    9076       
    9177      CALL wrk_alloc (jpi,jpj,zux, zvx , zuy , zvy ) 
    9278      CALL wrk_alloc (jpi,jpj,zue1, zue2 , zve1 , zve2 ) 
    9379      !!---------------------------------------------------------------------- 
     80      ! 
    9481      IF(  kt == nit000 ) THEN 
    9582         IF(lwp) WRITE(numout,*) 
    9683         IF(lwp) WRITE(numout,*) ' ldf_tra_smag : 3D eddy smagorinsky diffusivity ' 
    9784         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   --  ' 
    98          IF(lwp) WRITE(numout,*) '               Coefficients are computed' 
    99          IF(lwp) WRITE(numout,*) 
    100          IF(lwp) WRITE(numout,*) 
    10185      ENDIF 
    10286 
    10387      zhsmag = rn_chsmag 
    10488      zsmsh  = rn_smsh  
    105       zux(:,:)=0._wp ; zuy(:,:)=0._wp ; zvx(:,:)=0._wp ; zvy(:,:)=0._wp 
     89      zux(:,:) = 0._wp   ;   zuy(:,:) = 0._wp   ;   zvx(:,:) = 0._wp   ;   zvy(:,:) = 0._wp 
    10690 
    10791      ! ------------------- 
    10892      ahtt(:,:,:) = rn_aht_0 
    109        IF( ln_traldf_bilap ) THEN 
    110         IF( lwp .AND. kt == nit000) WRITE(numout,* )'ldf_tra_smag :no bilaplacian Smagorinsky diffusivity' 
    111         IF( lwp .AND. kt == nit000) WRITE(numout,* )'ldf_tra_smag :bilaplacian diffusivity set to constant'   
    112        ENDIF 
     93      IF( ln_traldf_bilap ) THEN 
     94         IF( lwp .AND. kt == nit000) WRITE(numout,* ) 'ldf_tra_smag :no bilaplacian Smagorinsky diffusivity' 
     95         IF( lwp .AND. kt == nit000) WRITE(numout,* ) 'ldf_tra_smag :bilaplacian diffusivity set to constant'   
     96      ENDIF 
    11397 
    11498 
    … …  
    116100      ! harmonic operator   (U-, V-, W-points) 
    117101      ! -----------------  
    118  
    119102      ahtu(:,:,:) = rn_aht_0                  ! set ahtu , ahtv at u- and v-points, 
    120103      ahtv(:,:,:) = rn_aht_0                  ! and ahtw at w-point 
    121       ahtw(:,:,:) = rn_aht_0                  ! (here example: no space variation) 
    122104       
    123105      IF( ln_traldf_lap ) THEN 
    124  
    125          DO jk=1,jpk 
    126  
    127            zue2(:,:)=un(:,:,jk)/e2u(:,:) 
    128            zve1(:,:)=vn(:,:,jk)/e1v(:,:) 
    129            zue1(:,:)=un(:,:,jk)/e1u(:,:) 
    130            zve2(:,:)=vn(:,:,jk)/e2v(:,:) 
    131  
    132  
    133            DO jj=2,jpj 
    134             DO ji=2,jpi 
    135             zux(ji,jj)=(zue2(ji,jj)-zue2(ji-1,jj))/e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk) * zsmsh  
    136             zvy(ji,jj)=(zve1(ji,jj)-zve1(ji,jj-1))/e2t(ji,jj)*e1t(ji,jj)*tmask(ji,jj,jk) * zsmsh  
    137             ENDDO 
    138            ENDDO 
    139  
    140            DO jj=1,jpjm1 
    141             DO ji=1,jpim1 
    142             zuy(ji,jj)=(zue1(ji,jj+1)-zue1(ji,jj))/e2f(ji,jj)*e1f(ji,jj)*fmask(ji,jj,jk) 
    143             zvx(ji,jj)=(zve2(ji+1,jj)-zve2(ji,jj))/e1f(ji,jj)*e2f(ji,jj)*fmask(ji,jj,jk) 
    144             ENDDO 
    145            ENDDO 
    146  
    147  
    148           DO jj=2,jpjm1 
    149            DO ji=2,jpim1 
    150            zdeltau=2._wp/( e1u(ji,jj)**(-2)+e2u(ji,jj)**(-2) ) 
    151            zdeltav=2._wp/( e1v(ji,jj)**(-2)+e2v(ji,jj)**(-2) ) 
    152  
    153            ahtu(ji,jj,jk)=MAX( rn_aht_0 , (zhsmag/rpi)**2*zdeltau*                                & 
    154                           SQRT(0.25_wp*( zux(ji,jj)+zux(ji+1,jj)-zvy(ji,jj)-zvy(ji+1,jj) )**2+    & 
    155                                0.25_wp*( zuy(ji,jj)+zuy(ji,jj-1)+zvx(ji,jj)+zvx(ji,jj-1)  )**2) ) 
    156  
    157            ahtv(ji,jj,jk)=MAX( rn_aht_0 ,  (zhsmag/rpi)**2*zdeltav*                               & 
    158                           SQRT(0.25_wp*( zux(ji,jj)+zux(ji,jj+1)-zvy(ji,jj)-zvy(ji,jj+1) )**2+    & 
    159                                0.25_wp*( zuy(ji,jj)+zuy(ji-1,jj)+zvx(ji-1,jj)+zvx(ji,jj)  )**2) ) 
    160  
    161  
    162          !!! stability criteria: aht<delta**2/(4*dt)   dt=2*rdt , positiveness require aht<delta**2/(8*dt) 
    163              ahtu(ji,jj,jk)=MIN(ahtu(ji,jj,jk),zdeltau/(16*rdt) ,rn_aht_m) 
    164              ahtv(ji,jj,jk)=MIN(ahtv(ji,jj,jk),zdeltav/(16*rdt) ,rn_aht_m) 
    165          ! so... 
    166  
    167  
    168             ENDDO 
    169            ENDDO 
    170          ENDDO 
    171         ENDIF 
    172             ahtu(:,:,jpk) = ahtu(:,:,jpkm1) 
    173             ahtv(:,:,jpk) = ahtv(:,:,jpkm1) 
    174         CALL lbc_lnk( ahtu, 'U', 1. )   ! Lateral boundary conditions 
    175         CALL lbc_lnk( ahtv, 'V', 1. ) 
    176  
    177 IF(  kt == nit000 ) THEN 
    178  
    179       IF(lwp ) THEN                    ! Control print 
    180          WRITE(numout,*) 
    181          WRITE(numout,*) 'inildf: ahtu at k = 1' 
    182          CALL prihre( ahtu(:,:,1), jpi, jpj, 1, jpi, 1,   & 
    183             &                                1, jpj, 1, 1.e-1, numout ) 
    184          WRITE(numout,*) 
    185          WRITE(numout,*) 'inildf: ahtv at k = 1' 
    186          CALL prihre( ahtv(:,:,1), jpi, jpj, 1, jpi, 1,   & 
    187             &                                1, jpj, 1, 1.e-1, numout ) 
    188          WRITE(numout,*) 
    189          WRITE(numout,*) 'inildf: ahtw at k = 1' 
    190          CALL prihre( ahtw(:,:,1), jpi, jpj, 1, jpi, 1,   & 
    191             &                                1, jpj, 1, 1.e-1, numout ) 
     106         ! 
     107         DO jk = 1 , jpkm1 
     108            zue2(:,:) = un(:,:,jk) / e2u(:,:)          !!gm  for stability reason use of before instead of now here !!!! 
     109            zve1(:,:) = vn(:,:,jk) / e1v(:,:) 
     110            zue1(:,:) = un(:,:,jk) / e1u(:,:) 
     111            zve2(:,:) = vn(:,:,jk) / e2v(:,:) 
     112            ! 
     113            DO jj = 2, jpj                               !!gm  multiplication by tmask useless as un, vn maked field ! 
     114               DO ji= 2, jpi 
     115                  zux(ji,jj) = ( zue2(ji,jj) - zue2(ji-1,jj  ) ) / e1e2t(ji,jj) * tmask(ji,jj,jk) * zsmsh  
     116                  zvy(ji,jj) = ( zve1(ji,jj) - zve1(ji  ,jj-1) ) / e1e2t(ji,jj) * tmask(ji,jj,jk) * zsmsh  
     117               END DO 
     118            END DO 
     119            ! 
     120            DO jj = 1, jpjm1 
     121               DO ji = 1, jpim1 
     122               zuy(ji,jj) = ( zue1(ji  ,jj+1) - zue1(ji,jj) ) / e2f(ji,jj) *e1f(ji,jj) * fmask(ji,jj,jk) 
     123               zvx(ji,jj) = ( zve2(ji+1,jj  ) - zve2(ji,jj) ) / e1f(ji,jj) *e2f(ji,jj) * fmask(ji,jj,jk) 
     124               END DO 
     125            END DO 
     126            ! 
     127            DO jj = 2, jpjm1 
     128               DO ji = 2, jpim1 
     129                  zdeltau = 2._wp / ( e1u(ji,jj)**(-2) + e2u(ji,jj)**(-2) ) 
     130                  zdeltav = 2._wp / ( e1v(ji,jj)**(-2) + e2v(ji,jj)**(-2) ) 
     131                  ! 
     132                  ahtu(ji,jj,jk) = MAX( rn_aht_0 , (zhsmag/rpi)**2*zdeltau*                                    & 
     133                     &            SQRT(  0.25_wp*( zux(ji,jj)+zux(ji+1,jj  )-zvy(ji,jj)-zvy(ji+1,jj  ) )**2    & 
     134                     &                 + 0.25_wp*( zuy(ji,jj)+zuy(ji  ,jj-1)+zvx(ji,jj)+zvx(ji  ,jj-1) )**2  )   ) 
     135                     ! 
     136                  ahtv(ji,jj,jk) = MAX( rn_aht_0 ,  (zhsmag/rpi)**2*zdeltav*                                   & 
     137                     &             SQRT(  0.25_wp*( zux(ji,jj)+zux(ji  ,jj+1)-zvy(ji  ,jj)-zvy(ji,jj+1) )**2     & 
     138                     &                  + 0.25_wp*( zuy(ji,jj)+zuy(ji-1,jj  )+zvx(ji-1,jj)+zvx(ji,jj  )  )**2  )   ) 
     139                     ! 
     140                  ! stability criteria: aht<delta**2/(4*dt)   dt=2*rdt , positiveness require aht<delta**2/(8*dt) 
     141                  ahtu(ji,jj,jk) = MIN( ahtu(ji,jj,jk) , zdeltau / (16*rdt) , rn_aht_m ) 
     142                  ahtv(ji,jj,jk) = MIN( ahtv(ji,jj,jk) , zdeltav / (16*rdt) , rn_aht_m ) 
     143               END DO 
     144            END DO 
     145         END DO 
    192146      ENDIF 
    193 ENDIF 
    194  
     147      ahtu(:,:,jpk) = ahtu(:,:,jpkm1) 
     148      ahtv(:,:,jpk) = ahtv(:,:,jpkm1) 
     149      CALL lbc_lnk( ahtu, 'U', 1. )   ! Lateral boundary conditions 
     150      CALL lbc_lnk( ahtv, 'V', 1. ) 
     151      ! 
    195152      CALL wrk_dealloc ( jpi,jpj,zux, zvx , zuy , zvy     ) 
    196153      CALL wrk_dealloc ( jpi,jpj,zue1, zue2 , zve1 , zve2 ) 
     154      ! 
     155   END SUBROUTINE ldf_tra_smag 
    197156 
    198  
    199 END SUBROUTINE ldf_tra_smag 
    200157#else 
    201158   !!---------------------------------------------------------------------- 
    202159   !!   Default option                                         Dummy module 
    203160   !!---------------------------------------------------------------------- 
    204 CONTAINS 
     161   CONTAINS 
    205162   SUBROUTINE ldf_tra_smag( kt )       ! Empty routine 
    206163      WRITE(*,*) 'ldf_dyn_smag: You should not have seen this print! error? check keys ldf:c3d+smag', kt 
    … …  
    208165#endif 
    209166 
     167   !!====================================================================== 
    210168END MODULE ldftra_smag 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90

    r4292 r4596  
    55   !!====================================================================== 
    66   !! History :  3.3.1  !   2011-09  (Adani M)  Original code: Drag Coefficient  
    7    !!         :  3.4    !   2012-10  (Adani M)                 Stokes Drift  
     7   !!            3.4    !   2012-10  (Adani M)                 Stokes Drift  
     8   !!---------------------------------------------------------------------- 
     9 
     10   !!---------------------------------------------------------------------- 
     11   !!   sbc_wave       : read drag coefficient from wave model in netcdf files  
    812   !!---------------------------------------------------------------------- 
    913   USE iom             ! I/O manager library 
    1014   USE in_out_manager  ! I/O manager 
    1115   USE lib_mpp         ! distribued memory computing library 
    12    USE fldread        ! read input fields 
     16   USE fldread         ! read input fields 
    1317   USE oce 
    14    USE sbc_oce        ! Surface boundary condition: ocean fields 
     18   USE sbc_oce         ! Surface boundary condition: ocean fields 
    1519   USE domvvl 
    16  
    17     
    18    !!---------------------------------------------------------------------- 
    19    !!   sbc_wave       : read drag coefficient from wave model in netcdf files  
    20    !!---------------------------------------------------------------------- 
    2120 
    2221   IMPLICIT NONE 
    … …  
    5857      !!                
    5958      !!--------------------------------------------------------------------- 
    60       USE oce,  ONLY : un,vn,hdivn,rotn 
    61       USE divcur 
     59      USE oce,  ONLY : un,vn,hdivn 
     60      USE divhor 
    6261      USE wrk_nemo 
    6362#if defined key_bdy 
    … …  
    6867      INTEGER                ::  ifpr, jj,ji,jk  
    6968      INTEGER                ::   ios     ! Local integer output status for namelist read 
    70       REAL(wp),DIMENSION(:,:,:),POINTER             ::  udummy,vdummy,hdivdummy,rotdummy 
     69      REAL(wp),DIMENSION(:,:,:),POINTER             ::  udummy,vdummy,hdivdummy 
    7170      REAL                                          ::  z2dt,z1_2dt 
    7271      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i     ! array of namelist informations on the fields to read 
    … …  
    159158          END DO 
    160159 
    161           CALL wrk_alloc( jpi,jpj,jpk,udummy,vdummy,hdivdummy,rotdummy) 
     160          CALL wrk_alloc( jpi,jpj,jpk,udummy,vdummy,hdivdummy) 
    162161           
    163162          udummy(:,:,:)=un(:,:,:) 
    164163          vdummy(:,:,:)=vn(:,:,:) 
    165164          hdivdummy(:,:,:)=hdivn(:,:,:) 
    166           rotdummy(:,:,:)=rotn(:,:,:) 
    167165          un(:,:,:)=usd3d(:,:,:) 
    168166          vn(:,:,:)=vsd3d(:,:,:) 
    169           CALL div_cur(kt) 
     167          CALL div_hor(kt) 
    170168      !                                           !------------------------------! 
    171169      !                                           !     Now Vertical Velocity    ! 
    … …  
    184182          END DO 
    185183          hdivn(:,:,:)=hdivdummy(:,:,:) 
    186           rotn(:,:,:)=rotdummy(:,:,:) 
    187184          vn(:,:,:)=vdummy(:,:,:) 
    188185          un(:,:,:)=udummy(:,:,:) 
    189           CALL wrk_dealloc( jpi,jpj,jpk,udummy,vdummy,hdivdummy,rotdummy) 
     186          CALL wrk_dealloc( jpi,jpj,jpk,udummy,vdummy,hdivdummy) 
    190187      ENDIF 
    191188   END SUBROUTINE sbc_wave 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r4292 r4596  
    66   !! History :  2.0  !  2005-11  (G. Madec)  Original code 
    77   !!            3.3  !  2010-09  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport 
    8    !!            4.0  !  2011-06  (G. Madec)  Addition of Mixed Layer Eddy parameterisation 
     8   !!            3.6  !  2011-06  (G. Madec)  Addition of Mixed Layer Eddy parameterisation 
    99   !!---------------------------------------------------------------------- 
    1010 
    … …  
    2222   USE traadv_ubs      ! UBS      scheme           (tra_adv_ubs    routine) 
    2323   USE traadv_qck      ! QUICKEST scheme           (tra_adv_qck    routine) 
    24    USE traadv_eiv      ! eddy induced velocity     (tra_adv_eiv    routine) 
    2524   USE traadv_mle      ! ML eddy induced velocity  (tra_adv_mle    routine) 
    2625   USE cla             ! cross land advection      (cla_traadv     routine) 
    27    USE ldftra_oce      ! lateral diffusion coefficient on tracers 
     26   USE ldftra          ! lateral diffusion: eddy diffusivity & EIV coeff. 
     27   USE ldfslp          ! Lateral diffusion: slopes of neutral surfaces 
    2828   USE in_out_manager  ! I/O manager 
    2929   USE iom             ! I/O module 
    … …  
    3232   USE wrk_nemo        ! Memory Allocation 
    3333   USE timing          ! Timing 
    34  
    3534 
    3635   IMPLICIT NONE 
    … …  
    8786      ENDIF 
    8887      ! 
    89       IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2 )   CALL cla_traadv( kt )       !==  Cross Land Advection  ==! (hor. advection) 
     88      IF( nn_cla == 1 )   CALL cla_traadv( kt )       !==  Cross Land Advection  ==! (hor. advection) 
    9089      ! 
    9190      !                                               !==  effective transport  ==! 
    … …  
    105104      zwn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
    106105      ! 
    107       IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   & 
    108          &              CALL tra_adv_eiv( kt, nit000, zun, zvn, zwn, 'TRA' )    ! add the eiv transport (if necessary) 
     106      IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   & 
     107         &              CALL ldf_eiv_trp( kt, nit000, zun, zvn, zwn, 'TRA' )   ! add the eiv transport (if necessary) 
    109108      ! 
    110109      IF( ln_mle    )   CALL tra_adv_mle( kt, nit000, zun, zvn, zwn, 'TRA' )    ! add the mle transport (if necessary) 
    … …  
    160159      !!              tracer advection schemes and set nadv 
    161160      !!---------------------------------------------------------------------- 
    162       INTEGER ::   ioptio 
    163       INTEGER ::   ios                 ! Local integer output status for namelist read 
     161      INTEGER ::   ioptio, ios   ! Local integers 
    164162      !! 
    165163      NAMELIST/namtra_adv/ ln_traadv_cen2 , ln_traadv_tvd,     & 
    … …  
    168166         &                 ln_traadv_msc_ups 
    169167      !!---------------------------------------------------------------------- 
    170  
     168      ! 
    171169      REWIND( numnam_ref )              ! Namelist namtra_adv in reference namelist : Tracer advection scheme 
    172170      READ  ( numnam_ref, namtra_adv, IOSTAT = ios, ERR = 901) 
    173171901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_adv in reference namelist', lwp ) 
    174  
     172      ! 
    175173      REWIND( numnam_cfg )              ! Namelist namtra_adv in configuration namelist : Tracer advection scheme 
    176174      READ  ( numnam_cfg, namtra_adv, IOSTAT = ios, ERR = 902 ) 
    177175902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_adv in configuration namelist', lwp ) 
    178176      WRITE ( numond, namtra_adv ) 
    179  
     177      ! 
    180178      IF(lwp) THEN                    ! Namelist print 
    181179         WRITE(numout,*) 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90

    r4488 r4596  
    44   !! Ocean Active tracers : lateral diffusive trends  
    55   !!===================================================================== 
    6    !! History :  9.0  ! 2005-11 (G. Madec)  Original code 
    7    !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA  
     6   !! History :  9.0  ! 2005-11  (G. Madec)  Original code 
     7   !!  NEMO      3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA  
     8   !!            3.7  ! 2013-12  (G. Madec) remove the optional computation from T & S anomaly profiles and traldf_bilapg 
     9   !!             -   ! 2013-12  (F. Lemarie, G. Madec)  triad operator (Griffies) + Method of Stabilizing Correction 
     10   !!             -   ! 2014-01  (G. Madec)  restructuration/simplification of aht/aeiv specification 
    811   !!---------------------------------------------------------------------- 
    912 
    … …  
    1114   !!   tra_ldf      : update the tracer trend with the lateral diffusion 
    1215   !!   tra_ldf_init : initialization, namelist read, and parameters control 
    13    !!       ldf_ano  : compute lateral diffusion for constant T-S profiles 
    14    !!---------------------------------------------------------------------- 
    15    USE oce             ! ocean dynamics and tracers 
    16    USE dom_oce         ! ocean space and time domain 
    17    USE phycst          ! physical constants 
    18    USE ldftra_oce      ! ocean tracer   lateral physics 
    19    USE ldfslp          ! ??? 
    20    USE traldf_bilapg   ! lateral mixing            (tra_ldf_bilapg routine) 
    21    USE traldf_bilap    ! lateral mixing             (tra_ldf_bilap routine) 
    22    USE traldf_iso      ! lateral mixing               (tra_ldf_iso routine) 
    23    USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine) 
    24    USE traldf_lap      ! lateral mixing               (tra_ldf_lap routine) 
    25    USE trdmod_oce      ! ocean space and time domain 
    26    USE trdtra          ! ocean active tracers trends 
    27    USE prtctl          ! Print control 
    28    USE in_out_manager  ! I/O manager 
    29    USE lib_mpp         ! distribued memory computing library 
    30    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    31    USE wrk_nemo        ! Memory allocation 
    32    USE timing          ! Timing 
     16   !!---------------------------------------------------------------------- 
     17   USE oce              ! ocean dynamics and tracers 
     18   USE dom_oce          ! ocean space and time domain 
     19   USE phycst           ! physical constants 
     20   USE ldftra           ! lateral diffusion: eddy diffusivity & EIV coeff. 
     21   USE ldfslp           ! lateral diffusion: iso-neutral slope  
     22   USE traldf_iso       ! lateral diffusion (Madec operator)         (tra_ldf_iso routine) 
     23   USE traldf_iso_triad ! lateral diffusion (triad operator)   (tra_ldf_iso_triad routine) 
     24   USE traldf_lap       ! lateral diffusion (iso-level lap/blp) (tra_ldf_lap/_blp routine) 
     25   USE trdmod_oce       ! ocean space and time domain 
     26   USE trdtra           ! ocean active tracers trends 
     27   ! 
     28   USE prtctl           ! Print control 
     29   USE in_out_manager   ! I/O manager 
     30   USE lib_mpp          ! distribued memory computing library 
     31   USE lbclnk           ! ocean lateral boundary conditions (or mpp link) 
     32   USE wrk_nemo         ! Memory allocation 
     33   USE timing           ! Timing 
    3334 
    3435   IMPLICIT NONE 
    … …  
    3637 
    3738   PUBLIC   tra_ldf         ! called by step.F90  
    38    PUBLIC   tra_ldf_init    ! called by opa.F90  
     39   PUBLIC   tra_ldf_init    ! called by nemogcm.F90  
    3940   ! 
    4041   INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_traldf_... namlist logicals) 
    41  
    42    REAL, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   t0_ldf, s0_ldf   !: lateral diffusion trends of T & S for a cst profile 
    43    !                                                               !  (key_traldf_ano only) 
    4442 
    4543   !! * Substitutions 
    … …  
    4745#  include "vectopt_loop_substitute.h90" 
    4846   !!---------------------------------------------------------------------- 
    49    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     47   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    5048   !! $Id$  
    5149   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    7573 
    7674      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend 
    77       CASE ( 0 )   ;   CALL tra_ldf_lap     ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  ! iso-level laplacian 
    78       CASE ( 1 )                                                                              ! rotated laplacian 
    79          IF( ln_traldf_grif ) THEN                                                           
    80                        CALL tra_ldf_iso_grif( kt, nit000,'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )      ! Griffies operator 
     75      CASE ( 0 )   ;   CALL tra_ldf_lap     ( kt, nit000, 'TRA', gtsu, gtsv, ahtu, ahtv, tsb     , tsa, jpts, 1)  ! iso-level laplacian 
     76      CASE ( 1 )                                                                                      ! rotated laplacian 
     77         IF( ln_traldf_triad ) THEN                                                           
     78                       CALL tra_ldf_iso_triad( kt, nit000,'TRA', gtsu, gtsv, ahtu, ahtv, tsb, tsb, tsa, jpts, 1 )    ! triad operator 
    8179         ELSE                                                                                 
    82                        CALL tra_ldf_iso     ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )      ! Madec operator 
    83          ENDIF 
    84       CASE ( 2 )   ;   CALL tra_ldf_bilap   ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  ! iso-level bilaplacian 
    85       CASE ( 3 )   ;   CALL tra_ldf_bilapg  ( kt, nit000, 'TRA',             tsb, tsa, jpts        )  ! s-coord. geopot. bilap. 
     80                       CALL tra_ldf_iso      ( kt, nit000,'TRA', gtsu, gtsv, ahtu, ahtv, tsb, tsb, tsa, jpts, 1 )    ! Madec operator 
     81         ENDIF 
     82      CASE ( 2 )   ;   CALL tra_ldf_blp      ( kt, nit000,'TRA', gtsu, gtsv, ahtu, ahtv, tsb     , tsa, jpts )    ! iso-level bilaplacian 
     83      CASE ( 3 )   ;   CALL tra_ldf_iso_blp  ( kt, nit000,'TRA', gtsu, gtsv, ahtu, ahtv, tsb     , tsa, jpts )    ! rotated   bilaplacian 
    8684         ! 
    8785      CASE ( -1 )                                ! esopa: test all possibility with control print 
    88          CALL tra_ldf_lap   ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  
     86         CALL tra_ldf_lap   ( kt, nit000, 'TRA', gtsu, gtsv, ahtu, ahtv, tsb, tsa, jpts, 1 )  
    8987         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf0 - Ta: ', mask1=tmask,               & 
    9088         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    91          IF( ln_traldf_grif ) THEN 
    92             CALL tra_ldf_iso_grif( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) 
     89         IF( ln_traldf_triad ) THEN 
     90            CALL tra_ldf_iso_triad( kt, nit000, 'TRA', gtsu, gtsv, ahtu, ahtv, tsb, tsb, tsa, jpts, 1 ) 
    9391         ELSE 
    94             CALL tra_ldf_iso     ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )   
     92            CALL tra_ldf_iso      ( kt, nit000, 'TRA', gtsu, gtsv, ahtu, ahtv, tsb, tsb, tsa, jpts, 1 )   
    9593         ENDIF 
    9694         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf1 - Ta: ', mask1=tmask,               & 
    9795         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    98          CALL tra_ldf_bilap ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  
     96         CALL tra_ldf_blp   ( kt, nit000, 'TRA', gtsu, gtsv, ahtu, ahtv, tsb, tsa, jpts        )  
    9997         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf2 - Ta: ', mask1=tmask,               & 
    10098         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    101          CALL tra_ldf_bilapg( kt, nit000, 'TRA',             tsb, tsa, jpts        )  
    102          CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf3 - Ta: ', mask1=tmask,               & 
    103          &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    10499      END SELECT 
    105  
    106 #if defined key_traldf_ano 
    107       tsa(:,:,:,jp_tem) = tsa(:,:,:,jp_tem) - t0_ldf(:,:,:)      ! anomaly: substract the reference diffusivity 
    108       tsa(:,:,:,jp_sal) = tsa(:,:,:,jp_sal) - s0_ldf(:,:,:) 
    109 #endif 
    110100 
    111101      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics 
    … …  
    132122      !! 
    133123      !! ** Method  :   set nldf from the namtra_ldf logicals 
     124      !!      nldf == -2   NO diffusive operator used (advective operator should include diffusion) 
    134125      !!      nldf == -1   ESOPA test: ALL operators are used 
    135126      !!      nldf ==  0   laplacian operator 
    … …  
    155146      !                               ! control the input 
    156147      ioptio = 0 
    157       IF( ln_traldf_lap   )   ioptio = ioptio + 1 
    158       IF( ln_traldf_bilap )   ioptio = ioptio + 1 
    159       IF( ioptio >  1 )   CALL ctl_stop( '          use ONE or NONE of the 2 lap/bilap operator type on tracer' ) 
    160       IF( ioptio == 0 )   nldf = -2   ! No lateral diffusion 
     148      IF( ln_traldf_lap )   ioptio = ioptio + 1 
     149      IF( ln_traldf_blp )   ioptio = ioptio + 1 
     150      IF( ioptio >  1   )   CALL ctl_stop( '          use ONE or NONE of the 2 lap/bilap operator type on tracer' ) 
     151      IF( ioptio == 0   )   nldf = -2             ! No lateral diffusion 
    161152      ioptio = 0 
    162       IF( ln_traldf_level )   ioptio = ioptio + 1 
    163       IF( ln_traldf_hor   )   ioptio = ioptio + 1 
    164       IF( ln_traldf_iso   )   ioptio = ioptio + 1 
     153      IF( ln_traldf_lev )   ioptio = ioptio + 1 
     154      IF( ln_traldf_hor )   ioptio = ioptio + 1 
     155      IF( ln_traldf_iso )   ioptio = ioptio + 1 
    165156      IF( ioptio >  1 )   CALL ctl_stop( '          use only ONE direction (level/hor/iso)' ) 
    166157 
    … …  
    170161      IF( ln_traldf_lap ) THEN       ! laplacian operator 
    171162         IF ( ln_zco ) THEN                ! z-coordinate 
    172             IF ( ln_traldf_level )   nldf = 0      ! iso-level  (no rotation) 
     163            IF ( ln_traldf_lev .OR.  & 
     164               & ln_traldf_hor   )   nldf = 0      ! iso-level = horizontal  (no rotation) 
     165            IF ( ln_traldf_iso .OR.  &   
     166               & ln_traldf_triad )   nldf = 1      ! isoneutral (   rotation) 
     167         ENDIF 
     168         IF ( ln_zps ) THEN             ! z-coordinate 
     169            IF ( ln_traldf_lev   )   ierr = 1      ! iso-level not allowed 
    173170            IF ( ln_traldf_hor   )   nldf = 0      ! horizontal (no rotation) 
    174             IF ( ln_traldf_iso   )   nldf = 1      ! isoneutral (   rotation) 
    175          ENDIF 
    176          IF ( ln_zps ) THEN             ! z-coordinate 
    177             IF ( ln_traldf_level )   ierr = 1      ! iso-level not allowed 
    178             IF ( ln_traldf_hor   )   nldf = 0      ! horizontal (no rotation) 
    179             IF ( ln_traldf_iso   )   nldf = 1      ! isoneutral (   rotation) 
     171            IF ( ln_traldf_iso .OR.  &   
     172               & ln_traldf_triad )   nldf = 1      ! isoneutral (   rotation) 
    180173         ENDIF 
    181174         IF ( ln_sco ) THEN             ! z-coordinate 
    182             IF ( ln_traldf_level )   nldf = 0      ! iso-level  (no rotation) 
     175            IF ( ln_traldf_lev  )   nldf = 0      ! iso-level  (no rotation) 
    183176            IF ( ln_traldf_hor   )   nldf = 1      ! horizontal (   rotation) 
    184             IF ( ln_traldf_iso   )   nldf = 1      ! isoneutral (   rotation) 
    185          ENDIF 
    186       ENDIF 
    187  
    188       IF( ln_traldf_bilap ) THEN      ! bilaplacian operator 
     177            IF ( ln_traldf_iso .OR.  & 
     178               & ln_traldf_triad )   nldf = 1      ! isoneutral (   rotation) 
     179         ENDIF 
     180      ENDIF 
     181 
     182      IF( ln_traldf_blp ) THEN          ! bilaplacian operator 
    189183         IF ( ln_zco ) THEN                ! z-coordinate 
    190             IF ( ln_traldf_level )   nldf = 2      ! iso-level  (no rotation) 
     184            IF ( ln_traldf_lev .OR.  &      
     185               & ln_traldf_hor   )   nldf = 2      ! iso-level = horizontal (no rotation) 
     186            IF ( ln_traldf_iso .OR.  &  
     187               & ln_traldf_triad )   nldf = 3      ! isoneutral (   rotation) 
     188         ENDIF 
     189         IF ( ln_zps ) THEN             ! z-coordinate with partial step 
     190            IF ( ln_traldf_lev   )   ierr = 1      ! iso-level not allowed  
    191191            IF ( ln_traldf_hor   )   nldf = 2      ! horizontal (no rotation) 
    192             IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
    193          ENDIF 
    194          IF ( ln_zps ) THEN             ! z-coordinate 
    195             IF ( ln_traldf_level )   ierr = 1      ! iso-level not allowed  
    196             IF ( ln_traldf_hor   )   nldf = 2      ! horizontal (no rotation) 
    197             IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
    198          ENDIF 
    199          IF ( ln_sco ) THEN             ! z-coordinate 
    200             IF ( ln_traldf_level )   nldf = 2      ! iso-level  (no rotation) 
    201             IF ( ln_traldf_hor   )   nldf = 3      ! horizontal (   rotation) 
    202             IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
    203          ENDIF 
    204       ENDIF 
    205  
    206       IF( nldf == 3 )   CALL ctl_warn( 'geopotential bilaplacian tracer diffusion in s-coords not thoroughly tested' ) 
     192            IF ( ln_traldf_iso .OR.  & 
     193               & ln_traldf_triad )   nldf = 3      ! isoneutral (   rotation) 
     194         ENDIF 
     195         IF ( ln_sco ) THEN             ! s-coordinate 
     196            IF ( ln_traldf_lev   )   nldf = 2      ! iso-level  (no rotation) 
     197            IF ( ln_traldf_hor   )   nldf = 3      ! horizontal (   rotation)       !!gm   a checker.... 
     198            IF ( ln_traldf_iso .OR.  &  
     199               & ln_traldf_triad )   nldf = 3      ! isoneutral (   rotation) 
     200         ENDIF 
     201      ENDIF 
     202 
    207203      IF( ierr == 1 )   CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' ) 
    208       IF( ierr == 2 )   CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' ) 
    209       IF( lk_traldf_eiv .AND. .NOT.ln_traldf_iso )   & 
    210            CALL ctl_stop( '          eddy induced velocity on tracers',   & 
    211            &              ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' ) 
    212       IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation 
    213          IF( .NOT.lk_ldfslp )   CALL ctl_stop( '          the rotation of the diffusive tensor require key_ldfslp' ) 
    214          l_traldf_rot = .TRUE.                 ! needed for trazdf_imp 
    215       ENDIF 
    216  
     204      IF( ln_ldfeiv .AND. .NOT.( ln_traldf_iso .OR. ln_traldf_triad ) )                                    & 
     205           &            CALL ctl_stop( '          eddy induced velocity on tracers requires isopycnal',    & 
     206           &                                                                    ' laplacian diffusion' ) 
     207      IF( nldf == 1 .OR. nldf == 3 )   l_ldfslp = .TRUE.    ! slope of neutral surfaces required  
    217208      IF( lk_esopa ) THEN 
    218209         IF(lwp) WRITE(numout,*) '          esopa control: use all lateral physics options' 
    … …  
    229220         IF( nldf ==  3 )   WRITE(numout,*) '          Rotated bilaplacian' 
    230221      ENDIF 
    231  
    232       ! Reference T & S diffusivity (if necessary) 
    233       ! =========================== 
    234       CALL ldf_ano 
    235222      ! 
    236223   END SUBROUTINE tra_ldf_init 
    237  
    238 #if defined key_traldf_ano 
    239    !!---------------------------------------------------------------------- 
    240    !!   'key_traldf_ano'               T & S lateral diffusion on anomalies 
    241    !!---------------------------------------------------------------------- 
    242  
    243    SUBROUTINE ldf_ano 
    244       !!---------------------------------------------------------------------- 
    245       !!                  ***  ROUTINE ldf_ano  *** 
    246       !! 
    247       !! ** Purpose :   initializations of  
    248       !!---------------------------------------------------------------------- 
    249       ! 
    250       USE zdf_oce         ! vertical mixing 
    251       USE trazdf          ! vertical mixing: double diffusion 
    252       USE zdfddm          ! vertical mixing: double diffusion 
    253       ! 
    254       INTEGER  ::   jk              ! Dummy loop indice 
    255       INTEGER  ::   ierr            ! local integer 
    256       LOGICAL  ::   llsave          ! local logical 
    257       REAL(wp) ::   zt0, zs0, z12   ! local scalar 
    258       REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_ref, zs_ref, ztb, zsb, zavt      
    259       !!---------------------------------------------------------------------- 
    260       ! 
    261       IF( nn_timing == 1 )  CALL timing_start('ldf_ano') 
    262       ! 
    263       CALL wrk_alloc( jpi, jpj, jpk, zt_ref, zs_ref, ztb, zsb, zavt )  
    264       ! 
    265  
    266       IF(lwp) THEN 
    267          WRITE(numout,*) 
    268          WRITE(numout,*) 'tra:ldf_ano : lateral diffusion acting on anomalies' 
    269          WRITE(numout,*) '~~~~~~~~~~~' 
    270       ENDIF 
    271  
    272       !                              ! allocate trabbl arrays 
    273       ALLOCATE( t0_ldf(jpi,jpj,jpk) , s0_ldf(jpi,jpj,jpk) , STAT=ierr ) 
    274       IF( lk_mpp    )   CALL mpp_sum( ierr ) 
    275       IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_ano: unable to allocate arrays' ) 
    276  
    277       ! defined the T & S reference profiles 
    278       ! ------------------------------------ 
    279       zt0 =10.e0                               ! homogeneous ocean 
    280       zs0 =35.e0 
    281       zt_ref(:,:,:) = 10.0 * tmask(:,:,:) 
    282       zs_ref(:,:,:) = 35.0 * tmask(:,:,:) 
    283       IF(lwp) WRITE(numout,*) '              homogeneous ocean T = ', zt0, ' S = ',zs0 
    284  
    285       !                                        ! T & S profile (to be coded +namelist parameter 
    286  
    287       ! prepare the ldf computation 
    288       ! --------------------------- 
    289       llsave = l_trdtra 
    290       l_trdtra = .false.      ! desactivate trend computation 
    291       t0_ldf(:,:,:) = 0.e0 
    292       s0_ldf(:,:,:) = 0.e0 
    293       ztb   (:,:,:) = tsb (:,:,:,jp_tem) 
    294       zsb   (:,:,:) = tsb (:,:,:,jp_sal) 
    295       ua    (:,:,:) = tsa (:,:,:,jp_tem) 
    296       va    (:,:,:) = tsa (:,:,:,jp_sal) 
    297       zavt  (:,:,:) = avt(:,:,:) 
    298       IF( lk_zdfddm ) THEN CALL ctl_stop( ' key_traldf_ano with key_zdfddm not implemented' ) 
    299       ! set tb, sb to reference values and avr to zero 
    300       tsb (:,:,:,jp_tem) = zt_ref(:,:,:) 
    301       tsb (:,:,:,jp_sal) = zs_ref(:,:,:) 
    302       tsa (:,:,:,jp_tem) = 0.e0 
    303       tsa (:,:,:,jp_sal) = 0.e0 
    304       avt(:,:,:)         = 0.e0 
    305  
    306       ! Compute the ldf trends 
    307       ! ---------------------- 
    308       CALL tra_ldf( nit000 + 1 )      ! horizontal components (+1: no more init) 
    309       CALL tra_zdf( nit000     )      ! vertical component (if necessary nit000 to performed the init) 
    310  
    311       ! finalise the computation and recover all arrays 
    312       ! ----------------------------------------------- 
    313       l_trdtra = llsave 
    314       z12 = 2.e0 
    315       IF( neuler == 1)   z12 = 1.e0 
    316       IF( ln_zdfexp ) THEN      ! ta,sa are the trends 
    317          t0_ldf(:,:,:) = tsa(:,:,:,jp_tem) 
    318          s0_ldf(:,:,:) = tsa(:,:,:,jp_sal) 
    319       ELSE 
    320          DO jk = 1, jpkm1 
    321             t0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / ( z12 *rdttra(jk) ) 
    322             s0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / ( z12 *rdttra(jk) ) 
    323          END DO 
    324       ENDIF 
    325       tsb(:,:,:,jp_tem) = ztb (:,:,:) 
    326       tsb(:,:,:,jp_sal) = zsb (:,:,:) 
    327       tsa(:,:,:,jp_tem) = ua  (:,:,:) 
    328       tsa(:,:,:,jp_sal) = va  (:,:,:) 
    329       avt(:,:,:)        = zavt(:,:,:) 
    330       ! 
    331       CALL wrk_dealloc( jpi, jpj, jpk, zt_ref, zs_ref, ztb, zsb, zavt )  
    332       ! 
    333       IF( nn_timing == 1 )  CALL timing_stop('ldf_ano') 
    334       ! 
    335    END SUBROUTINE ldf_ano 
    336  
    337 #else 
    338    !!---------------------------------------------------------------------- 
    339    !!   default option :   Dummy code   NO T & S background profiles 
    340    !!---------------------------------------------------------------------- 
    341    SUBROUTINE ldf_ano 
    342       IF(lwp) THEN 
    343          WRITE(numout,*) 
    344          WRITE(numout,*) 'tra:ldf_ano : lateral diffusion acting on the full fields' 
    345          WRITE(numout,*) '~~~~~~~~~~~' 
    346       ENDIF 
    347    END SUBROUTINE ldf_ano 
    348 #endif 
    349224 
    350225   !!====================================================================== 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r4292 r4596  
    44   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend 
    55   !!====================================================================== 
    6    !! History :  OPA  !  1994-08  (G. Madec, M. Imbard) 
    7    !!            8.0  !  1997-05  (G. Madec)  split into traldf and trazdf 
    8    !!            NEMO !  2002-08  (G. Madec)  Free form, F90 
    9    !!            1.0  !  2005-11  (G. Madec)  merge traldf and trazdf :-) 
    10    !!            3.3  !  2010-09  (C. Ethe, G. Madec) Merge TRA-TRC 
     6   !! History :  OPA  ! 1994-08  (G. Madec, M. Imbard) 
     7   !!            8.0  ! 1997-05  (G. Madec)  split into traldf and trazdf 
     8   !!            NEMO ! 2002-08  (G. Madec)  Free form, F90 
     9   !!            1.0  ! 2005-11  (G. Madec)  merge traldf and trazdf :-) 
     10   !!            3.3  ! 2010-09  (C. Ethe, G. Madec) Merge TRA-TRC 
     11   !!            3.7  ! 2014-01  (G. Madec)  restructuration/simplification of aht/aeiv specification 
     12   !!            3.7  ! 2014-02  (F. Lemarie, G. Madec)  triad operator (Griffies) + Method of Stabilizing Correction 
    1113   !!---------------------------------------------------------------------- 
    12 #if   defined key_ldfslp   ||   defined key_esopa 
     14 
    1315   !!---------------------------------------------------------------------- 
    14    !!   'key_ldfslp'               slope of the lateral diffusive direction 
    15    !!---------------------------------------------------------------------- 
    16    !!   tra_ldf_iso  : update the tracer trend with the horizontal  
    17    !!                  component of a iso-neutral laplacian operator 
    18    !!                  and with the vertical part of 
    19    !!                  the isopycnal or geopotential s-coord. operator  
     16   !!   tra_ldf_iso  : update the tracer trend with the horizontal component of a iso-neutral laplacian operator 
     17   !!                  and with the vertical part of the isopycnal or geopotential s-coord. operator  
    2018   !!---------------------------------------------------------------------- 
    2119   USE oce             ! ocean dynamics and active tracers 
    … …  
    2321   USE trc_oce         ! share passive tracers/Ocean variables 
    2422   USE zdf_oce         ! ocean vertical physics 
    25    USE ldftra_oce      ! ocean active tracers: lateral physics 
     23   USE ldftra          ! lateral diffusion: tracer eddy coefficients 
    2624   USE ldfslp          ! iso-neutral slopes 
    2725   USE diaptr          ! poleward transport diagnostics 
     26   ! 
    2827   USE in_out_manager  ! I/O manager 
    2928   USE iom             ! I/O library 
    30 #if defined key_diaar5 
    3129   USE phycst          ! physical constants 
    3230   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    33 #endif 
    3431   USE wrk_nemo        ! Memory Allocation 
    3532   USE timing          ! Timing 
    … …  
    4239   !! * Substitutions 
    4340#  include "domzgr_substitute.h90" 
    44 #  include "ldftra_substitute.h90" 
    4541#  include "vectopt_loop_substitute.h90" 
    4642   !!---------------------------------------------------------------------- 
    47    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     43   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    4844   !! $Id$ 
    4945   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    5147CONTAINS 
    5248 
    53    SUBROUTINE tra_ldf_iso( kt, kit000, cdtype, pgu, pgv,              & 
    54       &                                ptb, pta, kjpt, pahtb0 ) 
     49  SUBROUTINE tra_ldf_iso( kt, kit000, cdtype, pgu, pgv , pahu, pahv ,       & 
     50       &                                      ptb, ptbb, pta , kjpt , kpass ) 
    5551      !!---------------------------------------------------------------------- 
    5652      !!                  ***  ROUTINE tra_ldf_iso  *** 
    … …  
    7167      !!      2nd part :  horizontal fluxes of the lateral mixing operator 
    7268      !!      ========     
    73       !!         zftu = (aht+ahtb0) e2u*e3u/e1u di[ tb ] 
    74       !!               - aht      e2u*uslp    dk[ mi(mk(tb)) ] 
    75       !!         zftv = (aht+ahtb0) e1v*e3v/e2v dj[ tb ] 
    76       !!               - aht      e2u*vslp    dk[ mj(mk(tb)) ] 
     69      !!         zftu =  pahu e2u*e3u/e1u di[ tb ] 
     70      !!               - pahu e2u*uslp    dk[ mi(mk(tb)) ] 
     71      !!         zftv =  pahv e1v*e3v/e2v dj[ tb ] 
     72      !!               - pahv e2u*vslp    dk[ mj(mk(tb)) ] 
    7773      !!      take the horizontal divergence of the fluxes: 
    7874      !!         difft = 1/(e1t*e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  } 
    … …  
    8379      !!      ========  (excluding the vertical flux proportional to dk[t] ) 
    8480      !!      vertical fluxes associated with the rotated lateral mixing: 
    85       !!         zftw =-aht { e2t*wslpi di[ mi(mk(tb)) ] 
    86       !!                     + e1t*wslpj dj[ mj(mk(tb)) ]  } 
     81      !!         zftw = - {  mi(mk(pahu)) * e2t*wslpi di[ mi(mk(tb)) ] 
     82      !!                   + mj(mk(pahv)) * e1t*wslpj dj[ mj(mk(tb)) ]  } 
    8783      !!      take the horizontal divergence of the fluxes: 
    8884      !!         difft = 1/(e1t*e2t*e3t) dk[ zftw ] 
    … …  
    9288      !! ** Action :   Update pta arrays with the before rotated diffusion 
    9389      !!---------------------------------------------------------------------- 
    94       USE oce     , ONLY:   zftu => ua       , zftv  => va         ! (ua,va) used as workspace 
    95       ! 
    9690      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    97       INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
     91      INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index 
    9892      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    9993      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
    100       REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels 
    101       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields 
    102       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
    103       REAL(wp)                             , INTENT(in   ) ::   pahtb0     ! background diffusion coef 
     94      INTEGER                              , INTENT(in   ) ::   kpass      ! =1/2 first or second passage 
     95      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu , pgv  ! tracer gradient at pstep levels 
     96      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s] 
     97      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! tracer (kpass=1) or laplacian of tracer (kpass=2) 
     98      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptbb       ! tracer (only used in kpass=2) 
     99      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
    104100      ! 
    105101      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
    106       REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3   ! local scalars 
    107       REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      - 
    108       REAL(wp) ::  zcoef0, zbtr, ztra            !   -      - 
     102      INTEGER  ::  ierr             ! local integer 
     103      REAL(wp) ::  zmsku, zahu_w, zabe1, zcof1, zcoef3   ! local scalars 
     104      REAL(wp) ::  zmskv, zahv_w, zabe2, zcof2, zcoef4   !   -      - 
     105      REAL(wp) ::  zcoef0, ze3w_2, zsign, z2dt, z1_2dt   !   -      - 
    109106#if defined key_diaar5 
    110107      REAL(wp)                         ::   zztmp               ! local scalar 
    111108#endif 
    112       REAL(wp), POINTER, DIMENSION(:,:  ) ::  zdkt, zdk1t, z2d 
    113       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdit, zdjt, ztfw  
     109      REAL(wp), POINTER, DIMENSION(:,:)   ::   zdkt, zdk1t, z2d 
     110      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdit, zdjt, zftu, zftv, ztfw  
    114111      !!---------------------------------------------------------------------- 
    115112      ! 
    … …  
    117114      ! 
    118115      CALL wrk_alloc( jpi, jpj,      zdkt, zdk1t, z2d )  
    119       CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw  )  
    120       ! 
    121  
     116      CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, zftu, zftv, ztfw  )  
     117      ! 
    122118      IF( kt == kit000 )  THEN 
    123119         IF(lwp) WRITE(numout,*) 
    124120         IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype 
    125121         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     122         ! 
     123         akz     (:,:,:) = 0._wp       
     124         ah_wslp2(:,:,:) = 0._wp 
     125      ENDIF 
     126      ! 
     127      !                                               ! set time step size (Euler/Leapfrog) 
     128      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   z2dt =     rdttra(1)      ! at nit000   (Euler) 
     129      ELSE                                        ;   z2dt = 2.* rdttra(1)      !             (Leapfrog) 
     130      ENDIF 
     131      z1_2dt = 1._wp / z2dt 
     132      ! 
     133      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0) 
     134      ELSE                    ;   zsign = -1._wp 
     135      ENDIF 
     136          
     137          
     138      !!---------------------------------------------------------------------- 
     139      !!   0 - calculate  ah_wslp2 and akz 
     140      !!---------------------------------------------------------------------- 
     141      ! 
     142      IF( kpass == 1 ) THEN                  !==  first pass only  ==! 
     143         ! 
     144         DO jk = 2, jpkm1 
     145            DO jj = 2, jpjm1 
     146               DO ji = fs_2, fs_jpim1   ! vector opt. 
     147                  ! 
     148                  zmsku = tmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          & 
     149                     &                           + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk) , 1._wp  ) 
     150                  zmskv = tmask(ji,jj,jk) / MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)          & 
     151                     &                           + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk) , 1._wp  ) 
     152                     ! 
     153                  zahu_w = (   pahu(ji  ,jj,jk-1) + pahu(ji-1,jj,jk)    & 
     154                     &       + pahu(ji-1,jj,jk-1) + pahu(ji  ,jj,jk)  ) * zmsku 
     155                  zahv_w = (   pahv(ji,jj  ,jk-1) + pahv(ji,jj-1,jk)    & 
     156                     &       + pahv(ji,jj-1,jk-1) + pahv(ji,jj  ,jk)  ) * zmskv 
     157                     ! 
     158                  ah_wslp2(ji,jj,jk) = zahu_w * wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   & 
     159                     &               + zahv_w * wslpj(ji,jj,jk) * wslpj(ji,jj,jk) 
     160               END DO 
     161            END DO 
     162         END DO 
     163         ! 
     164         IF( ln_traldf_msc ) THEN                ! stabilizing vertical diffusivity coefficient 
     165            DO jk = 2, jpkm1 
     166               DO jj = 2, jpjm1 
     167                  DO ji = fs_2, fs_jpim1 
     168                     akz(ji,jj,jk) = 0.25_wp * (                                                                     & 
     169                        &              ( pahu(ji  ,jj,jk) + pahu(ji  ,jj,jk-1) ) / ( e1u(ji  ,jj) * e1u(ji  ,jj) )   & 
     170                        &            + ( pahu(ji-1,jj,jk) + pahu(ji-1,jj,jk-1) ) / ( e1u(ji-1,jj) * e1u(ji-1,jj) )   & 
     171                        &            + ( pahv(ji,jj  ,jk) + pahv(ji,jj  ,jk-1) ) / ( e2v(ji,jj  ) * e2v(ji,jj  ) )   & 
     172                        &            + ( pahv(ji,jj-1,jk) + pahv(ji,jj-1,jk-1) ) / ( e2v(ji,jj-1) * e2v(ji,jj-1) )   ) 
     173                  END DO 
     174               END DO 
     175            END DO 
     176            ! 
     177            IF( ln_traldf_blp ) THEN                ! bilaplacian operator 
     178               DO jk = 2, jpkm1 
     179                  DO jj = 1, jpjm1 
     180                     DO ji = 1, fs_jpim1 
     181                        akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk)   & 
     182                           &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( fse3w(ji,jj,jk) * fse3w(ji,jj,jk) )  ) 
     183                     END DO 
     184                  END DO 
     185               END DO 
     186            ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator 
     187               DO jk = 2, jpkm1 
     188                  DO jj = 1, jpjm1 
     189                     DO ji = 1, fs_jpim1 
     190                        ze3w_2 = fse3w(ji,jj,jk) * fse3w(ji,jj,jk) 
     191                        zcoef0 = z2dt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  ) 
     192                        akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt 
     193                     END DO 
     194                  END DO 
     195               END DO 
     196           ENDIF 
     197           ! 
     198         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 
     199            akz(:,:,:) = ah_wslp2(:,:,:)       
     200         ENDIF 
    126201      ENDIF 
    127202      ! 
    … …  
    133208         !!   I - masked horizontal derivative  
    134209         !!---------------------------------------------------------------------- 
    135          !!bug ajout.... why?   ( 1,jpj,:) and (jpi,1,:) should be sufficient.... 
    136          zdit (1,:,:) = 0.e0     ;     zdit (jpi,:,:) = 0.e0 
    137          zdjt (1,:,:) = 0.e0     ;     zdjt (jpi,:,:) = 0.e0 
     210!!gm : bug.... why (x,:,:)?   (1,jpj,:) and (jpi,1,:) should be sufficient.... 
     211         zdit (1,:,:) = 0._wp     ;     zdit (jpi,:,:) = 0._wp 
     212         zdjt (1,:,:) = 0._wp     ;     zdjt (jpi,:,:) = 0._wp 
    138213         !!end 
    139214 
    … …  
    159234         !!   II - horizontal trend  (full) 
    160235         !!---------------------------------------------------------------------- 
    161 !CDIR PARALLEL DO PRIVATE( zdk1t )  
    162          !                                                ! =============== 
     236         ! 
    163237         DO jk = 1, jpkm1                                 ! Horizontal slab 
    164             !                                             ! =============== 
    165             ! 1. Vertical tracer gradient at level jk and jk+1 
    166             ! ------------------------------------------------ 
    167             ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2) 
    168             zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask(:,:,jk+1) 
    169             ! 
    170             IF( jk == 1 ) THEN   ;   zdkt(:,:) = zdk1t(:,:) 
     238            ! 
     239            !                             !== Vertical tracer gradient 
     240            zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask(:,:,jk+1)     ! level jk+1 
     241            ! 
     242            IF( jk == 1 ) THEN   ;   zdkt(:,:) = zdk1t(:,:)                          ! surface: zdkt(jk=1)=zdkt(jk=2) 
    171243            ELSE                 ;   zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk) 
    172244            ENDIF 
    173245 
    174             ! 2. Horizontal fluxes 
    175             ! --------------------    
    176             DO jj = 1 , jpjm1 
     246            DO jj = 1 , jpjm1            !==  Horizontal fluxes 
    177247               DO ji = 1, fs_jpim1   ! vector opt. 
    178                   zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) 
    179                   zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) 
     248                  zabe1 = pahu(ji,jj,jk) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) 
     249                  zabe2 = pahv(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) 
    180250                  ! 
    181251                  zmsku = 1. / MAX(  tmask(ji+1,jj,jk  ) + tmask(ji,jj,jk+1)   & 
    … …  
    185255                     &             + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk  ), 1. ) 
    186256                  ! 
    187                   zcof1 = - fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku 
    188                   zcof2 = - fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv 
     257                  zcof1 = - pahu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku 
     258                  zcof2 = - pahv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv 
    189259                  ! 
    190260                  zftu(ji,jj,jk ) = (  zabe1 * zdit(ji,jj,jk)   & 
    … …  
    196266               END DO 
    197267            END DO 
    198  
    199             ! II.4 Second derivative (divergence) and add to the general trend 
    200             ! ---------------------------------------------------------------- 
    201             DO jj = 2 , jpjm1 
     268            ! 
     269            DO jj = 2 , jpjm1          !== horizontal divergence and add to pta 
    202270               DO ji = fs_2, fs_jpim1   ! vector opt. 
    203                   zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) 
    204                   ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  ) 
    205                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 
    206                END DO 
    207             END DO 
    208             !                                          ! =============== 
     271                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  zftu(ji,jj,jk) - zftu(ji-1,jj,jk)      & 
     272                     &                                           + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )   & 
     273                     &                                        / (  e1e2t(ji,jj) * fse3t(ji,jj,jk)  ) 
     274               END DO 
     275            END DO 
    209276         END DO                                        !   End of slab   
    210          !                                             ! =============== 
    211          ! 
    212          ! "Poleward" diffusive heat or salt transports (T-S case only) 
    213          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 
    214             ! note sign is reversed to give down-gradient diffusive transports (#1043) 
    215             IF( jn == jp_tem)   htr_ldf(:) = ptr_vj( -zftv(:,:,:) ) 
    216             IF( jn == jp_sal)   str_ldf(:) = ptr_vj( -zftv(:,:,:) ) 
    217          ENDIF 
    218   
    219 #if defined key_diaar5 
    220          IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN 
    221             z2d(:,:) = 0._wp  
    222             ! note sign is reversed to give down-gradient diffusive transports (#1043) 
    223             zztmp = -1.0_wp * rau0 * rcp 
    224             DO jk = 1, jpkm1 
    225                DO jj = 2, jpjm1 
    226                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    227                      z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)  
    228                   END DO 
    229                END DO 
    230             END DO 
    231             z2d(:,:) = zztmp * z2d(:,:) 
    232             CALL lbc_lnk( z2d, 'U', -1. ) 
    233             CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction 
    234             z2d(:,:) = 0._wp  
    235             DO jk = 1, jpkm1 
    236                DO jj = 2, jpjm1 
    237                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    238                      z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk)  
    239                   END DO 
    240                END DO 
    241             END DO 
    242             z2d(:,:) = zztmp * z2d(:,:) 
    243             CALL lbc_lnk( z2d, 'V', -1. ) 
    244             CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction 
    245          END IF 
    246 #endif 
    247  
    248          !!---------------------------------------------------------------------- 
    249          !!   III - vertical trend of T & S (extra diagonal terms only) 
    250          !!---------------------------------------------------------------------- 
    251           
    252          ! Local constant initialization 
    253          ! ----------------------------- 
    254          ztfw(1,:,:) = 0.e0     ;     ztfw(jpi,:,:) = 0.e0 
     277 
     278 
     279         !!---------------------------------------------------------------------- 
     280         !!   III - vertical trend (full) 
     281         !!---------------------------------------------------------------------- 
     282          
     283         ztfw(1,:,:) = 0._wp     ;     ztfw(jpi,:,:) = 0._wp 
    255284          
    256285         ! Vertical fluxes 
    … …  
    258287          
    259288         ! Surface and bottom vertical fluxes set to zero 
    260          ztfw(:,:, 1 ) = 0.e0      ;      ztfw(:,:,jpk) = 0.e0 
     289         ztfw(:,:, 1 ) = 0._wp      ;      ztfw(:,:,jpk) = 0._wp 
    261290          
    262291         ! interior (2=<jk=<jpk-1) 
    … …  
    264293            DO jj = 2, jpjm1 
    265294               DO ji = fs_2, fs_jpim1   ! vector opt. 
    266                   zcoef0 = - fsahtw(ji,jj,jk) * tmask(ji,jj,jk) 
    267                   ! 
    268                   zmsku = 1./MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)      & 
    269                      &            + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk), 1.  ) 
    270                   zmskv = 1./MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)      & 
    271                      &            + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk), 1.  ) 
    272                   ! 
    273                   zcoef3 = zcoef0 * e2t(ji,jj) * zmsku * wslpi (ji,jj,jk) 
    274                   zcoef4 = zcoef0 * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk) 
     295                  ! 
     296                  zmsku = tmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          & 
     297                     &                           + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk) , 1._wp  ) 
     298                  zmskv = tmask(ji,jj,jk) / MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)          & 
     299                     &                           + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk) , 1._wp  ) 
     300                     ! 
     301                  zahu_w = (   pahu(ji  ,jj,jk-1) + pahu(ji-1,jj,jk)    & 
     302                     &       + pahu(ji-1,jj,jk-1) + pahu(ji  ,jj,jk)  ) * zmsku 
     303                  zahv_w = (   pahv(ji,jj  ,jk-1) + pahv(ji,jj-1,jk)    & 
     304                     &       + pahv(ji,jj-1,jk-1) + pahv(ji,jj  ,jk)  ) * zmskv 
     305                     ! 
     306                  ah_wslp2(ji,jj,jk) = zahu_w * wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   & 
     307                     &               + zahv_w * wslpj(ji,jj,jk) * wslpj(ji,jj,jk) 
     308                     ! 
     309                  zcoef3 = - zahu_w * e2t(ji,jj) * zmsku * wslpi (ji,jj,jk) 
     310                  zcoef4 = - zahv_w * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk) 
    275311                  ! 
    276312                  ztfw(ji,jj,jk) = zcoef3 * (   zdit(ji  ,jj  ,jk-1) + zdit(ji-1,jj  ,jk)      & 
    … …  
    281317            END DO 
    282318         END DO 
    283           
    284           
    285          ! I.5 Divergence of vertical fluxes added to the general tracer trend 
    286          ! ------------------------------------------------------------------- 
    287          DO jk = 1, jpkm1 
     319         ! 
     320         !                                !==  add the vertical 33 flux  ==! 
     321         IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz 
     322            DO jk = 2, jpkm1        
     323               DO jj = 1, jpjm1 
     324                  DO ji = fs_2, fs_jpim1 
     325                     ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk)   & 
     326                        &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             & 
     327                        &                            * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 
     328                  END DO 
     329               END DO 
     330            END DO 
     331            ! 
     332         ELSE                                   ! bilaplacian  
     333            SELECT CASE( kpass ) 
     334            CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2 
     335               DO jk = 2, jpkm1  
     336                  DO jj = 1, jpjm1 
     337                     DO ji = fs_2, fs_jpim1 
     338                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk)    & 
     339                           &           + ah_wslp2(ji,jj,jk) * e1e2t(ji,jj)   & 
     340                           &           * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * tmask(ji,jj,jk) / fse3w(ji,jj,jk) 
     341                     END DO 
     342                  END DO 
     343               END DO  
     344            CASE(  2  )                         ! 2nd pass : eddy flux = ah_wslp2 and akz applied on ptb  and ptbb gradients, resp. 
     345               DO jk = 2, jpkm1  
     346                  DO jj = 1, jpjm1 
     347                     DO ji = fs_2, fs_jpim1 
     348                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk)                      & 
     349                           &                            * (  ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) )   & 
     350                           &                               + akz     (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) )   ) 
     351                     END DO 
     352                  END DO 
     353               END DO 
     354            END SELECT 
     355         ENDIF 
     356         !          
     357         DO jk = 1, jpkm1                 !==  Divergence of vertical fluxes added to pta  ==! 
    288358            DO jj = 2, jpjm1 
    289359               DO ji = fs_2, fs_jpim1   ! vector opt. 
    290                   zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) 
    291                   ztra = (  ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1)  ) * zbtr 
    292                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 
     360                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1)  )   & 
     361                     &                                        / (  e1e2t(ji,jj) * fse3t(ji,jj,jk)  ) 
    293362               END DO 
    294363            END DO 
    295364         END DO 
    296365         ! 
    297       END DO 
     366         IF( ( kpass == 1 .AND. ln_traldf_lap ) .OR.  &     !==  first pass only (  laplacian)  ==! 
     367             ( kpass == 2 .AND. ln_traldf_blp ) ) THEN      !==  2nd   pass      (bilaplacian)  ==! 
     368            ! 
     369            !                             ! "Poleward" diffusive heat or salt transports (T-S case only) 
     370            IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 
     371               ! note sign is reversed to give down-gradient diffusive transports (#1043) 
     372               IF( jn == jp_tem)   htr_ldf(:) = ptr_vj( -zftv(:,:,:) ) 
     373               IF( jn == jp_sal)   str_ldf(:) = ptr_vj( -zftv(:,:,:) ) 
     374            ENDIF 
     375#if defined key_diaar5 
     376            !                             ! AR5 diagnostics:  vertical integrated heat transport 
     377            IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN 
     378               z2d(:,:) = 0._wp  
     379               ! note sign is reversed to give down-gradient diffusive transports (#1043) 
     380               zztmp = -1.0_wp * rau0 * rcp 
     381               DO jk = 1, jpkm1 
     382                  DO jj = 2, jpjm1 
     383                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     384                        z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)  
     385                     END DO 
     386                  END DO 
     387               END DO 
     388               z2d(:,:) = zztmp * z2d(:,:) 
     389               CALL lbc_lnk( z2d, 'U', -1. ) 
     390               CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction 
     391               z2d(:,:) = 0._wp  
     392               DO jk = 1, jpkm1 
     393                  DO jj = 2, jpjm1 
     394                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     395                        z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk)  
     396                     END DO 
     397                  END DO 
     398               END DO 
     399               z2d(:,:) = zztmp * z2d(:,:) 
     400               CALL lbc_lnk( z2d, 'V', -1. ) 
     401               CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction 
     402            END IF 
     403#endif 
     404         ENDIF                                                    !== end pass selection  ==! 
     405         ! 
     406         !                                                        ! =============== 
     407      END DO                                                      ! end tracer loop 
     408      !                                                           ! =============== 
    298409      ! 
    299410      CALL wrk_dealloc( jpi, jpj,      zdkt, zdk1t, z2d )  
    300       CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw  )  
     411      CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, zftu, zftv, ztfw  )  
    301412      ! 
    302413      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_iso') 
    303414      ! 
    304415   END SUBROUTINE tra_ldf_iso 
    305  
    306 #else 
    307    !!---------------------------------------------------------------------- 
    308    !!   default option :   Dummy code   NO rotation of the diffusive tensor 
    309    !!---------------------------------------------------------------------- 
    310 CONTAINS 
    311    SUBROUTINE tra_ldf_iso( kt, kit000,cdtype, pgu, pgv, ptb, pta, kjpt, pahtb0 )      ! Empty routine 
    312       INTEGER:: kt, kit000 
    313       CHARACTER(len=3) ::   cdtype 
    314       REAL, DIMENSION(:,:,:) ::   pgu, pgv   ! tracer gradient at pstep levels 
    315       REAL, DIMENSION(:,:,:,:) ::   ptb, pta 
    316       WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', kt, kit000, cdtype,   & 
    317          &                       pgu(1,1,1), pgv(1,1,1), ptb(1,1,1,1), pta(1,1,1,1), kjpt, pahtb0 
    318    END SUBROUTINE tra_ldf_iso 
    319 #endif 
    320416 
    321417   !!============================================================================== 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90

    r4364 r4596  
    22   !!============================================================================== 
    33   !!                       ***  MODULE  traldf_lap  *** 
    4    !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend 
     4   !! Ocean tracers:  lateral diffusivity trend  (laplacian and bilaplacian) 
    55   !!============================================================================== 
    6    !! History :  OPA  !  87-06  (P. Andrich, D. L Hostis)  Original code 
    7    !!                 !  91-11  (G. Madec) 
    8    !!                 !  95-11  (G. Madec)  suppress volumetric scale factors 
    9    !!                 !  96-01  (G. Madec)  statement function for e3 
    10    !!            NEMO !  02-06  (G. Madec)  F90: Free form and module 
    11    !!            1.0  !  04-08  (C. Talandier) New trends organization 
    12    !!                 !  05-11  (G. Madec)  add zps case 
    13    !!            3.0  !  10-06  (C. Ethe, G. Madec) Merge TRA-TRC 
    14    !!---------------------------------------------------------------------- 
    15  
    16    !!---------------------------------------------------------------------- 
    17    !!   tra_ldf_lap  : update the tracer trend with the horizontal diffusion 
    18    !!                 using a iso-level harmonic (laplacien) operator. 
     6   !! History :  OPA  ! 1987-06  (P. Andrich, D. L Hostis)  Original code 
     7   !!                 ! 1991-11  (G. Madec) 
     8   !!                 ! 1995-11  (G. Madec)  suppress volumetric scale factors 
     9   !!                 ! 1996-01  (G. Madec)  statement function for e3 
     10   !!            NEMO ! 2002-06  (G. Madec)  F90: Free form and module 
     11   !!            1.0  ! 2004-08  (C. Talandier) New trends organization 
     12   !!                 ! 2005-11  (G. Madec)  add zps case 
     13   !!            3.0  ! 2010-06  (C. Ethe, G. Madec) Merge TRA-TRC 
     14   !!            3.7  ! 2014-01  (G. Madec) re-entrant laplacian  
     15   !!---------------------------------------------------------------------- 
     16 
     17   !!---------------------------------------------------------------------- 
     18   !!   tra_ldf_lap   : update the tracer trend with the lateral diffusion : iso-level laplacian operator 
     19   !!   tra_ldf_bilap : update the tracer trend with the lateral diffusion : iso-level bilaplacian operator 
    1920   !!---------------------------------------------------------------------- 
    2021   USE oce             ! ocean dynamics and active tracers 
    2122   USE dom_oce         ! ocean space and time domain 
    22    USE ldftra_oce      ! ocean active tracers: lateral physics 
    23    USE in_out_manager  ! I/O manager 
     23   USE ldftra          ! lateral physics: eddy diffusivity 
    2424   USE diaptr          ! poleward transport diagnostics 
    2525   USE trc_oce         ! share passive tracers/Ocean variables 
    26    USE lib_mpp         ! MPP library 
     26   USE zpshde          ! partial step: hor. derivative     (zps_hde routine) 
     27   ! 
     28   USE in_out_manager  ! I/O manager 
     29   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     30   USE lib_mpp         ! distribued memory computing library 
    2731   USE timing          ! Timing 
     32   USE wrk_nemo        ! Memory allocation 
    2833 
    2934   IMPLICIT NONE 
    … …  
    3136 
    3237   PUBLIC   tra_ldf_lap   ! routine called by step.F90 
     38   PUBLIC   tra_ldf_blp   ! routine called by step.F90 
     39 
     40   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::   e1ur, e2vr   ! scale factor coefficients 
    3341 
    3442   !! * Substitutions 
    3543#  include "domzgr_substitute.h90" 
    36 #  include "ldftra_substitute.h90" 
    3744#  include "vectopt_loop_substitute.h90" 
    3845   !!---------------------------------------------------------------------- 
    39    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     46   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    4047   !! $Id$ 
    4148   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    4350CONTAINS 
    4451 
    45    SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pgu, pgv,      & 
    46       &                                ptb, pta, kjpt )  
     52   SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pgu, pgv, pahu, pahv,   & 
     53      &                                        ptb, pta, kjpt, kpass )  
    4754      !!---------------------------------------------------------------------- 
    4855      !!                  ***  ROUTINE tra_ldf_lap  *** 
    … …  
    5461      !!      fields (forward time scheme). The horizontal diffusive trends of  
    5562      !!      the tracer is given by: 
    56       !!          difft = 1/(e1t*e2t*e3t) {  di-1[ aht e2u*e3u/e1u di(tb) ] 
    57       !!                                   + dj-1[ aht e1v*e3v/e2v dj(tb) ] } 
     63      !!          difft = 1/(e1t*e2t*e3t) {  di-1[ pahu e2u*e3u/e1u di(tb) ] 
     64      !!                                   + dj-1[ pahv e1v*e3v/e2v dj(tb) ] } 
    5865      !!      Add this trend to the general tracer trend pta : 
    5966      !!          pta = pta + difft 
    … …  
    6269      !!                harmonic mixing trend. 
    6370      !!---------------------------------------------------------------------- 
    64       USE oce, ONLY:   ztu => ua , ztv => va  ! (ua,va) used as workspace 
    65       ! 
    6671      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    67       INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
     72      INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index 
     73      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
     74      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
     75      INTEGER                              , INTENT(in   ) ::   kpass      ! =1/2 first or second passage 
     76      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels 
     77      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s] 
     78      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields 
     79      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
     80      ! 
     81      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     82      INTEGER  ::   iku, ikv         ! local integers 
     83      REAL(wp) ::   zsign            ! local scalars 
     84      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztu, ztv, zaheeu, zaheev 
     85      !!---------------------------------------------------------------------- 
     86      ! 
     87      IF( kt == nit000 .AND. lwp )  THEN 
     88         WRITE(numout,*) 
     89         WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype, ', pass=', kpass 
     90         WRITE(numout,*) '~~~~~~~~~~~ ' 
     91      ENDIF 
     92      ! 
     93      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_lap') 
     94      ! 
     95      CALL wrk_alloc( jpi, jpj, jpk, ztu, ztv, zaheeu, zaheev )  
     96      ! 
     97      DO jk = 1, jpkm1           !==  Initialization of metric arrays used for all tracers  ==! 
     98         DO jj = 1, jpjm1 
     99            DO ji = 1, fs_jpim1   ! vector opt. 
     100               zaheeu(ji,jj,jk) = pahu(ji,jj,jk) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)   !!gm   * umask(ji,jj,jk) 
     101               zaheev(ji,jj,jk) = pahv(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj)   !!gm   * vmask(ji,jj,jk) 
     102            END DO 
     103         END DO 
     104      END DO 
     105      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0) 
     106      ELSE                    ;   zsign = -1._wp 
     107      ENDIF 
     108      ! 
     109      !                             ! =========== ! 
     110      DO jn = 1, kjpt               ! tracer loop ! 
     111         !                          ! =========== !     
     112         !                                
     113         DO jk = 1, jpkm1              !== First derivative (gradient)  ==! 
     114            DO jj = 1, jpjm1 
     115               DO ji = 1, fs_jpim1 
     116                  ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) 
     117                  ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 
     118               END DO 
     119            END DO 
     120         END DO   
     121         IF( ln_zps ) THEN                ! set gradient at partial step level 
     122            DO jj = 1, jpjm1 
     123               DO ji = 1, fs_jpim1 
     124                  iku = mbku(ji,jj)             ! last level 
     125                  ikv = mbkv(ji,jj) 
     126                  ztu(ji,jj,iku) = zaheeu(ji,jj,iku) * pgu(ji,jj,jn) 
     127                  ztv(ji,jj,ikv) = zaheev(ji,jj,ikv) * pgv(ji,jj,jn) 
     128               END DO 
     129            END DO   
     130         ENDIF 
     131         ! 
     132         DO jk = 1, jpkm1              !== Second derivative (divergence) added to the general tracer trends  ==! 
     133            DO jj = 2, jpjm1 
     134               DO ji = fs_2, fs_jpim1 
     135                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk)     & 
     136                     &                                          + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )   & 
     137                     &                                        / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     138               END DO 
     139            END DO 
     140         END DO   
     141         ! 
     142         !                             !== "Poleward" diffusive heat or salt transports  ==! 
     143         IF( ( kpass == 1 .AND. .NOT.ln_traldf_blp ) .OR.  &     !==  first pass only (  laplacian)  ==! 
     144             ( kpass == 2 .AND.      ln_traldf_blp ) ) THEN      !==  2nd   pass only (bilaplacian)  ==! 
     145            IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 
     146               IF( jn  == jp_tem)   htr_ldf(:) = ptr_vj( ztv(:,:,:) ) 
     147               IF( jn  == jp_sal)   str_ldf(:) = ptr_vj( ztv(:,:,:) ) 
     148            ENDIF 
     149         ENDIF 
     150         !                          ! ================== 
     151      END DO                        ! end of tracer loop 
     152      !                             ! ================== 
     153      ! 
     154      CALL wrk_dealloc( jpi, jpj, jpk, ztu, ztv, zaheeu, zaheev )  
     155      ! 
     156      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_lap') 
     157      ! 
     158   END SUBROUTINE tra_ldf_lap 
     159    
     160 
     161   SUBROUTINE tra_ldf_blp( kt, kit000, cdtype, pgu, pgv, pahu, pahv,   & 
     162      &                                        ptb, pta, kjpt        ) 
     163      !!---------------------------------------------------------------------- 
     164      !!                 ***  ROUTINE tra_ldf_blp  *** 
     165      !!                     
     166      !! ** Purpose :   Compute the before horizontal tracer diffusive  
     167      !!      trend and add it to the general trend of tracer equation. 
     168      !! 
     169      !! ** Method  :   The lateral diffusive trends is provided by a bilaplacian 
     170      !!      operator applied to before field (forward in time). 
     171      !!      It is computed by two successive calls to tra_ldf_lap routine 
     172      !! 
     173      !! ** Action :   pta   updated with the before rotated bilaplacian diffusion 
     174      !!---------------------------------------------------------------------- 
     175      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
     176      INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index 
    68177      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    69178      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
    70179      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels 
     180      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s] 
    71181      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields 
    72       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
    73       ! 
    74       INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices 
    75       INTEGER  ::   iku, ikv, ierr       ! local integers 
    76       REAL(wp) ::   zabe1, zabe2, zbtr   ! local scalars 
    77       !!---------------------------------------------------------------------- 
    78       ! 
    79       IF( nn_timing == 1 ) CALL timing_start('tra_ldf_lap') 
    80       ! 
    81       IF( kt == kit000 )  THEN 
     182      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
     183      ! 
     184      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
     185      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zlap         ! laplacian at t-point 
     186      REAL(wp), POINTER, DIMENSION(:,:,:)   :: zglu, zglv   ! gradient of the laplacian at partial step level (u- and v-points) 
     187      !!---------------------------------------------------------------------- 
     188      ! 
     189      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_iso_blp') 
     190      ! 
     191      CALL wrk_alloc( jpi, jpj, jpk, kjpt, zlap )  
     192      CALL wrk_alloc( jpi, jpj     , kjpt, zglu, zglv )  
     193      ! 
     194      IF( kt == nit000 )  THEN 
    82195         IF(lwp) WRITE(numout,*) 
    83          IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype 
    84          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 
     196         IF(lwp) WRITE(numout,*) 'tra_ldf_iso_blp : iso-neutral biharmonic operator on ', cdtype 
     197         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    85198      ENDIF 
    86199 
    87       !                                                          ! =========== ! 
    88       DO jn = 1, kjpt                                            ! tracer loop ! 
    89          !                                                       ! =========== !     
    90          DO jk = 1, jpkm1                                            ! slab loop 
    91             !                                            
    92             ! 1. First derivative (gradient) 
    93             ! ------------------- 
    94             DO jj = 1, jpjm1 
    95                DO ji = 1, fs_jpim1   ! vector opt. 
    96                   zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) 
    97                   zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) 
    98                   ztu(ji,jj,jk) = zabe1 * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) 
    99                   ztv(ji,jj,jk) = zabe2 * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 
    100                END DO 
    101             END DO 
    102             IF( ln_zps ) THEN      ! set gradient at partial step level 
    103                DO jj = 1, jpjm1 
    104                   DO ji = 1, fs_jpim1   ! vector opt. 
    105                      ! last level 
    106                      iku = mbku(ji,jj) 
    107                      ikv = mbkv(ji,jj) 
    108                      IF( iku == jk ) THEN 
    109                         zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,iku) 
    110                         ztu(ji,jj,jk) = zabe1 * pgu(ji,jj,jn) 
    111                      ENDIF 
    112                      IF( ikv == jk ) THEN 
    113                         zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,ikv) 
    114                         ztv(ji,jj,jk) = zabe2 * pgv(ji,jj,jn) 
    115                      ENDIF 
    116                   END DO 
    117                END DO 
    118             ENDIF 
    119           
    120           
    121             ! 2. Second derivative (divergence) added to the general tracer trends 
    122             ! --------------------------------------------------------------------- 
    123             DO jj = 2, jpjm1 
    124                DO ji = fs_2, fs_jpim1   ! vector opt. 
    125                   zbtr = 1._wp / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) 
    126                   ! horizontal diffusive trends added to the general tracer trends 
    127                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   & 
    128                      &                                          + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) 
    129                END DO 
    130             END DO 
    131             ! 
    132          END DO                                             !  End of slab   
    133          ! 
    134          ! "Poleward" diffusive heat or salt transports 
    135          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 
    136             IF( jn  == jp_tem)   htr_ldf(:) = ptr_vj( ztv(:,:,:) ) 
    137             IF( jn  == jp_sal)   str_ldf(:) = ptr_vj( ztv(:,:,:) ) 
    138          ENDIF 
    139          !                                                  ! ================== 
    140       END DO                                                ! end of tracer loop 
    141       !                                                     ! ================== 
    142       IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_lap') 
    143       ! 
    144    END SUBROUTINE tra_ldf_lap 
     200      zlap(:,:,:,:) = 0._wp 
     201      CALL tra_ldf_lap( kt, kit000, cdtype, pgu, pgv, pahu, pahv, ptb, zlap, kjpt, 1 )   ! rotated laplacian applied to ptb (output in zlap) 
     202      ! 
     203      DO jn = 1, kjpt 
     204         CALL lbc_lnk( zlap(:,:,:,jn) , 'T', 1. )                     ! Lateral boundary conditions (unchanged sign) 
     205      END DO 
     206      ! 
     207      IF( ln_zps )   CALL zps_hde( kt, jpts, zlap, zglu, zglv )       ! Partial steps: hor. gradient of laplacian at the partial step level       
     208      ! 
     209      CALL tra_ldf_lap( kt, kit000, cdtype, pgu, pgv, pahu, pahv, zlap, pta, kjpt, 2 )   ! rotated laplacian applied to zlap (output in pta) 
     210      ! 
     211      CALL wrk_dealloc( jpi, jpj, jpk, kjpt, zlap )  
     212      CALL wrk_dealloc( jpi, jpj     , kjpt, zglu, zglv )  
     213      ! 
     214      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_iso_blp') 
     215      ! 
     216   END SUBROUTINE tra_ldf_blp 
    145217 
    146218   !!============================================================================== 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90

    r3294 r4596  
    1919   USE sbc_oce         ! surface boundary condition: ocean 
    2020   USE dynspg_oce 
    21  
     21   ! 
     22   USE ldftra          ! lateral diffusion: eddy diffusivity 
     23   USE ldfslp          ! lateral diffusion: iso-neutral slope  
    2224   USE trazdf_exp      ! vertical diffusion: explicit (tra_zdf_exp     routine) 
    2325   USE trazdf_imp      ! vertical diffusion: implicit (tra_zdf_imp     routine) 
    24  
    25    USE ldftra_oce      ! ocean active tracers: lateral physics 
    26    USE trdmod_oce      ! ocean active tracers: lateral physics 
    27    USE trdtra      ! ocean tracers trends  
     26   ! 
     27   USE trdmod_oce      ! trends diagnostics 
     28   USE trdtra          ! trends: ocean tracers 
     29   ! 
    2830   USE in_out_manager  ! I/O manager 
    2931   USE prtctl          ! Print control 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90

    r3294 r4596  
    1919   
    2020   !!---------------------------------------------------------------------- 
    21    !!   tra_zdf_imp : Update the tracer trend with the diagonal vertical   
    22    !!                 part of the mixing tensor. 
    23    !!---------------------------------------------------------------------- 
    24    USE oce             ! ocean dynamics and tracers variables 
    25    USE dom_oce         ! ocean space and time domain variables  
    26    USE zdf_oce         ! ocean vertical physics variables 
    27    USE trc_oce         ! share passive tracers/ocean variables 
    28    USE domvvl          ! variable volume 
    29    USE ldftra_oce      ! ocean active tracers: lateral physics 
    30    USE ldftra          ! lateral mixing type 
    31    USE ldfslp          ! lateral physics: slope of diffusion 
    32    USE zdfddm          ! ocean vertical physics: double diffusion 
    33    USE traldf_iso_grif ! active tracers: Griffies operator 
    34    USE in_out_manager  ! I/O manager 
    35    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    36    USE lib_mpp         ! MPP library 
    37    USE wrk_nemo        ! Memory Allocation 
    38    USE timing          ! Timing 
     21   !!   tra_zdf_imp : Update the tracer trend with the diagonal vertical part of the mixing tensor. 
     22   !!---------------------------------------------------------------------- 
     23   USE oce              ! ocean dynamics and tracers variables 
     24   USE dom_oce          ! ocean space and time domain variables  
     25   USE zdf_oce          ! ocean vertical physics variables 
     26   USE trc_oce          ! share passive tracers/ocean variables 
     27   USE domvvl           ! variable volume 
     28   USE ldftra           ! lateral mixing type 
     29   USE ldfslp           ! lateral physics: slope of diffusion 
     30   USE zdfddm           ! ocean vertical physics: double diffusion 
     31   USE traldf_iso_triad ! active tracers: Method of Stabilizing Correction 
     32   ! 
     33   USE in_out_manager   ! I/O manager 
     34   USE lbclnk           ! ocean lateral boundary conditions (or mpp link) 
     35   USE lib_mpp          ! MPP library 
     36   USE wrk_nemo         ! Memory Allocation 
     37   USE timing           ! Timing 
    3938 
    4039   IMPLICIT NONE 
    … …  
    4746   !! * Substitutions 
    4847#  include "domzgr_substitute.h90" 
    49 #  include "ldftra_substitute.h90" 
    5048#  include "zdfddm_substitute.h90" 
    5149#  include "vectopt_loop_substitute.h90" 
    5250   !!---------------------------------------------------------------------- 
    53    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     51   !! NEMO/OPA 3.7 , NEMO Consortium (2010) 
    5452   !! $Id$ 
    5553   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    122120            zwt(:,:,1) = 0._wp 
    123121            ! 
    124 #if defined key_ldfslp 
    125             ! isoneutral diffusion: add the contribution  
    126             IF( ln_traldf_grif    ) THEN     ! Griffies isoneutral diff 
    127                DO jk = 2, jpkm1 
    128                   DO jj = 2, jpjm1 
    129                      DO ji = fs_2, fs_jpim1   ! vector opt. 
    130                         zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk)        
     122            IF( l_ldfslp ) THEN            ! isoneutral diffusion: add the contribution  
     123               IF( ln_traldf_msc  ) THEN     ! MSC iso-neutral operator  
     124                  DO jk = 2, jpkm1 
     125                     DO jj = 2, jpjm1 
     126                        DO ji = fs_2, fs_jpim1   ! vector opt. 
     127                           zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk)   
     128                        END DO 
    131129                     END DO 
    132130                  END DO 
    133                END DO 
    134             ELSE IF( l_traldf_rot ) THEN     ! standard isoneutral diff 
    135                DO jk = 2, jpkm1 
    136                   DO jj = 2, jpjm1 
    137                      DO ji = fs_2, fs_jpim1   ! vector opt. 
    138                         zwt(ji,jj,jk) = zwt(ji,jj,jk) + fsahtw(ji,jj,jk)                       & 
    139                            &                          * (  wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   & 
    140                            &                             + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  ) 
     131               ELSE                          ! standard or triad iso-neutral operator 
     132                  DO jk = 2, jpkm1 
     133                     DO jj = 2, jpjm1 
     134                        DO ji = fs_2, fs_jpim1   ! vector opt. 
     135                           zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk) 
     136                        END DO 
    141137                     END DO 
    142138                  END DO 
    143                END DO 
     139               ENDIF 
    144140            ENDIF 
    145 #endif 
     141            ! 
    146142            ! Diagonal, lower (i), upper (s)  (including the bottom boundary condition since avt is masked) 
    147143            DO jk = 1, jpkm1 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90

    r3294 r4596  
    1818   USE phycst          ! physical constants 
    1919   USE eosbn2          ! ocean equation of state 
     20   ! 
    2021   USE in_out_manager  ! I/O manager 
    2122   USE lbclnk          ! lateral boundary conditions (or mpp link) 
    … …  
    4041 
    4142   SUBROUTINE zps_hde( kt, kjpt, pta, pgtu, pgtv,   & 
    42                                  prd, pgru, pgrv    ) 
     43      &                          prd, pgru, pgrv    ) 
    4344      !!---------------------------------------------------------------------- 
    4445      !!                     ***  ROUTINE zps_hde  *** 
    … …  
    8384      !!              - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points  
    8485      !!---------------------------------------------------------------------- 
    85       ! 
    8686      INTEGER                              , INTENT(in   )           ::  kt          ! ocean time-step index 
    8787      INTEGER                              , INTENT(in   )           ::  kjpt        ! number of tracers 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp.F90

    r4313 r4596  
    1818   USE oce             ! ocean dynamics and tracers variables 
    1919   USE dom_oce         ! ocean space and time domain variables 
     20   USE eosbn2          ! equation of state 
     21   USE phycst          ! physical constants 
    2022   USE trdmod_oce      ! ocean variables trends 
    21    USE ldftra_oce      ! ocean active tracers: lateral physics 
    22    USE ldfdyn_oce      ! ocean dynamics: lateral physics 
     23   USE ldftra          ! lateral physics: eddy diffusivity 
    2324   USE zdf_oce         ! ocean vertical physics 
     25   ! 
    2426   USE in_out_manager  ! I/O manager 
    2527   USE lib_mpp         ! distibuted memory computing library 
    26    USE eosbn2          ! equation of state 
    27    USE phycst          ! physical constants 
    2828   USE wrk_nemo        ! Memory allocation 
    2929 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90

    r3792 r4596  
    2323   USE trdmod_oce      ! ocean variables trends 
    2424   USE trdmld_oce      ! ocean variables trends 
    25    USE ldftra_oce      ! ocean active tracers lateral physics 
     25   USE ldftra          ! lateral physics : eddy diffusivity 
    2626   USE zdf_oce         ! ocean vertical physics 
    2727   USE in_out_manager  ! I/O manager 
    … …  
    3636   USE trdmld_rst      ! restart for diagnosing the ML trends 
    3737   USE prtctl          ! Print control 
     38   USE restart         ! for lrst_oce 
    3839   USE lib_mpp         ! MPP library 
    3940   USE wrk_nemo        ! Memory allocation 
    … …  
    5556   !! * Substitutions 
    5657#  include "domzgr_substitute.h90" 
    57 #  include "ldftra_substitute.h90" 
    5858#  include "zdfddm_substitute.h90" 
    5959   !!---------------------------------------------------------------------- 
    … …  
    9393      !!            surface and the control surface is called "mixed-layer" 
    9494      !!---------------------------------------------------------------------- 
    95       ! 
    9695      INTEGER                         , INTENT( in ) ::   ktrd       ! ocean trend index 
    9796      CHARACTER(len=2)                , INTENT( in ) ::   ctype      ! 2D surface/bottom or 3D interior physics 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90

    r4147 r4596  
    1717   USE zdf_oce                 ! ocean vertical physics variables 
    1818   USE trdmod_oce              ! ocean variables trends 
    19    USE ldftra_oce              ! ocean active tracers lateral physics 
     19   USE ldftra                  ! lateral physics: eddy diffusivity 
     20   USE ldfslp                  ! lateral physics: slope of iso-neutral surfaces 
    2021   USE sbc_oce                 ! surface boundary condition: ocean 
    2122   USE phycst                  ! physical constants 
    … …  
    252253      USE in_out_manager          ! I/O manager 
    253254      USE lib_mpp                 ! MPP library 
    254       !!     
     255      ! 
     256      INTEGER  ::   ios           ! Local integer output status for namelist read 
     257      ! 
    255258      NAMELIST/namtrd/ nn_trd, nn_ctls, cn_trdrst_in, cn_trdrst_out, ln_trdmld_restart, rn_ucf, ln_trdmld_instant 
    256       INTEGER  ::   ios           ! Local integer output status for namelist read 
    257       !!---------------------------------------------------------------------- 
    258  
     259      !!---------------------------------------------------------------------- 
     260      ! 
    259261      IF( l_trdtra .OR. l_trddyn )   THEN 
    260   
     262         ! 
    261263         REWIND( numnam_ref )              ! Namelist namtrd in reference namelist : Diagnostics: trends 
    262264         READ  ( numnam_ref, namtrd, IOSTAT = ios, ERR = 901) 
    263 901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrd in reference namelist', lwp ) 
    264  
     265901      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrd in reference namelist', lwp ) 
     266         ! 
    265267         REWIND( numnam_cfg )              ! Namelist namtrd in configuration namelist : Diagnostics: trends 
    266268         READ  ( numnam_cfg, namtrd, IOSTAT = ios, ERR = 902 ) 
    267 902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrd in configuration namelist', lwp ) 
     269902      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrd in configuration namelist', lwp ) 
    268270         WRITE ( numond, namtrd ) 
    269  
     271         ! 
    270272         IF(lwp) THEN 
    271273            WRITE(numout,*) 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90

    r3294 r4596  
    2121   USE in_out_manager  ! I/O manager 
    2222   USE phycst          ! Define parameters for the routines 
    23    USE ldfdyn_oce      ! ocean active tracers: lateral physics 
    2423   USE dianam          ! build the name of file (routine) 
    2524   USE zdfmxl          ! mixed layer depth 
    … …  
    5958   !! * Substitutions 
    6059#  include "domzgr_substitute.h90" 
    61 #  include "ldfdyn_substitute.h90" 
    6260#  include "vectopt_loop_substitute.h90" 
    6361   !!---------------------------------------------------------------------- 
    … …  
    109107      !!      trends output in netCDF format using ioipsl 
    110108      !!---------------------------------------------------------------------- 
    111       ! 
    112109      INTEGER                     , INTENT(in   ) ::   ktrd       ! ocean trend index 
    113110      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   putrdvor   ! u vorticity trend  
    … …  
    118115      REAL(wp), POINTER, DIMENSION(:,:) :: zudpvor, zvdpvor  ! total cmulative trends 
    119116      !!---------------------------------------------------------------------- 
    120  
    121117      ! 
    122118      CALL wrk_alloc( jpi, jpj, zudpvor, zvdpvor )                                     ! Memory allocation 
    123119      ! 
    124  
    125120      zudpvor(:,:) = 0._wp                 ;   zvdpvor(:,:) = 0._wp                    ! Initialisation 
    126121      CALL lbc_lnk( putrdvor, 'U', -1. )   ;   CALL lbc_lnk( pvtrdvor, 'V', -1. )      ! lateral boundary condition 
    … …  
    133128      SELECT CASE (ktrd)  
    134129      ! 
    135       CASE (jpvor_bfr)        ! bottom friction 
     130      CASE (jpvor_bfr)           ! bottom friction 
    136131         DO jj = 2, jpjm1 
    137132            DO ji = fs_2, fs_jpim1  
    … …  
    143138         END DO 
    144139         ! 
    145       CASE (jpvor_swf)        ! wind stress 
     140      CASE (jpvor_swf)           ! wind stress 
    146141         zudpvor(:,:) = putrdvor(:,:) * fse3u(:,:,1) * e1u(:,:) * umask(:,:,1) 
    147142         zvdpvor(:,:) = pvtrdvor(:,:) * fse3v(:,:,1) * e2v(:,:) * vmask(:,:,1) 
    … …  
    149144      END SELECT 
    150145 
    151       ! Average except for Beta.V 
     146      !                          ! Average except for Beta.V 
    152147      zudpvor(:,:) = zudpvor(:,:) * hur(:,:) 
    153148      zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:) 
    154149    
    155       ! Curl 
    156       DO ji=1,jpim1 
    157          DO jj=1,jpjm1 
    158             vortrd(ji,jj,ktrd) = (    zvdpvor(ji+1,jj) - zvdpvor(ji,jj)       & 
    159                  &                - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) )   ) / ( e1f(ji,jj) * e2f(ji,jj) ) 
     150      DO ji = 1, jpim1           ! Curl 
     151         DO jj = 1, jpjm1 
     152            vortrd(ji,jj,ktrd) = umask(ji+1,jj,1) * umask(ji,jj,1)            &    ! surface mask at f-point 
     153               &               * (    zvdpvor(ji+1,jj) - zvdpvor(ji,jj)       & 
     154               &                  - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) )   ) / ( e1f(ji,jj) * e2f(ji,jj) ) 
    160155         END DO 
    161156      END DO 
    162       vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1)      ! Surface mask 
    163157 
    164158      IF( ndebug /= 0 ) THEN 
    … …  
    241235    
    242236      ! Curl 
    243       DO ji=1,jpim1 
    244          DO jj=1,jpjm1 
    245             vortrd(ji,jj,ktrd) = (    zvdpvor(ji+1,jj) - zvdpvor(ji,jj)     & 
    246                &                  - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 
     237      DO ji = 1, jpim1 
     238         DO jj = 1, jpjm1 
     239            vortrd(ji,jj,ktrd) = umask(ji+1,jj,1) * umask(ji,jj,1)           &    ! surface mask at f-point 
     240               &               *  (    zvdpvor(ji+1,jj) - zvdpvor(ji,jj)     & 
     241               &                   - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 
    247242         END DO 
    248243      END DO 
    249  
    250       ! Surface mask 
    251       vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1) 
    252244 
    253245      ! Special treatement for the Beta.V term 
    254246      ! Compute the Curl of the Beta.V term which is not averaged 
    255247      IF( ktrd == jpvor_bev ) THEN 
    256          DO ji=1,jpim1 
    257             DO jj=1,jpjm1 
    258                vortrd(ji,jj,jpvor_bev) = (    zvbet(ji+1,jj) - zvbet(ji,jj)     & 
     248         DO ji = 1, jpim1 
     249            DO jj = 1, jpjm1 
     250               vortrd(ji,jj,jpvor_bev) = umask(ji+1,jj,1) * umask(ji,jj,1)      &    ! surface mask at f-point 
     251                  &                    * (    zvbet(ji+1,jj) - zvbet(ji,jj)     & 
    259252                  &                       - ( zubet(ji,jj+1) - zubet(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 
    260253            END DO 
    261254         END DO 
    262  
    263          ! Average on the Curl 
     255         !                          ! Average on the Curl 
    264256         vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * hur(:,:) 
    265  
    266          ! Surface mask 
    267          vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * fmask(:,:,1) 
    268257      ENDIF 
    269258    
    … …  
    330319 
    331320      ! Curl 
    332       DO ji=1,jpim1 
    333          DO jj=1,jpjm1 
    334             vor_avr(ji,jj) = (  ( zvn(ji+1,jj) - zvn(ji,jj) )    & 
    335                &              - ( zun(ji,jj+1) - zun(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1) 
     321      DO ji = 1, jpim1 
     322         DO jj = 1, jpjm1 
     323            vor_avr(ji,jj) = umask(ji+1,jj,1) * umask(ji,jj,1)       &    ! surface mask at f-point 
     324               &               * (  ( zvn(ji+1,jj) - zvn(ji,jj) )    & 
     325               &                  - ( zun(ji,jj+1) - zun(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 
    336326         END DO 
    337327      END DO 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90

    r4292 r4596  
    1414   !!---------------------------------------------------------------------- 
    1515   USE par_oce         ! mesh and scale factors 
    16    USE ldftra_oce      ! ocean active tracers: lateral physics 
    17    USE ldfdyn_oce      ! ocean dynamics lateral physics 
    1816   USE zdf_oce         ! TKE vertical mixing           
    1917   USE lib_mpp         ! distribued memory computing 
    … …  
    2624   USE tranpc          ! convection: non penetrative adjustment 
    2725   USE ldfslp          ! iso-neutral slopes 
    28  
     26   USE restart         ! ocean restart 
     27   ! 
    2928   USE in_out_manager  ! I/O manager 
    3029   USE iom             ! IOM library 
    … …  
    5049      !! ** Method  :   Read namelist namzdf, control logicals  
    5150      !!---------------------------------------------------------------------- 
    52       INTEGER ::   ioptio       ! temporary scalar 
    53       INTEGER ::   ios 
     51      INTEGER ::   ioptio, ios       ! local integers 
    5452      !! 
    5553      NAMELIST/namzdf/ rn_avm0, rn_avt0, nn_avb, nn_havtb, ln_zdfexp, nn_zdfexp,   & 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r4354 r4596  
    2828   !!             -   ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    2929   !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
    30    !!            3.4  ! 2011-11  (C. Harris) decomposition changes for running with CICE 
    31    !!                 ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening  
     30   !!            3.4  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_northcomms 
     31   !!             -   ! 2011-11  (C. Harris) decomposition changes for running with CICE 
     32   !!            3.6  ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening  
     33   !!             -   ! 2013-06  (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication  
    3234   !!---------------------------------------------------------------------- 
    3335 
    … …  
    4042   !!   nemo_partition : calculate MPP domain decomposition 
    4143   !!   factorise      : calculate the factors of the no. of MPI processes 
     44   !!   nemo_northcomms:  Setup for north fold exchanges with explicit point-to-point messaging 
    4245   !!---------------------------------------------------------------------- 
    43    USE step_oce        ! module used in the ocean time stepping module 
     46   USE step_oce        ! module used in the ocean time stepping module (step.F90) 
    4447   USE sbc_oce         ! surface boundary condition: ocean 
    4548   USE cla             ! cross land advection               (tra_cla routine) 
    … …  
    8689   USE sbctide, ONLY: lk_tide 
    8790   USE crsini          ! initialise grid coarsening utility 
    88    USE lbcnfd, ONLY: isendto, nsndto ! Setup of north fold exchanges  
    8991 
    9092   IMPLICIT NONE 
    … …  
    121123      !!---------------------------------------------------------------------- 
    122124      ! 
    123  
    124125#if defined key_agrif 
    125126      CALL Agrif_Init_Grids()      ! AGRIF: set the meshes 
    … …  
    139140# endif 
    140141#endif 
    141  
    142142      ! check that all process are still there... If some process have an error, 
    143143      ! they will never enter in step and other processes will wait until the end of the cpu time! 
    … …  
    166166 
    167167         DO WHILE ( istp <= nitend .AND. nstop == 0 ) 
    168  
    169168#if defined key_agrif 
    170169            CALL Agrif_Step( stp )           ! AGRIF: time stepping 
    … …  
    172171            CALL stp( istp )                 ! standard time stepping 
    173172#endif 
    174  
    175173            istp = istp + 1 
    176174            IF( lk_mpp )   CALL mpp_max( nstop ) 
    … …  
    228226      CHARACTER(len=80), DIMENSION(16) ::   cltxt 
    229227      !! 
    230       NAMELIST/namctl/ ln_ctl, nn_print, nn_ictls, nn_ictle,   & 
     228      NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   & 
    231229         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   & 
    232230         &             nn_bench, nn_timing 
    233       NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, & 
    234          &             jpizoom, jpjzoom, jperio 
     231      NAMELIST/namcfg/ cp_cfg, jp_cfg, jpidta , jpjdta , jpkdta,   & 
     232         &             cp_cfz, jperio, jpiglo , jpjglo ,           & 
     233         &                             jpizoom, jpjzoom 
    235234      !!---------------------------------------------------------------------- 
    236235      ! 
    … …  
    238237      ! 
    239238      !                             ! Open reference namelist and configuration namelist files 
    240       CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    241       CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    242       CALL ctl_opn( numond, 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 ) 
     239      CALL ctl_opn( numnam_ref, 'namelist_ref'       , 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE.    ) 
     240      CALL ctl_opn( numnam_cfg, 'namelist_cfg'       , 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE.    ) 
     241      CALL ctl_opn( numond    , 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., 1 ) 
    243242      ! 
    244243      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark 
    … …  
    261260      WRITE( numond, namcfg ) 
    262261 
    263 ! Force values for AGRIF zoom (cf. agrif_user.F90) 
     262      ! Force values for AGRIF zoom (cf. agrif_user.F90) 
    264263#if defined key_agrif 
    265264   IF( .NOT. Agrif_Root() ) THEN 
    … …  
    307306      ! If dimensions of processor grid weren't specified in the namelist file 
    308307      ! then we calculate them here now that we have our communicator size 
    309       IF( (jpni < 1) .OR. (jpnj < 1) )THEN 
     308      IF( (jpni < 1) .OR. (jpnj < 1) ) THEN 
    310309#if   defined key_mpp_mpi 
    311          IF( Agrif_Root() ) CALL nemo_partition(mppsize) 
     310         IF( Agrif_Root() ) CALL nemo_partition( mppsize ) 
    312311#else 
    313312         jpni  = 1 
    … …  
    315314         jpnij = jpni*jpnj 
    316315#endif 
    317       END IF 
     316      ENDIF 
    318317 
    319318      ! Calculate domain dimensions given calculated jpni and jpnj 
    320       ! This used to be done in par_oce.F90 when they were parameters rather 
    321       ! than variables 
     319      ! This used to be done in par_oce.F90 when they were parameters rather than variables 
    322320      IF( Agrif_Root() ) THEN 
    323321#if defined key_nemocice_decomp 
    … …  
    325323         jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.  
    326324#else 
    327          jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim. 
    328          jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim. 
    329 #endif 
    330       ENDIF 
    331          jpk = jpkdta                                             ! third dim 
    332          jpim1 = jpi-1                                            ! inner domain indices 
    333          jpjm1 = jpj-1                                            !   "           " 
    334          jpkm1 = jpk-1                                            !   "           " 
    335          jpij  = jpi*jpj                                          !  jpi x j 
     325         jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci      ! first  dim. 
     326         jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj      ! second dim. 
     327#endif 
     328      ENDIF 
     329      jpk = jpkdta                                                   ! third dim 
     330      jpim1 = jpi-1                                                  ! inner domain indices 
     331      jpjm1 = jpj-1                                                  !   "           " 
     332      jpkm1 = jpk-1                                                  !   "           " 
     333      jpij  = jpi*jpj                                                !  jpi x j 
    336334 
    337335      IF(lwp) THEN                            ! open listing units 
    … …  
    343341         WRITE(numout,*) '                       NEMO team' 
    344342         WRITE(numout,*) '            Ocean General Circulation Model' 
    345          WRITE(numout,*) '                  version 3.4  (2011) ' 
     343         WRITE(numout,*) '                  version 3.6  (2014) ' 
    346344         WRITE(numout,*) 
    347345         WRITE(numout,*) 
    … …  
    391389 
    392390                            CALL dyn_nept_init  ! simplified form of Neptune effect 
    393  
    394391      !      
    395392      IF( ln_crs        )   CALL     crs_init   ! Domain initialization of coarsened grid 
    396393      ! 
    397                                 ! Ocean physics 
     394      !                         ! Ocean physics 
    398395                            CALL     sbc_init   ! Forcings : surface module 
     396                             
    399397      !                                         ! Vertical physics 
    400  
    401398                            CALL     zdf_init      ! namelist read 
    402  
    403399                            CALL zdf_bfr_init      ! bottom friction 
    404  
    405400      IF( lk_zdfric     )   CALL zdf_ric_init      ! Richardson number dependent Kz 
    406401      IF( lk_zdftke     )   CALL zdf_tke_init      ! TKE closure scheme 
    … …  
    410405      IF( lk_zdfddm .AND. .NOT. lk_zdfkpp )   & 
    411406         &                  CALL zdf_ddm_init      ! double diffusive mixing 
     407          
    412408      !                                         ! Lateral physics 
    413409                            CALL ldf_tra_init      ! Lateral ocean tracer physics 
     410                            CALL ldf_eiv_init      ! eddy induced velocity param. 
    414411                            CALL ldf_dyn_init      ! Lateral ocean momentum physics 
    415       IF( lk_ldfslp     )   CALL ldf_slp_init      ! slope of lateral mixing 
    416  
    417       !                                     ! Active tracers 
    418                             CALL tra_qsr_init   ! penetrative solar radiation qsr 
    419                             CALL tra_bbc_init   ! bottom heat flux 
    420       IF( lk_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme 
    421                             CALL tra_dmp_init   ! internal damping trends- tracers 
    422                             CALL tra_adv_init   ! horizontal & vertical advection 
    423                             CALL tra_ldf_init   ! lateral mixing 
    424                             CALL tra_zdf_init   ! vertical mixing and after tracer fields 
    425  
    426       !                                     ! Dynamics 
    427       IF( lk_c1d        )   CALL dyn_dmp_init   ! internal damping trends- momentum 
    428                             CALL dyn_adv_init   ! advection (vector or flux form) 
    429                             CALL dyn_vor_init   ! vorticity term including Coriolis 
    430                             CALL dyn_ldf_init   ! lateral mixing 
    431                             CALL dyn_hpg_init   ! horizontal gradient of Hydrostatic pressure 
    432                             CALL dyn_zdf_init   ! vertical diffusion 
    433                             CALL dyn_spg_init   ! surface pressure gradient 
     412 
     413      !                                         ! Active tracers 
     414                            CALL tra_qsr_init      ! penetrative solar radiation qsr 
     415                            CALL tra_bbc_init      ! bottom heat flux 
     416      IF( lk_trabbl     )   CALL tra_bbl_init      ! advective (and/or diffusive) bottom boundary layer scheme 
     417                            CALL tra_dmp_init      ! internal tracer damping 
     418                            CALL tra_adv_init      ! horizontal & vertical advection 
     419                            CALL tra_ldf_init      ! lateral mixing 
     420                            CALL tra_zdf_init      ! vertical mixing and after tracer fields 
     421 
     422      !                                         ! Dynamics 
     423      IF( lk_c1d        )   CALL dyn_dmp_init      ! internal momentum damping 
     424                            CALL dyn_adv_init      ! advection (vector or flux form) 
     425                            CALL dyn_vor_init      ! vorticity term including Coriolis 
     426                            CALL dyn_ldf_init      ! lateral mixing 
     427                            CALL dyn_hpg_init      ! horizontal gradient of Hydrostatic pressure 
     428                            CALL dyn_zdf_init      ! vertical diffusion 
     429                            CALL dyn_spg_init      ! surface pressure gradient 
     430 
     431 
     432      IF( l_ldfslp      )   CALL ldf_slp_init   ! slope of lateral mixing 
     433 
     434 
    434435 
    435436      !                                     ! Misc. options 
    436       IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2 )   CALL cla_init       ! Cross Land Advection 
     437      IF( nn_cla == 1   )   CALL cla_init       ! Cross Land Advection 
    437438                            CALL icb_init( rdt, nit000)   ! initialise icebergs instance 
    438439      
    … …  
    441442                            CALL     trc_init 
    442443#endif 
    443       ! 
    444   
    445                                             ! Diagnostics 
     444      !                                     ! Diagnostics 
    446445      IF( lk_floats     )   CALL     flo_init   ! drifting Floats 
    447446      IF( lk_diaar5     )   CALL dia_ar5_init   ! ar5 diag 
    … …  
    501500         WRITE(numout,*) '~~~~~~~ ' 
    502501         WRITE(numout,*) '   Namelist namcfg' 
    503          WRITE(numout,*) '      configuration name              cp_cfg      = ', TRIM(cp_cfg) 
    504          WRITE(numout,*) '      configuration zoom name         cp_cfz      = ', TRIM(cp_cfz) 
    505          WRITE(numout,*) '      configuration resolution        jp_cfg      = ', jp_cfg 
    506          WRITE(numout,*) '      1st lateral dimension ( >= jpi ) jpidta     = ', jpidta 
    507          WRITE(numout,*) '      2nd    "         "    ( >= jpj ) jpjdta     = ', jpjdta 
    508          WRITE(numout,*) '      3nd    "         "               jpkdta     = ', jpkdta 
    509          WRITE(numout,*) '      1st dimension of global domain in i jpiglo  = ', jpiglo 
    510          WRITE(numout,*) '      2nd    -                  -    in j jpjglo  = ', jpjglo 
     502         WRITE(numout,*) '      configuration name                               cp_cfg  = ', TRIM(cp_cfg) 
     503         WRITE(numout,*) '      configuration zoom name                          cp_cfz  = ', TRIM(cp_cfz) 
     504         WRITE(numout,*) '      configuration resolution                         jp_cfg  = ', jp_cfg 
     505         WRITE(numout,*) '      1st lateral dimension ( >= jpiglo )              jpidta  = ', jpidta 
     506         WRITE(numout,*) '      2nd    "         "    ( >= jpjglo )              jpjdta  = ', jpjdta 
     507         WRITE(numout,*) '      3nd    "         "                               jpkdta  = ', jpkdta 
     508         WRITE(numout,*) '      1st dimension of global domain in i              jpiglo  = ', jpiglo 
     509         WRITE(numout,*) '      2nd    -                  -    in j              jpjglo  = ', jpjglo 
    511510         WRITE(numout,*) '      left bottom i index of the zoom (in data domain) jpizoom = ', jpizoom 
    512511         WRITE(numout,*) '      left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom 
    513          WRITE(numout,*) '      lateral cond. type (between 0 and 6) jperio = ', jperio    
     512         WRITE(numout,*) '      lateral cond. type (between 0 and 6)             jperio = ', jperio    
    514513      ENDIF 
    515514      !                             ! Parameter control 
    … …  
    595594      IF( numdct_heat     /= -1 )   CLOSE( numdct_heat     )   ! heat transports 
    596595      IF( numdct_salt     /= -1 )   CLOSE( numdct_salt     )   ! salt transports 
    597  
    598596      ! 
    599597      numout = 6                                     ! redefine numout in case it is used after this point... 
    … …  
    612610      USE diawri    , ONLY: dia_wri_alloc 
    613611      USE dom_oce   , ONLY: dom_oce_alloc 
    614       USE ldfdyn_oce, ONLY: ldfdyn_oce_alloc 
    615       USE ldftra_oce, ONLY: ldftra_oce_alloc 
    616612      USE trc_oce   , ONLY: trc_oce_alloc 
    617613#if defined key_diadct  
    … …  
    628624      ierr = ierr + dia_wri_alloc   () 
    629625      ierr = ierr + dom_oce_alloc   ()          ! ocean domain 
    630       ierr = ierr + ldfdyn_oce_alloc()          ! ocean lateral  physics : dynamics 
    631       ierr = ierr + ldftra_oce_alloc()          ! ocean lateral  physics : tracers 
    632626      ierr = ierr + zdf_oce_alloc   ()          ! ocean vertical physics 
    633627      ! 
    … …  
    715709         &                            128,   64,   32,   16,    8,   4,   2  / 
    716710      !!---------------------------------------------------------------------- 
    717  
     711      ! 
    718712      ! Clear the error flag and initialise output vars 
    719       kerr = 0 
    720       kfax = 1 
     713      kerr  = 0 
     714      kfax  = 1 
    721715      knfax = 0 
    722  
     716      ! 
    723717      ! Find the factors of n. 
    724718      IF( kn == 1 )   GOTO 20 
    … …  
    728722      ! l points to the allowed factor list. 
    729723      ! ifac holds the current factor. 
    730  
     724      ! 
    731725      inu   = kn 
    732726      knfax = 0 
    733  
     727      ! 
    734728      DO jl = ntest, 1, -1 
    735729         ! 
    … …  
    755749         ! 
    756750      END DO 
    757  
     751      ! 
    758752   20 CONTINUE      ! Label 20 is the exit point from the factor search loop. 
    759753      ! 
    760754   END SUBROUTINE factorise 
    761755 
    762 #if defined key_mpp_mpi 
     756 
    763757   SUBROUTINE nemo_northcomms 
    764       !!====================================================================== 
     758      !!---------------------------------------------------------------------- 
    765759      !!                     ***  ROUTINE  nemo_northcomms  *** 
    766       !! nemo_northcomms    :  Setup for north fold exchanges with explicit  
    767       !!                       point-to-point messaging 
    768       !!===================================================================== 
    769       !!---------------------------------------------------------------------- 
    770       !! 
    771       !! ** Purpose :   Initialization of the northern neighbours lists. 
    772       !!---------------------------------------------------------------------- 
    773       !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) 
    774       !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)  
    775       !!---------------------------------------------------------------------- 
    776  
    777       INTEGER  ::   sxM, dxM, sxT, dxT, jn 
    778       INTEGER  ::   njmppmax 
    779  
    780       njmppmax = MAXVAL( njmppt ) 
    781      
    782       !initializes the north-fold communication variables 
     760      !! ** Purpose :   Setup for north fold exchanges with explicit  
     761      !!                point-to-point messaging 
     762      !! 
     763      !! ** Method :   Initialization of the northern neighbours lists. 
     764      !!---------------------------------------------------------------------- 
     765      USE lbcnfd, ONLY:   isendto, nsndto   ! setup of north fold exchanges  
     766      ! 
     767      INTEGER  ::   jn 
     768      INTEGER  ::   isxM, idxM, isxT, idxT, ijmppmax 
     769      !!---------------------------------------------------------------------- 
     770      ! 
     771      ijmppmax = MAXVAL( njmppt ) 
     772      ! 
     773      ! initializes the north-fold communication variables 
    783774      isendto(:) = 0 
    784       nsndto = 0 
    785  
    786       !if I am a process in the north 
    787       IF ( njmpp == njmppmax ) THEN 
    788           !sxM is the first point (in the global domain) needed to compute the 
    789           !north-fold for the current process 
    790           sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 
    791           !dxM is the last point (in the global domain) needed to compute the 
    792           !north-fold for the current process 
    793           dxM = jpiglo - nimppt(narea) + 2 
    794  
    795           !loop over the other north-fold processes to find the processes 
    796           !managing the points belonging to the sxT-dxT range 
    797           DO jn = jpnij - jpni +1, jpnij 
    798              IF ( njmppt(jn) == njmppmax ) THEN 
    799                 !sxT is the first point (in the global domain) of the jn 
    800                 !process 
    801                 sxT = nimppt(jn) 
    802                 !dxT is the last point (in the global domain) of the jn 
    803                 !process 
    804                 dxT = nimppt(jn) + nlcit(jn) - 1 
    805                 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 
     775      nsndto     = 0 
     776      ! 
     777      IF( njmpp == ijmppmax ) THEN      ! if I am a process in the north 
     778         ! 
     779         ! isxM is the first point (in the global domain) needed to compute the 
     780         ! north-fold for the current process 
     781         isxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 
     782         ! idxM is the last point (in the global domain) needed to compute the 
     783         ! north-fold for the current process 
     784         idxM = jpiglo - nimppt(narea) + 2 
     785         ! 
     786         ! loop over the other north-fold processes to find the processes 
     787         ! managing the points belonging to the isxT-idxT range 
     788         DO jn = jpnij - jpni +1, jpnij 
     789            IF( njmppt(jn) == ijmppmax ) THEN 
     790                ! isxT is the first point (in the global domain) of the jn process 
     791                isxT = nimppt(jn) 
     792                ! idxT is the last  point (in the global domain) of the jn process 
     793                idxT = nimppt(jn) + nlcit(jn) - 1 
     794                IF( (isxM .gt. isxT) .AND. (isxM .lt. idxT) ) THEN 
    806795                   nsndto = nsndto + 1 
    807796                   isendto(nsndto) = jn 
    808                 ELSEIF ((sxM .le. sxT) .AND. (dxM .gt. dxT)) THEN 
     797                ELSEIF( (isxM .le. isxT) .AND. (idxM .gt. idxT) ) THEN 
    809798                   nsndto = nsndto + 1 
    810799                   isendto(nsndto) = jn 
    811                 ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 
     800                ELSEIF( (idxM .lt. idxT) .AND. (isxT .lt. idxM) ) THEN 
    812801                   nsndto = nsndto + 1 
    813802                   isendto(nsndto) = jn 
    … …  
    817806      ENDIF 
    818807      l_north_nogather = .TRUE. 
     808      ! 
    819809   END SUBROUTINE nemo_northcomms 
    820 #else 
    821    SUBROUTINE nemo_northcomms      ! Dummy routine 
    822       WRITE(*,*) 'nemo_northcomms: You should not have seen this print! error?' 
    823    END SUBROUTINE nemo_northcomms 
    824 #endif 
     810    
    825811   !!====================================================================== 
    826812END MODULE nemogcm 
    827  
    828  

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/oce.F90

    r4354 r4596  
    77   !!            3.1  !  2009-02  (G. Madec, M. Leclair)  pure z* coordinate 
    88   !!            3.3  !  2010-09  (C. Ethe) TRA-TRC merge: add ts, gtsu, gtsv 4D arrays 
     9   !!            3.7  !  2014-01  (G. Madec) suppression of curl and before hdiv from in-core memory 
    910   !!---------------------------------------------------------------------- 
    1011   USE par_oce        ! ocean parameters 
    … …  
    1617   PUBLIC oce_alloc ! routine called by nemo_init in nemogcm.F90 
    1718 
    18    LOGICAL, PUBLIC ::   l_traldf_rot = .FALSE.  !: rotated laplacian operator for lateral diffusion 
    19  
    2019   !! dynamics and tracer fields                            ! before ! now    ! after  ! the after trends becomes the fields 
    2120   !! --------------------------                            ! fields ! fields ! trends ! only after tra_zdf and dyn_spg 
    … …  
    2423   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   ua_sv,  va_sv          !: Saved trends (time spliting) [m/s2] 
    2524   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           wn             !: vertical velocity            [m/s] 
    26    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rotb ,  rotn           !: relative vorticity           [s-1] 
    27    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   hdivb,  hdivn          !: horizontal divergence        [s-1] 
     25   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           hdivn          !: horizontal divergence        [s-1] 
    2826   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsb  ,  tsn            !: 4D T-S fields        [Celcius,psu]  
    2927   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rn2b ,  rn2            !: brunt-vaisala frequency**2   [s-2] 
    … …  
    6159 
    6260   !!---------------------------------------------------------------------- 
    63    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     61   !! NEMO/OPA 4.0 , NEMO Consortium (2014) 
    6462   !! $Id$  
    6563   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    7775         &      vb   (jpi,jpj,jpk)      , vn   (jpi,jpj,jpk)      , va(jpi,jpj,jpk)       ,     &       
    7876         &      ua_sv(jpi,jpj,jpk)      , va_sv(jpi,jpj,jpk)      ,                             &       
    79          &      wn   (jpi,jpj,jpk)      ,                                                       & 
    80          &      rotb (jpi,jpj,jpk)      , rotn (jpi,jpj,jpk)      ,                             &    
    81          &      hdivb(jpi,jpj,jpk)      , hdivn(jpi,jpj,jpk)      ,                             & 
     77         &      wn   (jpi,jpj,jpk)      , hdivn(jpi,jpj,jpk)      ,                             & 
    8278         &      tsb  (jpi,jpj,jpk,jpts) , tsn  (jpi,jpj,jpk,jpts) , tsa(jpi,jpj,jpk,jpts) ,     & 
    83          &      rn2b (jpi,jpj,jpk)      , rn2  (jpi,jpj,jpk)                              , STAT=ierr(1) ) 
     79         &      rn2b (jpi,jpj,jpk)      , rn2  (jpi,jpj,jpk)      ,                             & 
     80         &      rhd  (jpi,jpj,jpk)      , rhop (jpi,jpj,jpk)                              , STAT=ierr(1) ) 
    8481         ! 
    85       ALLOCATE(rhd (jpi,jpj,jpk) ,                                         & 
    86          &     rhop(jpi,jpj,jpk) ,                                         & 
    87          &     sshb(jpi,jpj)     , sshn(jpi,jpj)   , ssha(jpi,jpj)   ,     & 
    88          &     ub_b(jpi,jpj)     , un_b(jpi,jpj)   , ua_b(jpi,jpj)   ,     & 
    89          &     vb_b(jpi,jpj)     , vn_b(jpi,jpj)   , va_b(jpi,jpj)   ,     & 
    90          &     spgu  (jpi,jpj)   , spgv(jpi,jpj)   ,                       & 
    91          &     gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts),                     & 
    92          &     gru(jpi,jpj)      , grv(jpi,jpj)                      , STAT=ierr(2) ) 
     82      ALLOCATE( sshb(jpi,jpj)     , sshn(jpi,jpj)     , ssha(jpi,jpj),     & 
     83         &      ub_b(jpi,jpj)     , un_b(jpi,jpj)     , ua_b(jpi,jpj),     & 
     84         &      vb_b(jpi,jpj)     , vn_b(jpi,jpj)     , va_b(jpi,jpj),     & 
     85         &      spgu(jpi,jpj)     , spgv(jpi,jpj)     ,                    & 
     86         &      gru (jpi,jpj)     , grv (jpi,jpj)     ,                    & 
     87         &      gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts)               , STAT=ierr(2) ) 
    9388         ! 
    9489      ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(3) ) 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/step.F90

    r4491 r4596  
    2424   !!             -   !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 
    2525   !!            3.4  !  2011-04  (G. Madec, C. Ethe) Merge of dtatem and dtasal 
    26    !!                 !  2012-07  (J. Simeon, G. Madec. C. Ethe) Online coarsening of outputs 
     26   !!            3.6  !  2012-07  (J. Simeon, G. Madec. C. Ethe)  Online coarsening of outputs 
     27   !!            3.7  !  2014-01  (G. Madec)  LDF simplication  
    2728   !!---------------------------------------------------------------------- 
    2829 
    … …  
    3536   PRIVATE 
    3637 
    37    PUBLIC   stp   ! called by opa.F90 
     38   PUBLIC   stp   ! called by nemogcm.F90 
    3839 
    3940   !! * Substitutions 
    … …  
    7475      INTEGER ::   kcall    ! optional integer argument (dom_vvl_sf_nxt) 
    7576      !! --------------------------------------------------------------------- 
    76  
    7777#if defined key_agrif 
    7878      kstp = nit000 + Agrif_Nb_Step() 
    79 !      IF ( Agrif_Root() .and. lwp) Write(*,*) '---' 
    80 !      IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp 
    81       IF ( kstp == (nit000 + 1) ) lk_agrif_fstep = .FALSE. 
     79      IF( kstp == nit000 + 1 )   lk_agrif_fstep = .FALSE. 
    8280# if defined key_iomput 
    8381      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( "nemo" ) 
    8482# endif 
    8583#endif 
    86                              indic = 0           ! reset to no error condition 
     84      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     85      ! update I/O and calendar  
     86      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     87                             indic = 0                    ! reset to no error condition 
    8788      IF( kstp == nit000 ) THEN 
    88                       CALL iom_init( "nemo" )      ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 
    89          IF( ln_crs ) CALL iom_init( "nemo_crs" )  ! initialize context for coarse grid 
    90       ENDIF 
    91  
    92       IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init) 
     89                             CALL iom_init( "nemo" )      ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 
     90         IF( ln_crs      )   CALL iom_init( "nemo_crs" )  ! initialize context for coarse grid 
     91      ENDIF 
     92      IF( kstp /= nit000 )   CALL day( kstp )             ! Calendar (day was already called at nit000 in day_init) 
    9393                             CALL iom_setkt( kstp - nit000 + 1, "nemo"     )   ! say to iom that we are at time step kstp 
    94       IF( ln_crs     )       CALL iom_setkt( kstp - nit000 + 1, "nemo_crs" )   ! say to iom that we are at time step kstp 
    95  
    96       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    97       ! Update data, open boundaries, surface boundary condition (including sea-ice) 
    98       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    99       IF( lk_tide    )   CALL sbc_tide( kstp ) 
    100       IF( lk_bdy     )   CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries 
    101  
    102                          CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice) 
    103                                                       ! clem: moved here for bdy ice purpose 
     94      IF( ln_crs         )   CALL iom_setkt( kstp - nit000 + 1, "nemo_crs" )   ! say to iom that we are at time step kstp 
     95 
     96      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     97      ! Update tide, open boundaries, and surface boundary condition (including sea-ice) 
     98      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     99      IF( lk_tide    )   CALL sbc_tide( kstp )                    ! update tide potential 
     100      IF( lk_bdy     )   CALL bdy_dta ( kstp, time_offset=+1 )    ! update dynamic, tracer & ice data at open boundaries 
     101                         CALL sbc     ( kstp )                    ! Surface Boundary Condition (including sea-ice) 
    104102 
    105103      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    139137      !  LATERAL  PHYSICS 
    140138      ! 
    141       IF( lk_ldfslp ) THEN                            ! slope of lateral mixing 
    142                          CALL eos( tsb, rhd, gdept_0(:,:,:) )             ! before in situ density 
     139      IF( l_ldfslp ) THEN                             ! slope of lateral mixing 
     140                         CALL eos( tsb, rhd, gdept_0(:,:,:) )             ! before in situ density at reference level 
    143141         IF( ln_zps )    CALL zps_hde( kstp, jpts, tsb, gtsu, gtsv,  &    ! Partial steps: before horizontal gradient 
    144142            &                                      rhd, gru , grv  )      ! of t, s, rd at the last ocean level 
    145          IF( ln_traldf_grif ) THEN                           ! before slope for Griffies operator 
    146                          CALL ldf_slp_grif( kstp ) 
    147          ELSE 
    148                          CALL ldf_slp( kstp, rhd, rn2b )     ! before slope for Madec operator 
     143         IF( ln_traldf_triad ) THEN  
     144                         CALL ldf_slp_grif( kstp )                        ! before slope for Griffies operator 
     145        ELSE      
     146                         CALL ldf_slp     ( kstp, rhd, rn2b )             ! before slope for Madec operator 
    149147         ENDIF 
    150148      ENDIF 
    151 #if defined key_traldf_c2d 
    152       IF( lk_traldf_eiv )   CALL ldf_eiv( kstp )      ! eddy induced velocity coefficient 
    153 #endif 
     149 
     150      !                                               ! eddy diffusivity coeff. and/or eiv coeff. 
     151      IF( l_ldftra_time .OR. l_ldfeiv_time )   CALL ldf_tra( kstp )  
     152 
     153!!gm  CALL to ldf_dyn is missing 
     154 
    154155#if defined key_traldf_c3d && key_traldf_smag 
    155156                          CALL ldf_tra_smag( kstp )      ! eddy induced velocity coefficient 
    … …  
    160161 
    161162      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    162       !  Ocean dynamics : hdiv, rot, ssh, e3, wn 
     163      !  Ocean dynamics : hdiv, ssh, e3, wn 
    163164      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    164165                         CALL ssh_nxt       ( kstp )  ! after ssh (includes call to div_cur) 
    … …  
    209210      IF( lk_diaharm )   CALL dia_harm( kstp )        ! Tidal harmonic analysis 
    210211                         CALL dia_wri( kstp )         ! ocean model: outputs 
    211       ! 
    212212      IF( ln_crs     )   CALL crs_fld( kstp )         ! ocean model: online field coarsening & output 
    213213 
    … …  
    266266                               ua(:,:,:) = ua_sv(:,:,:) 
    267267                               va(:,:,:) = va_sv(:,:,:) 
    268                                                              ! Revert now divergence and rotational to previously computed ones  
    269                                                              !(needed because of the time swap in div_cur, at the beginning of each time step) 
    270                                hdivn(:,:,:) = hdivb(:,:,:) 
    271                                rotn(:,:,:)  = rotb(:,:,:)  
    272268 
    273269                               CALL dyn_bfr( kstp )         ! bottom friction 

  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r4328 r4596  
    44   !! Ocean time-stepping : module used in both initialisation phase and time stepping 
    55   !!====================================================================== 
    6    !! History :   3.3  ! 2010-08  (C. Ethe)  Original code - reorganisation of the initial phase 
     6   !! History :   3.3  !  2010-08  (C. Ethe)  Original code - reorganisation of the initial phase 
     7   !!             3.7  !  2014-01  (G. Madec) LDF simplication  
    78   !!---------------------------------------------------------------------- 
    89   USE oce              ! ocean dynamics and tracers variables 
    910   USE dom_oce          ! ocean space and time domain variables 
    1011   USE zdf_oce          ! ocean vertical physics variables 
    11    USE ldftra_oce       ! ocean tracer   - trends 
    12    USE ldfdyn_oce       ! ocean dynamics - trends 
    13    USE divcur           ! hor. divergence and curl      (div & cur routines) 
    14    USE in_out_manager   ! I/O manager 
    15    USE iom              ! 
    16    USE lbclnk 
    17    USE restart          ! restart 
    18 #if defined key_iomput 
    19    USE xios 
    20 #endif 
    2112 
    2213   USE daymod           ! calendar                         (day     routine) 
    … …  
    6758 
    6859   USE ldfslp           ! iso-neutral slopes               (ldf_slp routine) 
    69    USE ldfeiv           ! eddy induced velocity coef.      (ldf_eiv routine) 
     60   USE ldfdyn           ! lateral eddy viscosity coef.     (ldf_dyn routine) 
     61   USE ldftra           ! lateral eddy diffusive coef.     (ldf_tra routine) 
    7062   USE ldftra_smag      ! Smagirinsky diffusion            (ldftra_smag routine) 
    7163   USE ldfdyn_smag      ! Smagorinsky viscosity            (ldfdyn_smag routine)  
    … …  
    10698   USE asmbkg 
    10799   USE stpctl           ! time stepping control            (stp_ctl routine) 
     100   USE restart          ! ocean restart                    (rst_wri routine) 
    108101   USE prtctl           ! Print control                    (prt_ctl routine) 
    109102 
    110103   USE diaobs           ! Observation operator 
    111104 
     105   USE in_out_manager   ! I/O manager 
     106   USE iom              ! 
     107   USE lbclnk 
    112108   USE timing           ! Timing 
    113109 
     110#if defined key_iomput 
     111   USE xios 
     112#endif 
    114113#if defined key_agrif 
    115114   USE agrif_opa_sponge ! Momemtum and tracers sponges 
    … …  
    119118#endif 
    120119   !!---------------------------------------------------------------------- 
    121    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     120   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    122121   !! $Id$ 
    123122   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
Note: See TracChangeset for help on using the changeset viewer.