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

Changeset 4619 for branches/2014


Ignore:
Timestamp:
2014-04-08T11:23:42+02:00 (10 years ago)
Author:
gm
Message:

#1294 : TEOS-10 and Ediag

Location:
branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM
Files:
9 added
7 deleted
71 edited

Legend:

Unmodified
Added
Removed

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

    r4370 r4619  
    1111   nn_stock    =    4320   !  frequency of creation of a restart file (modulo referenced to 1) 
    1212   nn_write    =      60   !  frequency of write in the output file   (modulo referenced to nn_it000) 
     13 
     14   ln_clobber  = .true.    !  clobber (overwrite) an existing file 
     15 
    1316/ 
    1417!----------------------------------------------------------------------- 
    … …  
    8285!----------------------------------------------------------------------- 
    8386   nn_fsbc     = 1         !  frequency of surface boundary condition computation 
    84                            !     (also = the frequency of sea-ice model call) 
     87   !                       !     (also = the frequency of sea-ice model call) 
    8588   ln_ana      = .true.    !  analytical formulation                    (T => fill namsbc_ana ) 
    8689   ln_blk_core = .false.   !  CORE bulk formulation                     (T => fill namsbc_core) 
    … …  
    198201&nameos        !   ocean physical parameters 
    199202!----------------------------------------------------------------------- 
    200    nn_eos      =   2       !  type of equation of state and Brunt-Vaisala frequency 
     203   nn_eos      =  0       !  type of equation of state and Brunt-Vaisala frequency 
     204                                 !  =-1, TEOS-10  
     205                                 !  = 0, EOS-80  
     206                                 !  = 1, S-EOS   (simplified eos) 
     207   ln_useCT    = .false.  ! use of Conservative Temp. ==> surface CT converted in Pot. Temp. in sbcssm 
     208   !                             ! 
     209   !                      ! S-EOS coefficients : 
     210   !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     211   rn_a0       =  1.6550e-1      !  thermal expension coefficient (nn_eos= 1) 
     212   rn_b0       =  7.6554e-1      !  saline  expension coefficient (nn_eos= 1) 
     213   rn_lambda1  =  5.9520e-2      !  cabbeling coeff in T^2  (=0 for linear eos) 
     214   rn_lambda2  =  7.4914e-4      !  cabbeling coeff in S^2  (=0 for linear eos) 
     215   rn_mu1      =  1.4970e-4      !  thermobaric coeff. in T (=0 for linear eos) 
     216   rn_mu2      =  1.1090e-5      !  thermobaric coeff. in S (=0 for linear eos) 
     217   rn_nu       =  2.4341e-3      !  cabbeling coeff in T*S  (=0 for linear eos) 
     218!!org GYRE   rn_alpha    =   2.0e-4  !  thermal expension coefficient (nn_eos= 1 or 2) 
     219!!org GYRE   rn_beta     =   7.7e-4  !  saline  expension coefficient (nn_eos= 2) 
     220!!org  caution  now a0 = alpha / rau0   with rau0 = 1026 
    201221/ 
    202222!----------------------------------------------------------------------- 
    203223&namtra_adv    !   advection scheme for tracer 
    204224!----------------------------------------------------------------------- 
    205    ln_traadv_msc_ups=  .false.  !  use upstream scheme within muscl  
     225   ln_traadv_cen2   =  .false.   !  2nd order centered scheme 
     226   ln_traadv_tvd    =  .true.    !  TVD scheme 
     227   ln_traadv_muscl  =  .false.   !  MUSCL scheme 
     228   ln_traadv_muscl2 =  .false.   !  MUSCL2 scheme + cen2 at boundaries 
     229   ln_traadv_ubs    =  .false.   !  UBS scheme 
     230   ln_traadv_qck    =  .false.   !  QUICKEST scheme 
     231   ln_traadv_msc_ups=  .false.   !  use upstream scheme within muscl 
    206232/ 
    207233!----------------------------------------------------------------------- 
    … …  
    242268!namdyn_spg    !   surface pressure gradient   (CPP key only) 
    243269!----------------------------------------------------------------------- 
     270 
    244271!----------------------------------------------------------------------- 
    245272&namdyn_ldf    !   lateral diffusion on momentum 
    … …  
    301328!              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor") 
    302329!----------------------------------------------------------------------- 
    303 / 
     330   ln_glo_trd  = .false.   ! (T) global domain averaged diag for T, T^2, KE, and PE 
     331   ln_dyn_trd  = .false.   ! (T) 3D momentum trend output 
     332   ln_dyn_mxl  = .FALSE.   ! (T) 2D momentum trends averaged over the mixed layer (not coded yet) 
     333   ln_vor_trd  = .FALSE.   ! (T) 2D barotropic vorticity trends (not coded yet) 
     334   ln_KE_trd   = .false.   ! (T) 3D Kinetic   Energy     trends 
     335   ln_PE_trd   = .false.   ! (T) 3D Potential Energy     trends 
     336   ln_tra_trd  = .false.    ! (T) 3D tracer trend output 
     337   ln_tra_mxl  = .false.   ! (T) 2D tracer trends averaged over the mixed layer (not coded yet) 
     338   nn_trd      = 365       !  print frequency (ln_glo_trd=T) (unit=time step) 
     339/ 
     340!!gm   nn_ctls     =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk) 
     341!!gm   rn_ucf      =   1.      !  unit conversion factor (=1 -> /seconds ; =86400. -> /day) 
     342!!gm   cn_trdrst_in      = "restart_mld"   ! suffix of ocean restart name (input) 
     343!!gm   cn_trdrst_out     = "restart_mld"   ! suffix of ocean restart name (output) 
     344!!gm   ln_trdmld_restart = .false.         !  restart for ML diagnostics 
     345!!gm   ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S 
     346!!gm 
    304347!----------------------------------------------------------------------- 
    305348&namflo       !   float parameters                                      ("key_float") 

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

    r4230 r4619  
    1  bld::tool::fppkeys key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi 
     1 bld::tool::fppkeys key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi key_nosignedzero 

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

    r4565 r4619  
    2828         <field id="mldkz5"       long_name="mixing layer depth (Turbocline)"           unit="m"                        /> 
    2929         <field id="mldr10_1"     long_name="Mixed Layer Depth 0.01 ref.10m"            unit="m"                        /> 
    30          <field id="rhop"         long_name="potential density (sigma0)"                unit="kg/m3" grid_ref="grid_T_3D"/> 
    31     <field id="eken"         long_name="kinetic energy"                            unit="m2/s2" grid_ref="grid_T_3D"/> 
    32     <field id="hdiv"         long_name="horizontal divergence"                     unit="s-1"   grid_ref="grid_T_3D"/> 
     30         <!-- EOS --!> 
     31         <field id="alpha"        long_name="thermal expansion"                         unit="1/degC" grid_ref="grid_T_3D"/> 
     32         <field id="beta"         long_name="haline contraction"                        unit="1/psu"  grid_ref="grid_T_3D"/> 
     33         <field id="bn2"          long_name="squared Brunt-Vaisala frequency"           unit="1/s"    grid_ref="grid_T_3D"/> 
     34         <field id="rhop"         long_name="potential density (sigma0)"                unit="kg/m3"  grid_ref="grid_T_3D"/> 
     35         <!-- Energy - horizontal divergence --!> 
     36         <field id="eken"         long_name="kinetic energy"                            unit="m2/s2"  grid_ref="grid_T_3D"/> 
     37         <field id="hdiv"         long_name="horizontal divergence"                     unit="s-1"    grid_ref="grid_T_3D"/> 
    3338         <!-- variables available with MLE --> 
    3439         <field id="Lf_NHpf"      long_name="MLE: Lf = N H / f"                         unit="m"                        /> 
    … …  
    629634    </field_group> 
    630635     
     636    <!--  
     637============================================================================================================ 
     638                     Trend diagnostics : temperature, KE, PE, momentum 
     639============================================================================================================ 
     640    --> 
     641 
     642    <field_group id="trendT" grid_ref="grid_T_3D"> 
     643      <!-- variables available with ln_tra_trd --> 
     644      <field id="ttrd_xad"      long_name="temperature-trend: i-advection"                 unit="degC/s" /> 
     645      <field id="strd_xad"      long_name="salinity   -trend: i-advection"                 unit="psu/s"  /> 
     646      <field id="ttrd_yad"      long_name="temperature-trend: j-advection"                 unit="degC/s" /> 
     647      <field id="strd_yad"      long_name="salinity   -trend: j-advection"                 unit="psu/s"  /> 
     648      <field id="ttrd_zad"      long_name="temperature-trend: k-advection"                 unit="degC/s" /> 
     649      <field id="strd_zad"      long_name="salinity   -trend: k-advection"                 unit="psu/s"  /> 
     650      <field id="ttrd_sad"      long_name="temperature-trend: surface adv. (no-vvl)"       unit="degC/s" grid_ref="grid_T_2D" /> 
     651      <field id="strd_sad"      long_name="salinity   -trend: surface adv. (no-vvl)"       unit="psu/s"  grid_ref="grid_T_2D" /> 
     652      <field id="ttrd_ldf"      long_name="temperature-trend: lateral  diffusion"          unit="degC/s" /> 
     653      <field id="strd_ldf"      long_name="salinity   -trend: lateral  diffusion"          unit="psu/s"  /> 
     654      <field id="ttrd_zdf"      long_name="temperature-trend: vertical diffusion"          unit="degC/s" /> 
     655      <field id="strd_zdf"      long_name="salinity   -trend: vertical diffusion"          unit="psu/s"  /> 
     656      <!-- ln_traldf_iso=T only (iso-neutral diffusion) --> 
     657      <field id="ttrd_zdfp"     long_name="temperature-trend: pure vert. diffusion"        unit="degC/s" /> 
     658      <field id="strd_zdfp"     long_name="salinity   -trend: pure vert. diffusion"        unit="psu/s"  /> 
     659      <!-- --> 
     660      <field id="ttrd_dmp"      long_name="temperature-trend: interior restoring"          unit="degC/s" /> 
     661      <field id="strd_dmp"      long_name="salinity   -trend: interior restoring"          unit="psu/s"  /> 
     662      <field id="ttrd_bbl"      long_name="temperature-trend: bottom boundary layer"       unit="degC/s" /> 
     663      <field id="strd_bbl"      long_name="salinity   -trend: bottom boundary layer"       unit="psu/s"  /> 
     664      <field id="ttrd_npc"      long_name="temperature-trend: non-penetrative conv."       unit="degC/s" /> 
     665      <field id="strd_npc"      long_name="salinity   -trend: non-penetrative conv."       unit="psu/s"  /> 
     666      <field id="ttrd_qns"      long_name="temperature-trend: non-solar flux + runoff"     unit="degC/s" /> 
     667      <field id="strd_cdt"      long_name="salinity   -trend: C/D term       + runoff"     unit="degC/s" /> 
     668      <field id="ttrd_qsr"      long_name="temperature-trend: solar penetr. heating"       unit="degC/s" /> 
     669      <field id="ttrd_bbc"      long_name="temperature-trend: geothermal heating"          unit="degC/s" /> 
     670      <field id="ttrd_atf"      long_name="temperature-trend: asselin time filter"         unit="degC/s" /> 
     671      <field id="strd_atf"      long_name="salinity   -trend: asselin time filter"         unit="psu/s"  /> 
     672      <!-- variables available with ln_KE_trd --> 
     673      <field id="ketrd_hpg"     long_name="ke-trend: hydrostatic pressure gradient"        unit="W/s^3"  /> 
     674      <field id="ketrd_spg"     long_name="ke-trend: surface     pressure gradient"        unit="W/s^3"  /> 
     675      <field id="ketrd_spgexp"  long_name="ke-trend: surface pressure gradient (explicit)" unit="W/s^3"  /> 
     676      <field id="ketrd_spgflt"  long_name="ke-trend: surface pressure gradient (filter)"   unit="W/s^3"  /> 
     677      <field id="ssh_flt"       long_name="filtered contribution to ssh (dynspg_flt)"      unit="m"     grid_ref="grid_T_2D"   /> 
     678      <field id="w0"            long_name="surface vertical velocity"                      unit="m/s"   grid_ref="grid_T_2D"   /> 
     679      <field id="pw0_exp"       long_name="surface pressure flux due to ssh"               unit="W/s^2" grid_ref="grid_T_2D"   /> 
     680      <field id="pw0_flt"       long_name="surface pressure flux due to filtered ssh"      unit="W/s^2" grid_ref="grid_T_2D"   /> 
     681      <field id="ketrd_keg"     long_name="ke-trend: KE gradient         or hor. adv."     unit="W/s^3"  /> 
     682      <field id="ketrd_rvo"     long_name="ke-trend: relative  vorticity or metric term"   unit="W/s^3"  /> 
     683      <field id="ketrd_pvo"     long_name="ke-trend: planetary vorticity"                  unit="W/s^3"  /> 
     684      <field id="ketrd_zad"     long_name="ke-trend: vertical  advection"                  unit="W/s^3"  /> 
     685      <field id="ketrd_udx"     long_name="ke-trend: U.dx[U]"                              unit="W/s^3"  /> 
     686      <field id="ketrd_ldf"     long_name="ke-trend: lateral   diffusion"                  unit="W/s^3"  /> 
     687      <field id="ketrd_zdf"     long_name="ke-trend: vertical  diffusion"                  unit="W/s^3"  /> 
     688      <field id="ketrd_tau"     long_name="ke-trend: wind stress "                         unit="W/s^3" grid_ref="grid_T_2D"   /> 
     689      <field id="ketrd_bfr"     long_name="ke-trend: bottom friction (explicit)"           unit="W/s^3"  />    
     690      <field id="ketrd_bfri"    long_name="ke-trend: bottom friction (implicit)"           unit="W/s^3"  />    
     691      <field id="ketrd_atf"     long_name="ke-trend: asselin time filter trend"            unit="W/s^3"  />   
     692      <field id="ketrd_convP2K" long_name="ke-trend: conversion (potential to kinetic)"    unit="W/s^3"  /> 
     693      <field id="KE"            long_name="kinetic energy: u(n)*u(n+1)/2"                  unit="W/s^2"  />    
     694      <!-- variables available with ln_PE_trd --> 
     695      <field id="petrd_xad"     long_name="pe-trend: i-advection"                          unit="W/m^3"  /> 
     696      <field id="petrd_yad"     long_name="pe-trend: j-advection"                          unit="W/m^3"  /> 
     697      <field id="petrd_zad"     long_name="pe-trend: k-advection"                          unit="W/m^3"  /> 
     698      <field id="petrd_sad"     long_name="pe-trend: surface adv. (no-vvl)"                unit="W/m^3"  grid_ref="grid_T_2D" /> 
     699      <field id="petrd_ldf"     long_name="pe-trend: lateral  diffusion"                   unit="W/m^3"  /> 
     700      <field id="petrd_zdf"     long_name="pe-trend: vertical diffusion"                   unit="W/m^3"  /> 
     701      <field id="petrd_zdfp"    long_name="pe-trend: pure vert. diffusion"                 unit="W/m^3"  /> 
     702      <field id="petrd_dmp"     long_name="pe-trend: interior restoring"                   unit="W/m^3"  /> 
     703      <field id="petrd_bbl"     long_name="pe-trend: bottom boundary layer"                unit="W/m^3"  /> 
     704      <field id="petrd_npc"     long_name="pe-trend: non-penetrative conv."                unit="W/m^3"  /> 
     705      <field id="petrd_nsr"     long_name="pe-trend: surface forcing + runoff"             unit="W/m^3"  /> 
     706      <field id="petrd_qsr"     long_name="pe-trend: solar penetr. heating"                unit="W/m^3"  /> 
     707      <field id="petrd_bbc"     long_name="pe-trend: geothermal heating"                   unit="W/m^3"  /> 
     708      <field id="petrd_atf"     long_name="pe-trend: asselin time filter"                  unit="W/m^3"  /> 
     709      <field id="PEanom"        long_name="potential energy anomaly"                       unit="SI"     />    
     710      <field id="alphaPE"       long_name="- partial deriv. of PEanom wrt T"               unit="/degC"  />    
     711      <field id="betaPE"        long_name="partial deriv. of PEanom wrt S"                 unit="/psu"   />    
     712    </field_group> 
     713 
     714    <field_group id="trendU" grid_ref="grid_U_3D"> 
     715     <!-- variables available with ln_dyn_trd --> 
     716     <field id="utrd_hpg"       long_name="i-trend: hydrostatic pressure gradient"         unit="m/s^2"                      /> 
     717     <field id="utrd_spg"       long_name="i-trend: surface     pressure gradient"         unit="m/s^2"                      /> 
     718     <field id="utrd_spgexp"    long_name="i-trend: surface pressure gradient (explicit)"  unit="m/s^2"                      /> 
     719     <field id="utrd_spgflt"    long_name="i-trend: surface pressure gradient (filtered)"  unit="m/s^2"                      /> 
     720     <field id="utrd_keg"       long_name="i-trend: KE gradient         or hor. adv."      unit="m/s^2"                      /> 
     721     <field id="utrd_rvo"       long_name="i-trend: relative  vorticity or metric term"    unit="m/s^2"                      /> 
     722     <field id="utrd_pvo"       long_name="i-trend: planetary vorticity"                   unit="m/s^2"                      /> 
     723     <field id="utrd_zad"       long_name="i-trend: vertical  advection"                   unit="m/s^2"                      /> 
     724     <field id="utrd_udx"       long_name="i-trend: U.dx[U]"                               unit="m/s^2"                      /> 
     725     <field id="utrd_ldf"       long_name="i-trend: lateral   diffusion"                   unit="m/s^2"                      /> 
     726     <field id="utrd_zdf"       long_name="i-trend: vertical  diffusion"                   unit="m/s^2"                      /> 
     727     <field id="utrd_tau"       long_name="i-trend: wind stress "                          unit="m/s^2" grid_ref="grid_U_2D" /> 
     728     <field id="utrd_bfr"       long_name="i-trend: bottom friction (explicit)"            unit="m/s^2"                      />    
     729     <field id="utrd_bfri"      long_name="i-trend: bottom friction (implicit)"            unit="m/s^2"                      />    
     730     <field id="utrd_tot"       long_name="i-trend: total momentum trend before atf"       unit="m/s^2"                      />    
     731     <field id="utrd_atf"       long_name="i-trend: asselin time filter trend"             unit="m/s^2"                      />    
     732    </field_group> 
     733 
     734    <field_group id="trendV" grid_ref="grid_V_3D"> 
     735     <!-- variables available with ln_dyn_trd --> 
     736     <field id="vtrd_hpg"       long_name="j-trend: hydrostatic pressure gradient"         unit="m/s^2"                      /> 
     737     <field id="vtrd_spg"       long_name="j-trend: surface     pressure gradient"         unit="m/s^2"                      /> 
     738     <field id="vtrd_spgexp"    long_name="j-trend: surface pressure gradient (explicit)"  unit="m/s^2"                      /> 
     739     <field id="vtrd_spgflt"    long_name="j-trend: surface pressure gradient (filtered)"  unit="m/s^2"                      /> 
     740     <field id="vtrd_keg"       long_name="j-trend: KE gradient         or hor. adv."      unit="m/s^2"                      /> 
     741     <field id="vtrd_rvo"       long_name="j-trend: relative  vorticity or metric term"    unit="m/s^2"                      /> 
     742     <field id="vtrd_pvo"       long_name="j-trend: planetary vorticity"                   unit="m/s^2"                      /> 
     743     <field id="vtrd_zad"       long_name="j-trend: vertical  advection"                   unit="m/s^2"                      /> 
     744     <field id="vtrd_vdy"       long_name="i-trend: V.dx[V]"                               unit="m/s^2"                      /> 
     745     <field id="vtrd_ldf"       long_name="j-trend: lateral   diffusion"                   unit="m/s^2"                      /> 
     746     <field id="vtrd_zdf"       long_name="j-trend: vertical  diffusion"                   unit="m/s^2"                      /> 
     747     <field id="vtrd_tau"       long_name="j-trend: wind stress "                          unit="m/s^2" grid_ref="grid_V_2D" /> 
     748     <field id="vtrd_bfr"       long_name="j-trend: bottom friction (explicit)"            unit="m/s^2"                      />    
     749     <field id="vtrd_bfri"      long_name="j-trend: bottom friction (implicit)"            unit="m/s^2"                      />    
     750     <field id="vtrd_tot"       long_name="j-trend: total momentum trend before atf"       unit="m/s^2"                      />    
     751     <field id="vtrd_atf"       long_name="j-trend: asselin time filter trend"            unit="m/s^2"                       />    
     752    </field_group> 
     753 
    631754    </field_definition> 

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

    r4384 r4619  
    11!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    2 !! NEMO/OPA  :  1 - run manager      (namrun, namcfg) 
    3 !! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namtsd) 
     2!! NEMO/OPA  :  1 - run manager      (namrun) 
     3!! namelists    2 - Domain           (namcfg, namzgr, namzgr_sco, namdom, namtsd) 
    44!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core, namsbc_sas 
    55!!                                    namsbc_cpl, namtra_qsr, namsbc_rnf, 
    … …  
    1818!!                   ***  Run management namelists  *** 
    1919!!====================================================================== 
    20 !!   namrun        parameters of the run 
     20!!   namrun       parameters of the run 
    2121!!====================================================================== 
    2222! 
    … …  
    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 
    … …  
    4747/ 
    4848! 
    49 !----------------------------------------------------------------------- 
    50 &namcfg     !   default parameters of the configuration       
     49!!====================================================================== 
     50!!                      ***  Domain namelists  *** 
     51!!====================================================================== 
     52!!   namcfg       parameters of the configuration       
     53!!   namzgr       vertical coordinate 
     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!!====================================================================== 
     58! 
     59!----------------------------------------------------------------------- 
     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 
    … …  
    635636!!   nameos        equation of state 
    636637!!   namtra_adv    advection scheme 
     638!!   namtra_adv_mle   mixed layer eddy param. (Fox-Kemper param.) 
    637639!!   namtra_ldf    lateral diffusion scheme 
    638640!!   namtra_dmp    T & S newtonian damping 
    … …  
    642644&nameos        !   ocean physical parameters 
    643645!----------------------------------------------------------------------- 
    644    nn_eos      =   0       !  type of equation of state and Brunt-Vaisala frequency 
    645                            !     = 0, UNESCO (formulation of Jackett and McDougall (1994) and of McDougall (1987) ) 
    646                            !     = 1, linear: rho(T)   = rau0 * ( 1.028 - ralpha * T ) 
    647                            !     = 2, linear: rho(T,S) = rau0 * ( rbeta * S - ralpha * T ) 
    648    rn_alpha    =   2.0e-4  !  thermal expension coefficient (nn_eos= 1 or 2) 
    649    rn_beta     =   7.7e-4  !  saline  expension coefficient (nn_eos= 2) 
     646   nn_eos      =  -1     !  type of equation of state and Brunt-Vaisala frequency 
     647                                 !  =-1, TEOS-10  
     648                                 !  = 0, EOS-80  
     649                                 !  = 1, S-EOS   (simplified eos) 
     650   ln_useCT    = .true.  ! use of Conservative Temp. ==> surface CT converted in Pot. Temp. in sbcssm 
     651   !                             ! 
     652   !                     ! S-EOS coefficients : 
     653   !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     654   rn_a0       =  1.6550e-1      !  thermal expension coefficient (nn_eos= 1) 
     655   rn_b0       =  7.6554e-1      !  saline  expension coefficient (nn_eos= 1) 
     656   rn_lambda1  =  5.9520e-2      !  cabbeling coeff in T^2  (=0 for linear eos) 
     657   rn_lambda2  =  7.4914e-4      !  cabbeling coeff in S^2  (=0 for linear eos) 
     658   rn_mu1      =  1.4970e-4      !  thermobaric coeff. in T (=0 for linear eos) 
     659   rn_mu2      =  1.1090e-5      !  thermobaric coeff. in S (=0 for linear eos) 
     660   rn_nu       =  2.4341e-3      !  cabbeling coeff in T*S  (=0 for linear eos) 
    650661/ 
    651662!----------------------------------------------------------------------- 
    652663&namtra_adv    !   advection scheme for tracer 
    653664!----------------------------------------------------------------------- 
    654    ln_traadv_cen2   =  .false.  !  2nd order centered scheme 
    655    ln_traadv_tvd    =  .true.   !  TVD scheme 
    656    ln_traadv_muscl  =  .false.  !  MUSCL scheme 
    657    ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries 
    658    ln_traadv_ubs    =  .false.  !  UBS scheme 
    659    ln_traadv_qck    =  .false.  !  QUICKEST scheme 
    660    ln_traadv_msc_ups=  .false.  !  use upstream scheme within muscl 
     665   ln_traadv_cen2   =  .false.   !  2nd order centered scheme 
     666   ln_traadv_tvd    =  .true.    !  TVD scheme 
     667   ln_traadv_muscl  =  .false.   !  MUSCL scheme 
     668   ln_traadv_muscl2 =  .false.   !  MUSCL2 scheme + cen2 at boundaries 
     669   ln_traadv_ubs    =  .false.   !  UBS scheme 
     670   ln_traadv_qck    =  .false.   !  QUICKEST scheme 
     671   ln_traadv_msc_ups=  .false.   !  use upstream scheme within muscl 
    661672/ 
    662673!----------------------------------------------------------------------- 
    … …  
    914925!!                  ***  Miscellaneous namelists  *** 
    915926!!====================================================================== 
     927!!   namsol            elliptic solver / island / free surface 
    916928!!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi) 
    917929!!   namctl            Control prints & Benchmark 
    918 !!   namsol            elliptic solver / island / free surface 
     930!!   namc1d            1D configuration options                         ("key_c1d") 
     931!!   namc1d_uvd        data: U & V currents                             ("key_c1d") 
     932!!   namc1d_dyndmp     U & V newtonian damping                          ("key_c1d") 
    919933!!====================================================================== 
    920934! 
    … …  
    981995   ln_dyndmp   =  .false.  !  add a damping term (T) or not (F) 
    982996/ 
     997 
    983998!!====================================================================== 
    984999!!                  ***  Diagnostics namelists  *** 
    9851000!!====================================================================== 
    9861001!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4") 
    987 !!   namtrd       dynamics and/or tracer trends                         ("key_trddyn","key_trdtra","key_trdmld") 
     1002!!   namtrd       dynamics and/or tracer trends 
    9881003!!   namflo       float parameters                                      ("key_float") 
    9891004!!   namptr       Poleward Transport Diagnostics 
    … …  
    10031018/ 
    10041019!----------------------------------------------------------------------- 
    1005 &namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra") 
    1006 !              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor") 
    1007 !----------------------------------------------------------------------- 
    1008    nn_trd      = 365       !  time step frequency dynamics and tracers trends 
    1009    nn_ctls     =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk) 
    1010    rn_ucf      =   1.      !  unit conversion factor (=1 -> /seconds ; =86400. -> /day) 
    1011    cn_trdrst_in      = "restart_mld"   ! suffix of ocean restart name (input) 
    1012    cn_trdrst_out     = "restart_mld"   ! suffix of ocean restart name (output) 
    1013    ln_trdmld_restart = .false.         !  restart for ML diagnostics 
    1014    ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S 
    1015 / 
     1020&namtrd        !   diagnostics on dynamics and/or tracer trends 
     1021!              !       and/or mixed-layer trends and/or barotropic vorticity 
     1022!----------------------------------------------------------------------- 
     1023   ln_glo_trd  = .false.   ! (T) global domain averaged diag for T, T^2, KE, and PE 
     1024   ln_dyn_trd  = .false.   ! (T) 3D momentum trend output 
     1025   ln_dyn_mxl  = .FALSE.   ! (T) 2D momentum trends averaged over the mixed layer (not coded yet) 
     1026   ln_vor_trd  = .FALSE.   ! (T) 2D barotropic vorticity trends (not coded yet) 
     1027   ln_KE_trd   = .false.   ! (T) 3D Kinetic   Energy     trends 
     1028   ln_PE_trd   = .false.   ! (T) 3D Potential Energy     trends 
     1029   ln_tra_trd  = .true.    ! (T) 3D tracer trend output 
     1030   ln_tra_mxl  = .false.   ! (T) 2D tracer trends averaged over the mixed layer (not coded yet) 
     1031   nn_trd      = 365       !  print frequency (ln_glo_trd=T) (unit=time step) 
     1032/ 
     1033!!gm   nn_ctls     =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk) 
     1034!!gm   rn_ucf      =   1.      !  unit conversion factor (=1 -> /seconds ; =86400. -> /day) 
     1035!!gm   cn_trdrst_in      = "restart_mld"   ! suffix of ocean restart name (input) 
     1036!!gm   cn_trdrst_out     = "restart_mld"   ! suffix of ocean restart name (output) 
     1037!!gm   ln_trdmld_restart = .false.         !  restart for ML diagnostics 
     1038!!gm   ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S 
     1039!!gm 
    10161040!----------------------------------------------------------------------- 
    10171041&namflo       !   float parameters                                      ("key_float") 

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

    r4313 r4619  
    109109      !! ** Action  :  
    110110      !!---------------------------------------------------------------------- 
    111       INTEGER :: ji, jj, jk 
    112       INTEGER :: jt 
    113       INTEGER :: imid 
    114       INTEGER :: inum 
     111      INTEGER :: ji, jj, jk, jt  ! dummy loop indices 
     112      INTEGER :: imid, inum      ! local integers 
     113      INTEGER :: ios             ! Local integer output status for namelist read 
    115114      INTEGER :: iiauper         ! Number of time steps in the IAU period 
    116115      INTEGER :: icycper         ! Number of time steps in the cycle 
    … …  
    120119      INTEGER :: iitiaustr_date  ! Date YYYYMMDD of IAU interval start time step 
    121120      INTEGER :: iitiaufin_date  ! Date YYYYMMDD of IAU interval final time step 
    122       INTEGER :: ios             ! Local integer output status for namelist read 
    123  
     121      ! 
    124122      REAL(wp) :: znorm        ! Normalization factor for IAU weights 
    125       REAL(wp) :: ztotwgt      ! Value of time-integrated IAU weights  
    126                                ! (should be equal to one) 
     123      REAL(wp) :: ztotwgt      ! Value of time-integrated IAU weights (should be equal to one) 
    127124      REAL(wp) :: z_inc_dateb  ! Start date of interval on which increment is valid 
    128125      REAL(wp) :: z_inc_datef  ! End date of interval on which increment is valid 
    129126      REAL(wp) :: zdate_bkg    ! Date in background state file for DI 
    130127      REAL(wp) :: zdate_inc    ! Time axis in increments file 
    131  
    132       REAL(wp), POINTER, DIMENSION(:,:) :: hdiv 
     128      ! 
     129      REAL(wp), POINTER, DIMENSION(:,:) ::   hdiv   ! 2D workspace 
    133130      !! 
    134131      NAMELIST/nam_asminc/ ln_bkgwri,                                      & 
    … …  
    136133         &                 ln_asmdin, ln_asmiau,                           & 
    137134         &                 nitbkg, nitdin, nitiaustr, nitiaufin, niaufn,   & 
    138          &                 ln_salfix, salfixmin,                & 
    139          &                 nn_divdmp 
     135         &                 ln_salfix, salfixmin, nn_divdmp 
    140136      !!---------------------------------------------------------------------- 
    141137 
    … …  
    143139      ! Read Namelist nam_asminc : assimilation increment interface 
    144140      !----------------------------------------------------------------------- 
    145  
    146141      ln_seaiceinc = .FALSE. 
    147142      ln_temnofreeze = .FALSE. 
    … …  
    186181      icycper = nitend      - nit000      + 1  ! Cycle interval length 
    187182 
    188       ! Date of final time step 
    189       CALL calc_date( nit000, nitend, ndate0, iitend_date ) 
    190  
    191       ! Background time for Jb referenced to ndate0 
    192       CALL calc_date( nit000, nitbkg_r, ndate0, iitbkg_date ) 
    193  
    194       ! Background time for DI referenced to ndate0 
    195       CALL calc_date( nit000, nitdin_r, ndate0, iitdin_date ) 
    196  
    197       ! IAU start time referenced to ndate0 
    198       CALL calc_date( nit000, nitiaustr_r, ndate0, iitiaustr_date ) 
    199  
    200       ! IAU end time referenced to ndate0 
    201       CALL calc_date( nit000, nitiaufin_r, ndate0, iitiaufin_date ) 
    202  
     183      CALL calc_date( nit000, nitend     , ndate0, iitend_date    )     ! Date of final time step 
     184      CALL calc_date( nit000, nitbkg_r   , ndate0, iitbkg_date    )     ! Background time for Jb referenced to ndate0 
     185      CALL calc_date( nit000, nitdin_r   , ndate0, iitdin_date    )     ! Background time for DI referenced to ndate0 
     186      CALL calc_date( nit000, nitiaustr_r, ndate0, iitiaustr_date )     ! IAU start time referenced to ndate0 
     187      CALL calc_date( nit000, nitiaufin_r, ndate0, iitiaufin_date )     ! IAU end time referenced to ndate0 
     188      ! 
    203189      IF(lwp) THEN 
    204190         WRITE(numout,*) 
    … …  
    675661      ! used to prevent the applied increments taking the temperature below the local freezing point  
    676662 
    677       DO jk=1, jpkm1 
    678          fzptnz (:,:,jk) = tfreez( tsn(:,:,jk,jp_sal), fsdept(:,:,jk) ) 
    679       ENDDO 
     663      DO jk = 1, jpkm1 
     664         fzptnz(:,:,jk) = eos_fzp( tsn(:,:,jk,jp_sal), fsdept(:,:,jk) ) 
     665      END DO 
    680666 
    681667      IF ( ln_asmiau ) THEN 
    … …  
    692678            IF(lwp) THEN 
    693679               WRITE(numout,*)  
    694                WRITE(numout,*) 'tra_asm_inc : Tracer IAU at time step = ', & 
    695                   &  kt,' with IAU weight = ', wgtiau(it) 
     680               WRITE(numout,*) 'tra_asm_inc : Tracer IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 
    696681               WRITE(numout,*) '~~~~~~~~~~~~' 
    697682            ENDIF 
    … …  
    741726            IF (ln_temnofreeze) THEN 
    742727               ! Do not apply negative increments if the temperature will fall below freezing 
    743                WHERE(t_bkginc(:,:,:) > 0.0_wp .OR. & 
    744                   &   tsn(:,:,:,jp_tem) + t_bkginc(:,:,:) > fzptnz(:,:,:) )  
     728               WHERE( t_bkginc(:,:,:) > 0.0_wp .OR. tsn(:,:,:,jp_tem) + t_bkginc(:,:,:) > fzptnz(:,:,:) )  
    745729                  tsn(:,:,:,jp_tem) = t_bkg(:,:,:) + t_bkginc(:,:,:)    
    746730               END WHERE 
    … …  
    751735               ! Do not apply negative increments if the salinity will fall below a specified 
    752736               ! minimum value salfixmin 
    753                WHERE(s_bkginc(:,:,:) > 0.0_wp .OR. & 
    754                   &   tsn(:,:,:,jp_sal) + s_bkginc(:,:,:) > salfixmin )  
     737               WHERE( s_bkginc(:,:,:) > 0.0_wp .OR. tsn(:,:,:,jp_sal) + s_bkginc(:,:,:) > salfixmin )  
    755738                  tsn(:,:,:,jp_sal) = s_bkg(:,:,:) + s_bkginc(:,:,:)    
    756739               END WHERE 
    … …  
    761744            tsb(:,:,:,:) = tsn(:,:,:,:)               ! Update before fields 
    762745 
     746!!gm   orig 
    763747            CALL eos( tsb, rhd, rhop, gdept_0(:,:,:) )                ! Before potential and in situ densities 
    764           
     748!!gm  fabien 
     749!            CALL eos( tsb, rhd, rhop )                ! Before potential and in situ densities 
     750!!gm 
     751 
     752 
    765753            IF( ln_zps .AND. .NOT. lk_c1d ) & 
    766754               &  CALL zps_hde( nit000, jpts, tsb, &  ! Partial steps: before horizontal derivative 
    … …  
    770758#if defined key_zdfkpp 
    771759            CALL eos( tsn, rhd, fsdept_n(:,:,:) )                      ! Compute rhd 
     760!!gm fabien            CALL eos( tsn, rhd )                      ! Compute rhd 
    772761#endif 
    773762 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90

    r4367 r4619  
    1515   USE dom_oce        ! ocean: domain variables 
    1616   USE c1d            ! 1D vertical configuration 
    17    USE trdmod         ! ocean: trends 
    18    USE trdmod_oce     ! ocean: trends variables 
    1917   USE tradmp         ! ocean: internal damping 
    2018   USE zdf_oce        ! ocean: vertical physics 
    … …  
    164162      !! ** Action  : - (ua,va)   momentum trends updated with the damping trend 
    165163      !!---------------------------------------------------------------------- 
    166       ! 
    167164      INTEGER, INTENT(in) ::   kt                        ! ocean time-step index 
    168165      !! 
    … …  
    236233      END SELECT 
    237234      ! 
    238       !                           ! Trend diagnostic 
    239       IF( l_trddyn )   CALL trd_mod( utrdmp, vtrdmp, jpdyn_trd_dat, 'DYN', kt ) 
     235!!gm      !                           ! Trend diagnostic 
     236!!gm      IF( l_trddyn )   CALL trd_mod( utrdmp, vtrdmp, jpdyn_trd_dat, 'DYN', kt ) 
    240237      ! 
    241238      !                           ! Control print 

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

    r4292 r4619  
    573573      !!--------------------------------------------------------------------  
    574574      ! 
    575       CALL wrk_alloc( jpj      , zphi , zfoo ) 
    576       CALL wrk_alloc( jpj , jpk, z_1 ) 
     575      CALL wrk_alloc( jpj       , zphi , zfoo ) 
     576      CALL wrk_alloc( jpj , jpk , z_1 ) 
    577577 
    578578      ! define time axis 

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

    r4570 r4619  
    8989      INTEGER, DIMENSION(2) :: ierr 
    9090      !!---------------------------------------------------------------------- 
    91       ! 
    9291      ierr = 0 
    93       ! 
    9492      ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) ,     & 
    9593         &      ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) ,     & 
    … …  
    165163         CALL iom_put( "sss2" , tsn(:,:,1,jp_sal) * tsn(:,:,1,jp_sal) ) ! square of sea surface salinity 
    166164      END IF 
     165!!gm  I don't understand why not thickness weighted velocity if ln_dynadv_vec .... 
    167166      IF( lk_vvl .AND. (.NOT. ln_dynadv_vec) ) THEN 
    168167         CALL iom_put( "uoce" , un(:,:,:) * fse3u_n(:,:,:) )    ! i-transport 

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

    r4370 r4619  
    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 
    … …  
    5657#  include "vectopt_loop_substitute.h90" 
    5758   !!---------------------------------------------------------------------- 
    58    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     59   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    5960   !! $Id$ 
    6061   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    7374      !!---------------------------------------------------------------------- 
    7475      ! 
    75       IF( nn_timing == 1 )  CALL timing_start('istate_init') 
     76      IF( nn_timing == 1 )   CALL timing_start('istate_init') 
    7677      ! 
    7778 
    … …  
    8384      IF( lk_c1d ) CALL dta_uvd_init          ! Initialization of U & V input data 
    8485 
    85       rhd  (:,:,:  ) = 0.e0 
    86       rhop (:,:,:  ) = 0.e0 
    87       rn2  (:,:,:  ) = 0.e0  
    88       tsa  (:,:,:,:) = 0.e0     
     86      rhd  (:,:,:  ) = 0._wp 
     87      rhop (:,:,:  ) = 0._wp 
     88      rn2  (:,:,:  ) = 0._wp 
     89      tsa  (:,:,:,:) = 0._wp    
     90      rab_b(:,:,:,:) = 0._wp 
     91      rab_n(:,:,:,:) = 0._wp 
    8992 
    9093      IF( ln_rstart ) THEN                    ! Restart from a file 
    … …  
    162165      ! 
    163166      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  
    168167         DO jj = 1, jpj 
    169168            DO ji = 1, jpi 
    170 #endif                   
    171169               un_b(ji,jj) = un_b(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 
    172170               vn_b(ji,jj) = vn_b(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 
    … …  
    185183      ! 
    186184      ! 
    187       IF( nn_timing == 1 )  CALL timing_stop('istate_init') 
     185      IF( nn_timing == 1 )   CALL timing_stop('istate_init') 
    188186      ! 
    189187   END SUBROUTINE istate_init 
     188 
    190189 
    191190   SUBROUTINE istate_t_s 
    … …  
    219218   END SUBROUTINE istate_t_s 
    220219 
     220 
    221221   SUBROUTINE istate_eel 
    222222      !!---------------------------------------------------------------------- 
    … …  
    233233      USE divcur     ! hor. divergence & rel. vorticity      (div_cur routine) 
    234234      USE iom 
    235   
     235      ! 
    236236      INTEGER  ::   inum              ! temporary logical unit 
    237237      INTEGER  ::   ji, jj, jk        ! dummy loop indices 
    … …  
    244244      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   zssh  ! initial ssh over the global domain 
    245245      !!---------------------------------------------------------------------- 
    246  
     246      ! 
    247247      SELECT CASE ( jp_cfg )  
    248248         !                                              ! ==================== 
    … …  
    375375      INTEGER, PARAMETER ::   ntsinit = 0   ! (0/1) (analytical/input data files) T&S initialization 
    376376      !!---------------------------------------------------------------------- 
    377  
     377      ! 
    378378      SELECT CASE ( ntsinit) 
    379  
     379      ! 
    380380      CASE ( 0 )                  ! analytical T/S profil deduced from LEVITUS 
    381381         IF(lwp) WRITE(numout,*) 
    382382         IF(lwp) WRITE(numout,*) 'istate_gyre : initial analytical T and S profil deduced from LEVITUS ' 
    383383         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    384  
     384         ! 
    385385         DO jk = 1, jpk 
    386386            DO jj = 1, jpj 
    … …  
    407407            END DO 
    408408         END DO 
    409  
     409         ! 
    410410      CASE ( 1 )                  ! T/S data fields read in dta_tem.nc/data_sal.nc files 
    411411         IF(lwp) WRITE(numout,*) 
    … …  
    431431         tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * tmask(:,:,:)  
    432432         tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 
    433  
     433         ! 
    434434      END SELECT 
    435  
     435      ! 
    436436      IF(lwp) THEN 
    437437         WRITE(numout,*) 
    … …  
    440440         WRITE(numout, "(10x, i4, 3f10.2)" ) ( jk, gdept_1d(jk), tsn(2,2,jk,jp_tem), tsn(2,2,jk,jp_sal), jk = 1, jpk ) 
    441441      ENDIF 
    442  
     442      ! 
    443443   END SUBROUTINE istate_gyre 
     444 
    444445 
    445446   SUBROUTINE istate_uvg 
    … …  
    457458      USE divcur          ! hor. divergence & rel. vorticity      (div_cur routine) 
    458459      USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    459  
     460      ! 
    460461      INTEGER ::   ji, jj, jk        ! dummy loop indices 
    461462      INTEGER ::   indic             ! ??? 
    … …  
    567568   !!===================================================================== 
    568569END MODULE istate 
    569  

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90

    r3625 r4619  
    4747   REAL(wp), PUBLIC ::   rt0_ice  = 273.05_wp        !: melting point of ice          [Kelvin] 
    4848#endif 
    49 #if defined key_cice 
    50    REAL(wp), PUBLIC ::   rau0     = 1026._wp         !: volumic mass of reference     [kg/m3] 
    51 #else 
    52    REAL(wp), PUBLIC ::   rau0     = 1035._wp         !: volumic mass of reference     [kg/m3] 
    53 #endif 
     49   REAL(wp), PUBLIC ::   rau0                        !: volumic mass of reference     [kg/m3] 
    5450   REAL(wp), PUBLIC ::   r1_rau0                     !: = 1. / rau0                   [m3/kg] 
    55    REAL(wp), PUBLIC ::   rauw     = 1000._wp         !: volumic mass of pure water    [m3/kg] 
    56    REAL(wp), PUBLIC ::   rcp      =    4.e3_wp       !: ocean specific heat           [J/Kelvin] 
     51   REAL(wp), PUBLIC ::   rcp                         !: ocean specific heat           [J/Kelvin] 
    5752   REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                    [Kelvin/J] 
    5853   REAL(wp), PUBLIC ::   r1_rau0_rcp                 !: = 1. / ( rau0 * rcp ) 
    … …  
    163158      IF(lwp) WRITE(numout,*) '          melting point of ice             rt0_ice  = ', rt0_ice , ' K' 
    164159 
    165       r1_rau0     = 1._wp / rau0 
    166       r1_rcp      = 1._wp / rcp 
    167       r1_rau0_rcp = 1._wp / ( rau0 * rcp ) 
    168       IF(lwp) WRITE(numout,*) 
    169       IF(lwp) WRITE(numout,*) '          volumic mass of pure water          rauw  = ', rauw   , ' kg/m^3' 
    170       IF(lwp) WRITE(numout,*) '          volumic mass of reference           rau0  = ', rau0   , ' kg/m^3' 
    171       IF(lwp) WRITE(numout,*) '          1. / rau0                        r1_rau0  = ', r1_rau0, ' m^3/kg' 
    172       IF(lwp) WRITE(numout,*) '          ocean specific heat                 rcp   = ', rcp    , ' J/Kelvin' 
    173       IF(lwp) WRITE(numout,*) '          1. / ( rau0 * rcp )           r1_rau0_rcp = ', r1_rau0_rcp 
    174  
    175  
     160      IF(lwp) WRITE(numout,*) '          reference density and heat capacity now defined in eosbn2.f90' 
     161               
    176162#if defined key_lim3 || defined key_cice 
    177163      xlsn = lfus * rhosn        ! volumetric latent heat fusion of snow [J/m3] 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90

    r3294 r4619  
    1515   USE oce            ! ocean dynamics and tracers 
    1616   USE dom_oce        ! ocean space and time domain 
    17    USE trdmod_oce     ! ocean variables trends 
    18    USE trdmod         ! ocean dynamics trends 
     17   USE trd_oce        ! trends: ocean variables 
     18   USE trddyn         ! trend manager: dynamics 
     19   ! 
    1920   USE in_out_manager ! I/O manager 
    2021   USE lib_mpp        ! MPP library 
    2122   USE prtctl         ! Print control 
    22    USE wrk_nemo        ! Memory Allocation 
    23    USE timing          ! Timing 
     23   USE wrk_nemo       ! Memory Allocation 
     24   USE timing         ! Timing 
    2425 
    2526   IMPLICIT NONE 
    … …  
    103104         zfu_uw(:,:,:) = ua(:,:,:) - zfu_uw(:,:,:) 
    104105         zfv_vw(:,:,:) = va(:,:,:) - zfv_vw(:,:,:) 
    105          CALL trd_mod( zfu_uw, zfv_vw, jpdyn_trd_had, 'DYN', kt ) 
     106         CALL trd_dyn( zfu_uw, zfv_vw, jpdyn_keg, kt ) 
    106107         zfu_t(:,:,:) = ua(:,:,:) 
    107108         zfv_t(:,:,:) = va(:,:,:) 
    … …  
    153154         zfu_t(:,:,:) = ua(:,:,:) - zfu_t(:,:,:) 
    154155         zfv_t(:,:,:) = va(:,:,:) - zfv_t(:,:,:) 
    155          CALL trd_mod( zfu_t, zfv_t, jpdyn_trd_zad, 'DYN', kt ) 
     156         CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt ) 
    156157      ENDIF 
    157158      !                                            ! Control print 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90

    r4153 r4619  
    1616   USE oce            ! ocean dynamics and tracers 
    1717   USE dom_oce        ! ocean space and time domain 
    18    USE trdmod         ! ocean dynamics trends 
    19    USE trdmod_oce     ! ocean variables trends 
     18   USE trd_oce        ! trends: ocean variables 
     19   USE trddyn         ! trend manager: dynamics 
     20   ! 
    2021   USE in_out_manager ! I/O manager 
    2122   USE prtctl         ! Print control 
    2223   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    2324   USE lib_mpp        ! MPP library 
    24    USE wrk_nemo        ! Memory Allocation 
    25    USE timing          ! Timing 
     25   USE wrk_nemo       ! Memory Allocation 
     26   USE timing         ! Timing 
    2627 
    2728   IMPLICIT NONE 
    … …  
    196197         zfu_uw(:,:,:) = ua(:,:,:) - zfu_uw(:,:,:) 
    197198         zfv_vw(:,:,:) = va(:,:,:) - zfv_vw(:,:,:) 
    198          CALL trd_mod( zfu_uw, zfv_vw, jpdyn_trd_had, 'DYN', kt ) 
     199         CALL trd_dyn( zfu_uw, zfv_vw, jpdyn_keg, kt ) 
    199200         zfu_t(:,:,:) = ua(:,:,:) 
    200201         zfv_t(:,:,:) = va(:,:,:) 
    … …  
    245246         zfu_t(:,:,:) = ua(:,:,:) - zfu_t(:,:,:) 
    246247         zfv_t(:,:,:) = va(:,:,:) - zfv_t(:,:,:) 
    247          CALL trd_mod( zfu_t, zfv_t, jpdyn_trd_zad, 'DYN', kt ) 
     248         CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt ) 
    248249      ENDIF 
    249250      !                                            ! Control print 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90

    r3294 r4619  
    1010 
    1111   !!---------------------------------------------------------------------- 
    12    !!   dyn_bfr      : Update the momentum trend with the bottom friction contribution 
     12   !!   dyn_bfr       : Update the momentum trend with the bottom friction contribution 
    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 
    17    USE zdfbfr          ! ocean bottom friction variables 
    18    USE trdmod          ! ocean active dynamics and tracers trends  
    19    USE trdmod_oce      ! ocean variables trends 
    20    USE in_out_manager  ! I/O manager 
    21    USE prtctl          ! Print control 
    22    USE timing          ! Timing 
    23    USE wrk_nemo        ! Memory Allocation 
     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 
     17   USE zdfbfr         ! ocean bottom friction variables 
     18   USE trd_oce        ! trends: ocean variables 
     19   USE trddyn         ! trend manager: dynamics 
     20   USE in_out_manager ! I/O manager 
     21   USE prtctl         ! Print control 
     22   USE timing         ! Timing 
     23   USE wrk_nemo       ! Memory Allocation 
    2424 
    2525   IMPLICIT NONE 
    2626   PRIVATE 
    2727 
    28    PUBLIC   dyn_bfr    !  routine called by step.F90 
     28   PUBLIC   dyn_bfr   !  routine called by step.F90 
    2929 
    3030   !! * Substitutions 
    … …  
    5757      IF( nn_timing == 1 )  CALL timing_start('dyn_bfr') 
    5858      ! 
     59!!gm issue: better to put the logical in step to control the call of zdf_bfr 
     60!!          ==> change the logical from ln_bfrimp to ln_bfr_exp !! 
    5961      IF( .NOT.ln_bfrimp) THEN     ! only for explicit bottom friction form 
    6062                                    ! implicit bfr is implemented in dynzdf_imp 
    6163 
     64!!gm bug : time step is only rdt (not 2 rdt if euler start !) 
    6265        zm1_2dt = - 1._wp / ( 2._wp * rdt ) 
    6366 
    … …  
    6972 
    7073 
    71 # if defined key_vectopt_loop 
    72         DO jj = 1, 1 
    73            DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    74 # else 
    7574        DO jj = 2, jpjm1 
    7675           DO ji = 2, jpim1 
    77 # endif 
    7876              ikbu = mbku(ji,jj)          ! deepest ocean u- & v-levels 
    7977              ikbv = mbkv(ji,jj) 
    … …  
    8987           ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    9088           ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    91            CALL trd_mod( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_trd_bfr, 'DYN', kt ) 
     89           CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt ) 
    9290           CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
    9391        ENDIF 

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

    r4292 r4619  
    3131   USE dom_oce         ! ocean space and time domain 
    3232   USE phycst          ! physical constants 
    33    USE trdmod          ! ocean dynamics trends 
    34    USE trdmod_oce      ! ocean variables trends 
     33   USE trd_oce         ! trends: ocean variables 
     34   USE trddyn          ! trend manager: dynamics 
     35   ! 
    3536   USE in_out_manager  ! I/O manager 
    3637   USE prtctl          ! Print control 
    37    USE lbclnk          ! lateral boundary condition 
     38   USE lbclnk          ! lateral boundary condition  
    3839   USE lib_mpp         ! MPP library 
    3940   USE wrk_nemo        ! Memory Allocation 
    … …  
    7475      !! 
    7576      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    76       !!             - Save the trend (l_trddyn=T) 
     77      !!             - send trends to trd_dyn for futher diagnostics (l_trddyn=T) 
    7778      !!---------------------------------------------------------------------- 
    7879      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    … …  
    99100         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    100101         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    101          CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_hpg, 'DYN', kt ) 
     102         CALL trd_dyn( ztrdu, ztrdv, jpdyn_hpg, kt ) 
    102103         CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
    103104      ENDIF 
    … …  
    315316 
    316317      ! partial steps correction at the last level  (use gru & grv computed in zpshde.F90) 
    317 # if defined key_vectopt_loop 
    318          jj = 1 
    319          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    320 # else 
    321318      DO jj = 2, jpjm1 
    322319         DO ji = 2, jpim1 
    323 # endif 
    324320            iku = mbku(ji,jj) 
    325321            ikv = mbkv(ji,jj) 
    … …  
    338334               va  (ji,jj,ikv) = va(ji,jj,ikv) + zhpj(ji,jj,ikv)         ! add the new one to the general momentum trend 
    339335            ENDIF 
    340 # if ! defined key_vectopt_loop 
    341          END DO 
    342 # endif 
     336         END DO 
    343337      END DO 
    344338      ! 
    … …  
    434428   END SUBROUTINE hpg_sco 
    435429 
     430 
    436431   SUBROUTINE hpg_djc( kt ) 
    437432      !!--------------------------------------------------------------------- 
    … …  
    671666      !! 
    672667      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    673       !!             - Save the trend (l_trddyn=T) 
    674       !! 
    675668      !!---------------------------------------------------------------------- 
    676669      INTEGER, PARAMETER  :: polynomial_type = 1    ! 1: cubic spline, 2: linear 
    … …  
    724717 
    725718      ! Transfer the depth of "T(:,:,:)" to vertical coordinate "zdept(:,:,:)" 
    726       DO jj = 1, jpj;   DO ji = 1, jpi 
    727           zdept(ji,jj,1) = 0.5_wp * fse3w(ji,jj,1) - sshn(ji,jj) * znad 
    728       END DO        ;   END DO 
    729  
    730       DO jk = 2, jpk;   DO jj = 1, jpj;   DO ji = 1, jpi 
    731           zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + fse3w(ji,jj,jk) 
    732       END DO        ;   END DO        ;   END DO 
    733  
    734       fsp(:,:,:) = zrhh(:,:,:) 
     719      DO jj = 1, jpj 
     720         DO ji = 1, jpi 
     721            zdept(ji,jj,1) = 0.5_wp * fse3w(ji,jj,1) - sshn(ji,jj) * znad 
     722         END DO 
     723      END DO 
     724 
     725      DO jk = 2, jpk 
     726         DO jj = 1, jpj 
     727            DO ji = 1, jpi 
     728               zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + fse3w(ji,jj,jk) 
     729            END DO 
     730         END DO 
     731      END DO 
     732 
     733      fsp(:,:,:) = zrhh (:,:,:) 
    735734      xsp(:,:,:) = zdept(:,:,:) 
    736735 
    … …  
    933932   END SUBROUTINE hpg_prj 
    934933 
     934 
    935935   SUBROUTINE cspline(fsp, xsp, asp, bsp, csp, dsp, polynomial_type) 
    936936      !!---------------------------------------------------------------------- 
    … …  
    940940      !! 
    941941      !! ** Method  :   f(x) = asp + bsp*x + csp*x^2 + dsp*x^3 
     942      !! 
    942943      !! Reference: CJC Kruger, Constrained Cubic Spline Interpoltation 
    943       !! 
    944944      !!---------------------------------------------------------------------- 
    945945      IMPLICIT NONE 
    … …  
    949949      INTEGER, INTENT(in) :: polynomial_type                        ! 1: cubic spline 
    950950                                                                    ! 2: Linear 
    951  
    952       ! Local Variables 
     951      ! 
    953952      INTEGER  ::   ji, jj, jk                 ! dummy loop indices 
    954953      INTEGER  ::   jpi, jpj, jpkm1 
    … …  
    10401039      ENDIF 
    10411040 
    1042  
    10431041   END SUBROUTINE cspline 
    10441042 
    … …  
    10501048      !! ** Purpose :   1-d linear interpolation 
    10511049      !! 
    1052       !! ** Method  : 
    1053       !!                interpolation is straight forward 
     1050      !! ** Method  :   interpolation is straight forward 
    10541051      !!                extrapolation is also permitted (no value limit) 
    1055       !! 
    10561052      !!---------------------------------------------------------------------- 
    10571053      IMPLICIT NONE 
    … …  
    10701066   END FUNCTION interp1 
    10711067 
     1068 
    10721069   FUNCTION interp2(x, a, b, c, d)  RESULT(f) 
    10731070      !!---------------------------------------------------------------------- 
    … …  
    11331130   END FUNCTION integ_spline 
    11341131 
    1135  
    11361132   !!====================================================================== 
    11371133END MODULE dynhpg 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90

    r3294 r4619  
    1414   USE oce             ! ocean dynamics and tracers 
    1515   USE dom_oce         ! ocean space and time domain 
    16    USE trdmod          ! ocean dynamics trends  
    17    USE trdmod_oce      ! ocean variables trends 
     16   USE trd_oce         ! trends: ocean variables 
     17   USE trddyn          ! trend manager: dynamics 
     18   ! 
    1819   USE in_out_manager  ! I/O manager 
    1920   USE lib_mpp         ! MPP library 
    … …  
    5253      !! 
    5354      !! ** Action : - Update the (ua, va) with the hor. ke gradient trend 
    54       !!             - save this trends (l_trddyn=T) for post-processing 
     55      !!             - send this trends to trd_dyn (l_trddyn=T) for post-processing 
    5556      !!---------------------------------------------------------------------- 
    5657      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    57       !! 
     58      ! 
    5859      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    5960      REAL(wp) ::   zu, zv       ! temporary scalars 
    … …  
    131132         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    132133         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    133          CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_keg, 'DYN', kt ) 
     134         CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt ) 
    134135         CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
    135136      ENDIF 

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

    r4522 r4619  
    1515   USE phycst         ! physical constants 
    1616   USE ldfdyn_oce     ! ocean dynamics lateral physics 
     17   USE ldftra_oce     ! ocean tracers  lateral physics 
    1718   USE ldfslp         ! lateral mixing: slopes of mixing orientation 
    1819   USE dynldf_bilapg  ! lateral mixing            (dyn_ldf_bilapg routine) 
    … …  
    2021   USE dynldf_iso     ! lateral mixing            (dyn_ldf_iso    routine) 
    2122   USE dynldf_lap     ! lateral mixing            (dyn_ldf_lap    routine) 
    22    USE ldftra_oce, ONLY: ln_traldf_hor     ! ocean tracers lateral physics 
    23    USE trdmod         ! ocean dynamics and tracer trends 
    24    USE trdmod_oce     ! ocean variables trends 
     23   USE trd_oce        ! trends: ocean variables 
     24   USE trddyn         ! trend manager: dynamics   (trd_dyn        routine) 
     25   ! 
    2526   USE prtctl         ! Print control 
    2627   USE in_out_manager ! I/O manager 
    … …  
    3031   USE timing          ! Timing 
    3132 
    32  
    3333   IMPLICIT NONE 
    3434   PRIVATE 
    … …  
    5555      !! ** Purpose :   compute the lateral ocean dynamics physics. 
    5656      !!---------------------------------------------------------------------- 
    57       ! 
    5857      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    5958      ! 
    … …  
    107106         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    108107         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    109          CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_ldf, 'DYN', kt ) 
     108         CALL trd_dyn( ztrdu, ztrdv, jpdyn_ldf, kt ) 
    110109         CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) 
    111110      ENDIF 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90

    r3634 r4619  
    1919   USE dom_oce         ! ocean space and time domain 
    2020   USE ldfdyn_oce      ! ocean dynamics: lateral physics 
     21   ! 
    2122   USE in_out_manager  ! I/O manager 
    22    USE trdmod          ! ocean dynamics trends  
    23    USE trdmod_oce      ! ocean variables trends 
    2423   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2524   USE wrk_nemo        ! Memory Allocation 
    … …  
    7069      !!      Add this before trend to the general trend (ua,va): 
    7170      !!            (ua,va) = (ua,va) + (diffu,diffv) 
    72       !!      'key_trddyn' defined: the two components of the horizontal 
    73       !!                               diffusion trend are saved. 
    7471      !! 
    7572      !! ** Action : - Update (ua,va) with the before iso-level biharmonic 
    7673      !!               mixing trend. 
    7774      !!---------------------------------------------------------------------- 
    78       ! 
    7975      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    8076      ! 

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

    r4488 r4619  
    1919   USE dom_oce         ! ocean space and time domain 
    2020   USE ldfdyn_oce      ! ocean dynamics lateral physics 
     21   USE zdf_oce         ! ocean vertical physics 
     22   USE ldfslp          ! iso-neutral slopes available 
    2123   USE ldftra_oce, ONLY: ln_traldf_iso 
    22    USE zdf_oce         ! ocean vertical physics 
    23    USE trdmod          ! ocean dynamics trends  
    24    USE trdmod_oce      ! ocean variables trends 
    25    USE ldfslp          ! iso-neutral slopes available 
     24   ! 
    2625   USE in_out_manager  ! I/O manager 
    2726   USE lib_mpp         ! MPP library 
    … …  
    8180      !!         -3- Add this trend to the general trend (ta,sa): 
    8281      !!            (ua,va) = (ua,va) + (zwk3,zwk4) 
    83       !!      'key_trddyn' defined: the trend is saved for diagnostics. 
    8482      !! 
    8583      !! ** Action  : - Update (ua,va) arrays with the before geopotential 
    8684      !!                biharmonic mixing trend. 
    87       !!              - save the trend in (zwk3,zwk4) ('key_trddyn') 
    8885      !!---------------------------------------------------------------------- 
    8986      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index 
    … …  
    201198      !!                          pu and pv (all the components except 
    202199      !!                          second order vertical derivative term) 
    203       !!      'key_trddyn' defined: the trend is saved for diagnostics. 
    204       !!---------------------------------------------------------------------- 
    205       !! 
     200      !!---------------------------------------------------------------------- 
    206201      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu , pv    ! 1st call: before horizontal velocity  
    207202      !                                                               ! 2nd call: ahm x these fields 

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

    r4488 r4619  
    2222   USE ldftra_oce      ! ocean tracer   lateral physics 
    2323   USE zdf_oce         ! ocean vertical physics 
    24    USE trdmod          ! ocean dynamics trends  
    25    USE trdmod_oce      ! ocean variables trends 
    2624   USE ldfslp          ! iso-neutral slopes  
     25   ! 
    2726   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2827   USE in_out_manager  ! I/O manager 

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

    r3294 r4619  
    1919   USE ldfdyn_oce      ! ocean dynamics: lateral physics 
    2020   USE zdf_oce         ! ocean vertical physics 
     21   ! 
    2122   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  
    2523   USE timing          ! Timing 
    2624 
    … …  
    5755      !!      Add this before trend to the general trend (ua,va): 
    5856      !!            (ua,va) = (ua,va) + (diffu,diffv) 
    59       !!      'key_trddyn' activated: the two components of the horizontal 
    60       !!                                 diffusion trend are saved. 
    6157      !! 
    62       !! ** Action : - Update (ua,va) with the before iso-level harmonic  
    63       !!               mixing trend. 
     58      !! ** Action : - Update (ua,va) with the iso-level harmonic mixing trend 
    6459      !!---------------------------------------------------------------------- 
    6560      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r4370 r4619  
    1818   !!            3.3  !  2011-03  (P. Oddo) Bug fix for time-splitting+(BDY-OBC) and not VVL 
    1919   !!            3.5  !  2013-07  (J. Chanut) Compliant with time splitting changes 
     20   !!            3.7  !  2014-04  (G. Madec) add the diagnostic of the time filter trends 
    2021   !!------------------------------------------------------------------------- 
    2122   
    … …  
    3435   USE bdydyn          ! ocean open boundary conditions 
    3536   USE bdyvol          ! ocean open boundary condition (bdy_vol routines) 
     37   USE trd_oce         ! trends: ocean variables 
     38   USE trddyn          ! trend manager: dynamics 
     39   USE trdken          ! trend manager: kinetic energy 
     40   ! 
    3641   USE in_out_manager  ! I/O manager 
     42   USE iom             ! I/O manager library 
    3743   USE lbclnk          ! lateral boundary condition (or mpp link) 
    3844   USE lib_mpp         ! MPP library 
    3945   USE wrk_nemo        ! Memory Allocation 
    4046   USE prtctl          ! Print control 
    41  
     47   USE timing          ! Timing 
    4248#if defined key_agrif 
    4349   USE agrif_opa_interp 
    4450#endif 
    45    USE timing          ! Timing 
    4651 
    4752   IMPLICIT NONE 
    … …  
    7984      !!             at the local domain boundaries through lbc_lnk call, 
    8085      !!             at the one-way open boundaries (lk_bdy=T), 
    81       !!             at the AGRIF zoom     boundaries (lk_agrif=T) 
     86      !!             at the AGRIF zoom   boundaries (lk_agrif=T) 
    8287      !! 
    8388      !!              * Apply the time filter applied and swap of the dynamics 
    … …  
    99104      REAL(wp) ::   z2dt         ! temporary scalar 
    100105#endif 
    101       REAL(wp) ::   zue3a, zue3n, zue3b, zuf, zec   ! local scalars 
    102       REAL(wp) ::   zve3a, zve3n, zve3b, zvf        !   -      - 
    103       REAL(wp), POINTER, DIMENSION(:,:)   ::  zua, zva 
    104       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ze3u_f, ze3v_f  
     106      REAL(wp) ::   zue3a, zue3n, zue3b, zuf, zec      ! local scalars 
     107      REAL(wp) ::   zve3a, zve3n, zve3b, zvf, z1_2dt   !   -      - 
     108      REAL(wp), POINTER, DIMENSION(:,:)   ::  zue, zve 
     109      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ze3u_f, ze3v_f, zua, zva  
    105110      !!---------------------------------------------------------------------- 
    106111      ! 
    107       IF( nn_timing == 1 )  CALL timing_start('dyn_nxt') 
    108       ! 
    109       CALL wrk_alloc( jpi,jpj,jpk, ze3u_f, ze3v_f ) 
    110       IF ( lk_dynspg_ts ) CALL wrk_alloc( jpi,jpj, zua, zva ) 
     112      IF( nn_timing == 1 )   CALL timing_start('dyn_nxt') 
     113      ! 
     114      CALL wrk_alloc( jpi,jpj,jpk,  ze3u_f, ze3v_f, zua, zva ) 
     115      IF( lk_dynspg_ts )   CALL wrk_alloc( jpi,jpj, zue, zve ) 
    111116      ! 
    112117      IF( kt == nit000 ) THEN 
    … …  
    152157 
    153158# if defined key_dynspg_ts 
     159!!gm IF ( lk_dynspg_ts ) THEN .... 
    154160      ! Ensure below that barotropic velocities match time splitting estimate 
    155161      ! Compute actual transport and replace it with ts estimate at "after" time step 
    156       zua(:,:) = 0._wp 
    157       zva(:,:) = 0._wp 
    158       DO jk = 1, jpkm1 
    159          zua(:,:) = zua(:,:) + fse3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 
    160          zva(:,:) = zva(:,:) + fse3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 
     162      zue(:,:) = fse3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1) 
     163      zve(:,:) = fse3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1) 
     164      DO jk = 2, jpkm1 
     165         zue(:,:) = zue(:,:) + fse3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 
     166         zve(:,:) = zve(:,:) + fse3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 
    161167      END DO 
    162168      DO jk = 1, jpkm1 
    163          ua(:,:,jk) = ( ua(:,:,jk) - zua(:,:) * hur_a(:,:) + ua_b(:,:) ) * umask(:,:,jk) 
    164          va(:,:,jk) = ( va(:,:,jk) - zva(:,:) * hvr_a(:,:) + va_b(:,:) ) * vmask(:,:,jk) 
     169         ua(:,:,jk) = ( ua(:,:,jk) - zue(:,:) * hur_a(:,:) + ua_b(:,:) ) * umask(:,:,jk) 
     170         va(:,:,jk) = ( va(:,:,jk) - zve(:,:) * hvr_a(:,:) + va_b(:,:) ) * vmask(:,:,jk) 
    165171      END DO 
    166172 
    … …  
    175181         END DO   
    176182      ENDIF 
     183!!gm ENDIF 
    177184# endif 
    178185 
    … …  
    195202# endif 
    196203#endif 
     204 
     205      IF( l_trddyn ) THEN             ! prepare the atf trend computation + some diagnostics 
     206         z1_2dt = 1._wp / (2. * rdt)        ! Euler or leap-frog time step  
     207         IF( neuler == 0 .AND. kt == nit000 )   z1_2dt = 1._wp / rdt 
     208         ! 
     209         !                                  ! Kinetic energy and Conversion 
     210         IF( ln_KE_trd  )   CALL trd_dyn( ua, va, jpdyn_ken, kt ) 
     211         ! 
     212         IF( ln_dyn_trd ) THEN              ! 3D output: total momentum trends 
     213            zua(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * z1_2dt 
     214            zva(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * z1_2dt 
     215            CALL iom_put( "utrd_tot", zua )        ! total momentum trends, except the asselin time filter 
     216            CALL iom_put( "vtrd_tot", zva ) 
     217         ENDIF 
     218         ! 
     219         zua(:,:,:) = un(:,:,:)             ! save the now velocity before the asselin filter 
     220         zva(:,:,:) = vn(:,:,:)             ! (caution: there will be a shift by 1 timestep in the 
     221         !                                  !  computation of the asselin filter trends) 
     222      ENDIF 
    197223 
    198224      ! Time filter and swap of dynamics arrays 
    … …  
    217243               DO jj = 1, jpj 
    218244                  DO ji = 1, jpi     
    219                      zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2.e0_wp * un(ji,jj,jk) + ua(ji,jj,jk) ) 
    220                      zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2.e0_wp * vn(ji,jj,jk) + va(ji,jj,jk) ) 
     245                     zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2._wp * un(ji,jj,jk) + ua(ji,jj,jk) ) 
     246                     zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2._wp * vn(ji,jj,jk) + va(ji,jj,jk) ) 
    221247                     ! 
    222248                     ub(ji,jj,jk) = zuf                      ! ub <-- filtered velocity 
    … …  
    301327            ! Revert "before" velocities to time split estimate 
    302328            ! Doing it here also means that asselin filter contribution is removed   
    303             zua(:,:) = 0._wp 
    304             zva(:,:) = 0._wp 
    305             DO jk = 1, jpkm1 
    306                zua(:,:) = zua(:,:) + fse3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 
    307                zva(:,:) = zva(:,:) + fse3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)     
     329            zue(:,:) = fse3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1) 
     330            zve(:,:) = fse3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1)     
     331            DO jk = 2, jpkm1 
     332               zue(:,:) = zue(:,:) + fse3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 
     333               zve(:,:) = zve(:,:) + fse3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)     
    308334            END DO 
    309335            DO jk = 1, jpkm1 
    310                ub(:,:,jk) = ub(:,:,jk) - (zua(:,:) * hur(:,:) - un_b(:,:)) * umask(:,:,jk) 
    311                vb(:,:,jk) = vb(:,:,jk) - (zva(:,:) * hvr(:,:) - vn_b(:,:)) * vmask(:,:,jk) 
     336               ub(:,:,jk) = ub(:,:,jk) - (zue(:,:) * hur(:,:) - un_b(:,:)) * umask(:,:,jk) 
     337               vb(:,:,jk) = vb(:,:,jk) - (zve(:,:) * hvr(:,:) - vn_b(:,:)) * vmask(:,:,jk) 
    312338            END DO 
    313339         ENDIF 
    … …  
    335361      ! 
    336362      DO jk = 1, jpkm1 
    337 #if defined key_vectopt_loop 
    338          DO jj = 1, 1         !Vector opt. => forced unrolling 
    339             DO ji = 1, jpij 
    340 #else  
    341363         DO jj = 1, jpj 
    342364            DO ji = 1, jpi 
    343 #endif                   
    344365               un_b(ji,jj) = un_b(ji,jj) + fse3u_a(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 
    345366               vn_b(ji,jj) = vn_b(ji,jj) + fse3v_a(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 
    … …  
    358379      ! 
    359380      ! 
     381 
     382      IF( l_trddyn ) THEN                ! 3D output: asselin filter trends on momentum 
     383         zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt 
     384         zva(:,:,:) = ( vb(:,:,:) - zva(:,:,:) ) * z1_2dt 
     385         CALL trd_dyn( zua, zva, jpdyn_atf, kt ) 
     386      ENDIF 
     387      ! 
    360388      IF(ln_ctl)   CALL prt_ctl( tab3d_1=un, clinfo1=' nxt  - Un: ', mask1=umask,   & 
    361389         &                       tab3d_2=vn, clinfo2=' Vn: '       , mask2=vmask ) 
    362390      !  
    363       CALL wrk_dealloc( jpi,jpj,jpk, ze3u_f, ze3v_f ) 
    364       IF ( lk_dynspg_ts ) CALL wrk_dealloc( jpi,jpj, zua, zva ) 
     391      CALL wrk_dealloc( jpi,jpj,jpk,  ze3u_f, ze3v_f, zua, zva ) 
     392      IF( lk_dynspg_ts )   CALL wrk_dealloc( jpi,jpj, zue, zve ) 
    365393      ! 
    366394      IF( nn_timing == 1 )  CALL timing_stop('dyn_nxt') 
    … …  
    370398   !!========================================================================= 
    371399END MODULE dynnxt 
    372  

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r4496 r4619  
    2626   USE sbctide 
    2727   USE updtide 
    28    USE trdmod         ! ocean dynamics trends 
    29    USE trdmod_oce     ! ocean variables trends 
     28   USE trd_oce        ! trends: ocean variables 
     29   USE trddyn         ! trend manager: dynamics 
     30   ! 
    3031   USE prtctl         ! Print control                     (prt_ctl routine) 
    3132   USE in_out_manager ! I/O manager 
    3233   USE lib_mpp        ! MPP library 
    33    USE solver          ! solver initialization 
    34    USE wrk_nemo        ! Memory Allocation 
    35    USE timing          ! Timing 
     34   USE solver         ! solver initialization 
     35   USE wrk_nemo       ! Memory Allocation 
     36   USE timing         ! Timing 
    3637 
    3738 
    … …  
    163164               END DO 
    164165            END DO 
    165          END DO          
     166         END DO     
     167          
     168!!gm add here a call to dyn_trd for ice pressure gradient, the surf pressure trends ???? 
     169               
    166170      ENDIF 
    167171 
    … …  
    191195         CASE( 2 ) 
    192196            z2dt = 2. * rdt 
    193             IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt 
     197            IF( neuler == 0 .AND. kt == nit000 )   z2dt = rdt 
    194198            ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) / z2dt - ztrdu(:,:,:) 
    195199            ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / z2dt - ztrdv(:,:,:) 
    196200         END SELECT 
    197          CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_spg, 'DYN', kt ) 
     201         CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt ) 
    198202         ! 
    199203         CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )  

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90

    r4328 r4619  
    1919   USE sbc_oce         ! surface boundary condition: ocean 
    2020   USE phycst          ! physical constants 
     21   ! 
    2122   USE in_out_manager  ! I/O manager 
    2223   USE lib_mpp         ! distributed memory computing library 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r4328 r4619  
    1313   !!             -   !  2006-08  (J.Chanut, A.Sellar) Calls to BDY routines.  
    1414   !!            3.2  !  2009-03  (G. Madec, M. Leclair, R. Benshila) introduce sshwzv module 
     15   !!            3.7  !  2014-04  (F. Roquet, G. Madec)  add some trends diag 
    1516   !!---------------------------------------------------------------------- 
    1617#if defined key_dynspg_flt   ||   defined key_esopa   
    … …  
    3637   USE bdyvol          ! ocean open boundary condition (bdy_vol routine) 
    3738   USE cla             ! cross land advection 
     39   USE trd_oce         ! trends: ocean variables 
     40   USE trddyn          ! trend manager: dynamics 
     41   ! 
    3842   USE in_out_manager  ! I/O manager 
    3943   USE lib_mpp         ! distributed memory computing library 
    … …  
    4347   USE iom 
    4448   USE lib_fortran 
     49   USE timing          ! Timing 
    4550#if defined key_agrif 
    4651   USE agrif_opa_interp 
    4752#endif 
    48    USE timing          ! Timing 
    4953 
    5054   IMPLICIT NONE 
    … …  
    99103      !! ** Action : - Update (ua,va) with the surf. pressure gradient trend 
    100104      !! 
    101       !! References : Roullet and Madec 1999, JGR. 
     105      !! References : Roullet and Madec, JGR, 2000. 
    102106      !!--------------------------------------------------------------------- 
    103107      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
    104108      INTEGER, INTENT(  out) ::   kindic   ! solver convergence flag (<0 if not converge) 
    105       !!                                    
     109      ! 
    106110      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    107111      REAL(wp) ::   z2dt, z2dtg, zgcb, zbtd, ztdgu, ztdgv   ! local scalars 
     112      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
     113      REAL(wp), POINTER, DIMENSION(:,:)   ::  zpw 
    108114      !!---------------------------------------------------------------------- 
    109115      ! 
    110116      IF( nn_timing == 1 )  CALL timing_start('dyn_spg_flt') 
    111       ! 
    112117      ! 
    113118      IF( kt == nit000 ) THEN 
    … …  
    179184         END DO 
    180185         ! 
     186         IF( l_trddyn )   THEN                      ! temporary save of spg trends 
     187            CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 
     188            DO jk = 1, jpkm1              ! unweighted time stepping  
     189               DO jj = 2, jpjm1 
     190                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     191                     ztrdu(ji,jj,jk) = spgu(ji,jj) * umask(ji,jj,jk) 
     192                     ztrdv(ji,jj,jk) = spgv(ji,jj) * vmask(ji,jj,jk) 
     193                  END DO 
     194               END DO 
     195            END DO 
     196            CALL trd_dyn( ztrdu, ztrdv, jpdyn_spgexp, kt ) 
     197         ENDIF 
     198         ! 
    181199      ENDIF 
    182200 
    … …  
    194212      DO jj = 2, jpjm1 
    195213         DO ji = fs_2, fs_jpim1   ! vector opt. 
    196             spgu(ji,jj) = 0._wp 
    197             spgv(ji,jj) = 0._wp 
    198          END DO 
    199       END DO 
    200  
    201       ! vertical sum 
    202 !CDIR NOLOOPCHG 
    203       IF( lk_vopt_loop ) THEN          ! vector opt., forced unroll 
    204          DO jk = 1, jpkm1 
    205             DO ji = 1, jpij 
    206                spgu(ji,1) = spgu(ji,1) + fse3u_a(ji,1,jk) * ua(ji,1,jk) 
    207                spgv(ji,1) = spgv(ji,1) + fse3v_a(ji,1,jk) * va(ji,1,jk) 
    208             END DO 
    209          END DO 
    210       ELSE                        ! No  vector opt. 
    211          DO jk = 1, jpkm1 
    212             DO jj = 2, jpjm1 
    213                DO ji = 2, jpim1 
    214                   spgu(ji,jj) = spgu(ji,jj) + fse3u_a(ji,jj,jk) * ua(ji,jj,jk) 
    215                   spgv(ji,jj) = spgv(ji,jj) + fse3v_a(ji,jj,jk) * va(ji,jj,jk) 
    216                END DO 
    217             END DO 
    218          END DO 
    219       ENDIF 
    220  
    221       ! transport: multiplied by the horizontal scale factor 
    222       DO jj = 2, jpjm1 
     214            spgu(ji,jj) = fse3u_a(ji,jj,1) * ua(ji,jj,1) 
     215            spgv(ji,jj) = fse3v_a(ji,jj,1) * va(ji,jj,1) 
     216         END DO 
     217      END DO 
     218      DO jk = 2, jpkm1                     ! vertical sum 
     219         DO jj = 2, jpjm1 
     220            DO ji = fs_2, fs_jpim1   ! vector opt. 
     221               spgu(ji,jj) = spgu(ji,jj) + fse3u_a(ji,jj,jk) * ua(ji,jj,jk) 
     222               spgv(ji,jj) = spgv(ji,jj) + fse3v_a(ji,jj,jk) * va(ji,jj,jk) 
     223            END DO 
     224         END DO 
     225      END DO 
     226 
     227      DO jj = 2, jpjm1                     ! transport: multiplied by the horizontal scale factor 
    223228         DO ji = fs_2, fs_jpim1   ! vector opt. 
    224229            spgu(ji,jj) = spgu(ji,jj) * e2u(ji,jj) 
    … …  
    322327      ENDIF 
    323328#endif       
     329 
     330      IF( l_trddyn )   THEN                      
     331         ztrdu(:,:,:) = ua(:,:,:)                 ! save the after velocity before the filtered SPG 
     332         ztrdv(:,:,:) = va(:,:,:) 
     333         ! 
     334         CALL wrk_alloc( jpi, jpj, zpw ) 
     335         ! 
     336         zpw(:,:) = - z2dt * gcx(:,:) 
     337         CALL iom_put( "ssh_flt" , zpw )          ! output equivalent ssh modification due to implicit filter 
     338         ! 
     339         !                                        ! save surface pressure flux: -pw at z=0 
     340         zpw(:,:) = - rau0 * grav * sshn(:,:) * wn(:,:,1) * tmask(:,:,1) 
     341         CALL iom_put( "pw0_exp" , zpw ) 
     342         zpw(:,:) = wn(:,:,1) 
     343         CALL iom_put( "w0" , zpw ) 
     344         zpw(:,:) =  rau0 * z2dtg * gcx(:,:) * wn(:,:,1) * tmask(:,:,1) 
     345         CALL iom_put( "pw0_flt" , zpw ) 
     346         ! 
     347         CALL wrk_dealloc( jpi, jpj, zpw )  
     348         !                                    
     349      ENDIF 
     350       
    324351      ! Add the trends multiplied by z2dt to the after velocity 
    325352      ! ------------------------------------------------------- 
    … …  
    336363      END DO 
    337364 
    338       ! write filtered free surface arrays in restart file 
    339       ! -------------------------------------------------- 
    340       IF( lrst_oce ) CALL flt_rst( kt, 'WRITE' ) 
    341       ! 
    342       ! 
    343       IF( nn_timing == 1 )  CALL timing_stop('dyn_spg_flt') 
     365      IF( l_trddyn )   THEN                      ! save the explicit SPG trends for further diagnostics 
     366         ztrdu(:,:,:) = ( ua(:,:,:) - ztrdu(:,:,:) ) / z2dt 
     367         ztrdv(:,:,:) = ( va(:,:,:) - ztrdv(:,:,:) ) / z2dt 
     368         CALL trd_dyn( ztrdu, ztrdv, jpdyn_spgflt, kt ) 
     369         ! 
     370         CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )  
     371      ENDIF 
     372 
     373      IF( lrst_oce )   CALL flt_rst( kt, 'WRITE' )      ! write filtered free surface arrays in restart file 
     374      ! 
     375      IF( nn_timing == 1 )   CALL timing_stop('dyn_spg_flt') 
    344376      ! 
    345377   END SUBROUTINE dyn_spg_flt 
    … …  
    352384      !! ** Purpose : Read or write filtered free surface arrays in restart file 
    353385      !!---------------------------------------------------------------------- 
    354       INTEGER         , INTENT(in) ::   kt         ! ocean time-step 
    355       CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
     386      INTEGER         , INTENT(in) ::   kt     ! ocean time-step 
     387      CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag 
    356388      !!---------------------------------------------------------------------- 
    357389      ! 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r4496 r4619  
    105105   END FUNCTION dyn_spg_ts_alloc 
    106106 
     107 
    107108   SUBROUTINE dyn_spg_ts( kt ) 
    108109      !!---------------------------------------------------------------------- 
     110      !!                  ***  routine dyn_spg_ts  *** 
    109111      !! 
    110       !! ** Purpose :    
    111       !!      -Compute the now trend due to the explicit time stepping 
    112       !!      of the quasi-linear barotropic system.  
     112      !! ** Purpose :   Compute the now trend due to the explicit time stepping 
     113      !!              of the quasi-linear barotropic system.  
    113114      !! 
    114115      !! ** Method  :   
    … …  
    128129      !!      -Update 3d trend (ua, va) with barotropic component. 
    129130      !! 
    130       !! References : Shchepetkin, A.F. and J.C. McWilliams, 2005:  
    131       !!              The regional oceanic modeling system (ROMS):  
    132       !!              a split-explicit, free-surface, 
    133       !!              topography-following-coordinate oceanic model.  
    134       !!              Ocean Modelling, 9, 347-404.  
     131      !! References : Shchepetkin and McWilliams, Ocean Modelling, 2005 
    135132      !!--------------------------------------------------------------------- 
    136       ! 
    137133      INTEGER, INTENT(in)  ::   kt   ! ocean time-step index 
    138134      ! 
    … …  
    290286      ! 
    291287      DO jk = 1, jpkm1 
    292 #if defined key_vectopt_loop 
    293          DO jj = 1, 1         !Vector opt. => forced unrolling 
    294             DO ji = 1, jpij 
    295 #else  
    296288         DO jj = 1, jpj 
    297289            DO ji = 1, jpi 
    298 #endif                                                                    
    299290               zu_frc(ji,jj) = zu_frc(ji,jj) + fse3u_n(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 
    300291               zv_frc(ji,jj) = zv_frc(ji,jj) + fse3v_n(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk)          
    … …  
    908899   END SUBROUTINE dyn_spg_ts 
    909900 
     901 
    910902   SUBROUTINE ts_wgt( ll_av, ll_fw, jpit, zwgt1, zwgt2) 
    911903      !!--------------------------------------------------------------------- 
    … …  
    10371029      ! 
    10381030   END SUBROUTINE ts_rst 
     1031 
    10391032 
    10401033   SUBROUTINE dyn_spg_ts_init( kt ) 
    … …  
    11721165   !!====================================================================== 
    11731166END MODULE dynspg_ts 
    1174  
    1175  
    1176  

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

    r4601 r4619  
    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-04  (G. Madec) trend simplification: suppress jpdyn_trd_dat vorticity  
    1718   !!---------------------------------------------------------------------- 
    1819 
    … …  
    2930   USE dommsk         ! ocean mask 
    3031   USE dynadv         ! momentum advection (use ln_dynadv_vec value) 
    31    USE trdmod         ! ocean dynamics trends  
    32    USE trdmod_oce     ! ocean variables trends 
     32   USE trd_oce        ! trends: ocean variables 
     33   USE trddyn         ! trend manager: dynamics 
    3334   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    3435   USE prtctl         ! Print control 
    … …  
    7374      !! ** Action : - Update (ua,va) with the now vorticity term trend 
    7475      !!             - save the trends in (ztrdu,ztrdv) in 2 parts (relative 
    75       !!               and planetary vorticity trends) ('key_trddyn') 
     76      !!               and planetary vorticity trends) and send them to trd_dyn  
     77      !!               for futher diagnostics (l_trddyn=T) 
    7678      !!---------------------------------------------------------------------- 
    7779      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    … …  
    108110            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    109111            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    110             CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_rvo, 'DYN', kt ) 
     112            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 
    111113            ztrdu(:,:,:) = ua(:,:,:) 
    112114            ztrdv(:,:,:) = va(:,:,:) 
    … …  
    114116            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    115117            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    116             CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_pvo, 'DYN', kt ) 
    117             CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_dat, 'DYN', kt ) 
     118            CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
    118119         ELSE 
    119120            CALL vor_ene( kt, ntot, ua, va )                ! total vorticity 
    … …  
    127128            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    128129            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    129             CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_rvo, 'DYN', kt ) 
     130            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 
    130131            ztrdu(:,:,:) = ua(:,:,:) 
    131132            ztrdv(:,:,:) = va(:,:,:) 
    … …  
    133134            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    134135            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    135             CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_pvo, 'DYN', kt ) 
    136             CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_dat, 'DYN', kt ) 
     136            CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
    137137         ELSE 
    138138            CALL vor_ens( kt, ntot, ua, va )                ! total vorticity 
    … …  
    146146            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    147147            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    148             CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_rvo, 'DYN', kt ) 
     148            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 
    149149            ztrdu(:,:,:) = ua(:,:,:) 
    150150            ztrdv(:,:,:) = va(:,:,:) 
    … …  
    152152            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    153153            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    154             CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_pvo, 'DYN', kt ) 
    155             CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_dat, 'DYN', kt ) 
     154            CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
    156155         ELSE 
    157156            CALL vor_mix( kt )                               ! total vorticity (mix=ens-ene) 
    … …  
    165164            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    166165            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    167             CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_rvo, 'DYN', kt ) 
     166            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 
    168167            ztrdu(:,:,:) = ua(:,:,:) 
    169168            ztrdv(:,:,:) = va(:,:,:) 
    … …  
    171170            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    172171            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    173             CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_pvo, 'DYN', kt ) 
    174             CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_dat, 'DYN', kt ) 
     172            CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
    175173         ELSE 
    176174            CALL vor_een( kt, ntot, ua, va )                ! total vorticity 
    … …  
    211209      !! 
    212210      !! ** 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') 
    215211      !! 
    216212      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
    … …  
    328324      !! 
    329325      !! ** 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') 
    332326      !! 
    333327      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
    … …  
    444438      !! 
    445439      !! ** 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') 
    448440      !! 
    449441      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
    … …  
    557549      !! 
    558550      !! ** 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') 
    561551      !! 
    562552      !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36 
    … …  
    601591            IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'dyn:vor_een : unable to allocate arrays' ) 
    602592         ENDIF 
    603          ze3f(:,:,:) = 0.d0 
     593         ze3f(:,:,:) = 0._wp 
    604594#endif 
    605595      ENDIF 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90

    r3294 r4619  
    1616   USE dom_oce        ! ocean space and time domain 
    1717   USE sbc_oce        ! surface boundary condition: ocean 
    18    USE trdmod_oce     ! ocean variables trends 
    19    USE trdmod         ! ocean dynamics trends  
     18   USE trd_oce        ! trends: ocean variables 
     19   USE trddyn         ! trend manager: dynamics 
     20   ! 
    2021   USE in_out_manager ! I/O manager 
    21    USE lib_mpp         ! MPP library 
     22   USE lib_mpp        ! MPP library 
    2223   USE prtctl         ! Print control 
    23    USE wrk_nemo        ! Memory Allocation 
    24    USE timing          ! Timing 
     24   USE wrk_nemo       ! Memory Allocation 
     25   USE timing         ! Timing 
    2526 
    2627   IMPLICIT NONE 
    … …  
    5354      !! 
    5455      !! ** Action  : - Update (ua,va) with the vert. momentum adv. trends 
    55       !!              - Save the trends in (ztrdu,ztrdv) ('key_trddyn') 
     56      !!              - Send the trends to trddyn for diagnostics (l_trddyn=T) 
    5657      !!---------------------------------------------------------------------- 
    5758      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx 
    … …  
    118119         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    119120         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    120          CALL trd_mod(ztrdu, ztrdv, jpdyn_trd_zad, 'DYN', kt) 
     121         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt ) 
    121122         CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )  
    122123      ENDIF 

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

    r3294 r4619  
    2020 
    2121   USE ldfdyn_oce      ! ocean dynamics: lateral physics 
    22    USE trdmod          ! ocean active dynamics and tracers trends  
    23    USE trdmod_oce      ! ocean variables trends 
     22   USE trd_oce         ! trends: ocean variables 
     23   USE trddyn          ! trend manager: dynamics 
    2424   USE in_out_manager  ! I/O manager 
    2525   USE lib_mpp         ! MPP library 
    … …  
    9191         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    9292         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    93          CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_zdf, 'DYN', kt ) 
    94          ! 
     93         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zdf, kt ) 
    9594         CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )  
    9695      ENDIF 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

    r4370 r4619  
    7070      REAL(wp) ::   z1_p2dt, zcoef, zzwi, zzws, zrhs   ! local scalars 
    7171      REAL(wp) ::   ze3ua, ze3va 
    72       !!---------------------------------------------------------------------- 
    73  
    7472      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwi, zwd, zws 
    7573      !!---------------------------------------------------------------------- 
    … …  
    10199 
    102100      IF( ln_bfrimp ) THEN 
    103 # if defined key_vectopt_loop 
    104          DO jj = 1, 1 
    105             DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    106 # else 
    107101         DO jj = 2, jpjm1 
    108102            DO ji = 2, jpim1 
    109 # endif 
    110103               ikbu = mbku(ji,jj)       ! ocean bottom level at u- and v-points  
    111104               ikbv = mbkv(ji,jj)       ! (deepest ocean u- and v-points) 
    … …  
    138131            ua(:,:,jk) = (ua(:,:,jk) - ua_b(:,:)) * umask(:,:,jk) 
    139132            va(:,:,jk) = (va(:,:,jk) - va_b(:,:)) * vmask(:,:,jk) 
    140          ENDDO 
     133         END DO 
    141134         ! Add bottom stress due to barotropic component only: 
    142135         DO jj = 2, jpjm1         
    … …  
    352345      !! restore bottom layer avmu(v)  
    353346      IF( ln_bfrimp ) THEN 
    354 # if defined key_vectopt_loop 
    355       DO jj = 1, 1 
    356          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    357 # else 
    358       DO jj = 2, jpjm1 
    359          DO ji = 2, jpim1 
    360 # endif 
    361             ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points  
    362             ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points) 
    363             avmu(ji,jj,ikbu+1) = 0.e0 
    364             avmv(ji,jj,ikbv+1) = 0.e0 
    365          END DO 
    366       END DO 
     347         DO jj = 2, jpjm1 
     348            DO ji = 2, jpim1 
     349               ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points  
     350               ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points) 
     351               avmu(ji,jj,ikbu+1) = 0.e0 
     352               avmv(ji,jj,ikbv+1) = 0.e0 
     353            END DO 
     354         END DO 
    367355      ENDIF 
    368356      ! 

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

    r4334 r4619  
    2222   USE iom             ! I/O module 
    2323   USE eosbn2          ! equation of state            (eos bn2 routine) 
    24    USE trdmld_oce      ! ocean active mixed layer tracers trends variables 
     24   USE trdmxl_oce      ! ocean active mixed layer tracers trends variables 
    2525   USE divcur          ! hor. divergence and curl      (div & cur routines) 
    2626   USE sbc_ice, ONLY : lk_lim3 
    … …  
    138138      IF( kt == nitrst ) THEN 
    139139         CALL iom_close( numrow )     ! close the restart file (only at last time step) 
    140          IF( .NOT. lk_trdmld )   lrst_oce = .FALSE. 
     140!!gm         IF( .NOT. lk_trdmld )   lrst_oce = .FALSE. 
     141!!gm  not sure what to do here   ===>>>  ask to Sebastian 
     142         lrst_oce = .FALSE. 
    141143      ENDIF 
    142144      ! 
    143145   END SUBROUTINE rst_write 
     146 
    144147 
    145148   SUBROUTINE rst_read_open 
    … …  
    155158      LOGICAL  ::   llok 
    156159      !!---------------------------------------------------------------------- 
    157  
    158       IF( numror .LE. 0 ) THEN 
     160      ! 
     161      IF( numror <= 0 ) THEN 
    159162         IF(lwp) THEN                                             ! Contol prints 
    160163            WRITE(numout,*) 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90

    r3294 r4619  
    8484      IF( ln_traldf_grif ) THEN 
    8585         DO jk = 1, jpk 
    86 #  if defined key_vectopt_loop   
    87 !CDIR NOVERRCHK  
    88             DO ji = 1, jpij   ! vector opt. 
    89                ! Take the max of N^2 and zero then take the vertical sum 
    90                ! of the square root of the resulting N^2 ( required to compute 
    91                ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 
    92                zn2 = MAX( rn2b(ji,1,jk), 0._wp ) 
    93                zn(ji,1) = zn(ji,1) + SQRT( zn2 ) * fse3w(ji,1,jk) 
    94                ! Compute elements required for the inverse time scale of baroclinic 
    95                ! eddies using the isopycnal slopes calculated in ldfslp.F : 
    96                ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w)) 
    97                ze3w = fse3w(ji,1,jk) * tmask(ji,1,jk) 
    98                zah(ji,1) = zah(ji,1) + zn2 * wslp2(ji,1,jk) * ze3w 
    99                zhw(ji,1) = zhw(ji,1) + ze3w 
    100             END DO 
    101 #  else 
    10286            DO jj = 2, jpjm1 
    103 !CDIR NOVERRCHK  
    10487               DO ji = 2, jpim1 
    10588                  ! Take the max of N^2 and zero then take the vertical sum  
    … …  
    11699               END DO 
    117100            END DO 
    118 #  endif 
    119101         END DO 
    120102      ELSE 
    121103         DO jk = 1, jpk 
    122 #  if defined key_vectopt_loop   
    123 !CDIR NOVERRCHK  
    124             DO ji = 1, jpij   ! vector opt. 
    125                ! Take the max of N^2 and zero then take the vertical sum 
    126                ! of the square root of the resulting N^2 ( required to compute 
    127                ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 
    128                zn2 = MAX( rn2b(ji,1,jk), 0._wp ) 
    129                zn(ji,1) = zn(ji,1) + SQRT( zn2 ) * fse3w(ji,1,jk) 
    130                ! Compute elements required for the inverse time scale of baroclinic 
    131                ! eddies using the isopycnal slopes calculated in ldfslp.F : 
    132                ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w)) 
    133                ze3w = fse3w(ji,1,jk) * tmask(ji,1,jk) 
    134                zah(ji,1) = zah(ji,1) + zn2 * ( wslpi(ji,1,jk) * wslpi(ji,1,jk)   & 
    135                   &                          + wslpj(ji,1,jk) * wslpj(ji,1,jk) ) * ze3w 
    136                zhw(ji,1) = zhw(ji,1) + ze3w 
    137             END DO 
    138 #  else 
    139104            DO jj = 2, jpjm1 
    140 !CDIR NOVERRCHK  
    141105               DO ji = 2, jpim1 
    142106                  ! Take the max of N^2 and zero then take the vertical sum  
    … …  
    154118               END DO 
    155119            END DO 
    156 #  endif 
    157120         END DO 
    158121      END IF 
    159122 
    160123      DO jj = 2, jpjm1 
    161 !CDIR NOVERRCHK  
    162124         DO ji = fs_2, fs_jpim1   ! vector opt. 
    163125            zfw = MAX( ABS( 2. * omega * SIN( rad * gphit(ji,jj) ) ) , 1.e-10 ) 

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

    r4488 r4619  
    2828   USE zdfmxl         ! mixed layer depth 
    2929   USE eosbn2         ! equation of states 
     30   ! 
     31   USE in_out_manager ! I/O manager 
    3032   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    31    USE in_out_manager ! I/O manager 
    3233   USE prtctl         ! Print control 
    3334   USE wrk_nemo       ! work arrays 
    … …  
    136137         END DO 
    137138         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 
    142139            DO jj = 1, jpjm1 
    143140               DO ji = 1, jpim1 
    144 # endif 
    145141                  zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) 
    146142                  zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj) 
    … …  
    435431      REAL(wp) ::   zdyrho_raw, ztj_coord, ztj_raw, ztj_lim, ztj_g_raw, ztj_g_lim 
    436432      REAL(wp) ::   zdzrho_raw 
    437       REAL(wp) ::   zbeta0 
    438433      REAL(wp), POINTER, DIMENSION(:,:)     ::   z1_mlbw 
    439       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalbet 
    440434      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zdxrho , zdyrho, zdzrho     ! Horizontal and vertical density gradients 
    441435      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zti_mlb, ztj_mlb            ! for Griffies operator only 
    … …  
    445439      ! 
    446440      CALL wrk_alloc( jpi,jpj, z1_mlbw ) 
    447       CALL wrk_alloc( jpi,jpj,jpk, zalbet ) 
    448441      CALL wrk_alloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  ) 
    449442      CALL wrk_alloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  ) 
    … …  
    452445      !  Some preliminary calculation  ! 
    453446      !--------------------------------! 
    454       ! 
    455       CALL eos_alpbet( tsb, zalbet, zbeta0 )  !==  before local thermal/haline expension ratio at T-points  ==! 
    456447      ! 
    457448      DO jl = 0, 1                            !==  unmasked before density i- j-, k-gradients  ==! 
    … …  
    465456                  zdjt = ( tsb(ji,jj+1,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )    ! j-gradient of T & S at v-point 
    466457                  zdjs = ( tsb(ji,jj+1,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
    467                   zdxrho_raw = ( - zalbet(ji+ip,jj   ,jk) * zdit + zbeta0*zdis ) / e1u(ji,jj) 
    468                   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 
     458                  zdxrho_raw = ( - rab_b(ji+ip,jj   ,jk,jp_tem) * zdit + rab_b(ji+ip,jj   ,jk,jp_sal) * zdis ) / e1u(ji,jj) 
     459                  zdyrho_raw = ( - rab_b(ji   ,jj+jp,jk,jp_tem) * zdjt + rab_b(ji   ,jj+jp,jk,jp_sal) * zdjs ) / e2v(ji,jj) 
     460                  zdxrho(ji+ip,jj   ,jk,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign 
    470461                  zdyrho(ji   ,jj+jp,jk,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 
    471462               END DO 
    … …  
    473464         END DO 
    474465         ! 
    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 
     466         IF( ln_zps .AND. l_grad_zps ) THEN     ! partial steps: correction of i- & j-grad on bottom 
    480467            DO jj = 1, jpjm1 
    481468               DO ji = 1, jpim1 
    482 # endif 
    483469                  iku  = mbku(ji,jj)          ;   ikv  = mbkv(ji,jj)             ! last ocean level (u- & v-points) 
    484470                  zdit = gtsu(ji,jj,jp_tem)   ;   zdjt = gtsv(ji,jj,jp_tem)      ! i- & j-gradient of Temperature 
    485471                  zdis = gtsu(ji,jj,jp_sal)   ;   zdjs = gtsv(ji,jj,jp_sal)      ! i- & j-gradient of Salinity 
    486                   zdxrho_raw = ( - zalbet(ji+ip,jj   ,iku) * zdit + zbeta0*zdis ) / e1u(ji,jj) 
    487                   zdyrho_raw = ( - zalbet(ji   ,jj+jp,ikv) * zdjt + zbeta0*zdjs ) / e2v(ji,jj) 
     472                  zdxrho_raw = ( - rab_b(ji+ip,jj   ,iku,jp_tem) * zdit + rab_b(ji+ip,jj   ,iku,jp_sal) * zdis ) / e1u(ji,jj) 
     473                  zdyrho_raw = ( - rab_b(ji   ,jj+jp,ikv,jp_tem) * zdjt + rab_b(ji   ,jj+jp,ikv,jp_sal) * zdjs ) / e2v(ji,jj) 
    488474                  zdxrho(ji+ip,jj   ,iku,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign 
    489475                  zdyrho(ji   ,jj+jp,ikv,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 
    … …  
    505491                     zdks = 0._wp 
    506492                  ENDIF 
    507                   zdzrho_raw = ( - zalbet(ji   ,jj   ,jk) * zdkt + zbeta0*zdks ) / fse3w(ji,jj,jk+kp) 
    508                   zdzrho(ji   ,jj   ,jk,  kp) =     - MIN( - repsln,      zdzrho_raw )    ! force zdzrho >= repsln 
     493                  zdzrho_raw = ( - rab_b(ji,jj,jk,jp_tem) * zdkt + rab_b(ji,jj,jk,jp_sal) * zdks ) / fse3w(ji,jj,jk+kp) 
     494                  zdzrho(ji,jj,jk,kp) = - MIN( - repsln, zdzrho_raw )    ! force zdzrho >= repsln 
    509495                 END DO 
    510496            END DO 
    … …  
    650636      ! 
    651637      CALL wrk_dealloc( jpi,jpj, z1_mlbw ) 
    652       CALL wrk_dealloc( jpi,jpj,jpk, zalbet ) 
    653638      CALL wrk_dealloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  ) 
    654639      CALL wrk_dealloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  ) 
    … …  
    701686      !                                            !==   surface mixed layer mask   ! 
    702687      DO jk = 1, jpk                               ! =1 inside the mixed layer, =0 otherwise 
    703 # if defined key_vectopt_loop 
    704          DO jj = 1, 1 
    705             DO ji = 1, jpij                        ! vector opt. (forced unrolling) 
    706 # else 
    707688         DO jj = 1, jpj 
    708689            DO ji = 1, jpi 
    709 # endif 
    710690               ik = nmln(ji,jj) - 1 
    711691               IF( jk <= ik ) THEN   ;   omlmask(ji,jj,jk) = 1._wp 
    … …  
    727707      !----------------------------------------------------------------------- 
    728708      ! 
    729 # if defined key_vectopt_loop 
    730       DO jj = 1, 1 
    731          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    732 # else 
    733709      DO jj = 2, jpjm1 
    734710         DO ji = 2, jpim1 
    735 # endif 
    736711            !                        !==   Slope at u- & v-points just below the Mixed Layer   ==! 
    737712            ! 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r4333 r4619  
    269269      zwnd_j(:,:) = 0.e0 
    270270#if defined key_cyclone 
    271 # if defined key_vectopt_loop 
    272 !CDIR COLLAPSE 
    273 # endif 
    274       CALL wnd_cyc( kt, zwnd_i, zwnd_j )    ! add Manu ! 
     271      CALL wnd_cyc( kt, zwnd_i, zwnd_j ) 
    275272      DO jj = 2, jpjm1 
    276273         DO ji = fs_2, fs_jpim1   ! vect. opt. 
    … …  
    279276         END DO 
    280277      END DO 
    281 #endif 
    282 #if defined key_vectopt_loop 
    283 !CDIR COLLAPSE 
    284278#endif 
    285279      DO jj = 2, jpjm1 
    … …  
    292286      CALL lbc_lnk( zwnd_j(:,:) , 'T', -1. ) 
    293287      ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked) 
    294 !CDIR NOVERRCHK 
    295 !CDIR COLLAPSE 
    296288      wndm(:,:) = SQRT(  zwnd_i(:,:) * zwnd_i(:,:)   & 
    297289         &             + zwnd_j(:,:) * zwnd_j(:,:)  ) * tmask(:,:,1) 
    … …  
    443435   END SUBROUTINE blk_oce_core 
    444436   
     437   
    445438   SUBROUTINE blk_bio_meanqsr 
    446439      !!--------------------------------------------------------------------- 
    … …  
    453446      !!  
    454447      !!--------------------------------------------------------------------- 
    455       IF( nn_timing == 1 )  CALL timing_start('blk_bio_meanqsr') 
    456  
    457       qsr_mean(:,:) = (1. - albo ) *  sf(jp_qsr)%fnow(:,:,1) 
    458  
    459       IF( nn_timing == 1 )  CALL timing_stop('blk_bio_meanqsr') 
    460  
     448      IF( nn_timing == 1 )   CALL timing_start('blk_bio_meanqsr') 
     449      ! 
     450      qsr_mean(:,:) = (1. - albo ) * sf(jp_qsr)%fnow(:,:,1) 
     451      ! 
     452      IF( nn_timing == 1 )   CALL timing_stop('blk_bio_meanqsr') 
     453      ! 
    461454   END SUBROUTINE blk_bio_meanqsr 
    462455  
    … …  
    604597         ! 
    605598      CASE( 'C' )                  ! C-grid ice dynamics :   U & V-points (same as ocean) 
    606 #if defined key_vectopt_loop 
    607 !CDIR COLLAPSE 
    608 #endif 
    609599         DO jj = 2, jpj 
    610600            DO ji = fs_2, jpi   ! vect. opt. 
    … …  
    614604            END DO 
    615605         END DO 
    616 #if defined key_vectopt_loop 
    617 !CDIR COLLAPSE 
    618 #endif 
    619606         DO jj = 2, jpjm1 
    620607            DO ji = fs_2, fs_jpim1   ! vect. opt. 
    … …  
    635622      DO jl = 1, ijpl                       !  Loop over ice categories  ! 
    636623         !                                  ! ========================== ! 
    637 !CDIR NOVERRCHK 
    638 !CDIR COLLAPSE 
    639624         DO jj = 1 , jpj 
    640 !CDIR NOVERRCHK 
    641625            DO ji = 1, jpi 
    642626               ! ----------------------------! 
    … …  
    700684      p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac      ! solid precipitation [kg/m2/s] 
    701685      CALL iom_put( 'snowpre', p_spr * 86400. )                  ! Snow precipitation  
    702       CALL iom_put( 'precip', p_tpr * 86400. )                   ! Total precipitation  
     686      CALL iom_put( 'precip' , p_tpr * 86400. )                  ! Total precipitation  
    703687      ! 
    704688      IF(ln_ctl) THEN 
    … …  
    810794 
    811795         !! Estimate the Monin-Obukov length : 
    812          L  = (U_star**2)/( kappa*grav*(T_star/T_vpot + q_star/(q_a + 1./0.608)) ) 
     796         L = U_star*U_star / ( kappa*grav*(T_star/T_vpot + q_star/(q_a + 1./0.608)) ) 
     797!!gm  !lolo  suggestion ......   TO BE TAKEN  ? 
     798!!         L = U_star*U_star / ( kappa*grav/T_vpot*(T_star*(1. + 0.608*q_a) + 0.608*T_a*q_star) ) 
     799!!gm     !lolo. 
    813800 
    814801         !! Stability parameters : 
    … …  
    10341021      REAL(wp), DIMENSION(:,:), POINTER        :: X2, X, stabit 
    10351022      !------------------------------------------------------------------------------- 
    1036  
     1023      ! 
    10371024      CALL wrk_alloc( jpi,jpj, X2, X, stabit ) 
    1038  
     1025      ! 
    10391026      X2 = sqrt(abs(1. - 16.*zta))  ;  X2 = max(X2 , 1.) ;  X  = sqrt(X2) 
    10401027      stabit    = 0.5 + sign(0.5,zta) 
    1041       psi_h = -5.*zta*stabit  &                                       ! Stable 
     1028      psi_h = -5.*zta*stabit   &                                       ! Stable 
    10421029         &    + (1. - stabit)*(2.*log( (1. + X2)/2. ))                 ! Unstable 
    1043  
     1030         ! 
    10441031      CALL wrk_dealloc( jpi,jpj, X2, X, stabit ) 
    10451032      ! 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

    r4161 r4619  
    9999                                 ! ( d rho / dt ) / ( d rho / ds )      ( s = 34, t = -1.8 ) 
    100100          
    101          fr_i(:,:) = tfreez( sss_m ) * tmask(:,:,1)      ! sea surface freezing temperature [Celcius] 
     101         fr_i(:,:) = eos_fzp( sss_m ) * tmask(:,:,1)      ! sea surface freezing temperature [Celcius] 
    102102 
    103 ! OM : probleme. a_i pas defini dans les cas lim3 et cice 
     103!!OM : probleme. a_i pas defini dans les cas lim3 et cice 
     104!!gm  Not sure at all that a_i  should be defined....   ==>>> to be checked 
    104105#if defined key_coupled && defined key_lim2 
    105106         a_i(:,:,1) = fr_i(:,:)          
    … …  
    107108 
    108109         ! Flux and ice fraction computation 
    109 !CDIR COLLAPSE 
    110110         DO jj = 1, jpj 
    111111            DO ji = 1, jpi 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r4333 r4619  
    182182         v_oce(:,:) = ssv_m(:,:)                     ! (C-grid dynamics :  U- & V-points as the ocean) 
    183183         ! 
    184          t_bo(:,:) = tfreez( sss_m ) +  rt0          ! masked sea surface freezing temperature [Kelvin] 
     184         t_bo(:,:) = eos_fzp( sss_m ) +  rt0         ! masked sea surface freezing temperature [Kelvin] 
    185185         !                                           ! (set to rt0 over land) 
    186186         CALL albedo_ice( t_su, ht_i, ht_s, zalb_ice_cs, zalb_ice_os )  ! ... ice albedo 
    … …  
    672672      !!                n : number of the option 
    673673      !!------------------------------------------------------------------- 
    674       INTEGER         , INTENT(in) ::   kt      ! ocean time step 
     674      INTEGER         , INTENT(in) ::   kt            ! ocean time step 
    675675      INTEGER         , INTENT(in) ::   ki, kj, kn    ! ocean gridpoint indices 
    676676      CHARACTER(len=*), INTENT(in) ::   cd1           ! 
    … …  
    850850         END DO 
    851851      END DO 
    852  
     852      ! 
    853853   END SUBROUTINE lim_prt_state 
    854854 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r4306 r4619  
    140140 
    141141         ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land) 
    142          tfu(:,:) = tfreez( sss_m ) +  rt0  
     142         tfu(:,:) = eos_fzp( sss_m ) +  rt0  
    143143 
    144144         zsist (:,:,1) = sist (:,:) + rt0 * ( 1. - tmask(:,:,1) ) 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90

    r4292 r4619  
    1414   USE oce             ! ocean dynamics and tracers 
    1515   USE dom_oce         ! ocean space and time domain 
    16    USE sbc_oce         ! Surface boundary condition: ocean fields 
    1716   USE sbc_oce         ! surface boundary condition: ocean fields 
    1817   USE sbcapr          ! surface boundary condition: atmospheric pressure 
    19    USE prtctl          ! Print control                    (prt_ctl routine) 
    20    USE iom 
     18   USE eosbn2          ! equation of state and related derivatives 
     19   ! 
    2120   USE in_out_manager  ! I/O manager 
     21   USE prtctl          ! Print control 
     22   USE iom             ! IOM library 
    2223 
    2324   IMPLICIT NONE 
    … …  
    6162         ssu_m(:,:) = ub(:,:,1) 
    6263         ssv_m(:,:) = vb(:,:,1) 
    63          sst_m(:,:) = tsn(:,:,1,jp_tem) 
     64         IF( ln_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 
     65         ELSE                    ;   sst_m(:,:) = tsn(:,:,1,jp_tem) 
     66         ENDIF 
    6467         sss_m(:,:) = tsn(:,:,1,jp_sal) 
    6568         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    … …  
    7982            ssu_m(:,:) = zcoef * ub(:,:,1) 
    8083            ssv_m(:,:) = zcoef * vb(:,:,1) 
    81             sst_m(:,:) = zcoef * tsn(:,:,1,jp_tem) 
     84            IF( ln_useCT )  THEN    ;   sst_m(:,:) = zcoef * eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 
     85            ELSE                    ;   sst_m(:,:) = zcoef * tsn(:,:,1,jp_tem) 
     86            ENDIF 
    8287            sss_m(:,:) = zcoef * tsn(:,:,1,jp_sal) 
    8388            !                          ! removed inverse barometer ssh when Patm forcing is used  
    … …  
    101106         ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1) 
    102107         ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1) 
    103          sst_m(:,:) = sst_m(:,:) + tsn(:,:,1,jp_tem) 
     108         IF( ln_useCT )  THEN    ;   sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 
     109         ELSE                    ;   sst_m(:,:) = sst_m(:,:) + tsn(:,:,1,jp_tem) 
     110         ENDIF 
    104111         sss_m(:,:) = sss_m(:,:) + tsn(:,:,1,jp_sal) 
    105112         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

    r4147 r4619  
    1010   !!---------------------------------------------------------------------- 
    1111   !!   sbc_ssr       : add to sbc a restoring term toward SST/SSS climatology 
     12   !!   sbc_ssr_init  : initialisation of surface restoring 
    1213   !!---------------------------------------------------------------------- 
    1314   USE oce            ! ocean dynamics and tracers 
    … …  
    1617   USE phycst         ! physical constants 
    1718   USE sbcrnf         ! surface boundary condition : runoffs 
     19   ! 
    1820   USE fldread        ! read input fields 
    1921   USE iom            ! I/O manager 
    … …  
    9395            ! 
    9496            IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term 
    95 !CDIR COLLAPSE 
    9697               DO jj = 1, jpj 
    9798                  DO ji = 1, jpi 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r4292 r4619  
    1515   !!             -   ! 2002-11  (G. Madec, A. Bozec)  partial step, eos_insitu_2d 
    1616   !!             -   ! 2003-08  (G. Madec)  F90, free form 
    17    !!            3.0  ! 2006-08  (G. Madec)  add tfreez function 
     17   !!            3.0  ! 2006-08  (G. Madec)  add tfreez function (now eos_fzp function) 
    1818   !!            3.3  ! 2010-05  (C. Ethe, G. Madec)  merge TRC-TRA 
    19    !!             -   ! 2010-10  (G. Nurser, G. Madec)  add eos_alpbet used in ldfslp 
     19   !!             -   ! 2010-10  (G. Nurser, G. Madec)  add alpha/beta used in ldfslp 
     20   !!            3.7  ! 2012-03  (F. Roquet, G. Madec)  add primitive of alpha and beta used in PE computation 
     21   !!             -   ! 2012-05  (F. Roquet)  add Vallis and original JM95 equation of state 
     22   !!             -   ! 2013-04  (F. Roquet, G. Madec)  add eos_rab, change bn2 computation and reorganize the module 
     23   !!             -   ! 2014-02  (F. Roquet)  add TEOS-10, S-EOS, and modify EOS-80 
    2024   !!---------------------------------------------------------------------- 
    2125 
    … …  
    2327   !!   eos            : generic interface of the equation of state 
    2428   !!   eos_insitu     : Compute the in situ density 
    25    !!   eos_insitu_pot : Compute the insitu and surface referenced potential 
    26    !!                    volumic mass 
     29   !!   eos_insitu_pot : Compute the insitu and surface referenced potential volumic mass 
    2730   !!   eos_insitu_2d  : Compute the in situ density for 2d fields 
    28    !!   eos_bn2        : Compute the Brunt-Vaisala frequency 
    29    !!   eos_alpbet     : calculates the in situ thermal/haline expansion ratio 
    30    !!   tfreez         : Compute the surface freezing temperature 
     31   !!   bn2            : Compute the Brunt-Vaisala frequency 
     32   !!   eos_rab        : generic interface of in situ thermal/haline expansion ratio  
     33   !!   eos_rab_3d     : compute in situ thermal/haline expansion ratio 
     34   !!   eos_rab_2d     : compute in situ thermal/haline expansion ratio for 2d fields 
     35   !!   eos_fzp        : freezing temperature 
    3136   !!   eos_init       : set eos parameters (namelist) 
    3237   !!---------------------------------------------------------------------- 
    3338   USE dom_oce         ! ocean space and time domain 
    3439   USE phycst          ! physical constants 
    35    USE zdfddm          ! vertical physics: double diffusion 
     40   ! 
    3641   USE in_out_manager  ! I/O manager 
    3742   USE lib_mpp         ! MPP library 
     43   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3844   USE prtctl          ! Print control 
    3945   USE wrk_nemo        ! Memory Allocation 
    … …  
    4753      MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d 
    4854   END INTERFACE 
    49    INTERFACE bn2 
    50       MODULE PROCEDURE eos_bn2 
     55   ! 
     56   INTERFACE eos_rab 
     57      MODULE PROCEDURE rab_3d, rab_2d 
    5158   END INTERFACE 
    52  
    53    PUBLIC   eos        ! called by step, istate, tranpc and zpsgrd modules 
    54    PUBLIC   eos_init   ! called by istate module 
    55    PUBLIC   bn2        ! called by step module 
    56    PUBLIC   eos_alpbet ! called by ldfslp module 
    57    PUBLIC   tfreez     ! called by sbcice_... modules 
    58  
    59    !                                  !!* Namelist (nameos) * 
    60    INTEGER , PUBLIC ::   nn_eos       !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ. 
    61    REAL(wp), PUBLIC ::   rn_alpha     !: thermal expension coeff. (linear equation of state) 
    62    REAL(wp), PUBLIC ::   rn_beta      !: saline  expension coeff. (linear equation of state) 
    63  
    64    REAL(wp), PUBLIC ::   ralpbet              !: alpha / beta ratio 
     59   ! 
     60   PUBLIC   eos            ! called by step, istate, tranpc and zpsgrd modules 
     61   PUBLIC   bn2            ! called by step module 
     62   PUBLIC   eos_rab        ! called by ldfslp, zdfddm, trabbl 
     63   PUBLIC   eos_pt_from_ct ! called by sbcssm 
     64   PUBLIC   eos_fzp        ! called by traadv_cen2 and sbcice_... modules 
     65   PUBLIC   eos_pen        ! used for pe diagnostics in trdpen module 
     66   PUBLIC   eos_init       ! called by istate module 
     67 
     68   !                                          !!* Namelist (nameos) * 
     69   INTEGER , PUBLIC ::   nn_eos   = 0         !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ. 
     70   LOGICAL , PUBLIC ::   ln_useCT  = .FALSE.  ! determine if eos_pt_from_ct is used to compute sst_m 
     71 
     72   !                                   !!!  simplified eos coefficients 
     73   ! default value: Vallis 2006 
     74   REAL(wp) ::   rn_a0      = 1.6550e-1_wp     ! thermal expansion coeff.  
     75   REAL(wp) ::   rn_b0      = 7.6554e-1_wp     ! saline  expansion coeff.  
     76   REAL(wp) ::   rn_lambda1 = 5.9520e-2_wp     ! cabbeling coeff. in T^2         
     77   REAL(wp) ::   rn_lambda2 = 5.4914e-4_wp     ! cabbeling coeff. in S^2         
     78   REAL(wp) ::   rn_mu1     = 1.4970e-4_wp     ! thermobaric coeff. in T   
     79   REAL(wp) ::   rn_mu2     = 1.1090e-5_wp     ! thermobaric coeff. in S   
     80   REAL(wp) ::   rn_nu      = 2.4341e-3_wp     ! cabbeling coeff. in theta*salt   
     81    
     82   ! EOS parameters 
     83   REAL(wp) ::   EOS111 , EOS211 , EOS311 , EOS411 , EOS511 , EOS611 , EOS711 
     84   REAL(wp) ::   EOS121 , EOS221 , EOS321 , EOS421 , EOS521 , EOS621 
     85   REAL(wp) ::   EOS131 , EOS231 , EOS331 , EOS431 , EOS531 
     86   REAL(wp) ::   EOS141 , EOS241 , EOS341 , EOS441 
     87   REAL(wp) ::   EOS151 , EOS251 , EOS351 
     88   REAL(wp) ::   EOS161 , EOS261 
     89   REAL(wp) ::   EOS171 
     90   REAL(wp) ::   EOS112 , EOS212 , EOS312 , EOS412 , EOS512 
     91   REAL(wp) ::   EOS122 , EOS222 , EOS322 , EOS422 
     92   REAL(wp) ::   EOS132 , EOS232 , EOS332 
     93   REAL(wp) ::   EOS142 , EOS242 
     94   REAL(wp) ::   EOS152 
     95   REAL(wp) ::   EOS113 , EOS213 , EOS313 
     96   REAL(wp) ::   EOS123 , EOS223 
     97   REAL(wp) ::   EOS133 
     98    
     99   ! ALPHA parameters 
     100   REAL(wp) ::   ALP111 , ALP211 , ALP311 , ALP411 , ALP511 , ALP611 
     101   REAL(wp) ::   ALP121 , ALP221 , ALP321 , ALP421 , ALP521 
     102   REAL(wp) ::   ALP131 , ALP231 , ALP331 , ALP431 
     103   REAL(wp) ::   ALP141 , ALP241 , ALP341 
     104   REAL(wp) ::   ALP151 , ALP251 
     105   REAL(wp) ::   ALP161 
     106   REAL(wp) ::   ALP112 , ALP212 , ALP312 , ALP412 
     107   REAL(wp) ::   ALP122 , ALP222 , ALP322 
     108   REAL(wp) ::   ALP132 , ALP232 
     109   REAL(wp) ::   ALP142 
     110   REAL(wp) ::   ALP113 , ALP213 
     111   REAL(wp) ::   ALP123 
     112    
     113   ! BETA parameters 
     114   REAL(wp) ::   BET111 , BET211 , BET311 , BET411 , BET511 , BET611 
     115   REAL(wp) ::   BET121 , BET221 , BET321 , BET421 , BET521 
     116   REAL(wp) ::   BET131 , BET231 , BET331 , BET431 
     117   REAL(wp) ::   BET141 , BET241 , BET341 
     118   REAL(wp) ::   BET151 , BET251 
     119   REAL(wp) ::   BET161 
     120   REAL(wp) ::   BET112 , BET212 , BET312 , BET412 
     121   REAL(wp) ::   BET122 , BET222 , BET322 
     122   REAL(wp) ::   BET132 , BET232 
     123   REAL(wp) ::   BET142 
     124   REAL(wp) ::   BET113 , BET213 
     125   REAL(wp) ::   BET123 
     126 
     127   ! PEN parameters 
     128   REAL(wp) ::   PEN112 , PEN212 , PEN312 , PEN412 , PEN512 
     129   REAL(wp) ::   PEN122 , PEN222 , PEN322 , PEN422 
     130   REAL(wp) ::   PEN132 , PEN232 , PEN332 
     131   REAL(wp) ::   PEN142 , PEN242 
     132   REAL(wp) ::   PEN152 
     133   REAL(wp) ::   PEN113 , PEN213 , PEN313 
     134   REAL(wp) ::   PEN123 , PEN223 
     135   REAL(wp) ::   PEN133 
     136    
     137   ! ALPHA_PEN parameters 
     138   REAL(wp) ::   APE112 , APE212 , APE312 , APE412 
     139   REAL(wp) ::   APE122 , APE222 , APE322 
     140   REAL(wp) ::   APE132 , APE232 
     141   REAL(wp) ::   APE142 
     142   REAL(wp) ::   APE113 , APE213 
     143   REAL(wp) ::   APE123 
     144 
     145   ! BETA_PEN parameters 
     146   REAL(wp) ::   BPE112 , BPE212 , BPE312 , BPE412 
     147   REAL(wp) ::   BPE122 , BPE222 , BPE322 
     148   REAL(wp) ::   BPE132 , BPE232 
     149   REAL(wp) ::   BPE142 
     150   REAL(wp) ::   BPE113 , BPE213 
     151   REAL(wp) ::   BPE123 
    65152 
    66153   !! * Substitutions 
    … …  
    68155#  include "vectopt_loop_substitute.h90" 
    69156   !!---------------------------------------------------------------------- 
    70    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     157   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    71158   !! $Id$ 
    72159   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    82169      !!       defined through the namelist parameter nn_eos. 
    83170      !! 
    84       !! ** Method  :   3 cases: 
    85       !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state. 
    86       !!         the in situ density is computed directly as a function of 
    87       !!         potential temperature relative to the surface (the opa t 
    88       !!         variable), salt and pressure (assuming no pressure variation 
    89       !!         along geopotential surfaces, i.e. the pressure p in decibars 
    90       !!         is approximated by the depth in meters. 
    91       !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0 
    92       !!         with pressure                      p        decibars 
    93       !!              potential temperature         t        deg celsius 
    94       !!              salinity                      s        psu 
    95       !!              reference volumic mass        rau0     kg/m**3 
    96       !!              in situ volumic mass          rho      kg/m**3 
    97       !!              in situ density anomalie      prd      no units 
    98       !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar, 
    99       !!          t = 40 deg celcius, s=40 psu 
    100       !!      nn_eos = 1 : linear equation of state function of temperature only 
    101       !!              prd(t) = 0.0285 - rn_alpha * t 
    102       !!      nn_eos = 2 : linear equation of state function of temperature and 
    103       !!               salinity 
    104       !!              prd(t,s) = rn_beta * s - rn_alpha * tn - 1. 
    105       !!      Note that no boundary condition problem occurs in this routine 
    106       !!      as pts are defined over the whole domain. 
     171      !! ** Method  :   prd(t,s,z) = ( rho(t,s,z) - rau0 ) / rau0 
     172      !!         with   prd    in situ density anomalie     no units 
     173      !!                t      potential temperature        Celsius 
     174      !!                s      salinity                     psu 
     175      !!                z      depth                        meters 
     176      !!                rho    in situ density              kg/m^3 
     177      !!                rau0   reference density            kg/m^3 
     178      !! 
     179      !!     nn_eos = -1 : polynomial TEOS-10 equation of state is used for rho(t,s,z). 
     180      !!         Check value: rho = 1028.21583 kg/m^3 for p=3000 dbar, t=3 Celcius, s=35.5 psu 
     181      !! 
     182      !!     nn_eos =  0 : Jackett and McDougall (1995) equation of state is used for rho(t,s,z) 
     183      !!            where the density anomaly of a water parcel at t=4, s=35 moved adiabatically to surface 
     184      !!            has been removed: rho = rho_JM95 - ( rho_JM95(4,35,z) - rho_JM95(4,35,0) ) 
     185      !!         Check value: rho = 1028.34976 kg/m^3 for p=3000 dbar, t=3 Celcius, s=35.5 psu 
     186      !!         Check value: rho_JM95 = 1041.83267 kg/m^3 for p=3000 dbar, t=3 Celcius, s=35.5 psu 
     187      !! 
     188      !!     nn_eos =  1 : simplified equation of state 
     189      !!              prd(t,s,z) = ( -a0*(1+lambda/2*(T-T0)+mu*z+nu*(S-S0))*(T-T0) + b0*(S-S0) ) / rau0 
     190      !!              linear case function of T only: rn_alpha<>0, other coefficients = 0 
     191      !!              linear eos function of T and S: rn_alpha and rn_beta<>0, other coefficients=0 
     192      !!              Vallis like equation: use default values of coefficients 
    107193      !! 
    108194      !! ** Action  :   compute prd , the in situ density (no units) 
    109195      !! 
    110       !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 
    111       !!---------------------------------------------------------------------- 
    112       !! 
    113       REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
    114       !                                                      ! 2 : salinity               [psu] 
    115       REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   prd   ! in situ density            [-] 
    116       REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pdep  ! depth                      [m] 
    117       !! 
    118       INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    119       REAL(wp) ::   zt , zs , zh , zsr   ! local scalars 
    120       REAL(wp) ::   zr1, zr2, zr3, zr4   !   -      - 
    121       REAL(wp) ::   zrhop, ze, zbw, zb   !   -      - 
    122       REAL(wp) ::   zd , zc , zaw, za    !   -      - 
    123       REAL(wp) ::   zb1, za1, zkw, zk0   !   -      - 
    124       REAL(wp), POINTER, DIMENSION(:,:,:) :: zws 
    125       !!---------------------------------------------------------------------- 
    126  
    127       ! 
    128       IF( nn_timing == 1 ) CALL timing_start('eos') 
    129       ! 
    130       CALL wrk_alloc( jpi, jpj, jpk, zws ) 
     196      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1995 
     197      !!                Vallis, Atmospheric and Oceanic Fluid Dynamics, 2006 
     198      !!                TEOS-10 Manual, 2010 
     199      !!                Roquet, Ocean Modelling, in preparation (2013) 
     200      !!---------------------------------------------------------------------- 
     201      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
     202      !                                                               ! 2 : salinity               [psu] 
     203      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd   ! in situ density            [-] 
     204      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep  ! depth                      [m] 
     205      ! 
     206      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     207      REAL(wp) ::   zt , zh , zs , zsr, ztm   ! local scalars 
     208      REAL(wp) ::   zn , zn0, zn1, zn2        !   -      - 
     209      !!---------------------------------------------------------------------- 
     210      ! 
     211      IF( nn_timing == 1 )   CALL timing_start('eos') 
    131212      ! 
    132213      SELECT CASE( nn_eos ) 
    133214      ! 
    134       CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    135 !CDIR NOVERRCHK 
    136          zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 
     215      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    137216         ! 
    138217         DO jk = 1, jpkm1 
    139218            DO jj = 1, jpj 
    140219               DO ji = 1, jpi 
    141                   zt = pts   (ji,jj,jk,jp_tem) 
    142                   zs = pts   (ji,jj,jk,jp_sal) 
    143                   zh = pdep(ji,jj,jk)        ! depth 
    144                   zsr= zws   (ji,jj,jk)        ! square root salinity 
    145                   ! 
    146                   ! compute volumic mass pure water at atm pressure 
    147                   zr1= ( ( ( ( 6.536332e-9_wp  *zt - 1.120083e-6_wp )*zt + 1.001685e-4_wp )*zt   & 
    148                      &        -9.095290e-3_wp )*zt + 6.793952e-2_wp )*zt +  999.842594_wp 
    149                   ! seawater volumic mass atm pressure 
    150                   zr2= ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp ) *zt+7.6438e-5_wp ) *zt        & 
    151                      &                      -4.0899e-3_wp ) *zt+0.824493_wp 
    152                   zr3= ( -1.6546e-6_wp*zt+1.0227e-4_wp )    *zt-5.72466e-3_wp 
    153                   zr4= 4.8314e-4_wp 
    154                   ! 
    155                   ! potential volumic mass (reference to the surface) 
    156                   zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1 
    157                   ! 
    158                   ! add the compression terms 
    159                   ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp 
    160                   zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp 
    161                   zb = zbw + ze * zs 
    162                   ! 
    163                   zd = -2.042967e-2_wp 
    164                   zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp 
    165                   zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt - 4.721788_wp 
    166                   za = ( zd*zsr + zc ) *zs + zaw 
    167                   ! 
    168                   zb1=   (-0.1909078_wp*zt+7.390729_wp )        *zt-55.87545_wp 
    169                   za1= ( ( 2.326469e-3_wp*zt+1.553190_wp)       *zt-65.00517_wp ) *zt+1044.077_wp 
    170                   zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp ) *zt-30.41638_wp ) *zt + 2098.925_wp ) *zt+190925.6_wp 
    171                   zk0= ( zb1*zsr + za1 )*zs + zkw 
    172                   ! 
    173                   ! masked in situ density anomaly 
    174                   prd(ji,jj,jk) = (  zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  )    & 
    175                      &             - rau0  ) * r1_rau0 * tmask(ji,jj,jk) 
     220                  ! 
     221                  zh  = pdep(ji,jj,jk)                                  ! depth 
     222                  zt  = pts (ji,jj,jk,jp_tem)                           ! temperature 
     223                  zsr = SQRT( MAX( pts(ji,jj,jk,jp_sal) , 0.1_wp ) )    ! square root salinity 
     224                  ztm = tmask(ji,jj,jk)                                 ! tmask 
     225                  ! 
     226                  zn2  = (   EOS133*zsr  + EOS223*zt + EOS123 )*zsr + ( EOS313*zt + EOS213 )*zt + EOS113 
     227                  ! 
     228                  zn1  = ( ( ( EOS152*zsr   & 
     229                     &   + EOS242*zt + EOS142 )*zsr   & 
     230                     &   + ( EOS332*zt + EOS232 )*zt + EOS132 )*zsr   & 
     231                     &   + ( ( EOS422*zt + EOS322 )*zt + EOS222 )*zt + EOS122 )*zsr   & 
     232                     &   + ( ( ( EOS512*zt + EOS412 )*zt + EOS312 )*zt + EOS212 )*zt + EOS112 
     233                  ! 
     234                  zn0  = ( ( ( ( ( EOS171*zsr   & 
     235                     &   + EOS261*zt + EOS161 )*zsr   & 
     236                     &   + ( EOS351*zt + EOS251 )*zt + EOS151 )*zsr   & 
     237                     &   + ( ( EOS441*zt + EOS341 )*zt + EOS241 )*zt + EOS141 )*zsr   & 
     238                     &   + ( ( ( EOS531*zt + EOS431 )*zt + EOS331 )*zt + EOS231 )*zt + EOS131 )*zsr   & 
     239                     &   + ( ( ( ( EOS621*zt + EOS521 )*zt + EOS421 )*zt + EOS321 )*zt + EOS221 )*zt + EOS121 )*zsr   & 
     240                     &   + ( ( ( ( ( EOS711*zt + EOS611 )*zt + EOS511 )*zt + EOS411 )*zt + EOS311 )*zt + EOS211 )*zt + EOS111 
     241                  ! 
     242                  zn   = ( zn2 * zh + zn1 ) * zh + zn0 
     243                  !                                                
     244                  prd(ji,jj,jk) = (  zn * r1_rau0 - 1._wp  ) * ztm  ! density anomaly (masked) 
    176245               END DO 
    177246            END DO 
    178247         END DO 
    179248         ! 
    180       CASE( 1 )                !==  Linear formulation function of temperature only  ==! 
     249      CASE( 1 )                !==  simplified EOS  ==! 
     250         ! 
    181251         DO jk = 1, jpkm1 
    182             prd(:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk) 
     252            DO jj = 1, jpj 
     253               DO ji = 1, jpi 
     254                  zt  = pts  (ji,jj,jk,jp_tem) - 10._wp 
     255                  zs  = pts  (ji,jj,jk,jp_sal) - 35._wp 
     256                  zh  = pdep (ji,jj,jk) 
     257                  ztm = tmask(ji,jj,jk) 
     258                  ! 
     259                  zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   & 
     260                     &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   & 
     261                     &  - rn_nu * zt * zs 
     262                  !                                  
     263                  prd(ji,jj,jk) = zn * r1_rau0 * ztm                ! density anomaly (masked) 
     264               END DO 
     265            END DO 
    183266         END DO 
    184267         ! 
    185       CASE( 2 )                !==  Linear formulation function of temperature and salinity  ==! 
    186          DO jk = 1, jpkm1 
    187             prd(:,:,jk) = ( rn_beta  * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk) 
    188          END DO 
    189          ! 
    190268      END SELECT 
    191269      ! 
    192270      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos  : ', ovlap=1, kdim=jpk ) 
    193271      ! 
    194       CALL wrk_dealloc( jpi, jpj, jpk, zws ) 
    195       ! 
    196       IF( nn_timing == 1 ) CALL timing_stop('eos') 
     272      IF( nn_timing == 1 )   CALL timing_stop('eos') 
    197273      ! 
    198274   END SUBROUTINE eos_insitu 
    … …  
    208284      !!     namelist parameter nn_eos. 
    209285      !! 
    210       !! ** Method  : 
    211       !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state. 
    212       !!         the in situ density is computed directly as a function of 
    213       !!         potential temperature relative to the surface (the opa t 
    214       !!         variable), salt and pressure (assuming no pressure variation 
    215       !!         along geopotential surfaces, i.e. the pressure p in decibars 
    216       !!         is approximated by the depth in meters. 
    217       !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0 
    218       !!              rhop(t,s)  = rho(t,s,0) 
    219       !!         with pressure                      p        decibars 
    220       !!              potential temperature         t        deg celsius 
    221       !!              salinity                      s        psu 
    222       !!              reference volumic mass        rau0     kg/m**3 
    223       !!              in situ volumic mass          rho      kg/m**3 
    224       !!              in situ density anomalie      prd      no units 
    225       !! 
    226       !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar, 
    227       !!          t = 40 deg celcius, s=40 psu 
    228       !! 
    229       !!      nn_eos = 1 : linear equation of state function of temperature only 
    230       !!              prd(t) = ( rho(t) - rau0 ) / rau0 = 0.028 - rn_alpha * t 
    231       !!              rhop(t,s)  = rho(t,s) 
    232       !! 
    233       !!      nn_eos = 2 : linear equation of state function of temperature and 
    234       !!               salinity 
    235       !!              prd(t,s) = ( rho(t,s) - rau0 ) / rau0 
    236       !!                       = rn_beta * s - rn_alpha * tn - 1. 
    237       !!              rhop(t,s)  = rho(t,s) 
    238       !!      Note that no boundary condition problem occurs in this routine 
    239       !!      as (tn,sn) or (ta,sa) are defined over the whole domain. 
    240       !! 
    241286      !! ** Action  : - prd  , the in situ density (no units) 
    242287      !!              - prhop, the potential volumic mass (Kg/m3) 
    243288      !! 
    244       !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 
    245       !!                Brown and Campana, Mon. Weather Rev., 1978 
    246       !!---------------------------------------------------------------------- 
    247       !! 
     289      !!---------------------------------------------------------------------- 
    248290      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celcius] 
    249291      !                                                                ! 2 : salinity               [psu] 
    … …  
    252294      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep   ! depth                      [m] 
    253295      ! 
    254       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    255       REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! local scalars 
    256       REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0               !   -      - 
    257       REAL(wp), POINTER, DIMENSION(:,:,:) :: zws 
    258       !!---------------------------------------------------------------------- 
    259       ! 
    260       IF( nn_timing == 1 ) CALL timing_start('eos-p') 
    261       ! 
    262       CALL wrk_alloc( jpi, jpj, jpk, zws ) 
     296      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     297      REAL(wp) ::   zt , zh , zs , zsr, ztm   ! local scalars 
     298      REAL(wp) ::   zn , zn0, zn1, zn2        !   -      - 
     299      !!---------------------------------------------------------------------- 
     300      ! 
     301      IF( nn_timing == 1 )   CALL timing_start('eos-p') 
    263302      ! 
    264303      SELECT CASE ( nn_eos ) 
    265304      ! 
    266       CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    267 !CDIR NOVERRCHK 
    268          zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 
     305      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    269306         ! 
    270307         DO jk = 1, jpkm1 
    271308            DO jj = 1, jpj 
    272309               DO ji = 1, jpi 
    273                   zt = pts   (ji,jj,jk,jp_tem) 
    274                   zs = pts   (ji,jj,jk,jp_sal) 
    275                   zh = pdep(ji,jj,jk)        ! depth 
    276                   zsr= zws   (ji,jj,jk)        ! square root salinity 
    277                   ! 
    278                   ! compute volumic mass pure water at atm pressure 
    279                   zr1= ( ( ( ( 6.536332e-9_wp*zt-1.120083e-6_wp )*zt+1.001685e-4_wp )*zt   & 
    280                      &                          -9.095290e-3_wp )*zt+6.793952e-2_wp )*zt+999.842594_wp 
    281                   ! seawater volumic mass atm pressure 
    282                   zr2= ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp ) *zt+7.6438e-5_wp ) *zt   & 
    283                      &                                         -4.0899e-3_wp ) *zt+0.824493_wp 
    284                   zr3= ( -1.6546e-6_wp*zt+1.0227e-4_wp )    *zt-5.72466e-3_wp 
    285                   zr4= 4.8314e-4_wp 
    286                   ! 
    287                   ! potential volumic mass (reference to the surface) 
    288                   zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1 
    289                   ! 
    290                   ! save potential volumic mass 
    291                   prhop(ji,jj,jk) = zrhop * tmask(ji,jj,jk) 
    292                   ! 
    293                   ! add the compression terms 
    294                   ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp 
    295                   zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp 
    296                   zb = zbw + ze * zs 
    297                   ! 
    298                   zd = -2.042967e-2_wp 
    299                   zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp 
    300                   zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt - 4.721788_wp 
    301                   za = ( zd*zsr + zc ) *zs + zaw 
    302                   ! 
    303                   zb1=   (  -0.1909078_wp  *zt+7.390729_wp    ) *zt-55.87545_wp 
    304                   za1= ( (   2.326469e-3_wp*zt+1.553190_wp    ) *zt-65.00517_wp ) *zt + 1044.077_wp 
    305                   zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp ) *zt-30.41638_wp ) *zt + 2098.925_wp ) *zt+190925.6_wp 
    306                   zk0= ( zb1*zsr + za1 )*zs + zkw 
    307                   ! 
    308                   ! masked in situ density anomaly 
    309                   prd(ji,jj,jk) = (  zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  )    & 
    310                      &             - rau0  ) * r1_rau0 * tmask(ji,jj,jk) 
     310                  ! 
     311                  zh  = pdep (ji,jj,jk)                                 ! depth 
     312                  zt  = pts  (ji,jj,jk,jp_tem)                          ! conservative temperature 
     313                  zsr = SQRT( MAX( pts(ji,jj,jk,jp_sal) , 0.1_wp ) )    ! square root salinity 
     314                  ztm = tmask(ji,jj,jk)                                 ! tmask 
     315                  ! 
     316                  zn2  = (   EOS133*zsr  + EOS223*zt + EOS123 )*zsr + ( EOS313*zt + EOS213 )*zt + EOS113 
     317                  ! 
     318                  zn1  = ( ( ( EOS152*zsr   & 
     319                     &   + EOS242*zt + EOS142 )*zsr   & 
     320                     &   + ( EOS332*zt + EOS232 )*zt + EOS132 )*zsr   & 
     321                     &   + ( ( EOS422*zt + EOS322 )*zt + EOS222 )*zt + EOS122 )*zsr   & 
     322                     &   + ( ( ( EOS512*zt + EOS412 )*zt + EOS312 )*zt + EOS212 )*zt + EOS112 
     323                  ! 
     324                  zn0  = ( ( ( ( ( EOS171*zsr   & 
     325                     &   + EOS261*zt + EOS161 )*zsr   & 
     326                     &   + ( EOS351*zt + EOS251 )*zt + EOS151 )*zsr   & 
     327                     &   + ( ( EOS441*zt + EOS341 )*zt + EOS241 )*zt + EOS141 )*zsr   & 
     328                     &   + ( ( ( EOS531*zt + EOS431 )*zt + EOS331 )*zt + EOS231 )*zt + EOS131 )*zsr   & 
     329                     &   + ( ( ( ( EOS621*zt + EOS521 )*zt + EOS421 )*zt + EOS321 )*zt + EOS221 )*zt + EOS121 )*zsr   & 
     330                     &   + ( ( ( ( ( EOS711*zt + EOS611 )*zt + EOS511 )*zt + EOS411 )*zt + EOS311 )*zt + EOS211 )*zt + EOS111 
     331                  ! 
     332                  zn   = ( zn2 * zh + zn1 ) * zh + zn0 
     333                  ! 
     334                  prhop(ji,jj,jk) = zn0 * ztm                           ! potential density referenced at the surface 
     335                  ! 
     336                  prd(ji,jj,jk) = (  zn * r1_rau0 - 1._wp  ) * ztm      ! density anomaly (masked) 
    311337               END DO 
    312338            END DO 
    313339         END DO 
    314340         ! 
    315       CASE( 1 )                !==  Linear formulation = F( temperature )  ==! 
     341      CASE( 1 )                !==  simplified EOS  ==! 
     342         ! 
    316343         DO jk = 1, jpkm1 
    317             prd  (:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) )        * tmask(:,:,jk) 
    318             prhop(:,:,jk) = ( 1.e0_wp   +            prd (:,:,jk)       ) * rau0 * tmask(:,:,jk) 
     344            DO jj = 1, jpj 
     345               DO ji = 1, jpi 
     346                  zt  = pts  (ji,jj,jk,jp_tem) - 10._wp 
     347                  zs  = pts  (ji,jj,jk,jp_sal) - 35._wp 
     348                  zh  = pdep (ji,jj,jk) 
     349                  ztm = tmask(ji,jj,jk) 
     350                  !                                                     ! potential density referenced at the surface 
     351                  zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt   & 
     352                     &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs   & 
     353                     &  - rn_nu * zt * zs 
     354                  prhop(ji,jj,jk) = ( rau0 + zn ) * ztm 
     355                  !                                                     ! density anomaly (masked) 
     356                  zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh 
     357                  prd(ji,jj,jk) = zn * r1_rau0 * ztm 
     358                  ! 
     359               END DO 
     360            END DO 
    319361         END DO 
    320362         ! 
    321       CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==! 
    322          DO jk = 1, jpkm1 
    323             prd  (:,:,jk) = ( rn_beta  * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) )        * tmask(:,:,jk) 
    324             prhop(:,:,jk) = ( 1.e0_wp  + prd (:,:,jk) )                                       * rau0 * tmask(:,:,jk) 
    325          END DO 
    326          ! 
    327363      END SELECT 
    328364      ! 
    329365      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-p: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk ) 
    330366      ! 
    331       CALL wrk_dealloc( jpi, jpj, jpk, zws ) 
    332       ! 
    333       IF( nn_timing == 1 ) CALL timing_stop('eos-p') 
     367      IF( nn_timing == 1 )   CALL timing_stop('eos-p') 
    334368      ! 
    335369   END SUBROUTINE eos_insitu_pot 
    … …  
    344378      !!      defined through the namelist parameter nn_eos. * 2D field case 
    345379      !! 
    346       !! ** Method : 
    347       !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state. 
    348       !!         the in situ density is computed directly as a function of 
    349       !!         potential temperature relative to the surface (the opa t 
    350       !!         variable), salt and pressure (assuming no pressure variation 
    351       !!         along geopotential surfaces, i.e. the pressure p in decibars 
    352       !!         is approximated by the depth in meters. 
    353       !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0 
    354       !!         with pressure                      p        decibars 
    355       !!              potential temperature         t        deg celsius 
    356       !!              salinity                      s        psu 
    357       !!              reference volumic mass        rau0     kg/m**3 
    358       !!              in situ volumic mass          rho      kg/m**3 
    359       !!              in situ density anomalie      prd      no units 
    360       !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar, 
    361       !!          t = 40 deg celcius, s=40 psu 
    362       !!      nn_eos = 1 : linear equation of state function of temperature only 
    363       !!              prd(t) = 0.0285 - rn_alpha * t 
    364       !!      nn_eos = 2 : linear equation of state function of temperature and 
    365       !!               salinity 
    366       !!              prd(t,s) = rn_beta * s - rn_alpha * tn - 1. 
    367       !!      Note that no boundary condition problem occurs in this routine 
    368       !!      as pts are defined over the whole domain. 
    369       !! 
    370       !! ** Action  : - prd , the in situ density (no units) 
    371       !! 
    372       !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 
    373       !!---------------------------------------------------------------------- 
    374       !! 
     380      !! ** Action  : - prd , the in situ density (no units) (unmasked) 
     381      !! 
     382      !!---------------------------------------------------------------------- 
    375383      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
    376384      !                                                           ! 2 : salinity               [psu] 
    377       REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                  [m] 
     385      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                      [m] 
    378386      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(  out) ::   prd   ! in situ density 
    379       !! 
    380       INTEGER  ::   ji, jj                    ! dummy loop indices 
    381       REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! temporary scalars 
    382       REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zmask        !    -         - 
    383       REAL(wp), POINTER, DIMENSION(:,:) :: zws 
    384       !!---------------------------------------------------------------------- 
    385       ! 
    386       IF( nn_timing == 1 ) CALL timing_start('eos2d') 
    387       ! 
    388       CALL wrk_alloc( jpi, jpj, zws ) 
    389       ! 
    390  
     387      ! 
     388      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     389      REAL(wp) ::   zt , zh , zs , zsr, ztm   ! local scalars 
     390      REAL(wp) ::   zn , zn0, zn1, zn2        !   -      - 
     391      !!---------------------------------------------------------------------- 
     392      ! 
     393      IF( nn_timing == 1 )   CALL timing_start('eos2d') 
     394      ! 
    391395      prd(:,:) = 0._wp 
    392  
     396      ! 
    393397      SELECT CASE( nn_eos ) 
    394398      ! 
    395       CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    396       ! 
    397 !CDIR NOVERRCHK 
     399      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
     400         ! 
    398401         DO jj = 1, jpjm1 
    399 !CDIR NOVERRCHK 
    400402            DO ji = 1, fs_jpim1   ! vector opt. 
    401                zws(ji,jj) = SQRT( ABS( pts(ji,jj,jp_sal) ) ) 
     403               ! 
     404               zt    = pts  (ji,jj,jp_tem)            ! interpolated T 
     405               zsr = SQRT( MAX( pts(ji,jj,jp_sal) , 0.1_wp ) )     ! square root salinity 
     406               zh    = pdep (ji,jj)            ! depth at the partial step level 
     407               ! 
     408               ! 
     409               zn2  = (   EOS133*zsr  + EOS223*zt + EOS123 )*zsr + ( EOS313*zt + EOS213 )*zt + EOS113 
     410               ! 
     411               zn1  = ( ( ( EOS152*zsr   & 
     412                  &   + EOS242*zt + EOS142 )*zsr   & 
     413                  &   + ( EOS332*zt + EOS232 )*zt + EOS132 )*zsr   & 
     414                  &   + ( ( EOS422*zt + EOS322 )*zt + EOS222 )*zt + EOS122 )*zsr   & 
     415                  &   + ( ( ( EOS512*zt + EOS412 )*zt + EOS312 )*zt + EOS212 )*zt + EOS112 
     416               ! 
     417               zn0  = ( ( ( ( ( EOS171*zsr   & 
     418                  &   + EOS261*zt + EOS161 )*zsr   & 
     419                  &   + ( EOS351*zt + EOS251 )*zt + EOS151 )*zsr   & 
     420                  &   + ( ( EOS441*zt + EOS341 )*zt + EOS241 )*zt + EOS141 )*zsr   & 
     421                  &   + ( ( ( EOS531*zt + EOS431 )*zt + EOS331 )*zt + EOS231 )*zt + EOS131 )*zsr   & 
     422                  &   + ( ( ( ( EOS621*zt + EOS521 )*zt + EOS421 )*zt + EOS321 )*zt + EOS221 )*zt + EOS121 )*zsr   & 
     423                  &   + ( ( ( ( ( EOS711*zt + EOS611 )*zt + EOS511 )*zt + EOS411 )*zt + EOS311 )*zt + EOS211 )*zt + EOS111 
     424               ! 
     425               zn   = ( zn2 * zh + zn1 ) * zh + zn0 
     426               ! 
     427               prd(ji,jj) = zn * r1_rau0 - 1._wp               ! unmasked in situ density anomaly 
     428               ! 
    402429            END DO 
    403430         END DO 
     431         ! 
     432      CASE( 1 )                !==  simplified EOS  ==! 
     433         ! 
    404434         DO jj = 1, jpjm1 
    405435            DO ji = 1, fs_jpim1   ! vector opt. 
    406                zmask = tmask(ji,jj,1)          ! land/sea bottom mask = surf. mask 
    407                zt    = pts  (ji,jj,jp_tem)            ! interpolated T 
    408                zs    = pts  (ji,jj,jp_sal)            ! interpolated S 
    409                zsr   = zws  (ji,jj)            ! square root of interpolated S 
    410                zh    = pdep (ji,jj)            ! depth at the partial step level 
    411                ! 
    412                ! compute volumic mass pure water at atm pressure 
    413                zr1 = ( ( ( ( 6.536332e-9_wp*zt-1.120083e-6_wp )*zt+1.001685e-4_wp )*zt   & 
    414                   &                        -9.095290e-3_wp )*zt+6.793952e-2_wp )*zt+999.842594_wp 
    415                ! seawater volumic mass atm pressure 
    416                zr2 = ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp )*zt+7.6438e-5_wp ) *zt   & 
    417                   &                                   -4.0899e-3_wp ) *zt+0.824493_wp 
    418                zr3 = ( -1.6546e-6_wp*zt+1.0227e-4_wp ) *zt-5.72466e-3_wp 
    419                zr4 = 4.8314e-4_wp 
    420                ! 
    421                ! potential volumic mass (reference to the surface) 
    422                zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1 
    423                ! 
    424                ! add the compression terms 
    425                ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp 
    426                zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp 
    427                zb = zbw + ze * zs 
    428                ! 
    429                zd =    -2.042967e-2_wp 
    430                zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp 
    431                zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt -4.721788_wp 
    432                za = ( zd*zsr + zc ) *zs + zaw 
    433                ! 
    434                zb1=     (-0.1909078_wp  *zt+7.390729_wp      ) *zt-55.87545_wp 
    435                za1=   ( ( 2.326469e-3_wp*zt+1.553190_wp      ) *zt-65.00517_wp ) *zt+1044.077_wp 
    436                zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp   ) *zt-30.41638_wp ) *zt   & 
    437                   &                             +2098.925_wp ) *zt+190925.6_wp 
    438                zk0= ( zb1*zsr + za1 )*zs + zkw 
    439                ! 
    440                ! masked in situ density anomaly 
    441                prd(ji,jj) = ( zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  ) - rau0 ) / rau0 * zmask 
     436               ! 
     437               zt    = pts  (ji,jj,jp_tem)  - 10._wp 
     438               zs    = pts  (ji,jj,jp_sal)  - 35._wp 
     439               zh    = pdep (ji,jj)                         ! depth at the partial step level 
     440               ! 
     441               zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   & 
     442                  &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   & 
     443                  &  - rn_nu * zt * zs 
     444               ! 
     445               prd(ji,jj) = zn * r1_rau0               ! unmasked in situ density anomaly 
     446               ! 
    442447            END DO 
    443448         END DO 
    444449         ! 
    445       CASE( 1 )                !==  Linear formulation = F( temperature )  ==! 
    446          DO jj = 1, jpjm1 
    447             DO ji = 1, fs_jpim1   ! vector opt. 
    448                prd(ji,jj) = ( 0.0285_wp - rn_alpha * pts(ji,jj,jp_tem) ) * tmask(ji,jj,1) 
    449             END DO 
    450          END DO 
    451          ! 
    452       CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==! 
    453          DO jj = 1, jpjm1 
    454             DO ji = 1, fs_jpim1   ! vector opt. 
    455                prd(ji,jj) = ( rn_beta * pts(ji,jj,jp_sal) - rn_alpha * pts(ji,jj,jp_tem) ) * tmask(ji,jj,1) 
    456             END DO 
    457          END DO 
    458          ! 
    459450      END SELECT 
    460  
     451      ! 
    461452      IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' ) 
    462453      ! 
    463       CALL wrk_dealloc( jpi, jpj, zws ) 
    464       ! 
    465       IF( nn_timing == 1 ) CALL timing_stop('eos2d') 
     454      IF( nn_timing == 1 )   CALL timing_stop('eos2d') 
    466455      ! 
    467456   END SUBROUTINE eos_insitu_2d 
    468457 
    469458 
    470    SUBROUTINE eos_bn2( pts, pn2 ) 
    471       !!---------------------------------------------------------------------- 
    472       !!                  ***  ROUTINE eos_bn2  *** 
    473       !! 
    474       !! ** Purpose :   Compute the local Brunt-Vaisala frequency at the time- 
    475       !!      step of the input arguments 
    476       !! 
    477       !! ** Method : 
    478       !!       * nn_eos = 0  : UNESCO sea water properties 
    479       !!         The brunt-vaisala frequency is computed using the polynomial 
    480       !!      polynomial expression of McDougall (1987): 
    481       !!            N^2 = grav * beta * ( alpha/beta*dk[ t ] - dk[ s ] )/e3w 
    482       !!      If lk_zdfddm=T, the heat/salt buoyancy flux ratio Rrau is 
    483       !!      computed and used in zdfddm module : 
    484       !!              Rrau = alpha/beta * ( dk[ t ] / dk[ s ] ) 
     459   SUBROUTINE rab_3d( pts, pab ) 
     460      !!---------------------------------------------------------------------- 
     461      !!                 ***  ROUTINE rab_3d  *** 
     462      !! 
     463      !! ** Purpose :   Calculates thermal/haline expansion ratio at T-points 
     464      !! 
     465      !! ** Method  :   calculates alpha / beta at T-points 
     466      !!       * nn_eos = 0  : polynomial approximation of McDougall (1987) 
     467      !!                       The alpha/beta is returned as 4-D array pab using the exact expression 
     468      !!                       based on the JM95 equation of state. 
    485469      !!       * nn_eos = 1  : linear equation of state (temperature only) 
    486       !!            N^2 = grav * rn_alpha * dk[ t ]/e3w 
     470      !!                       We return alpha and beta=0 
    487471      !!       * nn_eos = 2  : linear equation of state (temperature & salinity) 
    488       !!            N^2 = grav * (rn_alpha * dk[ t ] - rn_beta * dk[ s ] ) / e3w 
    489       !!      The use of potential density to compute N^2 introduces e r r o r 
    490       !!      in the sign of N^2 at great depths. We recommand the use of 
    491       !!      nn_eos = 0, except for academical studies. 
    492       !!        Macro-tasked on horizontal slab (jk-loop) 
    493       !!      N.B. N^2 is set to zero at the first level (JK=1) in inidtr 
    494       !!      and is never used at this level. 
    495       !! 
    496       !! ** Action  : - pn2 : the brunt-vaisala frequency 
    497       !! 
    498       !! References :   McDougall, J. Phys. Oceanogr., 17, 1950-1964, 1987. 
    499       !!---------------------------------------------------------------------- 
    500       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
    501       !                                                               ! 2 : salinity               [psu] 
    502       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pn2   ! Brunt-Vaisala frequency    [s-1] 
    503       !! 
    504       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    505       REAL(wp) ::   zgde3w, zt, zs, zh, zalbet, zbeta   ! local scalars 
    506 #if defined key_zdfddm 
    507       REAL(wp) ::   zds   ! local scalars 
    508 #endif 
    509       !!---------------------------------------------------------------------- 
    510  
    511       ! 
    512       IF( nn_timing == 1 ) CALL timing_start('bn2') 
    513       ! 
    514       ! pn2 : interior points only (2=< jk =< jpkm1 ) 
    515       ! -------------------------- 
    516       ! 
    517       SELECT CASE( nn_eos ) 
    518       ! 
    519       CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    520          DO jk = 2, jpkm1 
     472      !!                       We return alpha0 and beta0 
     473      !! 
     474      !! ** Action  : - pab     : thermal/haline expansion ratio at T-points 
     475      !!---------------------------------------------------------------------- 
     476      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! pot. temperature & salinity 
     477      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pab   ! thermal/haline expansion ratio 
     478      ! 
     479      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     480      REAL(wp) ::   zt , zh , zs , zsr, ztm   ! local scalars 
     481      REAL(wp) ::   zn , zn0, zn1, zn2        !   -      - 
     482      !!---------------------------------------------------------------------- 
     483      ! 
     484      IF( nn_timing == 1 )   CALL timing_start('rab_3d') 
     485      ! 
     486      SELECT CASE ( nn_eos ) 
     487      ! 
     488      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
     489         ! 
     490         DO jk = 1, jpkm1 
    521491            DO jj = 1, jpj 
    522492               DO ji = 1, jpi 
    523                   zgde3w = grav / fse3w(ji,jj,jk) 
    524                   zt = 0.5 * ( pts(ji,jj,jk,jp_tem) + pts(ji,jj,jk-1,jp_tem) )         ! potential temperature at w-pt 
    525                   zs = 0.5 * ( pts(ji,jj,jk,jp_sal) + pts(ji,jj,jk-1,jp_sal) ) - 35.0  ! salinity anomaly (s-35) at w-pt 
    526                   zh = fsdepw(ji,jj,jk)                                                ! depth in meters  at w-point 
    527                   ! 
    528                   zalbet = ( ( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt   &   ! ratio alpha/beta 
    529                      &                                  - 0.203814e-03_wp ) * zt   & 
    530                      &                                  + 0.170907e-01_wp ) * zt   & 
    531                      &   +         0.665157e-01_wp                                 & 
    532                      &   +     ( - 0.678662e-05_wp * zs                            & 
    533                      &           - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs   & 
    534                      &   +   ( ( - 0.302285e-13_wp * zh                            & 
    535                      &           - 0.251520e-11_wp * zs                            & 
    536                      &           + 0.512857e-12_wp * zt * zt              ) * zh   & 
    537                      &           - 0.164759e-06_wp * zs                            & 
    538                      &        +(   0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt   & 
    539                      &                                  + 0.380374e-04_wp ) * zh 
     493                  ! 
     494                  zh  = fsdept(ji,jj,jk)                        ! depth 
     495                  zt  = pts   (ji,jj,jk,jp_tem)                 ! conservative temperature 
     496                  zsr = SQRT( MAX( pts(ji,jj,jk,jp_sal) , 0.1_wp ) )     ! square root salinity 
     497                  ztm = tmask(ji,jj,jk)                         ! tmask 
     498                  ! 
     499                  zn2 = ALP123*zsr + ALP213*zt + ALP113 
     500                  ! 
     501                  zn1 = ( ( ALP142*zsr   & 
     502                     &   + ALP232*zt + ALP132 )*zsr   & 
     503                     &   + ( ALP322*zt + ALP222 )*zt + ALP122 )*zsr   & 
     504                     &   + ( ( ALP412*zt + ALP312 )*zt + ALP212 )*zt + ALP112 
     505                  ! 
     506                  zn0 = ( ( ( ( ALP161*zsr   & 
     507                     &   + ALP251*zt + ALP151 )*zsr   & 
     508                     &   + ( ALP341*zt + ALP241 )*zt + ALP141 )*zsr   & 
     509                     &   + ( ( ALP431*zt + ALP331 )*zt + ALP231 )*zt + ALP131 )*zsr   & 
     510                     &   + ( ( ( ALP521*zt + ALP421 )*zt + ALP321 )*zt + ALP221 )*zt + ALP121 )*zsr   & 
     511                     &   + ( ( ( ( ALP611*zt + ALP511 )*zt + ALP411 )*zt + ALP311 )*zt + ALP211 )*zt + ALP111 
    540512                     ! 
    541                   zbeta  = ( ( -0.415613e-09_wp * zt + 0.555579e-07_wp ) * zt      &   ! beta 
    542                      &                               - 0.301985e-05_wp ) * zt      & 
    543                      &   +       0.785567e-03_wp                                   & 
    544                      &   + (     0.515032e-08_wp * zs                              & 
    545                      &         + 0.788212e-08_wp * zt - 0.356603e-06_wp ) * zs     & 
    546                      &   + ( (   0.121551e-17_wp * zh                              & 
    547                      &         - 0.602281e-15_wp * zs                              & 
    548                      &         - 0.175379e-14_wp * zt + 0.176621e-12_wp ) * zh     & 
    549                      &                                + 0.408195e-10_wp   * zs     & 
    550                      &     + ( - 0.213127e-11_wp * zt + 0.192867e-09_wp ) * zt     & 
    551                      &                                - 0.121555e-07_wp ) * zh 
     513                  zn   = ( zn2 * zh + zn1 ) * zh + zn0 
     514                  ! 
     515                  pab(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm 
     516                  ! 
     517                  ! 
     518                  zn2 = BET123*zsr + BET213*zt + BET113 
     519                  ! 
     520                  zn1 = ( ( BET142*zsr   & 
     521                     &   + BET232*zt + BET132 )*zsr   & 
     522                     &   + ( BET322*zt + BET222 )*zt + BET122 )*zsr   & 
     523                     &   + ( ( BET412*zt + BET312 )*zt + BET212 )*zt + BET112 
    552524                     ! 
    553                   pn2(ji,jj,jk) = zgde3w * zbeta * tmask(ji,jj,jk)           &   ! N^2 
    554                      &          * ( zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )   & 
    555                      &                     - ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) ) 
    556 #if defined key_zdfddm 
    557                   !                                                         !!bug **** caution a traiter zds=dk[S]= 0 !!!! 
    558                   zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )                    ! Rrau = (alpha / beta) (dk[t] / dk[s]) 
    559                   IF ( ABS( zds) <= 1.e-20_wp ) zds = 1.e-20_wp 
    560                   rrau(ji,jj,jk) = zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) / zds 
    561 #endif 
     525                  zn0 = ( ( ( ( BET161*zsr   & 
     526                     &   + BET251*zt + BET151 )*zsr   & 
     527                     &   + ( BET341*zt + BET241 )*zt + BET141 )*zsr   & 
     528                     &   + ( ( BET431*zt + BET331 )*zt + BET231 )*zt + BET131 )*zsr   & 
     529                     &   + ( ( ( BET521*zt + BET421 )*zt + BET321 )*zt + BET221 )*zt + BET121 )*zsr   & 
     530                     &   + ( ( ( ( BET611*zt + BET511 )*zt + BET411 )*zt + BET311 )*zt + BET211 )*zt + BET111 
     531                     ! 
     532                  zn  = ( zn2 * zh + zn1 ) * zh + zn0 
     533                  ! 
     534                  pab(ji,jj,jk,jp_sal) = zn / zsr * r1_rau0 * ztm 
     535                  ! 
    562536               END DO 
    563537            END DO 
    564538         END DO 
    565539         ! 
    566       CASE( 1 )                !==  Linear formulation = F( temperature )  ==! 
    567          DO jk = 2, jpkm1 
    568             pn2(:,:,jk) = grav * rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk) 
    569          END DO 
    570          ! 
    571       CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==! 
    572          DO jk = 2, jpkm1 
    573             pn2(:,:,jk) = grav * (  rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) )      & 
    574                &                  - rn_beta  * ( pts(:,:,jk-1,jp_sal) - pts(:,:,jk,jp_sal) )  )   & 
    575                &               / fse3w(:,:,jk) * tmask(:,:,jk) 
    576          END DO 
    577 #if defined key_zdfddm 
    578          DO jk = 2, jpkm1                                 ! Rrau = (alpha / beta) (dk[t] / dk[s]) 
     540      CASE( 1 )                  !==  simplified EOS  ==! 
     541         ! 
     542         DO jk = 1, jpkm1 
    579543            DO jj = 1, jpj 
    580544               DO ji = 1, jpi 
    581                   zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) 
    582                   IF ( ABS( zds ) <= 1.e-20_wp ) zds = 1.e-20_wp 
    583                   rrau(ji,jj,jk) = ralpbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) / zds 
     545                  zt  = pts (ji,jj,jk,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0) 
     546                  zs  = pts (ji,jj,jk,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0) 
     547                  zh  = fsdept(ji,jj,jk)                 ! depth in meters at t-point 
     548                  ztm = tmask(ji,jj,jk)                  ! land/sea bottom mask = surf. mask 
     549                  !                                      ! alpha 
     550                  pab(ji,jj,jk,jp_tem) = ( rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs ) * r1_rau0 * ztm   ! alpha 
     551                  pab(ji,jj,jk,jp_sal) = ( rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt ) * r1_rau0 * ztm   ! beta                            ! beta 
    584552               END DO 
    585553            END DO 
    586554         END DO 
    587 #endif 
    588       END SELECT 
    589  
    590       IF(ln_ctl)   CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2  : ', ovlap=1, kdim=jpk ) 
    591 #if defined key_zdfddm 
    592       IF(ln_ctl)   CALL prt_ctl( tab3d_1=rrau, clinfo1=' rrau : ', ovlap=1, kdim=jpk ) 
    593 #endif 
    594       ! 
    595       IF( nn_timing == 1 ) CALL timing_stop('bn2') 
    596       ! 
    597    END SUBROUTINE eos_bn2 
    598  
    599  
    600    SUBROUTINE eos_alpbet( pts, palpbet, beta0 ) 
    601       !!---------------------------------------------------------------------- 
    602       !!                 ***  ROUTINE eos_alpbet  *** 
    603       !! 
    604       !! ** Purpose :   Calculates the in situ thermal/haline expansion ratio at T-points 
    605       !! 
    606       !! ** Method  :   calculates alpha / beta ratio at T-points 
    607       !!       * nn_eos = 0  : UNESCO sea water properties 
    608       !!                       The alpha/beta ratio is returned as 3-D array palpbet using the polynomial 
    609       !!                       polynomial expression of McDougall (1987). 
    610       !!                       Scalar beta0 is returned = 1. 
    611       !!       * nn_eos = 1  : linear equation of state (temperature only) 
    612       !!                       The ratio is undefined, so we return alpha as palpbet 
    613       !!                       Scalar beta0 is returned = 0. 
    614       !!       * nn_eos = 2  : linear equation of state (temperature & salinity) 
    615       !!                       The alpha/beta ratio is returned as ralpbet 
    616       !!                       Scalar beta0 is returned = 1. 
    617       !! 
    618       !! ** Action  : - palpbet : thermal/haline expansion ratio at T-points 
    619       !!            :   beta0   : 1. or 0. 
    620       !!---------------------------------------------------------------------- 
    621       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts       ! pot. temperature & salinity 
    622       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   palpbet   ! thermal/haline expansion ratio 
    623       REAL(wp),                              INTENT(  out) ::   beta0     ! set = 1 except with case 1 eos, rho=rho(T) 
    624       !! 
    625       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    626       REAL(wp) ::   zt, zs, zh   ! local scalars 
    627       !!---------------------------------------------------------------------- 
    628       ! 
    629       IF( nn_timing == 1 ) CALL timing_start('eos_alpbet') 
    630       ! 
    631       SELECT CASE ( nn_eos ) 
    632       ! 
    633       CASE ( 0 )               ! Jackett and McDougall (1994) formulation 
    634          DO jk = 1, jpk 
    635             DO jj = 1, jpj 
    636                DO ji = 1, jpi 
    637                   zt = pts(ji,jj,jk,jp_tem)           ! potential temperature 
    638                   zs = pts(ji,jj,jk,jp_sal) - 35._wp  ! salinity anomaly (s-35) 
    639                   zh = fsdept(ji,jj,jk)               ! depth in meters 
    640                   ! 
    641                   palpbet(ji,jj,jk) =                                              & 
    642                      &     ( ( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt   & 
    643                      &                                  - 0.203814e-03_wp ) * zt   & 
    644                      &                                  + 0.170907e-01_wp ) * zt   & 
    645                      &   + 0.665157e-01_wp                                         & 
    646                      &   +     ( - 0.678662e-05_wp * zs                            & 
    647                      &           - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs   & 
    648                      &   +   ( ( - 0.302285e-13_wp * zh                            & 
    649                      &           - 0.251520e-11_wp * zs                            & 
    650                      &           + 0.512857e-12_wp * zt * zt              ) * zh   & 
    651                      &           - 0.164759e-06_wp * zs                            & 
    652                      &        +(   0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt   & 
    653                      &                                  + 0.380374e-04_wp ) * zh 
    654                END DO 
    655             END DO 
    656          END DO 
    657          beta0 = 1._wp 
    658          ! 
    659       CASE ( 1 )              !==  Linear formulation = F( temperature )  ==! 
    660          palpbet(:,:,:) = rn_alpha 
    661          beta0 = 0._wp 
    662          ! 
    663       CASE ( 2 )              !==  Linear formulation = F( temperature , salinity )  ==! 
    664          palpbet(:,:,:) = ralpbet 
    665          beta0 = 1._wp 
    666555         ! 
    667556      CASE DEFAULT 
    … …  
    672561      END SELECT 
    673562      ! 
    674       IF( nn_timing == 1 ) CALL timing_stop('eos_alpbet') 
    675       ! 
    676    END SUBROUTINE eos_alpbet 
    677  
    678  
    679    FUNCTION tfreez( psal, pdep ) RESULT( ptf ) 
     563      IF( nn_timing == 1 )   CALL timing_stop('rab_3d') 
     564      ! 
     565   END SUBROUTINE rab_3d 
     566 
     567 
     568   SUBROUTINE rab_2d( pts, pdep, pab ) 
     569      !!---------------------------------------------------------------------- 
     570      !!                 ***  ROUTINE rab_2d  *** 
     571      !! 
     572      !! ** Purpose :   Calculates thermal/haline expansion ratio for a 2d field (unmasked) 
     573      !! 
     574      !! ** Action  : - pab     : thermal/haline expansion ratio at T-points 
     575      !!---------------------------------------------------------------------- 
     576      REAL(wp), DIMENSION(jpi,jpj,jpts)    , INTENT(in   ) ::   pts    ! pot. temperature & salinity 
     577      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(in   ) ::   pdep   ! depth                  [m] 
     578      REAL(wp), DIMENSION(jpi,jpj,jpts)    , INTENT(  out) ::   pab    ! thermal/haline expansion ratio 
     579      ! 
     580      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     581      REAL(wp) ::   zt , zh , zs , zsr, ztm   ! local scalars 
     582      REAL(wp) ::   zn , zn0, zn1, zn2        !   -      - 
     583      !!---------------------------------------------------------------------- 
     584      ! 
     585      IF( nn_timing == 1 ) CALL timing_start('rab_2d') 
     586      ! 
     587      pab(:,:,:) = 0._wp 
     588      ! 
     589      SELECT CASE ( nn_eos ) 
     590      ! 
     591      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
     592         ! 
     593         DO jj = 1, jpjm1 
     594            DO ji = 1, fs_jpim1   ! vector opt. 
     595               ! 
     596               zt    = pts  (ji,jj,jp_tem)            ! interpolated T 
     597               zsr = SQRT( MAX( pts(ji,jj,jp_sal) , 0.1_wp ) )     ! square root salinity 
     598               zh    = pdep (ji,jj)                   ! depth at the partial step level 
     599               ! 
     600               ! 
     601               zn2 = ALP123*zsr + ALP213*zt + ALP113 
     602               ! 
     603               zn1 = ( ( ALP142*zsr   & 
     604                  &   + ALP232*zt + ALP132 )*zsr   & 
     605                  &   + ( ALP322*zt + ALP222 )*zt + ALP122 )*zsr   & 
     606                  &   + ( ( ALP412*zt + ALP312 )*zt + ALP212 )*zt + ALP112 
     607               ! 
     608               zn0 = ( ( ( ( ALP161*zsr   & 
     609                  &   + ALP251*zt + ALP151 )*zsr   & 
     610                  &   + ( ALP341*zt + ALP241 )*zt + ALP141 )*zsr   & 
     611                  &   + ( ( ALP431*zt + ALP331 )*zt + ALP231 )*zt + ALP131 )*zsr   & 
     612                  &   + ( ( ( ALP521*zt + ALP421 )*zt + ALP321 )*zt + ALP221 )*zt + ALP121 )*zsr   & 
     613                  &   + ( ( ( ( ALP611*zt + ALP511 )*zt + ALP411 )*zt + ALP311 )*zt + ALP211 )*zt + ALP111 
     614               ! 
     615               zn   = ( zn2 * zh + zn1 ) * zh + zn0 
     616               ! 
     617               pab(ji,jj,jp_tem) = zn * r1_rau0 
     618               ! 
     619               ! 
     620               zn2 = BET123*zsr + BET213*zt + BET113 
     621               ! 
     622               zn1 = ( ( BET142*zsr   & 
     623                  &   + BET232*zt + BET132 )*zsr   & 
     624                  &   + ( BET322*zt + BET222 )*zt + BET122 )*zsr   & 
     625                  &   + ( ( BET412*zt + BET312 )*zt + BET212 )*zt + BET112 
     626               ! 
     627               zn0 = ( ( ( ( BET161*zsr   & 
     628                  &   + BET251*zt + BET151 )*zsr   & 
     629                  &   + ( BET341*zt + BET241 )*zt + BET141 )*zsr   & 
     630                  &   + ( ( BET431*zt + BET331 )*zt + BET231 )*zt + BET131 )*zsr   & 
     631                  &   + ( ( ( BET521*zt + BET421 )*zt + BET321 )*zt + BET221 )*zt + BET121 )*zsr   & 
     632                  &   + ( ( ( ( BET611*zt + BET511 )*zt + BET411 )*zt + BET311 )*zt + BET211 )*zt + BET111 
     633               ! 
     634               zn   = ( zn2 * zh + zn1 ) * zh + zn0 
     635               ! 
     636               pab(ji,jj,jp_sal) = zn / zsr * r1_rau0 
     637               ! 
     638               ! 
     639            END DO 
     640         END DO 
     641         ! 
     642      CASE( 1 )                  !==  simplified EOS  ==! 
     643         ! 
     644         DO jj = 1, jpjm1 
     645            DO ji = 1, fs_jpim1   ! vector opt. 
     646               ! 
     647               zt    = pts  (ji,jj,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0) 
     648               zs    = pts  (ji,jj,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0) 
     649               zh    = pdep (ji,jj)                   ! depth at the partial step level 
     650               ! 
     651               !                                    ! alpha 
     652               pab(ji,jj,jp_tem) = ( rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs ) * r1_rau0   ! alpha 
     653               pab(ji,jj,jp_sal) = ( rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt ) * r1_rau0   ! beta                            ! beta 
     654               ! 
     655            END DO 
     656         END DO 
     657         ! 
     658      CASE DEFAULT 
     659         IF(lwp) WRITE(numout,cform_err) 
     660         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos 
     661         nstop = nstop + 1 
     662         ! 
     663      END SELECT 
     664      ! 
     665      IF( nn_timing == 1 )   CALL timing_stop('rab_2d') 
     666      ! 
     667   END SUBROUTINE rab_2d 
     668 
     669 
     670   SUBROUTINE bn2( pts, pab, pn2 ) 
     671      !!---------------------------------------------------------------------- 
     672      !!                  ***  ROUTINE bn2  *** 
     673      !! 
     674      !! ** Purpose :   Compute the local Brunt-Vaisala frequency at the  
     675      !!                time-step of the input arguments 
     676      !! 
     677      !! ** Method  :   pn2 = grav * (alpha dk[T] + beta dk[S] ) / e3w 
     678      !!      where alpha and beta are given in pab, and computed on T-points. 
     679      !!      N.B. N^2 is set one for all to zero at jk=1 in istate module. 
     680      !! 
     681      !! ** Action  :   pn2 : square of the brunt-vaisala frequency at w-point  
     682      !! 
     683      !! References :   Vallis, Atmospheric and Oceanic Fluid Dynamics, 2006 
     684      !!                Jackett and McDougall, J. Atmos. Ocean. Tech., 1995 
     685      !!                McDougall, J. Phys. Oceano., 1987 
     686      !!---------------------------------------------------------------------- 
     687      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pts   ! pot. temperature and salinity   [Celcius,psu] 
     688      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pab   ! thermal/haline expansion coef.  [Celcius-1,psu-1] 
     689      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::  pn2   ! Brunt-Vaisala frequency squared [1/s^2] 
     690      ! 
     691      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
     692      REAL(wp) ::   zaw, zbw, zrw   ! local scalars 
     693      !!---------------------------------------------------------------------- 
     694      ! 
     695      IF( nn_timing == 1 ) CALL timing_start('bn2') 
     696      ! 
     697      DO jk = 2, jpkm1           ! interior points only (2=< jk =< jpkm1 ) 
     698         DO jj = 1, jpj          ! surface and bottom value set to zero one for all in istate.F90 
     699            DO ji = 1, jpi 
     700               zrw =   ( fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk) )   & 
     701                  &  / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) )  
     702               ! 
     703               zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw  
     704               zbw = pab(ji,jj,jk,jp_sal) * (1. - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw 
     705               ! 
     706               pn2(ji,jj,jk) = grav * (  zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )     & 
     707                  &                    - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )  )  & 
     708                  &            / fse3w(ji,jj,jk) * tmask(ji,jj,jk) 
     709            END DO 
     710         END DO 
     711      END DO 
     712      ! 
     713      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2  : ', ovlap=1, kdim=jpk ) 
     714      ! 
     715      IF( nn_timing == 1 )   CALL timing_stop('bn2') 
     716      ! 
     717   END SUBROUTINE bn2 
     718 
     719 
     720   FUNCTION eos_pt_from_ct( ctmp, psal ) RESULT( ptmp ) 
     721      !!---------------------------------------------------------------------- 
     722      !!                 ***  ROUTINE eos_pt_from_ct  *** 
     723      !! 
     724      !! ** Purpose :   Compute pot.temp. from cons. temp. [Celcius] 
     725      !! 
     726      !! ** Method  :   rational approximation (5/3th order) of TEOS-10 algorithm 
     727      !!       checkvalue: pt=20.0239165517474 Celsius for s=35.7psu, t=20degC 
     728      !! 
     729      !! Reference  :   TEOS-10, UNESCO 
     730      !!                Rational fit, see Roquet (2013) 
     731      !!---------------------------------------------------------------------- 
     732      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ctmp   ! Cons. Temp [Celcius] 
     733      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity   [psu] 
     734      ! Leave result array automatic rather than making explicitly allocated 
     735      REAL(wp), DIMENSION(jpi,jpj) ::   ptmp   ! potential temperature [Celcius] 
     736      ! 
     737      INTEGER  ::   ji, jj               ! dummy loop indices 
     738      REAL(wp) ::   zt , zsr, ztm        ! local scalars 
     739      REAL(wp) ::   zn , zd              ! local scalars 
     740      !!---------------------------------------------------------------------- 
     741      ! 
     742      IF ( nn_timing == 1 )   CALL timing_start('eos_pt_from_ct') 
     743      ! 
     744      DO jj = 1, jpj 
     745          DO ji = 1, jpi 
     746              zt  = ctmp   (ji,jj) 
     747              zsr = SQRT( MAX( psal(ji,jj) , 0.1_wp ) )              ! square root salinity 
     748              ztm = tmask(ji,jj,1)                          ! tmask 
     749              ! 
     750              zn = ( ( ( ( -1.960202285944569e-04_wp*zsr    & 
     751                  &    - 6.698743070819174e-05_wp*zt + 4.456449354084589e-03_wp )*zsr    & 
     752                  &    + ( 1.424140773841990e-05_wp*zt - 1.961306826357777e-04_wp )*zt & 
     753                  &        - 1.535458707717669e-02_wp )*zsr    & 
     754                  &    + ( ( 2.814957335530553e-06_wp*zt + 1.534287192323960e-04_wp )*zt & 
     755                  &        + 2.701363554476190e-02_wp )*zt - 1.869037589289360e-02_wp )*zsr    & 
     756                  &    + ( ( ( -1.646758381788031e-08_wp*zt + 4.568111226988701e-07_wp )*zt & 
     757                  &        - 7.853794523448087e-04_wp )*zt - 8.000001510387515e-03_wp )*zt & 
     758                  &        - 1.132820958753811e-03_wp )*zsr    & 
     759                  &    + ( ( ( ( -3.885399051933490e-09_wp*zt + 6.608853649947305e-07_wp )*zt & 
     760                  &        - 1.507746029483144e-04_wp )*zt - 3.457378558412451e-03_wp )*zt & 
     761                  &        - 7.616362942562558e-01_wp )*zt - 2.067472332529282e-01_wp 
     762              ! 
     763              zd = ( ( 8.421053090759674e-04_wp*zsr    & 
     764                  &    - 8.267668312138185e-04_wp*zt - 6.920238162292441e-02_wp )*zsr    & 
     765                  &    + ( 5.063023899703211e-05_wp*zt + 1.488626985392304e-02_wp )*zt & 
     766                  &        + 1.541411683853927e-01_wp )*zsr    & 
     767                  &    + ( ( 6.537389208598346e-07_wp*zt + 1.856814792031252e-03_wp )*zt & 
     768                  &        + 1.592477436776734e-01_wp )*zt + 1.406742653394891e+01_wp 
     769              ! 
     770              ptmp(ji,jj) = ( zt + zn / zd ) * ztm 
     771              ! 
     772          END DO 
     773      END DO 
     774      ! 
     775      IF( nn_timing == 1 )   CALL timing_stop('eos_pt_from_ct') 
     776      ! 
     777   END FUNCTION eos_pt_from_ct 
     778 
     779 
     780   FUNCTION eos_fzp( psal, pdep ) RESULT( ptf ) 
     781      !!---------------------------------------------------------------------- 
     782      !!                 ***  ROUTINE eos_fzp  *** 
     783      !! 
     784      !! ** Purpose :   Compute the freezing point temperature [Celcius] 
     785      !! 
     786      !! ** Method  :   UNESCO freezing point (ptf) in Celcius is given by 
     787      !!       ptf(t,z) = (-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s - 7.53e-4*z 
     788      !!       checkvalue: tf=-2.588567 Celsius for s=40psu, z=500m 
     789      !! 
     790      !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978 
     791      !!---------------------------------------------------------------------- 
     792      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   )           ::   psal   ! salinity   [psu] 
     793      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ), OPTIONAL ::   pdep   ! depth      [m] 
     794      ! Leave result array automatic rather than making explicitly allocated 
     795      REAL(wp), DIMENSION(jpi,jpj) ::   ptf   ! freezing temperature [Celcius] 
     796      ! 
     797      INTEGER  ::   ji, jj               ! dummy loop indices 
     798      REAL(wp) ::   zt , zsr             ! local scalars 
     799      !!---------------------------------------------------------------------- 
     800      ! 
     801      SELECT CASE ( nn_eos ) 
     802      ! 
     803      CASE ( -1, 1 )                !==  CT,SA (TEOS-10 formulation) ==! 
     804         ! 
     805         DO jj = 1, jpj 
     806            DO ji = 1, jpi 
     807               zsr= SQRT( ABS( psal(ji,jj) ) ) * 0.1_wp   ! square root salinity x 0.1 
     808               ptf(ji,jj) = 0.017947064327968_wp & 
     809                    &    + zsr*zsr*(-6.07609909992982_wp + zsr*(4.883198653547851_wp & 
     810                    &    + zsr*(-11.8808160123054_wp + zsr*(13.34658511480257_wp & 
     811                    &    + zsr*(-8.722761043208607_wp + 2.082038908808201_wp*zsr))))) 
     812            END DO 
     813         END DO 
     814         ! 
     815         IF( PRESENT( pdep ) )   ptf(:,:) = ptf(:,:) - 7.69e-4 * pdep(:,:) 
     816         ! 
     817      CASE ( 0 )                     !==  PT,SP (UNESCO formulation)  ==! 
     818         ! 
     819         ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) )   & 
     820            &                     - 2.154996e-4_wp *       psal(:,:)   ) * psal(:,:) 
     821         ! 
     822         IF( PRESENT( pdep ) )   ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 
     823         ! 
     824      CASE DEFAULT 
     825         IF(lwp) WRITE(numout,cform_err) 
     826         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos 
     827         nstop = nstop + 1 
     828         ! 
     829      END SELECT 
     830      ! 
     831   END FUNCTION eos_fzp 
     832 
     833 
     834   SUBROUTINE eos_pen( pts, pab_pe, ppen ) 
     835      !!---------------------------------------------------------------------- 
     836      !!                 ***  ROUTINE eos_pen  *** 
     837      !! 
     838      !! ** Purpose :   Calculates nonlinear anomalies of alpha_PE, beta_PE and PE at T-points 
     839      !! 
     840      !! ** Method  :   PE is defined analytically as the vertical  
     841      !!                   primitive of EOS times -g integrated between 0 and z>0. 
     842      !!                pen is the nonlinear PE anomaly: ppen = ( PE - rau0 gz ) / rau0 gz - rd 
     843      !!                                                      = 1/z * /int_0^z rd dz - rd  
     844      !!                                where rd is the density anomaly (see eos_rhd function) 
     845      !!                ab_pe are partial derivatives of PE anomaly with respect to T and S: 
     846      !!                    ab_pe(1) = - 1/(rau0 gz) * dPE/dT + drd/dT = - d(pen)/dT 
     847      !!                    ab_pe(2) =   1/(rau0 gz) * dPE/dS + drd/dS =   d(pen)/dS 
     848      !! 
     849      !!       * nn_eos = -1 : polynomial TEOS-10 
     850      !!       * nn_eos =  0 : Jackett and McDougall (1995) (should not be used, using polynomial TEOS-10 formulation) 
     851      !!       * nn_eos =  1 : Vallis equation of state (Vallis 2006) 
     852      !! 
     853      !! ** Action  : - pen         : PE anomaly given at T-points 
     854      !!            : - pab_pe  : given at T-points 
     855      !!                    pab_pe(:,:,:,jp_tem) is alpha_pe 
     856      !!                    pab_pe(:,:,:,jp_sal) is beta_pe 
     857      !!---------------------------------------------------------------------- 
     858      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts     ! pot. temperature & salinity 
     859      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pab_pe  ! alpha_pe and beta_pe 
     860      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   ppen     ! potential energy anomaly 
     861      ! 
     862      INTEGER  ::   ji, jj, jk               ! dummy loop indices 
     863      REAL(wp) ::   zt , zh , zsr, ztm , zs  ! local scalars 
     864      REAL(wp) ::   zn 
     865      !!---------------------------------------------------------------------- 
     866      ! 
     867      IF ( nn_timing == 1 )   CALL timing_start('eos_pen') 
     868      ! 
     869      SELECT CASE ( nn_eos ) 
     870      ! 
     871      CASE ( -1 , 0 )               ! polyTEOS10 (used also for JM95 case as an approximation) 
     872         ! 
     873         DO jk = 1, jpkm1 
     874            DO jj = 1, jpj 
     875               DO ji = 1, jpi 
     876                  zt  = pts (ji,jj,jk,jp_tem) 
     877                  zh  = fsdept(ji,jj,jk)                              ! depth 
     878                  zsr = SQRT( MAX( pts(ji,jj,jk,jp_sal) , 0.1_wp ) )  ! square root salinity 
     879                  ztm = tmask(ji,jj,jk)                               ! tmask 
     880                  ! 
     881                  ! 
     882                  zn  = ( ( ( PEN133*zsr   & 
     883                     &   + PEN223*zt + PEN123 )*zsr   & 
     884                     &   + ( PEN313*zt + PEN213 )*zt + PEN113 )*zh   & 
     885                     &   + ( ( ( PEN152*zsr   & 
     886                     &   + PEN242*zt + PEN142 )*zsr   & 
     887                     &   + ( PEN332*zt + PEN232 )*zt + PEN132 )*zsr   & 
     888                     &   + ( ( PEN422*zt + PEN322 )*zt + PEN222 )*zt + PEN122 )*zsr   & 
     889                     &   + ( ( ( PEN512*zt + PEN412 )*zt + PEN312 )*zt + PEN212 )*zt + PEN112 )*zh 
     890                  ! 
     891                  !                              ! potential energy non-linear anomaly 
     892                  ppen(ji,jj,jk)  = zn * r1_rau0 * ztm 
     893                  ! 
     894                  ! 
     895                  zn  = ( ( ( APE123 )*zsr   & 
     896                     &   + APE213*zt + APE113 )*zh   & 
     897                     &   + ( ( ( APE142 )*zsr   & 
     898                     &   + APE232*zt + APE132 )*zsr   & 
     899                     &   + ( APE322*zt + APE222 )*zt + APE122 )*zsr   & 
     900                     &   + ( ( APE412*zt + APE312 )*zt + APE212 )*zt + APE112 )*zh 
     901                  ! 
     902                  !                              ! alphaPE non-linear anomaly 
     903                  pab_pe(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm 
     904                  ! 
     905                  ! 
     906                  zn  = ( ( ( BPE123 )*zsr   & 
     907                     &   + BPE213*zt + BPE113 )*zh   & 
     908                     &   + ( ( ( BPE142 )*zsr   & 
     909                     &   + BPE232*zt + BPE132 )*zsr   & 
     910                     &   + ( BPE322*zt + BPE222 )*zt + BPE122 )*zsr   & 
     911                     &   + ( ( BPE412*zt + BPE312 )*zt + BPE212 )*zt + BPE112 )*zh 
     912                  ! 
     913                  !                              ! betaPE non-linear anomaly 
     914                  pab_pe(ji,jj,jk,jp_sal) = zn / zsr * r1_rau0 * ztm 
     915                  ! 
     916               END DO 
     917            END DO 
     918         END DO 
     919         ! 
     920      CASE( 1 )                !==  Vallis (2006) simplified EOS  ==! 
     921         ! 
     922         DO jk = 1, jpkm1 
     923            DO jj = 1, jpj 
     924               DO ji = 1, jpi 
     925                  zt  = pts(ji,jj,jk,jp_tem) - 10._wp  ! temperature anomaly (t-T0) 
     926                  zs = pts (ji,jj,jk,jp_sal) - 35._wp  ! abs. salinity anomaly (s-S0) 
     927                  zh  = fsdept(ji,jj,jk)               ! depth in meters  at t-point 
     928                  ztm = tmask(ji,jj,jk)                ! tmask 
     929                  zn  = 0.5_wp * zh * r1_rau0 * ztm 
     930                  !                                    ! Potential Energy 
     931                  ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn 
     932                  !                                    ! alphaPE 
     933                  pab_pe(ji,jj,jk,jp_tem) = - rn_a0 * rn_mu1 * zn 
     934                  pab_pe(ji,jj,jk,jp_sal) =   rn_b0 * rn_mu2 * zn 
     935                  ! 
     936               END DO 
     937            END DO 
     938         END DO 
     939         ! 
     940      CASE DEFAULT 
     941         IF(lwp) WRITE(numout,cform_err) 
     942         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos 
     943         nstop = nstop + 1 
     944         ! 
     945      END SELECT 
     946      ! 
     947      IF( nn_timing == 1 )   CALL timing_stop('eos_pen') 
     948      ! 
     949   END SUBROUTINE eos_pen 
     950 
     951 
     952   SUBROUTINE eos_init 
    680953      !!---------------------------------------------------------------------- 
    681954      !!                 ***  ROUTINE eos_init  *** 
    682955      !! 
    683       !! ** Purpose :   Compute the sea surface freezing temperature [Celcius] 
    684       !! 
    685       !! ** Method  :   UNESCO freezing point at the surface (pressure = 0???) 
    686       !!       freezing point [Celcius]=(-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s-7.53e-4*p 
    687       !!       checkvalue: tf= -2.588567 Celsius for s=40.0psu, p=500. decibars 
    688       !! 
    689       !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978 
    690       !!---------------------------------------------------------------------- 
    691       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity             [psu] 
    692       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ), OPTIONAL ::   pdep   ! depth      [decibars] 
    693       ! Leave result array automatic rather than making explicitly allocated 
    694       REAL(wp), DIMENSION(jpi,jpj)                ::   ptf    ! freezing temperature [Celcius] 
    695       !!---------------------------------------------------------------------- 
    696       ! 
    697       ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) )   & 
    698          &                     - 2.154996e-4_wp *       psal(:,:)   ) * psal(:,:) 
    699       IF ( PRESENT( pdep ) ) THEN    
    700          ptf(:,:) = ptf(:,:) - 7.53e-4_wp * pdep(:,:) 
    701       ENDIF 
    702       ! 
    703    END FUNCTION tfreez 
    704  
    705  
    706    SUBROUTINE eos_init 
    707       !!---------------------------------------------------------------------- 
    708       !!                 ***  ROUTINE eos_init  *** 
    709       !! 
    710956      !! ** Purpose :   initializations for the equation of state 
    711957      !! 
    712958      !! ** Method  :   Read the namelist nameos and control the parameters 
    713959      !!---------------------------------------------------------------------- 
    714       NAMELIST/nameos/ nn_eos, rn_alpha, rn_beta 
    715       !!---------------------------------------------------------------------- 
    716       INTEGER  ::   ios 
     960      INTEGER  ::   ios   ! local integer 
     961      !! 
     962      NAMELIST/nameos/ nn_eos, ln_useCT, rn_a0, rn_b0, rn_lambda1, rn_mu1,   & 
     963         &                                             rn_lambda2, rn_mu2, rn_nu 
     964      !!---------------------------------------------------------------------- 
    717965      ! 
    718966      REWIND( numnam_ref )              ! Namelist nameos in reference namelist : equation of state 
    719967      READ  ( numnam_ref, nameos, IOSTAT = ios, ERR = 901 ) 
    720968901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in reference namelist', lwp ) 
    721  
     969      ! 
    722970      REWIND( numnam_cfg )              ! Namelist nameos in configuration namelist : equation of state 
    723971      READ  ( numnam_cfg, nameos, IOSTAT = ios, ERR = 902 ) 
    724972902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in configuration namelist', lwp ) 
    725973      WRITE( numond, nameos ) 
     974      ! 
     975      rau0        = 1026._wp      !: volumic mass of reference     [kg/m3] 
     976      rcp         = 3992._wp      !: heat capacity                 [J/K] 
    726977      ! 
    727978      IF(lwp) THEN                ! Control print 
    … …  
    731982         WRITE(numout,*) '          Namelist nameos : set eos parameters' 
    732983         WRITE(numout,*) '             flag for eq. of state and N^2  nn_eos   = ', nn_eos 
    733          WRITE(numout,*) '             thermal exp. coef. (linear)    rn_alpha = ', rn_alpha 
    734          WRITE(numout,*) '             saline  exp. coef. (linear)    rn_beta  = ', rn_beta 
     984         IF( ln_useCT )   THEN 
     985            WRITE(numout,*) '             model uses Conservative Temperature' 
     986            WRITE(numout,*) '             Important: model must be initialized with CT and SA fields' 
     987         ENDIF 
    735988      ENDIF 
    736989      ! 
    737990      SELECT CASE( nn_eos )         ! check option 
    738991      ! 
    739       CASE( 0 )                        !==  Jackett and McDougall (1994) formulation  ==! 
     992      CASE( -1 )                       !==  polynomial TEOS-10  ==! 
    740993         IF(lwp) WRITE(numout,*) 
    741          IF(lwp) WRITE(numout,*) '          use of Jackett & McDougall (1994) equation of state and' 
    742          IF(lwp) WRITE(numout,*) '                 McDougall (1987) Brunt-Vaisala frequency' 
    743          ! 
    744       CASE( 1 )                        !==  Linear formulation = F( temperature )  ==! 
     994         IF(lwp) WRITE(numout,*) '          use of TEOS-10 equation of state (cons. temp. and abs. salinity)' 
     995         ! 
     996         EOS111 =  9.9984112007e+02_wp 
     997         EOS211 =  6.4904564681e-02_wp 
     998         EOS311 = -8.1866708294e-03_wp 
     999         EOS411 =  8.4327846386e-05_wp 
     1000         EOS511 = -9.9853850905e-07_wp 
     1001         EOS611 =  9.5342506671e-09_wp 
     1002         EOS711 = -5.5942725501e-11_wp 
     1003         EOS121 =  4.8745609554e-04_wp 
     1004         EOS221 = -7.9137653036e-04_wp 
     1005         EOS321 =  1.1241300058e-04_wp 
     1006         EOS421 = -4.2658318975e-06_wp 
     1007         EOS521 =  2.7589924936e-08_wp 
     1008         EOS621 =  5.6573234128e-10_wp 
     1009         EOS131 =  8.2409990767e-01_wp 
     1010         EOS231 = -3.6746935996e-03_wp 
     1011         EOS331 =  2.8088034997e-05_wp 
     1012         EOS431 =  3.9432934562e-07_wp 
     1013         EOS531 = -8.6081969467e-09_wp 
     1014         EOS141 = -8.5860758561e-03_wp 
     1015         EOS241 =  1.0048170774e-04_wp 
     1016         EOS341 = -1.1219591564e-06_wp 
     1017         EOS441 = -1.4550322467e-09_wp 
     1018         EOS151 =  1.2633903654e-03_wp 
     1019         EOS251 = -7.2707200365e-06_wp 
     1020         EOS351 =  2.6241351559e-08_wp 
     1021         EOS161 = -7.4242043203e-05_wp 
     1022         EOS261 =  3.8374457797e-07_wp 
     1023         EOS171 =  1.2722088050e-06_wp 
     1024         EOS112 =  4.3845092294e-04_wp 
     1025         EOS212 = -3.5237528758e-05_wp 
     1026         EOS312 =  5.7586626030e-07_wp 
     1027         EOS412 = -6.3139238271e-09_wp 
     1028         EOS512 =  3.9434377793e-11_wp 
     1029         EOS122 = -7.6672754907e-06_wp 
     1030         EOS222 =  9.0194877799e-08_wp 
     1031         EOS322 = -1.6940551903e-09_wp 
     1032         EOS422 =  3.1783762285e-11_wp 
     1033         EOS132 = -5.9870305749e-06_wp 
     1034         EOS232 =  1.0325176608e-07_wp 
     1035         EOS332 = -8.0185331501e-10_wp 
     1036         EOS142 = -5.6324524012e-07_wp 
     1037         EOS242 =  6.6221210305e-10_wp 
     1038         EOS152 =  3.9558159454e-08_wp 
     1039         EOS113 = -1.6847693220e-09_wp 
     1040         EOS213 =  5.3653075114e-10_wp 
     1041         EOS313 = -1.0864160933e-11_wp 
     1042         EOS123 = -1.6883150438e-09_wp 
     1043         EOS223 =  6.5982407189e-12_wp 
     1044         EOS133 =  2.7370939782e-10_wp 
     1045         ! 
     1046         ALP111 = -6.4904564681e-02_wp 
     1047         ALP211 =  1.6373341659e-02_wp 
     1048         ALP311 = -2.5298353916e-04_wp 
     1049         ALP411 =  3.9941540362e-06_wp 
     1050         ALP511 = -4.7671253336e-08_wp 
     1051         ALP611 =  3.3565635301e-10_wp 
     1052         ALP121 =  7.9137653036e-04_wp 
     1053         ALP221 = -2.2482600117e-04_wp 
     1054         ALP321 =  1.2797495693e-05_wp 
     1055         ALP421 = -1.1035969974e-07_wp 
     1056         ALP521 = -2.8286617064e-09_wp 
     1057         ALP131 =  3.6746935996e-03_wp 
     1058         ALP231 = -5.6176069994e-05_wp 
     1059         ALP331 = -1.1829880369e-06_wp 
     1060         ALP431 =  3.4432787787e-08_wp 
     1061         ALP141 = -1.0048170774e-04_wp 
     1062         ALP241 =  2.2439183129e-06_wp 
     1063         ALP341 =  4.3650967401e-09_wp 
     1064         ALP151 =  7.2707200365e-06_wp 
     1065         ALP251 = -5.2482703118e-08_wp 
     1066         ALP161 = -3.8374457797e-07_wp 
     1067         ALP112 =  3.5237528758e-05_wp 
     1068         ALP212 = -1.1517325206e-06_wp 
     1069         ALP312 =  1.8941771481e-08_wp 
     1070         ALP412 = -1.5773751117e-10_wp 
     1071         ALP122 = -9.0194877799e-08_wp 
     1072         ALP222 =  3.3881103805e-09_wp 
     1073         ALP322 = -9.5351286854e-11_wp 
     1074         ALP132 = -1.0325176608e-07_wp 
     1075         ALP232 =  1.6037066300e-09_wp 
     1076         ALP142 = -6.6221210305e-10_wp 
     1077         ALP113 = -5.3653075114e-10_wp 
     1078         ALP213 =  2.1728321866e-11_wp 
     1079         ALP123 = -6.5982407189e-12_wp 
     1080         ! 
     1081         BET111 =  2.4372804777e-04_wp 
     1082         BET211 = -3.9568826518e-04_wp 
     1083         BET311 =  5.6206500292e-05_wp 
     1084         BET411 = -2.1329159488e-06_wp 
     1085         BET511 =  1.3794962468e-08_wp 
     1086         BET611 =  2.8286617064e-10_wp 
     1087         BET121 =  8.2409990767e-01_wp 
     1088         BET221 = -3.6746935996e-03_wp 
     1089         BET321 =  2.8088034997e-05_wp 
     1090         BET421 =  3.9432934562e-07_wp 
     1091         BET521 = -8.6081969467e-09_wp 
     1092         BET131 = -1.2879113784e-02_wp 
     1093         BET231 =  1.5072256162e-04_wp 
     1094         BET331 = -1.6829387347e-06_wp 
     1095         BET431 = -2.1825483700e-09_wp 
     1096         BET141 =  2.5267807308e-03_wp 
     1097         BET241 = -1.4541440073e-05_wp 
     1098         BET341 =  5.2482703118e-08_wp 
     1099         BET151 = -1.8560510801e-04_wp 
     1100         BET251 =  9.5936144494e-07_wp 
     1101         BET161 =  3.8166264151e-06_wp 
     1102         BET112 = -3.8336377454e-06_wp 
     1103         BET212 =  4.5097438900e-08_wp 
     1104         BET312 = -8.4702759513e-10_wp 
     1105         BET412 =  1.5891881142e-11_wp 
     1106         BET122 = -5.9870305749e-06_wp 
     1107         BET222 =  1.0325176608e-07_wp 
     1108         BET322 = -8.0185331501e-10_wp 
     1109         BET132 = -8.4486786018e-07_wp 
     1110         BET232 =  9.9331815458e-10_wp 
     1111         BET142 =  7.9116318907e-08_wp 
     1112         BET113 = -8.4415752190e-10_wp 
     1113         BET213 =  3.2991203594e-12_wp 
     1114         BET123 =  2.7370939782e-10_wp 
     1115         ! 
     1116         PEN112 = -2.1922546147e-04_wp 
     1117         PEN212 =  1.7618764379e-05_wp 
     1118         PEN312 = -2.8793313015e-07_wp 
     1119         PEN412 =  3.1569619136e-09_wp 
     1120         PEN512 = -1.9717188896e-11_wp 
     1121         PEN122 =  3.8336377454e-06_wp 
     1122         PEN222 = -4.5097438900e-08_wp 
     1123         PEN322 =  8.4702759513e-10_wp 
     1124         PEN422 = -1.5891881142e-11_wp 
     1125         PEN132 =  2.9935152875e-06_wp 
     1126         PEN232 = -5.1625883042e-08_wp 
     1127         PEN332 =  4.0092665751e-10_wp 
     1128         PEN142 =  2.8162262006e-07_wp 
     1129         PEN242 = -3.3110605153e-10_wp 
     1130         PEN152 = -1.9779079727e-08_wp 
     1131         PEN113 =  1.1231795480e-09_wp 
     1132         PEN213 = -3.5768716743e-10_wp 
     1133         PEN313 =  7.2427739554e-12_wp 
     1134         PEN123 =  1.1255433625e-09_wp 
     1135         PEN223 = -4.3988271459e-12_wp 
     1136         PEN133 = -1.8247293188e-10_wp 
     1137         ! 
     1138         APE112 = -1.7618764379e-05_wp 
     1139         APE212 =  5.7586626030e-07_wp 
     1140         APE312 = -9.4708857407e-09_wp 
     1141         APE412 =  7.8868755586e-11_wp 
     1142         APE122 =  4.5097438900e-08_wp 
     1143         APE222 = -1.6940551903e-09_wp 
     1144         APE322 =  4.7675643427e-11_wp 
     1145         APE132 =  5.1625883042e-08_wp 
     1146         APE232 = -8.0185331501e-10_wp 
     1147         APE142 =  3.3110605153e-10_wp 
     1148         APE113 =  3.5768716743e-10_wp 
     1149         APE213 = -1.4485547911e-11_wp 
     1150         APE123 =  4.3988271459e-12_wp 
     1151         ! 
     1152         BPE112 =  1.9168188727e-06_wp 
     1153         BPE212 = -2.2548719450e-08_wp 
     1154         BPE312 =  4.2351379756e-10_wp 
     1155         BPE412 = -7.9459405711e-12_wp 
     1156         BPE122 =  2.9935152875e-06_wp 
     1157         BPE222 = -5.1625883042e-08_wp 
     1158         BPE322 =  4.0092665751e-10_wp 
     1159         BPE132 =  4.2243393009e-07_wp 
     1160         BPE232 = -4.9665907729e-10_wp 
     1161         BPE142 = -3.9558159454e-08_wp 
     1162         BPE113 =  5.6277168127e-10_wp 
     1163         BPE213 = -2.1994135730e-12_wp 
     1164         BPE123 = -1.8247293188e-10_wp 
     1165         ! 
     1166      CASE( 0 )                        !==  polynomial EOS-80 formulation  ==! 
     1167         ! 
    7451168         IF(lwp) WRITE(numout,*) 
    746          IF(lwp) WRITE(numout,*) '          use of linear eos rho(T) = rau0 * ( 1.0285 - rn_alpha * T )' 
    747          IF( lk_zdfddm ) CALL ctl_stop( '          double diffusive mixing parameterization requires',   & 
    748               &                         ' that T and S are used as state variables' ) 
    749          ! 
    750       CASE( 2 )                        !==  Linear formulation = F( temperature , salinity )  ==! 
    751          ralpbet = rn_alpha / rn_beta 
    752          IF(lwp) WRITE(numout,*) 
    753          IF(lwp) WRITE(numout,*) '          use of linear eos rho(T,S) = rau0 * ( rn_beta * S - rn_alpha * T )' 
     1169         IF(lwp) WRITE(numout,*) '          use of EOS-80 equation of state (pot. temp. and pract. salinity)' 
     1170         ! 
     1171         EOS111 =  9.9984240021e+02_wp 
     1172         EOS211 =  6.8051135248e-02_wp 
     1173         EOS311 = -9.0991456041e-03_wp 
     1174         EOS411 =  9.9238754931e-05_wp 
     1175         EOS511 = -1.0602210389e-06_wp 
     1176         EOS611 =  5.1296071368e-09_wp 
     1177         EOS711 =  1.1887242136e-11_wp 
     1178         EOS121 = -1.9799119661e-04_wp 
     1179         EOS221 = -1.6676932531e-05_wp 
     1180         EOS321 =  3.2084304200e-06_wp 
     1181         EOS421 = -4.8983568948e-08_wp 
     1182         EOS521 = -1.5610111448e-09_wp 
     1183         EOS621 =  2.8366680541e-11_wp 
     1184         EOS131 =  8.2448582544e-01_wp 
     1185         EOS231 = -4.0764319966e-03_wp 
     1186         EOS331 =  7.4898579574e-05_wp 
     1187         EOS431 = -7.7884546946e-07_wp 
     1188         EOS531 =  5.0405569756e-09_wp 
     1189         EOS141 = -5.7150204345e-03_wp 
     1190         EOS241 =  1.0157923923e-04_wp 
     1191         EOS341 = -1.6325795501e-06_wp 
     1192         EOS441 = -1.6144820180e-09_wp 
     1193         EOS151 =  4.8005813592e-04_wp 
     1194         EOS251 =  1.6199868493e-07_wp 
     1195         EOS351 =  7.8805435082e-09_wp 
     1196         EOS161 =  1.9978872493e-07_wp 
     1197         EOS261 = -3.1437087783e-08_wp 
     1198         EOS171 =  2.5463113215e-08_wp 
     1199         EOS112 =  4.3756680685e-04_wp 
     1200         EOS212 = -3.7298355935e-05_wp 
     1201         EOS312 =  6.5348660941e-07_wp 
     1202         EOS412 = -7.2558835910e-09_wp 
     1203         EOS512 =  3.8273323221e-11_wp 
     1204         EOS122 =  1.4369434305e-06_wp 
     1205         EOS222 =  5.6521871685e-08_wp 
     1206         EOS322 = -1.2136936896e-08_wp 
     1207         EOS422 =  2.1030996727e-10_wp 
     1208         EOS132 = -1.0262750144e-05_wp 
     1209         EOS232 =  2.0858571138e-07_wp 
     1210         EOS332 = -1.4826357415e-09_wp 
     1211         EOS142 =  8.5860757162e-08_wp 
     1212         EOS242 = -5.2140945761e-09_wp 
     1213         EOS152 =  8.2162682979e-09_wp 
     1214         EOS113 = -5.5011801985e-09_wp 
     1215         EOS213 =  5.7020541017e-10_wp 
     1216         EOS313 = -1.0193603551e-11_wp 
     1217         EOS123 = -1.0893703284e-10_wp 
     1218         EOS223 = -4.1944954508e-12_wp 
     1219         EOS133 =  1.1857534169e-10_wp 
     1220         ! 
     1221         ALP111 = -6.8051135248e-02_wp 
     1222         ALP211 =  1.8198291208e-02_wp 
     1223         ALP311 = -2.9771626479e-04_wp 
     1224         ALP411 =  4.2408841556e-06_wp 
     1225         ALP511 = -2.5648035684e-08_wp 
     1226         ALP611 = -7.1323452819e-11_wp 
     1227         ALP121 =  1.6676932531e-05_wp 
     1228         ALP221 = -6.4168608399e-06_wp 
     1229         ALP321 =  1.4695070684e-07_wp 
     1230         ALP421 =  6.2440445791e-09_wp 
     1231         ALP521 = -1.4183340270e-10_wp 
     1232         ALP131 =  4.0764319966e-03_wp 
     1233         ALP231 = -1.4979715915e-04_wp 
     1234         ALP331 =  2.3365364084e-06_wp 
     1235         ALP431 = -2.0162227903e-08_wp 
     1236         ALP141 = -1.0157923923e-04_wp 
     1237         ALP241 =  3.2651591003e-06_wp 
     1238         ALP341 =  4.8434460540e-09_wp 
     1239         ALP151 = -1.6199868493e-07_wp 
     1240         ALP251 = -1.5761087016e-08_wp 
     1241         ALP161 =  3.1437087783e-08_wp 
     1242         ALP112 =  3.7298355935e-05_wp 
     1243         ALP212 = -1.3069732188e-06_wp 
     1244         ALP312 =  2.1767650773e-08_wp 
     1245         ALP412 = -1.5309329288e-10_wp 
     1246         ALP122 = -5.6521871685e-08_wp 
     1247         ALP222 =  2.4273873792e-08_wp 
     1248         ALP322 = -6.3092990180e-10_wp 
     1249         ALP132 = -2.0858571138e-07_wp 
     1250         ALP232 =  2.9652714830e-09_wp 
     1251         ALP142 =  5.2140945761e-09_wp 
     1252         ALP113 = -5.7020541017e-10_wp 
     1253         ALP213 =  2.0387207103e-11_wp 
     1254         ALP123 =  4.1944954508e-12_wp 
     1255         ! 
     1256         BET111 = -9.8995598303e-05_wp 
     1257         BET211 = -8.3384662657e-06_wp 
     1258         BET311 =  1.6042152100e-06_wp 
     1259         BET411 = -2.4491784474e-08_wp 
     1260         BET511 = -7.8050557238e-10_wp 
     1261         BET611 =  1.4183340270e-11_wp 
     1262         BET121 =  8.2448582544e-01_wp 
     1263         BET221 = -4.0764319966e-03_wp 
     1264         BET321 =  7.4898579574e-05_wp 
     1265         BET421 = -7.7884546946e-07_wp 
     1266         BET521 =  5.0405569756e-09_wp 
     1267         BET131 = -8.5725306517e-03_wp 
     1268         BET231 =  1.5236885884e-04_wp 
     1269         BET331 = -2.4488693252e-06_wp 
     1270         BET431 = -2.4217230270e-09_wp 
     1271         BET141 =  9.6011627184e-04_wp 
     1272         BET241 =  3.2399736986e-07_wp 
     1273         BET341 =  1.5761087016e-08_wp 
     1274         BET151 =  4.9947181231e-07_wp 
     1275         BET251 = -7.8592719459e-08_wp 
     1276         BET161 =  7.6389339644e-08_wp 
     1277         BET112 =  7.1847171523e-07_wp 
     1278         BET212 =  2.8260935842e-08_wp 
     1279         BET312 = -6.0684684481e-09_wp 
     1280         BET412 =  1.0515498363e-10_wp 
     1281         BET122 = -1.0262750144e-05_wp 
     1282         BET222 =  2.0858571138e-07_wp 
     1283         BET322 = -1.4826357415e-09_wp 
     1284         BET132 =  1.2879113574e-07_wp 
     1285         BET232 = -7.8211418642e-09_wp 
     1286         BET142 =  1.6432536596e-08_wp 
     1287         BET113 = -5.4468516419e-11_wp 
     1288         BET213 = -2.0972477254e-12_wp 
     1289         BET123 =  1.1857534169e-10_wp 
     1290         ! 
     1291         PEN112 = -2.1878340343e-04_wp 
     1292         PEN212 =  1.8649177967e-05_wp 
     1293         PEN312 = -3.2674330470e-07_wp 
     1294         PEN412 =  3.6279417955e-09_wp 
     1295         PEN512 = -1.9136661610e-11_wp 
     1296         PEN122 = -7.1847171523e-07_wp 
     1297         PEN222 = -2.8260935842e-08_wp 
     1298         PEN322 =  6.0684684481e-09_wp 
     1299         PEN422 = -1.0515498363e-10_wp 
     1300         PEN132 =  5.1313750720e-06_wp 
     1301         PEN232 = -1.0429285569e-07_wp 
     1302         PEN332 =  7.4131787075e-10_wp 
     1303         PEN142 = -4.2930378581e-08_wp 
     1304         PEN242 =  2.6070472881e-09_wp 
     1305         PEN152 = -4.1081341490e-09_wp 
     1306         PEN113 =  3.6674534657e-09_wp 
     1307         PEN213 = -3.8013694011e-10_wp 
     1308         PEN313 =  6.7957357010e-12_wp 
     1309         PEN123 =  7.2624688558e-11_wp 
     1310         PEN223 =  2.7963303006e-12_wp 
     1311         PEN133 = -7.9050227794e-11_wp 
     1312         ! 
     1313         APE112 = -1.8649177967e-05_wp 
     1314         APE212 =  6.5348660941e-07_wp 
     1315         APE312 = -1.0883825386e-08_wp 
     1316         APE412 =  7.6546646441e-11_wp 
     1317         APE122 =  2.8260935842e-08_wp 
     1318         APE222 = -1.2136936896e-08_wp 
     1319         APE322 =  3.1546495090e-10_wp 
     1320         APE132 =  1.0429285569e-07_wp 
     1321         APE232 = -1.4826357415e-09_wp 
     1322         APE142 = -2.6070472881e-09_wp 
     1323         APE113 =  3.8013694011e-10_wp 
     1324         APE213 = -1.3591471402e-11_wp 
     1325         APE123 = -2.7963303006e-12_wp 
     1326         ! 
     1327         BPE112 = -3.5923585761e-07_wp 
     1328         BPE212 = -1.4130467921e-08_wp 
     1329         BPE312 =  3.0342342240e-09_wp 
     1330         BPE412 = -5.2577491816e-11_wp 
     1331         BPE122 =  5.1313750720e-06_wp 
     1332         BPE222 = -1.0429285569e-07_wp 
     1333         BPE322 =  7.4131787075e-10_wp 
     1334         BPE132 = -6.4395567871e-08_wp 
     1335         BPE232 =  3.9105709321e-09_wp 
     1336         BPE142 = -8.2162682979e-09_wp 
     1337         BPE113 =  3.6312344279e-11_wp 
     1338         BPE213 =  1.3981651503e-12_wp 
     1339         BPE123 = -7.9050227794e-11_wp 
     1340         ! 
     1341      CASE( 1 )                        !==  Simplified EOS     ==! 
     1342         IF(lwp) THEN 
     1343            WRITE(numout,*) 
     1344            WRITE(numout,*) '          use of simplified eos:    rhd(dT=T-10,dS=S-35,Z) = ' 
     1345            WRITE(numout,*) '             [-a0*(1+lambda1/2*dT+mu1*Z)*dT + b0*(1+lambda2/2*dT+mu2*Z)*dS - nu*dT*dS]/rau0' 
     1346            WRITE(numout,*) 
     1347            WRITE(numout,*) '             thermal exp. coef.    rn_a0      = ', rn_a0 
     1348            WRITE(numout,*) '             saline  cont. coef.   rn_b0      = ', rn_b0 
     1349            WRITE(numout,*) '             cabbeling coef.       rn_lambda1 = ', rn_lambda1 
     1350            WRITE(numout,*) '             cabbeling coef.       rn_lambda2 = ', rn_lambda2 
     1351            WRITE(numout,*) '             thermobar. coef.      rn_mu1     = ', rn_mu1 
     1352            WRITE(numout,*) '             thermobar. coef.      rn_mu2     = ', rn_mu2 
     1353            WRITE(numout,*) '             2nd cabbel. coef.     rn_nu      = ', rn_nu 
     1354            WRITE(numout,*) '               Caution: rn_beta0=0 incompatible with ddm parameterization ' 
     1355         ENDIF 
    7541356         ! 
    7551357      CASE DEFAULT                     !==  ERROR in nn_eos  ==! 
    … …  
    7591361      END SELECT 
    7601362      ! 
     1363      r1_rau0     = 1._wp / rau0 
     1364      r1_rcp      = 1._wp / rcp 
     1365      r1_rau0_rcp = 1._wp / ( rau0 * rcp ) 
     1366      ! 
     1367      IF(lwp) WRITE(numout,*) 
     1368      IF(lwp) WRITE(numout,*) '          volumic mass of reference           rau0  = ', rau0   , ' kg/m^3' 
     1369      IF(lwp) WRITE(numout,*) '          1. / rau0                        r1_rau0  = ', r1_rau0, ' m^3/kg' 
     1370      IF(lwp) WRITE(numout,*) '          ocean specific heat                 rcp   = ', rcp    , ' J/Kelvin' 
     1371      IF(lwp) WRITE(numout,*) '          1. / ( rau0 * rcp )           r1_rau0_rcp = ', r1_rau0_rcp 
     1372      ! 
    7611373   END SUBROUTINE eos_init 
    7621374 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r4499 r4619  
    44   !! Ocean  tracers:  horizontal & vertical advective trend 
    55   !!====================================================================== 
    6    !! History :  8.2  ! 2001-08  (G. Madec, E. Durand) trahad+trazad=traadv  
    7    !!            1.0  ! 2002-06  (G. Madec)  F90: Free form and module 
    8    !!            9.0  ! 2004-08  (C. Talandier) New trends organization 
     6   !! History :  OPA  ! 2001-08  (G. Madec, E. Durand) v8.2 trahad+trazad=traadv  
     7   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module 
     8   !!             -   ! 2004-08  (C. Talandier) New trends organization 
    99   !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization 
    1010   !!            2.0  ! 2006-04  (R. Benshila, G. Madec) Step reorganization 
    … …  
    2121   USE dom_oce         ! ocean space and time domain 
    2222   USE eosbn2          ! equation of state 
    23    USE trdmod_oce      ! tracers trends 
    24    USE trdtra          ! tracers trends 
     23   USE trd_oce         ! trends: ocean variables 
     24   USE trdtra          ! trends manager: tracers  
    2525   USE closea          ! closed sea 
    2626   USE sbcrnf          ! river runoffs 
    … …  
    3737   PRIVATE 
    3838 
    39    PUBLIC   tra_adv_cen2       ! routine called by step.F90 
    40    PUBLIC   ups_orca_set       ! routine used by traadv_cen2_jki.F90 
    41  
    42    LOGICAL  :: l_trd       ! flag to compute trends 
     39   PUBLIC   tra_adv_cen2   ! routine called by traadv.F90 
    4340 
    4441   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: upsmsk !: mixed upstream/centered scheme near some straits  
    … …  
    5552 
    5653   SUBROUTINE tra_adv_cen2( kt, kit000, cdtype, pun, pvn, pwn,     & 
    57       &                                 ptb, ptn, pta, kjpt   )  
     54      &                                         ptb, ptn, pta, kjpt   )  
    5855      !!---------------------------------------------------------------------- 
    5956      !!                  ***  ROUTINE tra_adv_cen2  *** 
    … …  
    8582      !!       * Add this trend now to the general trend of tracer (ta,sa): 
    8683      !!               pta = pta + ztra 
    87       !!       * trend diagnostic ('key_trdtra' defined): the trend is 
     84      !!       * trend diagnostic (l_trdtra=T or l_trctra=T): the trend is 
    8885      !!      saved for diagnostics. The trends saved is expressed as 
    89       !!      Uh.gradh(T), i.e. 
    90       !!                     save trend = ztra + ptn divn 
     86      !!      Uh.gradh(T), i.e.  save trend = ztra + ptn divn 
    9187      !! 
    9288      !!         Part II : vertical advection 
    … …  
    104100      !!         Add this trend now to the general trend of tracer (ta,sa): 
    105101      !!             pta = pta + ztra 
    106       !!         Trend diagnostic ('key_trdtra' defined): the trend is 
     102      !!         Trend diagnostic (l_trdtra=T or l_trctra=T): the trend is 
    107103      !!      saved for diagnostics. The trends saved is expressed as : 
    108104      !!             save trend =  w.gradz(T) = ztra - ptn divn. 
    … …  
    111107      !!              - save trends if needed 
    112108      !!---------------------------------------------------------------------- 
    113       USE oce     , ONLY:   zwx => ua        , zwy  => va          ! (ua,va) used as 3D workspace 
    114       ! 
    115109      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    116110      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    … …  
    128122      REAL(wp) ::   zupsut, zcenut, zupst                 !   -      - 
    129123      REAL(wp) ::   zupsvt, zcenvt, zcent, zice           !   -      - 
    130       REAL(wp), POINTER, DIMENSION(:,:  ) :: ztfreez  
    131       REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz, zind 
     124      REAL(wp), POINTER, DIMENSION(:,:)   :: zfzp         ! 2D workspace 
     125      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwx, zwy     ! 3D     - 
     126      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz, zind    !  -     - 
    132127      !!---------------------------------------------------------------------- 
    133128      ! 
    134129      IF( nn_timing == 1 )  CALL timing_start('tra_adv_cen2') 
    135130      ! 
    136       CALL wrk_alloc( jpi, jpj, ztfreez ) 
    137       CALL wrk_alloc( jpi, jpj, jpk, zwz, zind ) 
     131      CALL wrk_alloc( jpi, jpj, zfzp ) 
     132      CALL wrk_alloc( jpi, jpj, jpk, zwx, zwy, zwz, zind ) 
    138133      ! 
    139134 
    … …  
    144139         IF(lwp) WRITE(numout,*) 
    145140         ! 
    146          IF ( .NOT. ALLOCATED( upsmsk ) )  THEN 
     141         IF( .NOT. ALLOCATED( upsmsk ) )  THEN 
    147142             ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 
    148143             IF( ierr /= 0 )   CALL ctl_stop('STOP', 'tra_adv_cen2: unable to allocate array') 
    … …  
    162157      ENDIF 
    163158      ! 
    164       l_trd = .FALSE. 
    165       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE. 
    166       ! 
    167159      ! Upstream / centered scheme indicator 
    168160      ! ------------------------------------ 
    169161!!gm  not strickly exact : the freezing point should be computed at each ocean levels... 
    170162!!gm  not a big deal since cen2 is no more used in global ice-ocean simulations 
    171       ztfreez(:,:) = tfreez( tsn(:,:,1,jp_sal) ) 
     163      zfzp(:,:) = eos_fzp( tsn(:,:,1,jp_sal) ) 
    172164      DO jk = 1, jpk 
    173165         DO jj = 1, jpj 
    174166            DO ji = 1, jpi 
    175167               !                                        ! below ice covered area (if tn < "freezing"+0.1 ) 
    176                IF( tsn(ji,jj,jk,jp_tem) <= ztfreez(ji,jj) + 0.1 ) THEN   ;   zice = 1.e0 
    177                ELSE                                                      ;   zice = 0.e0 
     168               IF( tsn(ji,jj,jk,jp_tem) <= zfzp(ji,jj) + 0.1 ) THEN   ;   zice = 1._wp 
     169               ELSE                                                   ;   zice = 0._wp 
    178170               ENDIF 
    179171               zind(ji,jj,jk) = MAX (   & 
    … …  
    260252         END DO 
    261253 
    262          !                                 ! trend diagnostics (contribution of upstream fluxes) 
    263          IF( l_trd ) THEN 
    264             CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptn(:,:,:,jn) ) 
    265             CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptn(:,:,:,jn) ) 
    266             CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zwz, pwn, ptn(:,:,:,jn) ) 
     254         !                                 ! trend diagnostics 
     255         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR.    & 
     256            &( cdtype == 'TRC' .AND. l_trdtrc ) )   THEN 
     257            CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) ) 
     258            CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 
     259            CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) ) 
    267260         END IF 
    268261         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    269262         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    270            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) 
    271            IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) 
     263           IF( jn == jp_tem )   htr_adv(:) = ptr_vj( zwy(:,:,:) ) 
     264           IF( jn == jp_sal )   str_adv(:) = ptr_vj( zwy(:,:,:) ) 
    272265         ENDIF 
    273266         ! 
    274       ENDDO 
     267      END DO 
    275268 
    276269      ! ---------------------------  required in restart file to ensure restartability) 
    … …  
    281274      ENDIF 
    282275      ! 
    283       CALL wrk_dealloc( jpi, jpj, ztfreez ) 
    284       CALL wrk_dealloc( jpi, jpj, jpk, zwz, zind ) 
     276      CALL wrk_dealloc( jpi, jpj, zfzp ) 
     277      CALL wrk_dealloc( jpi, jpj, jpk, zwx, zwy, zwz, zind ) 
    285278      ! 
    286279      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_cen2') 
    … …  
    303296      INTEGER  ::   ii0, ii1, ij0, ij1      ! temporary integers 
    304297      !!---------------------------------------------------------------------- 
    305        
    306298      ! 
    307299      IF( nn_timing == 1 )  CALL timing_start('ups_orca_set') 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    r4499 r4619  
    1616   !!---------------------------------------------------------------------- 
    1717   USE oce            ! ocean dynamics and active tracers 
     18   USE trc_oce        ! share passive tracers/Ocean variables 
    1819   USE dom_oce        ! ocean space and time domain 
    19    USE trdmod_oce     ! tracers trends  
    20    USE trdtra         ! tracers trends  
    21    USE in_out_manager ! I/O manager 
     20   USE trd_oce        ! trends: ocean variables 
     21   USE trdtra         ! tracers trends manager 
    2222   USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient 
    23    USE trabbl         ! tracers: bottom boundary layer 
    24    USE lib_mpp        ! distribued memory computing 
    25    USE lbclnk         ! ocean lateral boundary condition (or mpp link)  
     23   USE sbcrnf          ! river runoffs 
    2624   USE diaptr         ! poleward transport diagnostics 
    27    USE trc_oce        ! share passive tracers/Ocean variables 
     25   ! 
    2826   USE wrk_nemo       ! Memory Allocation 
    2927   USE timing         ! Timing 
    3028   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    31    USE eosbn2          ! equation of state 
    32    USE sbcrnf          ! river runoffs 
     29   USE in_out_manager ! I/O manager 
     30   USE lib_mpp        ! distribued memory computing 
     31   USE lbclnk         ! ocean lateral boundary condition (or mpp link)  
    3332 
    3433   IMPLICIT NONE 
    3534   PRIVATE 
    3635 
    37    PUBLIC   tra_adv_muscl  ! routine called by step.F90 
    38  
    39    LOGICAL  :: l_trd                        ! flag to compute trends 
    40    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: upsmsk !: mixed upstream/centered scheme near some straits 
    41    !                                                             !  and in closed seas (orca 2 and 4 configurations) 
    42    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xind         !: mixed upstream/centered index 
     36   PUBLIC   tra_adv_muscl   ! routine called by traadv.F90 
     37    
     38   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   upsmsk   !: mixed upstream/centered scheme near some straits 
     39   !                                                           !  and in closed seas (orca 2 and 4 configurations) 
     40   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xind     !: mixed upstream/centered index 
     41    
    4342   !! * Substitutions 
    4443#  include "domzgr_substitute.h90" 
    … …  
    5150CONTAINS 
    5251 
    53    SUBROUTINE tra_adv_muscl( kt, kit000, cdtype, p2dt, pun, pvn, pwn, & 
    54       &                                        ptb, pta, kjpt, ld_msc_ups ) 
     52   SUBROUTINE tra_adv_muscl( kt, kit000, cdtype, p2dt, pun, pvn, pwn,   & 
     53      &                                                ptb, pta, kjpt, ld_msc_ups ) 
    5554      !!---------------------------------------------------------------------- 
    5655      !!                    ***  ROUTINE tra_adv_muscl  *** 
    … …  
    6867      !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa) 
    6968      !!---------------------------------------------------------------------- 
    70       USE oce     , ONLY:   zwx   => ua    , zwy   => va          ! (ua,va) used as workspace 
    71       ! 
    7269      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    7370      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    … …  
    7976      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb             ! before tracer field 
    8077      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    81  
    82       ! 
    83       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     78      ! 
     79      INTEGER  ::   ji, jj, jk, jn            ! dummy loop indices 
     80      INTEGER  ::   ierr                      ! local integer 
    8481      REAL(wp) ::   zu, z0u, zzwx, zw         ! local scalars 
    8582      REAL(wp) ::   zv, z0v, zzwy, z0w        !   -      - 
    8683      REAL(wp) ::   ztra, zbtr, zdt, zalpha   !   -      - 
    87       REAL(wp), POINTER, DIMENSION(:,:,:) :: zslpx, zslpy 
    88       INTEGER  ::   ierr 
     84      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zslpx, zslpy   ! 3D workspace 
     85      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx  , zwy     ! -      -  
    8986      !!---------------------------------------------------------------------- 
    9087      ! 
    9188      IF( nn_timing == 1 )  CALL timing_start('tra_adv_muscl') 
    9289      ! 
    93       CALL wrk_alloc( jpi, jpj, jpk, zslpx, zslpy ) 
    94       ! 
    95  
     90      CALL wrk_alloc( jpi, jpj, jpk, zslpx, zslpy, zwx, zwy ) 
     91      ! 
    9692      IF( kt == kit000 )  THEN 
    9793         IF(lwp) WRITE(numout,*) 
    … …  
    117113 
    118114         ! 
    119          ! Upstream / centered scheme indicator 
     115         ! Upstream / MUSCL scheme indicator 
    120116         ! ------------------------------------ 
     117!!gm  useless 
    121118         xind(:,:,:) = 1._wp                             ! set equal to 1 where up-stream is not needed 
     119!!gm 
    122120         ! 
    123121         IF( ld_msc_ups )  THEN 
    124             DO jk = 1, jpk 
    125                DO jj = 1, jpj 
    126                   DO ji = 1, jpi 
    127                      xind(ji,jj,jk) = 1  - MAX (           & 
    128                         rnfmsk(ji,jj) * rnfmsk_z(jk),      &  ! near runoff mouths (& closed sea outflows) 
    129                         upsmsk(ji,jj) ) * tmask(ji,jj,jk)     ! some of some straits 
    130                   END DO 
    131                END DO 
     122            DO jk = 1, jpkm1 
     123               xind(:,:,jk) = 1._wp                              &                 ! =>1 where up-stream is not needed 
     124                  &         - MAX ( rnfmsk(:,:) * rnfmsk_z(jk),  &                 ! =>0 near runoff mouths (& closed sea outflows) 
     125                  &                 upsmsk(:,:)                ) * tmask(:,:,jk)   ! =>0 near some straits 
    132126            END DO 
    133127         ENDIF  
    134128         ! 
    135129      ENDIF  
    136       ! 
    137       l_trd = .FALSE. 
    138       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 
    139        
     130      !       
    140131      !                                                     ! =========== 
    141132      DO jn = 1, kjpt                                       ! tracer loop 
    … …  
    192183                  zalpha = 0.5 - z0u 
    193184                  zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) 
    194                   zzwx = ptb(ji+1,jj,jk,jn) + xind(ji,jj,jk) * (zu * zslpx(ji+1,jj,jk)) 
    195                   zzwy = ptb(ji  ,jj,jk,jn) + xind(ji,jj,jk) * (zu * zslpx(ji  ,jj,jk)) 
     185                  zzwx = ptb(ji+1,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji+1,jj,jk) 
     186                  zzwy = ptb(ji  ,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji  ,jj,jk) 
    196187                  zwx(ji,jj,jk) = pun(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
    197188                  ! 
    … …  
    199190                  zalpha = 0.5 - z0v 
    200191                  zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) 
    201                   zzwx = ptb(ji,jj+1,jk,jn) + xind(ji,jj,jk) * (zv * zslpy(ji,jj+1,jk)) 
    202                   zzwy = ptb(ji,jj  ,jk,jn) + xind(ji,jj,jk) * (zv * zslpy(ji,jj  ,jk)) 
     192                  zzwx = ptb(ji,jj+1,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj+1,jk) 
     193                  zzwy = ptb(ji,jj  ,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj  ,jk) 
    203194                  zwy(ji,jj,jk) = pvn(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
    204195               END DO 
    … …  
    222213         END DO         
    223214         !                                 ! trend diagnostics (contribution of upstream fluxes) 
    224          IF( l_trd )  THEN 
    225             CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptb(:,:,:,jn) ) 
    226             CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptb(:,:,:,jn) ) 
     215         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR.   & 
     216            &( cdtype == 'TRC' .AND. l_trdtrc )      )  THEN 
     217            CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptb(:,:,:,jn) ) 
     218            CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptb(:,:,:,jn) ) 
    227219         END IF 
    228220         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    … …  
    274266                  zalpha = 0.5 + z0w 
    275267                  zw  = z0w - 0.5 * pwn(ji,jj,jk+1) * zdt * zbtr  
    276                   zzwx = ptb(ji,jj,jk+1,jn) + xind(ji,jj,jk) * (zw * zslpx(ji,jj,jk+1)) 
    277                   zzwy = ptb(ji,jj,jk  ,jn) + xind(ji,jj,jk) * (zw * zslpx(ji,jj,jk  )) 
     268                  zzwx = ptb(ji,jj,jk+1,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk+1) 
     269                  zzwy = ptb(ji,jj,jk  ,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk  ) 
    278270                  zwx(ji,jj,jk+1) = pwn(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
    279271               END DO  
    … …  
    281273         END DO 
    282274 
    283          ! Compute & add the vertical advective trend 
    284          DO jk = 1, jpkm1 
     275         DO jk = 1, jpkm1                    ! Compute & add the vertical advective trend 
    285276            DO jj = 2, jpjm1       
    286277               DO ji = fs_2, fs_jpim1   ! vector opt. 
    287                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     278                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    288279                  ! vertical advective trends  
    289280                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) 
    … …  
    294285         END DO 
    295286         !                                 ! Save the vertical advective trends for diagnostic 
    296          IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zwx, pwn, ptb(:,:,:,jn) ) 
    297          ! 
    298       ENDDO 
    299       ! 
    300       CALL wrk_dealloc( jpi, jpj, jpk, zslpx, zslpy ) 
     287         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR.     & 
     288            &( cdtype == 'TRC' .AND. l_trdtrc )      )   & 
     289            CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pwn, ptb(:,:,:,jn) ) 
     290         ! 
     291      END DO 
     292      ! 
     293      CALL wrk_dealloc( jpi, jpj, jpk, zslpx, zslpy, zwx, zwy ) 
    301294      ! 
    302295      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_muscl') 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90

    r4499 r4619  
    1313   !!---------------------------------------------------------------------- 
    1414   USE oce             ! ocean dynamics and active tracers 
     15   USE trc_oce         ! share passive tracers/Ocean variables 
    1516   USE dom_oce         ! ocean space and time domain 
    16    USE trdmod_oce      ! tracers trends  
    17    USE trdtra          ! tracers trends  
     17   USE trd_oce         ! trends: ocean variables 
     18   USE trdtra          ! trends manager: tracers  
    1819   USE in_out_manager  ! I/O manager 
    1920   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient 
    20    USE trabbl          ! tracers: bottom boundary layer 
     21   USE diaptr          ! poleward transport diagnostics 
     22   ! 
    2123   USE lib_mpp         ! distribued memory computing 
    2224   USE lbclnk          ! ocean lateral boundary condition (or mpp link)  
    23    USE diaptr          ! poleward transport diagnostics 
    24    USE trc_oce         ! share passive tracers/Ocean variables 
    2525   USE wrk_nemo        ! Memory Allocation 
    2626   USE timing          ! Timing 
    … …  
    3131 
    3232   PUBLIC   tra_adv_muscl2        ! routine called by step.F90 
    33  
    34    LOGICAL  :: l_trd       ! flag to compute trends 
    3533 
    3634   !! * Substitutions 
    … …  
    6159      !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa) 
    6260      !!---------------------------------------------------------------------- 
    63       USE oce     , ONLY:   zwx   => ua    , zwy   => va         ! (ua,va) used as 3D workspace 
    64       !! 
    6561      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    6662      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    … …  
    7672      REAL(wp) ::   zv, z0v, zzwy, z0w        !   -      - 
    7773      REAL(wp) ::   ztra, zbtr, zdt, zalpha   !   -      - 
    78       REAL(wp), POINTER, DIMENSION(:,:,:) :: zslpx, zslpy 
     74      REAL(wp), POINTER, DIMENSION(:,:,:) :: zslpx, zslpy , zwx, zwy 
    7975      !!---------------------------------------------------------------------- 
    8076      ! 
    8177      IF( nn_timing == 1 )  CALL timing_start('tra_adv_muscl2') 
    8278      ! 
    83       CALL wrk_alloc( jpi, jpj, jpk, zslpx, zslpy ) 
     79      CALL wrk_alloc( jpi, jpj, jpk, zslpx, zslpy, zwx, zwy ) 
    8480      ! 
    8581 
    … …  
    9086      ENDIF 
    9187      ! 
    92       l_trd = .FALSE. 
    93       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE. 
    94  
    9588      !                                                          ! =========== 
    9689      DO jn = 1, kjpt                                            ! tracer loop 
    … …  
    200193         END DO 
    201194         !                                 ! trend diagnostics (contribution of upstream fluxes) 
    202          IF( l_trd ) THEN 
    203             CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptb(:,:,:,jn) ) 
    204             CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptb(:,:,:,jn) ) 
     195         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR.   & 
     196            &( cdtype == 'TRC' .AND. l_trdtrc )      ) THEN 
     197            CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptb(:,:,:,jn) ) 
     198            CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptb(:,:,:,jn) ) 
    205199         END IF 
    206200 
    … …  
    284278         END DO 
    285279         !                       ! trend diagnostics (contribution of upstream fluxes) 
    286          IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zwx, pwn, ptb(:,:,:,jn) ) 
     280         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR.     & 
     281            &( cdtype == 'TRC' .AND. l_trdtrc )      )   & 
     282            CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pwn, ptb(:,:,:,jn) ) 
    287283         ! 
    288284      END DO 
    289285      ! 
    290       CALL wrk_dealloc( jpi, jpj, jpk, zslpx, zslpy ) 
     286      CALL wrk_dealloc( jpi, jpj, jpk, zslpx, zslpy, zwx, zwy ) 
    291287      ! 
    292288      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_muscl2') 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r4499 r4619  
    1717   USE oce             ! ocean dynamics and active tracers 
    1818   USE dom_oce         ! ocean space and time domain 
    19    USE trdmod_oce      ! ocean space and time domain 
    20    USE trdtra          ! ocean tracers trends  
    21    USE trabbl          ! advective term in the BBL 
     19   USE trc_oce         ! share passive tracers/Ocean variables 
     20   USE trd_oce         ! trends: ocean variables 
     21   USE trdtra          ! trends manager: tracers  
     22   USE dynspg_oce      ! surface pressure gradient variables 
     23   USE diaptr          ! poleward transport diagnostics 
     24   ! 
    2225   USE lib_mpp         ! distribued memory computing 
    2326   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    24    USE dynspg_oce      ! surface pressure gradient variables 
    2527   USE in_out_manager  ! I/O manager 
    26    USE diaptr          ! poleward transport diagnostics 
    27    USE trc_oce         ! share passive tracers/Ocean variables 
    2828   USE wrk_nemo        ! Memory Allocation 
    2929   USE timing          ! Timing 
    … …  
    9393      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    9494      !!---------------------------------------------------------------------- 
    95  
    9695      ! 
    9796      IF( nn_timing == 1 )  CALL timing_start('tra_adv_qck') 
    … …  
    103102         IF(lwp) WRITE(numout,*) 
    104103      ENDIF 
    105       ! 
    106104      l_trd = .FALSE. 
    107       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 
    108  
     105      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE. 
     106      ! 
    109107      ! I. The horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme 
    110108      CALL tra_adv_qck_i( kt, cdtype, p2dt, pun, ptb, ptn, pta, kjpt )  
    … …  
    124122      !! 
    125123      !!---------------------------------------------------------------------- 
    126       USE oce     , ONLY:   zwx => ua       ! ua used as workspace 
    127       ! 
    128124      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    129125      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    … …  
    136132      INTEGER  :: ji, jj, jk, jn   ! dummy loop indices 
    137133      REAL(wp) :: ztra, zbtr, zdir, zdx, zdt, zmsk   ! local scalars 
    138       REAL(wp), POINTER, DIMENSION(:,:,:) :: zfu, zfc, zfd 
     134      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwx, zfu, zfc, zfd 
    139135      !---------------------------------------------------------------------- 
    140136      ! 
    141       CALL wrk_alloc( jpi, jpj, jpk, zfu, zfc, zfd ) 
     137      CALL wrk_alloc( jpi, jpj, jpk, zwx, zfu, zfc, zfd ) 
    142138      !                                                          ! =========== 
    143139      DO jn = 1, kjpt                                            ! tracer loop 
    … …  
    233229         END DO 
    234230         !                                 ! trend diagnostics (contribution of upstream fluxes) 
    235          IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptn(:,:,:,jn) ) 
     231         IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) ) 
    236232         ! 
    237233      END DO 
    238234      ! 
    239       CALL wrk_dealloc( jpi, jpj, jpk, zfu, zfc, zfd ) 
     235      CALL wrk_dealloc( jpi, jpj, jpk, zwx, zfu, zfc, zfd ) 
    240236      ! 
    241237   END SUBROUTINE tra_adv_qck_i 
    … …  
    247243      !! 
    248244      !!---------------------------------------------------------------------- 
    249       USE oce     , ONLY:   zwy => ua       ! ua used as workspace 
    250       ! 
    251245      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    252246      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    … …  
    259253      INTEGER  :: ji, jj, jk, jn   ! dummy loop indices 
    260254      REAL(wp) :: ztra, zbtr, zdir, zdx, zdt, zmsk   ! local scalars 
    261       REAL(wp), POINTER, DIMENSION(:,:,:) :: zfu, zfc, zfd 
     255      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwy, zfu, zfc, zfd 
    262256      !---------------------------------------------------------------------- 
    263257      ! 
    264       CALL wrk_alloc( jpi, jpj, jpk, zfu, zfc, zfd ) 
     258      CALL wrk_alloc( jpi, jpj, jpk, zwy, zfu, zfc, zfd ) 
    265259      ! 
    266260      !                                                          ! =========== 
    … …  
    359353         END DO 
    360354         !                                 ! trend diagnostics (contribution of upstream fluxes) 
    361          IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptn(:,:,:,jn) ) 
     355         IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 
    362356         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    363357         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    … …  
    368362      END DO 
    369363      ! 
    370       CALL wrk_dealloc( jpi, jpj, jpk, zfu, zfc, zfd ) 
     364      CALL wrk_dealloc( jpi, jpj, jpk, zwy, zfu, zfc, zfd ) 
    371365      ! 
    372366   END SUBROUTINE tra_adv_qck_j 
    … …  
    378372      !! 
    379373      !!---------------------------------------------------------------------- 
    380       USE oce, ONLY:   zwz => ua   ! ua used as workspace 
    381       ! 
    382374      INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index 
    383375      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
    … …  
    389381      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    390382      REAL(wp) ::   zbtr , ztra      ! local scalars 
    391       !!---------------------------------------------------------------------- 
    392  
     383      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz 
     384      !!---------------------------------------------------------------------- 
     385      ! 
     386      CALL wrk_alloc( jpi, jpj, jpk, zwz ) 
    393387      !                                                          ! =========== 
    394388      DO jn = 1, kjpt                                            ! tracer loop 
    … …  
    422416         END DO 
    423417         !                                 ! Save the vertical advective trends for diagnostic 
    424          IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zwz, pwn, ptn(:,:,:,jn) ) 
     418         IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) ) 
    425419         ! 
    426420      END DO 
     421      ! 
     422      CALL wrk_dealloc( jpi, jpj, jpk, zwz ) 
    427423      ! 
    428424   END SUBROUTINE tra_adv_cen2_k 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r4499 r4619  
    2222   USE oce            ! ocean dynamics and active tracers 
    2323   USE dom_oce        ! ocean space and time domain 
    24    USE trdmod_oce     ! tracers trends 
     24   USE trc_oce        ! share passive tracers/Ocean variables 
     25   USE trd_oce        ! trends: ocean variables 
    2526   USE trdtra         ! tracers trends 
    26    USE in_out_manager ! I/O manager 
    2727   USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient 
     28   USE diaptr         ! poleward transport diagnostics 
     29   ! 
    2830   USE lib_mpp        ! MPP library 
    2931   USE lbclnk         ! ocean lateral boundary condition (or mpp link)  
    30    USE diaptr         ! poleward transport diagnostics 
    31    USE trc_oce        ! share passive tracers/Ocean variables 
     32   USE in_out_manager ! I/O manager 
    3233   USE wrk_nemo       ! Memory Allocation 
    3334   USE timing         ! Timing 
    … …  
    9394         IF(lwp) WRITE(numout,*) 'tra_adv_tvd : TVD advection scheme on ', cdtype 
    9495         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     96         ! 
     97         l_trd = .FALSE. 
     98         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 
    9599      ENDIF 
    96       ! 
    97       l_trd = .FALSE. 
    98       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 
    99100      ! 
    100101      IF( l_trd )  THEN 
    … …  
    228229            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed 
    229230             
    230             CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, ztrdx, pun, ptn(:,:,:,jn) )    
    231             CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, ztrdy, pvn, ptn(:,:,:,jn) )   
    232             CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, ztrdz, pwn, ptn(:,:,:,jn) )  
     231            CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) )    
     232            CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) )   
     233            CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) )  
    233234         END IF 
    234235         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    … …  
    261262      !!       in-space based differencing for fluid 
    262263      !!---------------------------------------------------------------------- 
    263       ! 
    264       !!---------------------------------------------------------------------- 
    265264      REAL(wp), DIMENSION(jpk)         , INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step 
    266265      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft      ! before & after field 
    267266      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions 
    268267      ! 
    269       INTEGER ::   ji, jj, jk   ! dummy loop indices 
    270       INTEGER ::   ikm1         ! local integer 
     268      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     269      INTEGER  ::   ikm1         ! local integer 
    271270      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt   ! local scalars 
    272271      REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      - 
    … …  
    278277      CALL wrk_alloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo ) 
    279278      ! 
    280  
    281279      zbig  = 1.e+40_wp 
    282280      zrtrn = 1.e-15_wp 
    283281      zbetup(:,:,jpk) = 0._wp   ;   zbetdo(:,:,jpk) = 0._wp 
    284282 
    285  
    286283      ! Search local extrema 
    287284      ! -------------------- 
    288285      ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land 
    289       zbup = MAX( pbef * tmask - zbig * ( 1.e0 - tmask ),   & 
    290          &        paft * tmask - zbig * ( 1.e0 - tmask )  ) 
    291       zbdo = MIN( pbef * tmask + zbig * ( 1.e0 - tmask ),   & 
    292          &        paft * tmask + zbig * ( 1.e0 - tmask )  ) 
     286      zbup = MAX( pbef * tmask - zbig * ( 1._wp - tmask ),   & 
     287         &        paft * tmask - zbig * ( 1._wp - tmask )  ) 
     288      zbdo = MIN( pbef * tmask + zbig * ( 1._wp - tmask ),   & 
     289         &        paft * tmask + zbig * ( 1._wp - tmask )  ) 
    293290 
    294291      DO jk = 1, jpkm1 
    … …  
    334331         DO jj = 2, jpjm1 
    335332            DO ji = fs_2, fs_jpim1   ! vector opt. 
    336                zau = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) ) 
    337                zbu = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) ) 
     333               zau = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) ) 
     334               zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) ) 
    338335               zcu =       ( 0.5  + SIGN( 0.5 , paa(ji,jj,jk) ) ) 
    339                paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1.e0 - zcu) * zbu ) 
    340  
    341                zav = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) ) 
    342                zbv = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) ) 
     336               paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1._wp - zcu) * zbu ) 
     337 
     338               zav = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) ) 
     339               zbv = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) ) 
    343340               zcv =       ( 0.5  + SIGN( 0.5 , pbb(ji,jj,jk) ) ) 
    344                pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1.e0 - zcv) * zbv ) 
     341               pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1._wp - zcv) * zbv ) 
    345342 
    346343      ! monotonic flux in the k direction, i.e. pcc 
    … …  
    349346               zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) ) 
    350347               zc =       ( 0.5  + SIGN( 0.5 , pcc(ji,jj,jk+1) ) ) 
    351                pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1.e0 - zc) * zb ) 
     348               pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb ) 
    352349            END DO 
    353350         END DO 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    r4499 r4619  
    1414   USE oce            ! ocean dynamics and active tracers 
    1515   USE dom_oce        ! ocean space and time domain 
    16    USE trdmod_oce     ! ocean space and time domain 
    17    USE trdtra 
    18    USE lib_mpp 
     16   USE trc_oce        ! share passive tracers/Ocean variables 
     17   USE trd_oce        ! trends: ocean variables 
     18   USE trdtra         ! trends manager: tracers  
     19   USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient 
     20   USE diaptr         ! poleward transport diagnostics 
     21   ! 
     22   USE lib_mpp        ! I/O library 
    1923   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
    2024   USE in_out_manager ! I/O manager 
    21    USE diaptr         ! poleward transport diagnostics 
    22    USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient 
    23    USE trc_oce        ! share passive tracers/Ocean variables 
    2425   USE wrk_nemo       ! Memory Allocation 
    2526   USE timing         ! Timing 
    … …  
    5152      !!      and add it to the general trend of passive tracer equations. 
    5253      !! 
    53       !! ** Method  :   The upstream biased 3rd order scheme (UBS) is based on an 
     54      !! ** Method  :   The upstream biased scheme (UBS) is based on a 3rd order 
    5455      !!      upstream-biased parabolic interpolation (Shchepetkin and McWilliams 2005) 
    5556      !!      It is only used in the horizontal direction. 
    5657      !!      For example the i-component of the advective fluxes are given by : 
    5758      !!                !  e2u e3u un ( mi(Tn) - zltu(i  ) )   if un(i) >= 0 
    58       !!          zwx = !  or  
     59      !!          ztu = !  or  
    5960      !!                !  e2u e3u un ( mi(Tn) - zltu(i+1) )   if un(i) < 0 
    6061      !!      where zltu is the second derivative of the before temperature field: 
    … …  
    7677      !!             Farrow, D.E., Stevens, D.P., 1995, J. Phys. Ocean. 25, 1731Ð1741.  
    7778      !!---------------------------------------------------------------------- 
    78       USE oce     , ONLY:   zwx  => ua       , zwy  => va         ! (ua,va) used as workspace 
    79       ! 
    8079      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    8180      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    … …  
    9897      CALL wrk_alloc( jpi, jpj, jpk, ztu, ztv, zltu, zltv, zti, ztw ) 
    9998      ! 
    100  
    10199      IF( kt == kit000 )  THEN 
    102100         IF(lwp) WRITE(numout,*) 
    … …  
    151149                  zcenvt = pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) ) 
    152150                  ! UBS advective fluxes 
    153                   zwx(ji,jj,jk) = 0.5 * ( zcenut - zfp_ui * zltu(ji,jj,jk) - zfm_ui * zltu(ji+1,jj,jk) ) 
    154                   zwy(ji,jj,jk) = 0.5 * ( zcenvt - zfp_vj * zltv(ji,jj,jk) - zfm_vj * zltv(ji,jj+1,jk) ) 
     151                  ztu(ji,jj,jk) = 0.5 * ( zcenut - zfp_ui * zltu(ji,jj,jk) - zfm_ui * zltu(ji+1,jj,jk) ) 
     152                  ztv(ji,jj,jk) = 0.5 * ( zcenvt - zfp_vj * zltv(ji,jj,jk) - zfm_vj * zltv(ji,jj+1,jk) ) 
    155153               END DO 
    156154            END DO 
    … …  
    159157         zltu(:,:,:) = pta(:,:,:,jn)      ! store pta trends 
    160158 
    161          ! Horizontal advective trends 
    162          DO jk = 1, jpkm1 
    163             !  Tracer flux divergence at t-point added to the general trend 
     159         DO jk = 1, jpkm1                 ! Horizontal advective trends 
    164160            DO jj = 2, jpjm1 
    165161               DO ji = fs_2, fs_jpim1   ! vector opt. 
    166                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    167                   ! horizontal advective 
    168                   ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk)   & 
    169                      &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk)  ) 
    170                   ! add it to the general tracer trends 
    171                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 
     162                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                        & 
     163                     &             - (  ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk)    & 
     164                     &                + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  ) / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    172165               END DO 
    173166            END DO 
    … …  
    178171         zltu(:,:,:) = pta(:,:,:,jn) - zltu(:,:,:) 
    179172 
    180          ! 3. Save the horizontal advective trends for diagnostic 
    181          ! ------------------------------------------------------ 
    182          !                                 ! trend diagnostics (contribution of upstream fluxes) 
    183          IF( l_trd ) THEN 
    184              CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptn(:,:,:,jn) ) 
    185              CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptn(:,:,:,jn) ) 
     173         !                 
     174         IF( l_trd ) THEN                  ! trend diagnostics 
     175             CALL trd_tra( kt, cdtype, jn, jptra_xad, ztu, pun, ptn(:,:,:,jn) ) 
     176             CALL trd_tra( kt, cdtype, jn, jptra_yad, ztv, pvn, ptn(:,:,:,jn) ) 
    186177         END IF 
    187178         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    188179         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    189             IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) 
    190             IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) 
     180            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( ztv(:,:,:) ) 
     181            IF( jn == jp_sal )  str_adv(:) = ptr_vj( ztv(:,:,:) ) 
    191182         ENDIF 
    192183          
    … …  
    265256               END DO 
    266257            END DO 
    267             CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zltv ) 
     258            CALL trd_tra( kt, cdtype, jn, jptra_zad, zltv ) 
    268259         ENDIF 
    269260         ! 
    270       ENDDO 
     261      END DO 
    271262      ! 
    272263      CALL wrk_dealloc( jpi, jpj, jpk, ztu, ztv, zltu, zltv, zti, ztw ) 
    … …  
    290281      !!       in-space based differencing for fluid 
    291282      !!---------------------------------------------------------------------- 
    292       ! 
    293283      REAL(wp), INTENT(in   ), DIMENSION(jpk)          ::   p2dt   ! vertical profile of tracer time-step 
    294284      REAL(wp),                DIMENSION (jpi,jpj,jpk) ::   pbef   ! before field 
    … …  
    306296      CALL wrk_alloc( jpi, jpj, jpk, zbetup, zbetdo ) 
    307297      ! 
    308  
    309298      zbig  = 1.e+40_wp 
    310299      zrtrn = 1.e-15_wp 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

    r4147 r4619  
    1818   USE dom_oce         ! domain: ocean 
    1919   USE phycst          ! physical constants 
    20    USE trdmod_oce      ! trends: ocean variables  
    21    USE trdtra          ! trends: active tracers  
     20   USE trd_oce         ! trends: ocean variables 
     21   USE trdtra          ! trends manager: tracers  
    2222   USE in_out_manager  ! I/O manager 
    2323   USE prtctl          ! Print control 
    … …  
    8484      ! 
    8585      !                             !  Add the geothermal heat flux trend on temperature 
    86 #if defined key_vectopt_loop 
    87       DO jj = 1, 1 
    88          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    89 #else 
    9086      DO jj = 2, jpjm1 
    9187         DO ji = 2, jpim1 
    92 #endif 
    9388            ik = mbkt(ji,jj) 
    9489            zqgh_trd = qgh_trd0(ji,jj) / fse3t(ji,jj,ik) 
    … …  
    9994      IF( l_trdtra ) THEN        ! Save the geothermal heat flux trend for diagnostics 
    10095         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    101          CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_bbc, ztrdt ) 
     96         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrdt ) 
    10297         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt ) 
    10398      ENDIF 
    … …  
    130125      INTEGER  ::   inum                ! temporary logical unit 
    131126      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    132       !! 
     127      ! 
    133128      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst  
    134129      !!---------------------------------------------------------------------- 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r4292 r4619  
    1212   !!             -   ! 2010-06  (C. Ethe, G. Madec)  merge TRA-TRC 
    1313   !!             -   ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level 
     14   !!             -   ! 2013-04  (F. Roquet, G. Madec)  use of eosbn2 instead of local hard coded alpha and beta 
    1415   !!---------------------------------------------------------------------- 
    1516#if   defined key_trabbl   ||   defined key_esopa 
    … …  
    2829   USE phycst         ! physical constant 
    2930   USE eosbn2         ! equation of state 
    30    USE trdmod_oce     ! trends: ocean variables 
     31   USE trd_oce     ! trends: ocean variables 
    3132   USE trdtra         ! trends: active tracers 
    32    USE iom            ! IOM server 
     33   ! 
     34   USE iom            ! IOM library                
    3335   USE in_out_manager ! I/O manager 
    3436   USE lbclnk         ! ocean lateral boundary conditions 
    … …  
    3638   USE wrk_nemo       ! Memory Allocation 
    3739   USE timing         ! Timing 
    38  
     40   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3941 
    4042   IMPLICIT NONE 
    … …  
    5759   REAL(wp), PUBLIC ::   rn_gambbl   !: lateral coeff. for bottom boundary layer scheme [s] 
    5860 
    59    LOGICAL , PUBLIC ::   l_bbl                  !: flag to compute bbl diffu. flux coef and transport 
     61   LOGICAL , PUBLIC ::   l_bbl       !: flag to compute bbl diffu. flux coef and transport 
    6062 
    6163   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   utr_bbl  , vtr_bbl   ! u- (v-) transport in the bottom boundary layer 
    … …  
    8486         &      vtr_bbl  (jpi,jpj) , ahv_bbl  (jpi,jpj) , mbkv_d  (jpi,jpj) , mgrhv(jpi,jpj) ,     & 
    8587         &      ahu_bbl_0(jpi,jpj) , ahv_bbl_0(jpi,jpj) ,                                          & 
    86          &      e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) , STAT= tra_bbl_alloc                ) 
     88         &      e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) ,                                      STAT=tra_bbl_alloc ) 
    8789         ! 
    8890      IF( lk_mpp            )   CALL mpp_sum ( tra_bbl_alloc ) 
    … …  
    104106      !!---------------------------------------------------------------------- 
    105107      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
    106       !! 
     108      ! 
    107109      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    108110      !!---------------------------------------------------------------------- 
    … …  
    110112      IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl') 
    111113      ! 
    112       IF( l_trdtra )   THEN                        !* Save ta and sa trends 
     114      IF( l_trdtra )   THEN                         !* Save ta and sa trends 
    113115         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
    114116         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    … …  
    116118      ENDIF 
    117119 
    118       IF( l_bbl )  CALL bbl( kt, nit000, 'TRA' )   !* bbl coef. and transport (only if not already done in trcbbl) 
    119  
    120       IF( nn_bbl_ldf == 1 ) THEN                   !* Diffusive bbl 
     120      IF( l_bbl )   CALL bbl( kt, nit000, 'TRA' )   !* bbl coef. and transport (only if not already done in trcbbl) 
     121 
     122      IF( nn_bbl_ldf == 1 ) THEN                    !* Diffusive bbl 
    121123         ! 
    122124         CALL tra_bbl_dif( tsb, tsa, jpts ) 
    123125         IF( ln_ctl )  & 
    124126         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbl_ldf  - Ta: ', mask1=tmask, & 
    125          &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     127            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    126128         ! lateral boundary conditions ; just need for outputs 
    127129         CALL lbc_lnk( ahu_bbl, 'U', 1. )     ;     CALL lbc_lnk( ahv_bbl, 'V', 1. ) 
    … …  
    131133      END IF 
    132134 
    133       IF( nn_bbl_adv /= 0 ) THEN                !* Advective bbl 
     135      IF( nn_bbl_adv /= 0 ) THEN                    !* Advective bbl 
    134136         ! 
    135137         CALL tra_bbl_adv( tsb, tsa, jpts ) 
    136138         IF(ln_ctl)   & 
    137139         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbl_adv  - Ta: ', mask1=tmask,   & 
    138          &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     140            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    139141         ! lateral boundary conditions ; just need for outputs 
    140142         CALL lbc_lnk( utr_bbl, 'U', 1. )     ;   CALL lbc_lnk( vtr_bbl, 'V', 1. ) 
    … …  
    147149         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    148150         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 
    149          CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_bbl, ztrdt ) 
    150          CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_bbl, ztrds ) 
     151         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrdt ) 
     152         CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrds ) 
    151153         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
    152154      ENDIF 
    … …  
    164166      !!                advection terms. 
    165167      !! 
    166       !! ** Method  : 
    167       !!        * diffusive bbl (nn_bbl_ldf=1) : 
     168      !! ** Method  : * diffusive bbl only (nn_bbl_ldf=1) : 
    168169      !!        When the product grad( rho) * grad(h) < 0 (where grad is an 
    169170      !!      along bottom slope gradient) an additional lateral 2nd order 
    … …  
    179180      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 
    180181      !!---------------------------------------------------------------------- 
    181       ! 
    182182      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers 
    183183      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields 
    … …  
    196196      DO jn = 1, kjpt                                     ! tracer loop 
    197197         !                                                ! =========== 
    198 #  if defined key_vectopt_loop 
    199          DO jj = 1, 1   ! vector opt. (forced unrolling) 
    200             DO ji = 1, jpij 
    201 #else 
    202198         DO jj = 1, jpj 
    203199            DO ji = 1, jpi 
    204 #endif 
    205                ik = mbkt(ji,jj)                        ! bottom T-level index 
    206                zptb(ji,jj) = ptb(ji,jj,ik,jn)              ! bottom before T and S 
     200               zptb(ji,jj) = ptb(ji,jj,mbkt(ji,jj),jn)       ! bottom before T and S 
    207201            END DO 
    208202         END DO 
    209          !                                                ! Compute the trend 
    210 #  if defined key_vectopt_loop 
    211          DO jj = 1, 1   ! vector opt. (forced unrolling) 
    212             DO ji = jpi+1, jpij-jpi-1 
    213 #  else 
    214          DO jj = 2, jpjm1 
     203         !                
     204         DO jj = 2, jpjm1                                    ! Compute the trend 
    215205            DO ji = 2, jpim1 
    216 #  endif 
    217                ik = mbkt(ji,jj)                            ! bottom T-level index 
     206               ik = mbkt(ji,jj)                              ! bottom T-level index 
    218207               zbtr = r1_e12t(ji,jj)  / fse3t(ji,jj,ik) 
    219208               pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                         & 
    … …  
    264253      DO jn = 1, kjpt                                            ! tracer loop 
    265254         !                                                       ! =========== 
    266 # if defined key_vectopt_loop 
    267          DO jj = 1, 1 
    268             DO ji = 1, jpij-jpi-1   ! vector opt. (forced unrolling) 
    269 # else 
    270255         DO jj = 1, jpjm1 
    271256            DO ji = 1, jpim1            ! CAUTION start from i=1 to update i=2 when cyclic east-west 
    272 # endif 
    273257               IF( utr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero i-direction bbl advection 
    274258                  ! down-slope i/k-indices (deep)      &   up-slope i/k indices (shelf) 
    … …  
    333317      !!                advection terms. 
    334318      !! 
    335       !! ** Method  : 
    336       !!        * diffusive bbl (nn_bbl_ldf=1) : 
     319      !! ** Method  : * diffusive bbl (nn_bbl_ldf=1) : 
    337320      !!        When the product grad( rho) * grad(h) < 0 (where grad is an 
    338321      !!      along bottom slope gradient) an additional lateral 2nd order 
    … …  
    342325      !!      a downslope velocity of 20 cm/s if the condition for slope 
    343326      !!      convection is satified) 
    344       !!        * advective bbl (nn_bbl_adv=1 or 2) : 
     327      !!              * advective bbl (nn_bbl_adv=1 or 2) : 
    345328      !!      nn_bbl_adv = 1   use of the ocean velocity as bbl velocity 
    346329      !!      nn_bbl_adv = 2   follow Campin and Goosse (1999) implentation 
    … …  
    353336      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 
    354337      !!---------------------------------------------------------------------- 
    355       ! 
    356338      INTEGER         , INTENT(in   ) ::   kt       ! ocean time-step index 
    357       INTEGER         , INTENT(in   ) ::   kit000          ! first time step index 
     339      INTEGER         , INTENT(in   ) ::   kit000   ! first time step index 
    358340      CHARACTER(len=3), INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
    359341      !! 
    360342      INTEGER  ::   ji, jj                    ! dummy loop indices 
    361343      INTEGER  ::   ik                        ! local integers 
    362       INTEGER  ::   iis , iid , ijs , ijd     !   -       - 
    363       INTEGER  ::   ikus, ikud, ikvs, ikvd    !   -       - 
    364       REAL(wp) ::   zsign, zsigna, zgbbl      ! local scalars 
    365       REAL(wp) ::   zgdrho, zt, zs, zh        !   -      - 
    366       !! 
    367       REAL(wp) ::   fsalbt, fsbeta, pft, pfs, pfh   ! statement function 
    368       REAL(wp), POINTER, DIMENSION(:,:) :: zub, zvb, ztb, zsb, zdep 
    369       !!----------------------- zv_bbl----------------------------------------------- 
    370       ! ratio alpha/beta = fsalbt : ratio of thermal over saline expension coefficients 
    371       ! ================            pft :  potential temperature in degrees celcius 
    372       !                             pfs :  salinity anomaly (s-35) in psu 
    373       !                             pfh :  depth in meters 
    374       ! nn_eos = 0  (Jackett and McDougall 1994 formulation) 
    375       fsalbt( pft, pfs, pfh ) =                                              &   ! alpha/beta 
    376          ( ( ( -0.255019e-07 * pft + 0.298357e-05 ) * pft                    & 
    377                                    - 0.203814e-03 ) * pft                    & 
    378                                    + 0.170907e-01 ) * pft                    & 
    379                                    + 0.665157e-01                            & 
    380          +(-0.678662e-05 * pfs - 0.846960e-04 * pft + 0.378110e-02 ) * pfs   & 
    381          +  ( ( - 0.302285e-13 * pfh                                         & 
    382                 - 0.251520e-11 * pfs                                         & 
    383                 + 0.512857e-12 * pft * pft          ) * pfh                  & 
    384                                      - 0.164759e-06   * pfs                  & 
    385              +(   0.791325e-08 * pft - 0.933746e-06 ) * pft                  & 
    386                                      + 0.380374e-04 ) * pfh 
    387       fsbeta( pft, pfs, pfh ) =                                              &   ! beta 
    388          ( ( -0.415613e-09 * pft + 0.555579e-07 ) * pft                      & 
    389                                  - 0.301985e-05 ) * pft                      & 
    390                                  + 0.785567e-03                              & 
    391          + (     0.515032e-08 * pfs                                          & 
    392                + 0.788212e-08 * pft - 0.356603e-06 ) * pfs                   & 
    393                +(  (   0.121551e-17 * pfh                                    & 
    394                      - 0.602281e-15 * pfs                                    & 
    395                      - 0.175379e-14 * pft + 0.176621e-12 ) * pfh             & 
    396                                           + 0.408195e-10   * pfs             & 
    397                  + ( - 0.213127e-11 * pft + 0.192867e-09 ) * pft             & 
    398                                           - 0.121555e-07 ) * pfh 
    399       !!---------------------------------------------------------------------- 
    400  
     344      INTEGER  ::   iis, iid, ikus, ikud      !   -       - 
     345      INTEGER  ::   ijs, ijd, ikvs, ikvd      !   -       - 
     346      REAL(wp) ::   za, zb, zgdrho            ! local scalars 
     347      REAL(wp) ::   zsign, zsigna, zgbbl      !   -      - 
     348      REAL(wp), DIMENSION(jpi,jpj,jpts)   :: zts, zab         ! 3D workspace 
     349      REAL(wp), DIMENSION(jpi,jpj)        :: zub, zvb, zdep   ! 2D workspace 
     350      !!---------------------------------------------------------------------- 
    401351      ! 
    402352      IF( nn_timing == 1 )  CALL timing_start( 'bbl') 
    403353      ! 
    404       CALL wrk_alloc( jpi, jpj, zub, zvb, ztb, zsb, zdep ) 
    405       ! 
    406  
    407354      IF( kt == kit000 )  THEN 
    408355         IF(lwp)  WRITE(numout,*) 
    … …  
    410357         IF(lwp)  WRITE(numout,*) '~~~~~~~~~~' 
    411358      ENDIF 
    412  
    413       !                                        !* bottom temperature, salinity, velocity and depth 
    414 #if defined key_vectopt_loop 
    415       DO jj = 1, 1   ! vector opt. (forced unrolling) 
    416          DO ji = 1, jpij 
    417 #else 
     359      !                                        !* bottom variables (T, S, alpha, beta, depth, velocity) 
    418360      DO jj = 1, jpj 
    419361         DO ji = 1, jpi 
    420 #endif 
    421             ik = mbkt(ji,jj)                        ! bottom T-level index 
    422             ztb (ji,jj) = tsb(ji,jj,ik,jp_tem) * tmask(ji,jj,1)      ! bottom before T and S 
    423             zsb (ji,jj) = tsb(ji,jj,ik,jp_sal) * tmask(ji,jj,1) 
    424             zdep(ji,jj) = gdept_0(ji,jj,ik)         ! bottom T-level reference depth 
     362            ik = mbkt(ji,jj)                             ! bottom T-level index 
     363            zts (ji,jj,jp_tem) = tsb(ji,jj,ik,jp_tem)    ! bottom before T and S 
     364            zts (ji,jj,jp_sal) = tsb(ji,jj,ik,jp_sal) 
    425365            ! 
    426             zub(ji,jj) = un(ji,jj,mbku(ji,jj))      ! bottom velocity 
    427             zvb(ji,jj) = vn(ji,jj,mbkv(ji,jj)) 
     366            zdep(ji,jj) = fsdept(ji,jj,ik)               ! bottom T-level reference depth 
     367            zub (ji,jj) = un(ji,jj,mbku(ji,jj))          ! bottom velocity 
     368            zvb (ji,jj) = vn(ji,jj,mbkv(ji,jj)) 
    428369         END DO 
    429370      END DO 
    430  
     371      ! 
     372      CALL eos_rab( zts, zdep, zab ) 
     373      ! 
    431374      !                                   !-------------------! 
    432375      IF( nn_bbl_ldf == 1 ) THEN          !   diffusive bbl   ! 
    433376         !                                !-------------------! 
    434377         DO jj = 1, jpjm1                      ! (criteria for non zero flux: grad(rho).grad(h) < 0 ) 
    435             DO ji = 1, jpim1 
    436                !                                                ! i-direction 
    437                zt = 0.5 * ( ztb (ji,jj) + ztb (ji+1,jj) )  ! T, S anomalie, and depth 
    438                zs = 0.5 * ( zsb (ji,jj) + zsb (ji+1,jj) ) - 35.0 
    439                zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 
    440                !                                                         ! masked bbl i-gradient of density 
    441                zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji+1,jj) - ztb(ji,jj) )    & 
    442                   &                             - ( zsb(ji+1,jj) - zsb(ji,jj) )  ) * umask(ji,jj,1) 
     378            DO ji = 1, fs_jpim1   ! vector opt. 
     379               !                                                   ! i-direction 
     380               za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)              ! 2*(alpha,beta) at u-point 
     381               zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal) 
     382               !                                                         ! 2*masked bottom density gradient 
     383               zgdrho = (  za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) )    & 
     384                  &      - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) )  ) * umask(ji,jj,1) 
    443385               ! 
    444                zsign          = SIGN(  0.5, - zgdrho * REAL( mgrhu(ji,jj) )  )    ! sign of ( i-gradient * i-slope ) 
    445                ahu_bbl(ji,jj) = ( 0.5 - zsign ) * ahu_bbl_0(ji,jj)                  ! masked diffusive flux coeff. 
     386               zsign  = SIGN(  0.5, -zgdrho * REAL( mgrhu(ji,jj) )  )    ! sign of ( i-gradient * i-slope ) 
     387               ahu_bbl(ji,jj) = ( 0.5 - zsign ) * ahu_bbl_0(ji,jj)       ! masked diffusive flux coeff. 
    446388               ! 
    447                !                                                ! j-direction 
    448                zt = 0.5 * ( ztb (ji,jj+1) + ztb (ji,jj) )                ! T, S anomalie, and depth 
    449                zs = 0.5 * ( zsb (ji,jj+1) + zsb (ji,jj) ) - 35.0 
    450                zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) ) 
    451                !                                                         ! masked bbl j-gradient of density 
    452                zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji,jj+1) - ztb(ji,jj) )    & 
    453                   &                             - ( zsb(ji,jj+1) - zsb(ji,jj) )  ) * vmask(ji,jj,1) 
     389               !                                                   ! j-direction 
     390               za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)              ! 2*(alpha,beta) at v-point 
     391               zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal) 
     392               !                                                         ! 2*masked bottom density gradient 
     393               zgdrho = (  za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) )    & 
     394                  &      - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) )  ) * vmask(ji,jj,1) 
    454395               ! 
    455                zsign          = SIGN(  0.5, -zgdrho * REAL( mgrhv(ji,jj) )  )     ! sign of ( j-gradient * j-slope ) 
     396               zsign = SIGN(  0.5, -zgdrho * REAL( mgrhv(ji,jj) )  )     ! sign of ( j-gradient * j-slope ) 
    456397               ahv_bbl(ji,jj) = ( 0.5 - zsign ) * ahv_bbl_0(ji,jj) 
    457                ! 
    458398            END DO 
    459399         END DO 
    … …  
    469409            DO jj = 1, jpjm1                                 ! criteria: grad(rho).grad(h)<0  and grad(rho).grad(h)<0 
    470410               DO ji = 1, fs_jpim1   ! vector opt. 
    471                   !                                               ! i-direction 
    472                   zt = 0.5 * ( ztb (ji,jj) + ztb (ji+1,jj) )                  ! T, S anomalie, and depth 
    473                   zs = 0.5 * ( zsb (ji,jj) + zsb (ji+1,jj) ) - 35.0 
    474                   zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 
    475                   !                                                           ! masked bbl i-gradient of density 
    476                   zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji+1,jj) - ztb(ji,jj) )    & 
    477                      &                             - ( zsb(ji+1,jj) - zsb(ji,jj) )  ) * umask(ji,jj,1) 
    478                   ! 
    479                   zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhu(ji,jj) )  )    ! sign of i-gradient * i-slope 
    480                   zsigna= SIGN(  0.5, zub(ji,jj) * REAL( mgrhu(ji,jj) )  )    ! sign of u * i-slope 
    481                   ! 
    482                   !                                                           ! bbl velocity 
     411                  !                                                  ! i-direction 
     412                  za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at u-point 
     413                  zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal) 
     414                  !                                                          ! 2*masked bottom density gradient  
     415                  zgdrho = (  za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) )    & 
     416                            - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) )  ) * umask(ji,jj,1) 
     417                  ! 
     418                  zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhu(ji,jj) )  )   ! sign of i-gradient * i-slope 
     419                  zsigna= SIGN(  0.5, zub(ji,jj) * REAL( mgrhu(ji,jj) )  )   ! sign of u * i-slope 
     420                  ! 
     421                  !                                                          ! bbl velocity 
    483422                  utr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e2u(ji,jj) * e3u_bbl_0(ji,jj) * zub(ji,jj) 
    484423                  ! 
    485                   !                                               ! j-direction 
    486                   zt = 0.5 * ( ztb (ji,jj+1) + ztb (ji,jj) )                  ! T, S anomalie, and depth 
    487                   zs = 0.5 * ( zsb (ji,jj+1) + zsb (ji,jj) ) - 35.0 
    488                   zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) ) 
    489                   !                                                           ! masked bbl j-gradient of density 
    490                   zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji,jj+1) - ztb(ji,jj) )    & 
    491                      &                             - ( zsb(ji,jj+1) - zsb(ji,jj) )  ) * vmask(ji,jj,1) 
    492                   zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhv(ji,jj) )  )    ! sign of j-gradient * j-slope 
    493                   zsigna= SIGN(  0.5, zvb(ji,jj) * REAL( mgrhv(ji,jj) )  )    ! sign of u * i-slope 
    494                   ! 
    495                   !                                                           ! bbl velocity 
     424                  !                                                  ! j-direction 
     425                  za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at v-point 
     426                  zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal) 
     427                  !                                                          ! 2*masked bottom density gradient 
     428                  zgdrho = (  za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) )    & 
     429                     &      - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) )  ) * vmask(ji,jj,1) 
     430                  zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhv(ji,jj) )  )   ! sign of j-gradient * j-slope 
     431                  zsigna= SIGN(  0.5, zvb(ji,jj) * REAL( mgrhv(ji,jj) )  )   ! sign of u * i-slope 
     432                  ! 
     433                  !                                                          ! bbl transport 
    496434                  vtr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e1v(ji,jj) * e3v_bbl_0(ji,jj) * zvb(ji,jj) 
    497435               END DO 
    … …  
    502440            DO jj = 1, jpjm1                            ! criteria: rho_up > rho_down 
    503441               DO ji = 1, fs_jpim1   ! vector opt. 
    504                   !                                         ! i-direction 
     442                  !                                                  ! i-direction 
    505443                  ! down-slope T-point i/k-index (deep)  &   up-slope T-point i/k-index (shelf) 
    506                   iid  = ji + MAX( 0, mgrhu(ji,jj) )     ;    iis  = ji + 1 - MAX( 0, mgrhu(ji,jj) ) 
    507                   ikud = mbku_d(ji,jj)                   ;    ikus = mbku(ji,jj) 
    508                   ! 
    509                   !                                             ! mid-depth density anomalie (up-slope minus down-slope) 
    510                   zt = 0.5 * ( ztb (ji,jj) + ztb (ji+1,jj) )           ! mid slope depth of T, S, and depth 
    511                   zs = 0.5 * ( zsb (ji,jj) + zsb (ji+1,jj) ) - 35.0 
    512                   zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 
    513                   zgdrho =    fsbeta( zt, zs, zh )                                    & 
    514                      &   * (  fsalbt( zt, zs, zh ) * ( ztb(iid,jj) - ztb(iis,jj) )    & 
    515                      &                             - ( zsb(iid,jj) - zsb(iis,jj) )  ) * umask(ji,jj,1) 
    516                   zgdrho = MAX( 0.e0, zgdrho )                         ! only if shelf is denser than deep 
    517                   ! 
    518                   !                                             ! bbl transport (down-slope direction) 
     444                  iid  = ji + MAX( 0, mgrhu(ji,jj) ) 
     445                  iis  = ji + 1 - MAX( 0, mgrhu(ji,jj) ) 
     446                  ! 
     447                  ikud = mbku_d(ji,jj) 
     448                  ikus = mbku(ji,jj) 
     449                  ! 
     450                  za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at u-point 
     451                  zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal) 
     452                  !                                                          !   masked bottom density gradient 
     453                  zgdrho = 0.5 * (  za * ( zts(iid,jj,jp_tem) - zts(iis,jj,jp_tem) )    & 
     454                     &            - zb * ( zts(iid,jj,jp_sal) - zts(iis,jj,jp_sal) )  ) * umask(ji,jj,1) 
     455                  zgdrho = MAX( 0.e0, zgdrho )                               ! only if shelf is denser than deep 
     456                  ! 
     457                  !                                                          ! bbl transport (down-slope direction) 
    519458                  utr_bbl(ji,jj) = e2u(ji,jj) * e3u_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhu(ji,jj) ) 
    520459                  ! 
    521                   !                                         ! j-direction 
     460                  !                                                  ! j-direction 
    522461                  !  down-slope T-point j/k-index (deep)  &   of the up  -slope T-point j/k-index (shelf) 
    523                   ijd  = jj + MAX( 0, mgrhv(ji,jj) )      ;    ijs  = jj + 1 - MAX( 0, mgrhv(ji,jj) ) 
    524                   ikvd = mbkv_d(ji,jj)                    ;    ikvs = mbkv(ji,jj) 
    525                   ! 
    526                   !                                             ! mid-depth density anomalie (up-slope minus down-slope) 
    527                   zt = 0.5 * ( ztb (ji,jj) + ztb (ji,jj+1) )           ! mid slope depth of T, S, and depth 
    528                   zs = 0.5 * ( zsb (ji,jj) + zsb (ji,jj+1) ) - 35.0 
    529                   zh = 0.5 * ( zdep(ji,jj) + zdep(ji,jj+1) ) 
    530                   zgdrho =    fsbeta( zt, zs, zh )                                    & 
    531                      &   * (  fsalbt( zt, zs, zh ) * ( ztb(ji,ijd) - ztb(ji,ijs) )    & 
    532                      &                             - ( zsb(ji,ijd) - zsb(ji,ijs) )  ) * vmask(ji,jj,1) 
    533                   zgdrho = MAX( 0.e0, zgdrho )                         ! only if shelf is denser than deep 
    534                   ! 
    535                   !                                             ! bbl transport (down-slope direction) 
     462                  ijd  = jj + MAX( 0, mgrhv(ji,jj) ) 
     463                  ijs  = jj + 1 - MAX( 0, mgrhv(ji,jj) ) 
     464                  ! 
     465                  ikvd = mbkv_d(ji,jj) 
     466                  ikvs = mbkv(ji,jj) 
     467                  ! 
     468                  za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at v-point 
     469                  zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal) 
     470                  !                                                          !   masked bottom density gradient 
     471                  zgdrho = 0.5 * (  za * ( zts(ji,ijd,jp_tem) - zts(ji,ijs,jp_tem) )    & 
     472                     &            - zb * ( zts(ji,ijd,jp_sal) - zts(ji,ijs,jp_sal) )  ) * vmask(ji,jj,1) 
     473                  zgdrho = MAX( 0.e0, zgdrho )                               ! only if shelf is denser than deep 
     474                  ! 
     475                  !                                                          ! bbl transport (down-slope direction) 
    536476                  vtr_bbl(ji,jj) = e1v(ji,jj) * e3v_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhv(ji,jj) ) 
    537477               END DO 
    … …  
    541481      ENDIF 
    542482      ! 
    543       CALL wrk_dealloc( jpi, jpj, zub, zvb, ztb, zsb, zdep ) 
    544       ! 
    545483      IF( nn_timing == 1 )  CALL timing_stop( 'bbl') 
    546484      ! 
    … …  
    558496      !!---------------------------------------------------------------------- 
    559497      INTEGER ::   ji, jj               ! dummy loop indices 
    560       INTEGER ::   ii0, ii1, ij0, ij1   ! temporary integer 
    561       INTEGER  ::   ios                 ! Local integer output status for namelist read 
     498      INTEGER ::   ii0, ii1, ij0, ij1   ! local integer 
     499      INTEGER ::   ios                  !   -      - 
    562500      REAL(wp), POINTER, DIMENSION(:,:) :: zmbk 
    563501      !! 
    … …  
    598536      IF( nn_bbl_adv == 2 )    WRITE(numout,*) '       * Advective BBL using velocity = F( delta rho)' 
    599537 
    600       IF( nn_eos /= 0 )   CALL ctl_stop ( ' bbl parameterisation requires eos = 0. We stop.' ) 
    601  
    602538      !                             !* vertical index of  "deep" bottom u- and v-points 
    603539      DO jj = 1, jpjm1                    ! (the "shelf" bottom k-indices are mbku and mbkv) 
    … …  
    607543         END DO 
    608544      END DO 
    609       ! convert into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
     545      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
    610546      zmbk(:,:) = REAL( mbku_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'U',1.)   ;   mbku_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
    611547      zmbk(:,:) = REAL( mbkv_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
    612548 
    613                                      !* sign of grad(H) at u- and v-points 
    614       mgrhu(jpi,:) = 0.    ;    mgrhu(:,jpj) = 0.   ;    mgrhv(jpi,:) = 0.    ;    mgrhv(:,jpj) = 0. 
     549                                        !* sign of grad(H) at u- and v-points 
     550      mgrhu(jpi,:) = 0   ;   mgrhu(:,jpj) = 0   ;   mgrhv(jpi,:) = 0   ;   mgrhv(:,jpj) = 0 
    615551      DO jj = 1, jpjm1 
    616552         DO ji = 1, jpim1 
    617             mgrhu(ji,jj) = INT(  SIGN( 1.e0, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) )  ) 
    618             mgrhv(ji,jj) = INT(  SIGN( 1.e0, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) )  ) 
     553            mgrhu(ji,jj) = INT(  SIGN( 1.e0, fsdept_0(ji+1,jj,mbkt(ji+1,jj)) - fsdept_0(ji,jj,mbkt(ji,jj)) )  ) 
     554            mgrhv(ji,jj) = INT(  SIGN( 1.e0, fsdept_0(ji,jj+1,mbkt(ji,jj+1)) - fsdept_0(ji,jj,mbkt(ji,jj)) )  ) 
    619555         END DO 
    620556      END DO 
    621557 
    622558      DO jj = 1, jpjm1              !* bbl thickness at u- (v-) point 
    623          DO ji = 1, jpim1           ! minimum of top & bottom e3u_0 (e3v_0) 
    624             e3u_bbl_0(ji,jj) = MIN( e3u_0(ji,jj,mbkt(ji+1,jj  )), e3u_0(ji,jj,mbkt(ji,jj)) ) 
    625             e3v_bbl_0(ji,jj) = MIN( e3v_0(ji,jj,mbkt(ji  ,jj+1)), e3v_0(ji,jj,mbkt(ji,jj)) ) 
     559         DO ji = 1, jpim1                 ! minimum of top & bottom e3u_0 (e3v_0) 
     560            e3u_bbl_0(ji,jj) = MIN( fse3u_0(ji,jj,mbkt(ji+1,jj  )), fse3u_0(ji,jj,mbkt(ji,jj)) ) 
     561            e3v_bbl_0(ji,jj) = MIN( fse3v_0(ji,jj,mbkt(ji  ,jj+1)), fse3v_0(ji,jj,mbkt(ji,jj)) ) 
    626562         END DO 
    627563      END DO 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90

    r4292 r4619  
    2828   USE dom_oce        ! ocean: domain variables 
    2929   USE c1d            ! 1D vertical configuration 
    30    USE trdmod_oce     ! ocean: trend variables 
    31    USE trdtra         ! active tracers: trends 
     30   USE trd_oce        ! trends: ocean variables 
     31   USE trdtra         ! trends manager: tracers  
    3232   USE zdf_oce        ! ocean: vertical physics 
    3333   USE phycst         ! physical constants 
    … …  
    4848   PUBLIC   dtacof_zoom  ! routine called by tradmp.F90, trcdmp.F90 and dyndmp.F90 
    4949 
     50!!gm  why all namelist variable public????   only ln_tradmp should be sufficient 
     51 
    5052   !                               !!* Namelist namtra_dmp : T & S newtonian damping * 
    5153   LOGICAL , PUBLIC ::   ln_tradmp   !: internal damping flag 
    … …  
    112114      ! 
    113115      CALL wrk_alloc( jpi, jpj, jpk, jpts,  zts_dta ) 
     116      ! 
    114117      !                           !==   input T-S data at kt   ==! 
    115118      CALL dta_tsd( kt, zts_dta )            ! read and interpolates T-S data at kt 
    … …  
    172175      ! 
    173176      IF( l_trdtra )   THEN       ! trend diagnostic 
    174          CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_dmp, ttrdmp ) 
    175          CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_dmp, strdmp ) 
     177         CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ttrdmp ) 
     178         CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, strdmp ) 
    176179      ENDIF 
    177180      !                           ! Control print 
    … …  
    194197      !! ** Method  :   read the namtra_dmp namelist and check the parameters 
    195198      !!---------------------------------------------------------------------- 
     199      INTEGER  ::   ios   ! Local integer output status for namelist read 
     200      !! 
    196201      NAMELIST/namtra_dmp/ ln_tradmp, nn_hdmp, nn_zdmp, rn_surf, rn_bot, rn_dep, nn_file 
    197       INTEGER  ::   ios                 ! Local integer output status for namelist read 
    198       !!---------------------------------------------------------------------- 
    199  
     202      !!---------------------------------------------------------------------- 
     203      ! 
    200204      REWIND( numnam_ref )              ! Namelist namtra_dmp in reference namelist : Temperature and salinity damping term 
    201205      READ  ( numnam_ref, namtra_dmp, IOSTAT = ios, ERR = 901) 
    202206901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in reference namelist', lwp ) 
    203  
     207      ! 
    204208      REWIND( numnam_cfg )              ! Namelist namtra_dmp in configuration namelist : Temperature and salinity damping term 
    205209      READ  ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 ) 
    … …  
    228232         IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' ) 
    229233         ! 
     234!!gm  I don't understand the specificities of c1d case......    
     235!!gm  to be check with the autor of these lines 
     236          
    230237#if ! defined key_c1d 
    231238         SELECT CASE ( nn_hdmp ) 

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

    r4488 r4619  
    2323   USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine) 
    2424   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 
     25   USE trd_oce         ! trends: ocean variables 
     26   USE trdtra          ! trends manager: tracers  
     27   ! 
    2728   USE prtctl          ! Print control 
    2829   USE in_out_manager  ! I/O manager 
    … …  
    3536   PRIVATE 
    3637 
    37    PUBLIC   tra_ldf         ! called by step.F90  
    38    PUBLIC   tra_ldf_init    ! called by opa.F90  
     38   PUBLIC   tra_ldf        ! called by step.F90  
     39   PUBLIC   tra_ldf_init   ! called by opa.F90  
    3940   ! 
    4041   INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_traldf_... namlist logicals) 
    … …  
    112113         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    113114         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 
    114          CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_ldf, ztrdt ) 
    115          CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_ldf, ztrds ) 
     115         CALL trd_tra( kt, 'TRA', jp_tem, jptra_ldf, ztrdt ) 
     116         CALL trd_tra( kt, 'TRA', jp_sal, jptra_ldf, ztrds ) 
    116117         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )  
    117118      ENDIF 
    … …  
    174175            IF ( ln_traldf_iso   )   nldf = 1      ! isoneutral (   rotation) 
    175176         ENDIF 
    176          IF ( ln_zps ) THEN             ! z-coordinate 
     177         IF ( ln_zps ) THEN             ! zps-coordinate 
    177178            IF ( ln_traldf_level )   ierr = 1      ! iso-level not allowed 
    178179            IF ( ln_traldf_hor   )   nldf = 0      ! horizontal (no rotation) 
    179180            IF ( ln_traldf_iso   )   nldf = 1      ! isoneutral (   rotation) 
    180181         ENDIF 
    181          IF ( ln_sco ) THEN             ! z-coordinate 
     182         IF ( ln_sco ) THEN             ! s-coordinate 
    182183            IF ( ln_traldf_level )   nldf = 0      ! iso-level  (no rotation) 
    183184            IF ( ln_traldf_hor   )   nldf = 1      ! horizontal (   rotation) 
    … …  
    192193            IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
    193194         ENDIF 
    194          IF ( ln_zps ) THEN             ! z-coordinate 
     195         IF ( ln_zps ) THEN             ! zps-coordinate 
    195196            IF ( ln_traldf_level )   ierr = 1      ! iso-level not allowed  
    196197            IF ( ln_traldf_hor   )   nldf = 2      ! horizontal (no rotation) 
    197198            IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
    198199         ENDIF 
    199          IF ( ln_sco ) THEN             ! z-coordinate 
     200         IF ( ln_sco ) THEN             ! s-coordinate 
    200201            IF ( ln_traldf_level )   nldf = 2      ! iso-level  (no rotation) 
    201202            IF ( ln_traldf_hor   )   nldf = 3      ! horizontal (   rotation) 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90

    r3632 r4619  
    252252         END DO 
    253253         IF( ln_zps.and.l_grad_zps ) THEN              ! partial steps: correction at the last level 
    254 # if defined key_vectopt_loop 
    255             DO jj = 1, 1 
    256                DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    257 # else 
    258254            DO jj = 1, jpjm1 
    259255               DO ji = 1, jpim1 
    260 # endif 
    261256                  zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 
    262257                  zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90

    r4313 r4619  
    1717   USE dom_oce         ! ocean space and time domain 
    1818   USE zdf_oce         ! ocean vertical physics 
    19    USE trdmod_oce      ! ocean active tracer trends 
     19   USE trd_oce         ! ocean active tracer trends 
    2020   USE trdtra          ! ocean active tracer trends 
    2121   USE eosbn2          ! equation of state (eos routine)  
    … …  
    199199            ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    200200            ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 
    201             CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_npc, ztrdt ) 
    202             CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_npc, ztrds ) 
     201            CALL trd_tra( kt, 'TRA', jp_tem, jptra_npc, ztrdt ) 
     202            CALL trd_tra( kt, 'TRA', jp_sal, jptra_npc, ztrds ) 
    203203            CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
    204204         ENDIF 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r4328 r4619  
    2727   USE dom_oce         ! ocean space and time domain variables  
    2828   USE sbc_oce         ! surface boundary condition: ocean 
    29    USE zdf_oce         ! ??? 
     29   USE zdf_oce         ! ocean vertical mixing 
    3030   USE domvvl          ! variable volume 
    3131   USE dynspg_oce      ! surface     pressure gradient variables 
    3232   USE dynhpg          ! hydrostatic pressure gradient  
    33    USE trdmod_oce      ! ocean space and time domain variables  
    34    USE trdtra          ! ocean active tracers trends  
    35    USE phycst 
    36    USE bdy_oce 
     33   USE trd_oce         ! trends: ocean variables 
     34   USE trdtra          ! trends manager: tracers  
     35   USE traqsr          ! penetrative solar radiation (needed for nksr) 
     36   USE phycst          ! physical constant 
     37   USE ldftra_oce      ! lateral physics on tracers 
     38   USE bdy_oce         ! BDY open boundary condition variables 
    3739   USE bdytra          ! open boundary condition (bdy_tra routine) 
     40   ! 
    3841   USE in_out_manager  ! I/O manager 
    3942   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    4043   USE prtctl          ! Print control 
    41    USE traqsr          ! penetrative solar radiation (needed for nksr) 
     44   USE wrk_nemo        ! Memory allocation 
     45   USE timing          ! Timing 
    4246#if defined key_agrif 
    4347   USE agrif_opa_update 
    4448   USE agrif_opa_interp 
    4549#endif 
    46    USE wrk_nemo        ! Memory allocation 
    47    USE timing          ! Timing 
    4850 
    4951   IMPLICIT NONE 
    … …  
    8082      !!             at the local domain   boundaries through lbc_lnk call,  
    8183      !!             at the one-way open boundaries (lk_bdy=T),  
    82       !!             at the AGRIF zoom     boundaries (lk_agrif=T) 
     84      !!             at the AGRIF zoom   boundaries (lk_agrif=T) 
    8385      !! 
    8486      !!              - Update lateral boundary conditions on AGRIF children 
    … …  
    127129         ztrdt(:,:,:) = tsn(:,:,:,jp_tem)  
    128130         ztrds(:,:,:) = tsn(:,:,:,jp_sal) 
     131         IF( ln_traldf_iso ) THEN              ! diagnose the "pure" Kz diffusive trend  
     132            CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt ) 
     133            CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrds ) 
     134         ENDIF 
    129135      ENDIF 
    130136 
    … …  
    150156      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt      
    151157         DO jk = 1, jpkm1 
    152             zfact = 1.e0_wp / r2dtra(jk)              
     158            zfact = 1._wp / r2dtra(jk)              
    153159            ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact 
    154160            ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact 
    155161         END DO 
    156          CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_atf, ztrdt ) 
    157          CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_atf, ztrds ) 
     162         CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt ) 
     163         CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds ) 
    158164         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
    159165      END IF 
    … …  
    163169         &                       tab3d_2=tsn(:,:,:,jp_sal), clinfo2=       ' Sn: ', mask2=tmask ) 
    164170      ! 
    165       ! 
    166       IF( nn_timing == 1 )  CALL timing_stop('tra_nxt') 
     171      IF( nn_timing == 1 )   CALL timing_stop('tra_nxt') 
    167172      ! 
    168173   END SUBROUTINE tra_nxt 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r4333 r4619  
    1010   !!             -   !  2005-11  (G. Madec) zco, zps, sco coordinate 
    1111   !!            3.2  !  2009-04  (G. Madec & NEMO team)  
    12    !!            4.0  !  2012-05  (C. Rousset) store attenuation coef for use in ice model  
     12   !!            3.6  !  2012-05  (C. Rousset) store attenuation coef for use in ice model  
    1313   !!---------------------------------------------------------------------- 
    1414 
    … …  
    1717   !!   tra_qsr_init : solar radiation penetration initialization 
    1818   !!---------------------------------------------------------------------- 
    19    USE oce             ! ocean dynamics and active tracers 
    20    USE dom_oce         ! ocean space and time domain 
    21    USE sbc_oce         ! surface boundary condition: ocean 
    22    USE trc_oce         ! share SMS/Ocean variables 
    23    USE trdmod_oce      ! ocean variables trends 
    24    USE trdtra          ! ocean active tracers trends  
    25    USE in_out_manager  ! I/O manager 
    26    USE phycst          ! physical constants 
    27    USE prtctl          ! Print control 
    28    USE iom             ! I/O manager 
    29    USE fldread         ! read input fields 
    30    USE restart         ! ocean restart 
    31    USE lib_mpp         ! MPP library 
     19   USE oce            ! ocean dynamics and active tracers 
     20   USE dom_oce        ! ocean space and time domain 
     21   USE sbc_oce        ! surface boundary condition: ocean 
     22   USE trc_oce        ! share SMS/Ocean variables 
     23   USE trd_oce        ! trends: ocean variables 
     24   USE trdtra         ! trends manager: tracers  
     25   USE phycst         ! physical constants 
     26   USE sbc_ice,  ONLY : lk_lim3 
     27   ! 
     28   USE in_out_manager ! I/O manager 
     29   USE prtctl         ! Print control 
     30   USE iom            ! I/O manager 
     31   USE fldread        ! read input fields 
     32   USE lib_mpp        ! MPP library 
    3233   USE wrk_nemo       ! Memory Allocation 
    3334   USE timing         ! Timing 
    34    USE sbc_ice, ONLY : lk_lim3 
    3535 
    3636   IMPLICIT NONE 
    … …  
    5151   REAL(wp), PUBLIC ::   rn_si1       !: deepest depth of extinction (water type I)       (2 bands) 
    5252    
    53    ! Module variables 
    54    REAL(wp) ::   xsi0r                           !: inverse of rn_si0 
    55    REAL(wp) ::   xsi1r                           !: inverse of rn_si1 
     53   INTEGER , PUBLIC ::   nksr   !: levels below which the light cannot penetrate ( depth larger than 391 m) 
     54 
     55   REAL(wp)                  ::   xsi0r, xsi1r        ! inverse of rn_si0 and rn_si1, resp. 
     56   REAL(wp), DIMENSION(3,61) ::   rkrgb               ! tabulated attenuation coefficients for RGB absorption 
    5657   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chl   ! structure of input Chl (file informations, fields read) 
    57    INTEGER, PUBLIC ::   nksr              ! levels below which the light cannot penetrate ( depth larger than 391 m) 
    58    REAL(wp), DIMENSION(3,61) ::   rkrgb   !: tabulated attenuation coefficients for RGB absorption 
    5958 
    6059   !! * Substitutions 
    … …  
    9089      !! 
    9190      !! ** Action  : - update ta with the penetrative solar radiation trend 
    92       !!              - save the trend in ttrd ('key_trdtra') 
     91      !!              - send the trend to trdtra (l_trdtra=T) 
    9392      !! 
    9493      !! Reference  : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp. 
    9594      !!              Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516. 
    9695      !!---------------------------------------------------------------------- 
    97       ! 
    9896      INTEGER, INTENT(in) ::   kt     ! ocean time-step 
    9997      ! 
    … …  
    120118      ENDIF 
    121119 
    122       IF( l_trdtra ) THEN      ! Save ta and sa trends 
     120      IF( l_trdtra ) THEN      ! Save temperature trends 
    123121         CALL wrk_alloc( jpi, jpj, jpk, ztrdt )  
    124122         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    … …  
    145143      !                                        Compute now qsr tracer content field 
    146144      !                                        ************************************ 
    147        
    148145      !                                           ! ============================================== ! 
    149146      IF( lk_qsr_bio .AND. ln_qsr_bio ) THEN      !  bio-model fluxes  : all vertical coordinates  ! 
    … …  
    183180            IF( nn_chldta == 1 .OR. lk_vvl ) THEN            !*  Variable Chlorophyll or ocean volume 
    184181               ! 
    185                IF( nn_chldta == 1 ) THEN                             !* Variable Chlorophyll 
     182               IF( nn_chldta == 1 ) THEN                             !- Variable Chlorophyll 
    186183                  ! 
    187184                  CALL fld_read( kt, 1, sf_chl )                         ! Read Chl data and provides it at the current time step 
    … …  
    199196                     END DO 
    200197                  END DO 
    201                ELSE                                            ! Variable ocean volume but constant chrlorophyll 
    202                   zchl = 0.05                                     ! constant chlorophyll 
     198               ELSE                                                  !- Variable ocean volume but constant chrlorophyll 
     199                  zchl = 0.05                                           ! constant chlorophyll 
    203200                  irgb = NINT( 41 + 20.*LOG10( zchl ) + 1.e-15 ) 
    204                   zekb(:,:) = rkrgb(1,irgb)                       ! Separation in R-G-B depending of the chlorophyll  
     201                  zekb(:,:) = rkrgb(1,irgb)                             ! Separation in R-G-B depending of the chlorophyll  
    205202                  zekg(:,:) = rkrgb(2,irgb) 
    206203                  zekr(:,:) = rkrgb(3,irgb) 
    207204               ENDIF 
    208205               ! 
    209                zcoef  = ( 1. - rn_abs ) / 3.e0                        ! equi-partition in R-G-B 
    210                ze0(:,:,1) = rn_abs  * qsr(:,:) 
    211                ze1(:,:,1) = zcoef * qsr(:,:) 
    212                ze2(:,:,1) = zcoef * qsr(:,:) 
    213                ze3(:,:,1) = zcoef * qsr(:,:) 
    214                zea(:,:,1) =         qsr(:,:) 
     206               zcoef  = ( 1. - rn_abs ) / 3.e0                       !- equi-partition in R-G-B 
     207               ze0(:,:,1) = rn_abs * qsr(:,:) 
     208               ze1(:,:,1) =  zcoef * qsr(:,:) 
     209               ze2(:,:,1) =  zcoef * qsr(:,:) 
     210               ze3(:,:,1) =  zcoef * qsr(:,:) 
     211               zea(:,:,1) =          qsr(:,:) 
    215212               ! 
    216213               DO jk = 2, nksr+1 
    … …  
    257254               ! clem: store attenuation coefficient of the first ocean level 
    258255               IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 
     256                
     257!!gm  BUG ??????   ? ?  ? 
    259258                  oatte(:,:) = etot3(:,:,1) / r1_rau0_rcp 
    260259                  iatte(:,:) = oatte(:,:) 
    … …  
    332331      IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics 
    333332         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    334          CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_qsr, ztrdt ) 
     333         CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt ) 
    335334         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt )  
    336335      ENDIF 
    … …  
    363362      !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp. 
    364363      !!---------------------------------------------------------------------- 
    365       ! 
    366364      INTEGER  ::   ji, jj, jk                   ! dummy loop indices 
    367365      INTEGER  ::   irgb, ierror, ioptio, nqsr   ! local integer 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r3764 r4619  
    1818   USE dom_oce         ! ocean space domain variables 
    1919   USE phycst          ! physical constant 
     20   USE sbcmod          ! ln_rnf   
     21   USE sbcrnf          ! River runoff   
    2022   USE traqsr          ! solar radiation penetration 
    21    USE trdmod_oce      ! ocean trends  
    22    USE trdtra          ! ocean trends 
     23   USE trd_oce         ! trends: ocean variables 
     24   USE trdtra          ! trends manager: tracers  
     25   ! 
    2326   USE in_out_manager  ! I/O manager 
    2427   USE prtctl          ! Print control 
    25    USE sbcrnf          ! River runoff   
    26    USE sbcmod          ! ln_rnf   
    27    USE iom 
     28   USE iom             ! I/O library 
    2829   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2930   USE wrk_nemo        ! Memory Allocation 
    … …  
    3940#  include "vectopt_loop_substitute.h90" 
    4041   !!---------------------------------------------------------------------- 
    41    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     42   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    4243   !! $Id$ 
    4344   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    9192      !!         where emp, the surface freshwater budget (evaporation minus 
    9293      !!         precipitation minus runoff) given in kg/m2/s is divided 
    93       !!         by rau0 = 1020 kg/m3 (density of sea water) to obtain m/s.     
     94      !!         by rau0 (density of sea water) to obtain m/s.     
    9495      !!         Note: even though Fwe does not appear explicitly for  
    9596      !!         temperature in this routine, the heat carried by the water 
    … …  
    107108      !! ** Action  : - Update the 1st level of (ta,sa) with the trend associated 
    108109      !!                with the tracer surface boundary condition  
    109       !!              - save the trend it in ttrd ('key_trdtra') 
     110      !!              - send trends to trdtra module (l_trdtra=T) 
    110111      !!---------------------------------------------------------------------- 
    111112      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    … …  
    124125      ENDIF 
    125126 
    126       IF( l_trdtra )   THEN                    !* Save ta and sa trends 
     127      IF( l_trdtra ) THEN                    !* Save ta and sa trends 
    127128         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )  
    128129         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    … …  
    137138 
    138139      !---------------------------------------- 
    139       !        EMP, EMPS and QNS effects 
     140      !        EMP, SFX and QNS effects 
    140141      !---------------------------------------- 
    141142      !                                          Set before sbc tracer content fields 
    … …  
    146147              & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN 
    147148            IF(lwp) WRITE(numout,*) '          nit000-1 surface tracer content forcing fields red in the restart file' 
    148             zfact = 0.5e0 
     149            zfact = 0.5_wp 
    149150            CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) )   ! before heat content sbc trend 
    150151            CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) )   ! before salt content sbc trend 
    151152         ELSE                                         ! No restart or restart not found: Euler forward time stepping 
    152             zfact = 1.e0 
    153             sbc_tsc_b(:,:,:) = 0.e0 
     153            zfact = 1._wp 
     154            sbc_tsc_b(:,:,:) = 0._wp 
    154155         ENDIF 
    155156      ELSE                                         ! Swap of forcing fields 
    156157         !                                         ! ---------------------- 
    157          zfact = 0.5e0 
     158         zfact = 0.5_wp 
    158159         sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:) 
    159160      ENDIF 
    … …  
    226227      ENDIF 
    227228  
    228       IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics 
     229      IF( l_trdtra )   THEN                      ! send trends for further diagnostics 
    229230         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    230231         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 
    231          CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_nsr, ztrdt ) 
    232          CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_nsr, ztrds ) 
     232         CALL trd_tra( kt, 'TRA', jp_tem, jptra_nsr, ztrdt ) 
     233         CALL trd_tra( kt, 'TRA', jp_sal, jptra_nsr, ztrds ) 
    233234         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )  
    234235      ENDIF 

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

    r3294 r4619  
    1919   USE sbc_oce         ! surface boundary condition: ocean 
    2020   USE dynspg_oce 
    21  
    2221   USE trazdf_exp      ! vertical diffusion: explicit (tra_zdf_exp     routine) 
    2322   USE trazdf_imp      ! vertical diffusion: implicit (tra_zdf_imp     routine) 
    24  
    2523   USE ldftra_oce      ! ocean active tracers: lateral physics 
    26    USE trdmod_oce      ! ocean active tracers: lateral physics 
    27    USE trdtra      ! ocean tracers trends  
     24   USE trd_oce         ! trends: ocean variables 
     25   USE trdtra          ! trends manager: tracers  
     26   ! 
    2827   USE in_out_manager  ! I/O manager 
    2928   USE prtctl          ! Print control 
    … …  
    3231   USE wrk_nemo        ! Memory allocation 
    3332   USE timing          ! Timing 
    34  
    3533 
    3634   IMPLICIT NONE 
    … …  
    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) 
    … …  
    9694            ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dtra(jk) ) - ztrds(:,:,jk) 
    9795         END DO 
    98          CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_zdf, ztrdt ) 
    99          CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_zdf, ztrds ) 
     96         CALL lbc_lnk( ztrdt, 'T', 1. ) 
     97         CALL lbc_lnk( ztrds, 'T', 1. ) 
     98         CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdf, ztrdt ) 
     99         CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdf, ztrds ) 
    100100         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
    101101      ENDIF 

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

    r3294 r4619  
    7474      !!          Idem for di(s) and dj(s)           
    7575      !! 
    76       !!      For rho, we call eos_insitu_2d which will compute rd~(t~,s~) at  
    77       !!      the good depth zh from interpolated T and S for the different 
    78       !!      formulation of the equation of state (eos). 
     76      !!      For rho, we call eos which will compute rd~(t~,s~) at the right 
     77      !!      depth zh from interpolated T and S for the different formulations 
     78      !!      of the equation of state (eos). 
    7979      !!      Gradient formulation for rho : 
    80       !!          di(rho) = rd~ - rd(i,j,k) or rd(i+1,j,k) - rd~ 
     80      !!          di(rho) = rd~ - rd(i,j,k)   or  rd(i+1,j,k) - rd~ 
    8181      !! 
    8282      !! ** Action  : - pgtu, pgtv: horizontal gradient of tracer at u- & v-points 
    8383      !!              - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points  
    8484      !!---------------------------------------------------------------------- 
    85       ! 
    8685      INTEGER                              , INTENT(in   )           ::  kt          ! ocean time-step index 
    8786      INTEGER                              , INTENT(in   )           ::  kjpt        ! number of tracers 
    8887      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta         ! 4D tracers fields 
    8988      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts  
    90       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields 
    91       REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad. of prd at u- & v-pts  
     89      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields 
     90      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad. of prd at u- & v-pts  
    9291      ! 
    9392      INTEGER  ::   ji, jj, jn      ! Dummy loop indices 
    9493      INTEGER  ::   iku, ikv, ikum1, ikvm1   ! partial step level (ocean bottom level) at u- and v-points 
    9594      REAL(wp) ::  ze3wu, ze3wv, zmaxu, zmaxv  ! temporary scalars 
    96       REAL(wp), POINTER, DIMENSION(:,:  ) ::  zri, zrj, zhi, zhj 
    97       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zti, ztj    ! interpolated value of tracer 
     95      REAL(wp), DIMENSION(jpi,jpj)      ::  zri, zrj, zhi, zhj   ! NB: 3rd dim=1 to use eos 
     96      REAL(wp), DIMENSION(jpi,jpj,kjpt) ::  zti, ztj             !  
    9897      !!---------------------------------------------------------------------- 
    9998      ! 
    10099      IF( nn_timing == 1 )  CALL timing_start( 'zps_hde') 
    101100      ! 
    102       CALL wrk_alloc( jpi, jpj,       zri, zrj, zhi, zhj )  
    103       CALL wrk_alloc( jpi, jpj, kjpt, zti, ztj           )  
    104       ! 
    105101      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==! 
    106102         ! 
    107 # if defined key_vectopt_loop 
    108          jj = 1 
    109          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled) 
    110 # else 
    111103         DO jj = 1, jpjm1 
    112104            DO ji = 1, jpim1 
    113 # endif 
    114105               iku = mbku(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points 
    115106               ikv = mbkv(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1 
    … …  
    121112                  zmaxu =  ze3wu / fse3w(ji+1,jj,iku) 
    122113                  ! interpolated values of tracers 
    123                   zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 
     114                  zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 
    124115                  ! gradient of  tracers 
    125116                  pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 
    … …  
    127118                  zmaxu = -ze3wu / fse3w(ji,jj,iku) 
    128119                  ! interpolated values of tracers 
    129                   zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 
     120                  zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 
    130121                  ! gradient of tracers 
    131122                  pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 
    … …  
    136127                  zmaxv =  ze3wv / fse3w(ji,jj+1,ikv) 
    137128                  ! interpolated values of tracers 
    138                   ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 
     129                  ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 
    139130                  ! gradient of tracers 
    140131                  pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 
    … …  
    142133                  zmaxv =  -ze3wv / fse3w(ji,jj,ikv) 
    143134                  ! interpolated values of tracers 
    144                   ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 
     135                  ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 
    145136                  ! gradient of tracers 
    146137                  pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 
    147138               ENDIF 
    148 # if ! defined key_vectopt_loop 
    149139            END DO 
    150 # endif 
    151140         END DO 
    152141         CALL lbc_lnk( pgtu(:,:,jn), 'U', -1. )   ;   CALL lbc_lnk( pgtv(:,:,jn), 'V', -1. )   ! Lateral boundary cond. 
    … …  
    156145      ! horizontal derivative of density anomalies (rd) 
    157146      IF( PRESENT( prd ) ) THEN         ! depth of the partial step level 
    158 # if defined key_vectopt_loop 
    159          jj = 1 
    160          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled) 
    161 # else 
    162147         DO jj = 1, jpjm1 
    163148            DO ji = 1, jpim1 
    164 # endif 
    165149               iku = mbku(ji,jj) 
    166150               ikv = mbkv(ji,jj) 
    … …  
    173157               ELSE                        ;   zhj(ji,jj) = fsdept(ji,jj+1,ikv)     ! -     -      case 2 
    174158               ENDIF 
    175 # if ! defined key_vectopt_loop 
    176159            END DO 
    177 # endif 
    178160         END DO 
    179161 
    … …  
    184166 
    185167         ! Gradient of density at the last level  
    186 # if defined key_vectopt_loop 
    187          jj = 1 
    188          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled) 
    189 # else 
    190168         DO jj = 1, jpjm1 
    191169            DO ji = 1, jpim1 
    192 # endif 
    193170               iku = mbku(ji,jj) 
    194171               ikv = mbkv(ji,jj) 
    195172               ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku) 
    196173               ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv) 
    197                IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji  ,jj) - prd(ji,jj,iku) )   ! i: 1 
    198                ELSE                        ;   pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj) )   ! i: 2 
     174               IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji  ,jj    ) - prd(ji,jj,iku) )   ! i: 1 
     175               ELSE                        ;   pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj    ) )   ! i: 2 
    199176               ENDIF 
    200                IF( ze3wv >= 0._wp ) THEN   ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj  ) - prd(ji,jj,ikv) )   ! j: 1 
    201                ELSE                        ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) )   ! j: 2 
     177               IF( ze3wv >= 0._wp ) THEN   ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj      ) - prd(ji,jj,ikv) )   ! j: 1 
     178               ELSE                        ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj    ) )   ! j: 2 
    202179               ENDIF 
    203 # if ! defined key_vectopt_loop 
    204180            END DO 
    205 # endif 
    206181         END DO 
    207182         CALL lbc_lnk( pgru , 'U', -1. )   ;   CALL lbc_lnk( pgrv , 'V', -1. )   ! Lateral boundary conditions 
    208183         ! 
    209184      END IF 
    210       ! 
    211       CALL wrk_dealloc( jpi, jpj,       zri, zrj, zhi, zhj )  
    212       CALL wrk_dealloc( jpi, jpj, kjpt, zti, ztj           )  
    213185      ! 
    214186      IF( nn_timing == 1 )  CALL timing_stop( 'zps_hde') 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90

    r3632 r4619  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  trdtra  *** 
    4    !! Ocean diagnostics:  ocean tracers trends 
     4   !! Ocean diagnostics:  ocean tracers trends pre-processing 
    55   !!===================================================================== 
    6    !! History :  1.0  !  2004-08  (C. Talandier) Original code 
    7    !!            2.0  !  2005-04  (C. Deltel)    Add Asselin trend in the ML budget 
    8    !!            3.3  !  2010-06  (C. Ethe) merge TRA-TRC  
    9    !!---------------------------------------------------------------------- 
    10 #if  defined key_trdtra || defined key_trdtrc || defined key_trdmld || defined key_trdmld_trc  
    11    !!---------------------------------------------------------------------- 
    12    !!   trd_tra      : Call the trend to be computed 
    13    !!---------------------------------------------------------------------- 
    14    USE dom_oce          ! ocean domain  
    15    USE trdmod_oce       ! ocean active mixed layer tracers trends  
    16    USE trdmod           ! ocean active mixed layer tracers trends  
    17    USE trdmod_trc       ! ocean passive mixed layer tracers trends  
    18    USE in_out_manager   ! I/O manager 
    19    USE lib_mpp          ! MPP library 
    20    USE wrk_nemo        ! Memory allocation 
    21  
     6   !! History :  3.3  !  2010-06  (C. Ethe) creation for the TRA/TRC merge 
     7   !!            3.5  !  2012-02  (G. Madec) update the comments  
     8   !!---------------------------------------------------------------------- 
     9 
     10   !!---------------------------------------------------------------------- 
     11   !!   trd_tra       : pre-process the tracer trends 
     12   !!   trd_tra_adv   : transform a div(U.T) trend into a U.grad(T) trend 
     13   !!   trd_tra_mng   : tracer trend manager: dispatch to the diagnostic modules 
     14   !!   trd_tra_iom   : output 3D tracer trends using IOM 
     15   !!---------------------------------------------------------------------- 
     16   USE oce            ! ocean dynamics and tracers variables 
     17   USE dom_oce        ! ocean domain  
     18   USE sbc_oce        ! surface boundary condition: ocean 
     19   USE zdf_oce        ! ocean vertical physics 
     20   USE trd_oce        ! trends: ocean variables 
     21   USE trdmod_trc     ! ocean passive mixed layer tracers trends  
     22   USE trdglo         ! trends: global domain averaged 
     23   USE trdpen         ! trends: Potential ENergy 
     24   USE trdmxl         ! ocean active mixed layer tracers trends  
     25   USE ldftra_oce     ! ocean active tracers lateral physics 
     26   USE zdfddm         ! vertical physics: double diffusion 
     27   USE phycst         ! physical constants 
     28   USE in_out_manager ! I/O manager 
     29   USE iom            ! I/O manager library 
     30   USE lib_mpp        ! MPP library 
     31   USE wrk_nemo       ! Memory allocation 
    2232 
    2333   IMPLICIT NONE 
    2434   PRIVATE 
    2535 
    26    PUBLIC   trd_tra          ! called by all  traXX modules 
    27   
    28    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: trdtx, trdty, trdt  !: 
     36   PUBLIC   trd_tra   ! called by all tra_... modules 
     37 
     38   REAL(wp) ::   r2dt   ! time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0 
     39 
     40   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   trdtx, trdty, trdt   ! use to store the temperature trends 
    2941 
    3042   !! * Substitutions 
    3143#  include "domzgr_substitute.h90" 
     44#  include "zdfddm_substitute.h90" 
    3245#  include "vectopt_loop_substitute.h90" 
    3346   !!---------------------------------------------------------------------- 
    34    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     47   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3548   !! $Id$ 
    3649   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    3952 
    4053   INTEGER FUNCTION trd_tra_alloc() 
    41       !!---------------------------------------------------------------------------- 
     54      !!--------------------------------------------------------------------- 
    4255      !!                  ***  FUNCTION trd_tra_alloc  *** 
    43       !!---------------------------------------------------------------------------- 
     56      !!--------------------------------------------------------------------- 
    4457      ALLOCATE( trdtx(jpi,jpj,jpk) , trdty(jpi,jpj,jpk) , trdt(jpi,jpj,jpk) , STAT= trd_tra_alloc ) 
    4558      ! 
    … …  
    5366      !!                  ***  ROUTINE trd_tra  *** 
    5467      !!  
    55       !! ** Purpose : Dispatch all trends computation, e.g. vorticity, mld or  
    56       !!              integral constraints 
     68      !! ** Purpose : pre-process tracer trends 
    5769      !! 
    58       !! ** Method/usage : For the mixed-layer trend, the control surface can be either 
    59       !!       a mixed layer depth (time varying) or a fixed surface (jk level or bowl).  
    60       !!      Choose control surface with nn_ctls in namelist NAMTRD : 
    61       !!        nn_ctls = 0  : use mixed layer with density criterion  
    62       !!        nn_ctls = 1  : read index from file 'ctlsurf_idx' 
    63       !!        nn_ctls > 1  : use fixed level surface jk = nn_ctls 
    64       !!---------------------------------------------------------------------- 
    65       ! 
    66       INTEGER                         , INTENT(in)           ::  kt      ! time step 
    67       CHARACTER(len=3)                , INTENT(in)           ::  ctype   ! tracers trends type 'TRA'/'TRC' 
    68       INTEGER                         , INTENT(in)           ::  ktra    ! tracer index 
    69       INTEGER                         , INTENT(in)           ::  ktrd    ! tracer trend index 
    70       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::  ptrd    ! tracer trend  or flux 
    71       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pun     ! velocity  
    72       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variablea 
    73       ! 
    74       REAL(wp), POINTER, DIMENSION(:,:,:)  ::  ztrds 
    75       !!---------------------------------------------------------------------- 
    76  
     70      !! ** Method  : - mask the trend 
     71      !!              - advection (ptra present) converte the incoming flux (U.T)  
     72      !!              into trend (U.T => -U.grat(T)=div(U.T)-T.div(U)) through a  
     73      !!              call to trd_tra_adv 
     74      !!              - 'TRA' case : regroup T & S trends 
     75      !!              - send the trends to trd_tra_mng (trdmod_trc) for further processing 
     76      !!---------------------------------------------------------------------- 
     77      INTEGER                         , INTENT(in)           ::   kt      ! time step 
     78      CHARACTER(len=3)                , INTENT(in)           ::   ctype   ! tracers trends type 'TRA'/'TRC' 
     79      INTEGER                         , INTENT(in)           ::   ktra    ! tracer index 
     80      INTEGER                         , INTENT(in)           ::   ktrd    ! tracer trend index 
     81      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::   ptrd    ! tracer trend  or flux 
     82      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   pun     ! now velocity  
     83      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   ptra    ! now tracer variable 
     84      ! 
     85      INTEGER  ::   jk   ! loop indices 
     86      REAL(wp), POINTER, DIMENSION(:,:,:)  ::   zwt, zws, ztrdt, ztrds   ! 3D workspace 
     87      !!---------------------------------------------------------------------- 
     88      ! 
    7789      CALL wrk_alloc( jpi, jpj, jpk, ztrds ) 
    78  
    79       IF( .NOT. ALLOCATED( trdtx ) ) THEN       ! allocate trdtra arrays 
     90      !       
     91      IF( .NOT. ALLOCATED( trdtx ) ) THEN      ! allocate trdtra arrays 
    8092         IF( trd_tra_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trd_tra : unable to allocate arrays' ) 
    8193      ENDIF 
    82        
    83       ! Control of optional arguments 
    84       IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN  
    85          IF( PRESENT( ptra ) ) THEN     
    86             SELECT CASE( ktrd )            ! shift depending on the direction 
    87             CASE( jptra_trd_xad )  ;  CALL trd_tra_adv( ptrd, pun, ptra, 'X', trdtx )  
    88             CASE( jptra_trd_yad )  ;  CALL trd_tra_adv( ptrd, pun, ptra, 'Y', trdty )  
    89             CASE( jptra_trd_zad )  ;  CALL trd_tra_adv( ptrd, pun, ptra, 'Z', trdt  )  
    90             END SELECT 
    91          ELSE 
    92             trdt(:,:,:) = ptrd(:,:,:) 
    93             IF( ktrd == jptra_trd_bbc .OR. ktrd == jptra_trd_qsr ) THEN 
    94                ztrds(:,:,:) = 0. 
    95                CALL trd_mod( trdt, ztrds, ktrd, ctype, kt ) 
    96             END IF 
    97          END IF 
    98       END IF 
    99  
    100       IF( ctype == 'TRA' .AND. ktra == jp_sal ) THEN  
    101          IF( PRESENT( ptra ) ) THEN     
    102             SELECT CASE( ktrd )            ! shift depending on the direction 
    103             CASE( jptra_trd_xad )   
    104                                 CALL trd_tra_adv( ptrd, pun, ptra, 'X', ztrds )  
    105                                 CALL trd_mod( trdtx, ztrds, ktrd, ctype, kt   ) 
    106             CASE( jptra_trd_yad )   
    107                                 CALL trd_tra_adv( ptrd, pun, ptra, 'Y', ztrds )  
    108                                 CALL trd_mod( trdty, ztrds, ktrd, ctype, kt   ) 
    109             CASE( jptra_trd_zad )     
    110                                 CALL trd_tra_adv( ptrd, pun, ptra, 'Z', ztrds )  
    111                                 CALL trd_mod( trdt , ztrds, ktrd, ctype, kt   ) 
    112             END SELECT 
    113          ELSE 
    114             ztrds(:,:,:) = ptrd(:,:,:) 
    115             CALL trd_mod( trdt, ztrds, ktrd, ctype, kt )   
    116          END IF 
    117       END IF 
    118  
    119       IF( ctype == 'TRC' ) THEN 
    120          ! 
    121          IF( PRESENT( ptra ) ) THEN   
    122             SELECT CASE( ktrd )            ! shift depending on the direction 
    123             CASE( jptra_trd_xad )   
    124                                 CALL trd_tra_adv( ptrd, pun, ptra, 'X', ztrds )  
    125                                 CALL trd_mod_trc( ztrds, ktra, ktrd, kt       ) 
    126             CASE( jptra_trd_yad )   
    127                                 CALL trd_tra_adv( ptrd, pun, ptra, 'Y', ztrds )  
    128                                 CALL trd_mod_trc( ztrds, ktra, ktrd, kt       ) 
    129             CASE( jptra_trd_zad )     
    130                                 CALL trd_tra_adv( ptrd, pun, ptra, 'Z', ztrds )  
    131                                 CALL trd_mod_trc( ztrds, ktra, ktrd, kt       ) 
    132             END SELECT 
    133          ELSE 
    134             ztrds(:,:,:) = ptrd(:,:,:) 
    135             CALL trd_mod_trc( ztrds, ktra, ktrd, kt       )   
    136          END IF 
     94 
     95      IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN   !==  Temperature trend  ==! 
     96         ! 
     97         SELECT CASE( ktrd ) 
     98         !                            ! advection: transform the advective flux into a trend 
     99         CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'X', trdtx )  
     100         CASE( jptra_yad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'Y', trdty )  
     101         CASE( jptra_zad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'Z', trdt  )  
     102         CASE( jptra_bbc,    &        ! qsr, bbc: on temperature only, send to trd_tra_mng 
     103            &  jptra_qsr )   ;   trdt(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 
     104                                 ztrds(:,:,:) = 0._wp 
     105                                 CALL trd_tra_mng( trdt, ztrds, ktrd, kt ) 
     106         CASE DEFAULT                 ! other trends: masked trends 
     107            trdt(:,:,:) = ptrd(:,:,:) * tmask(:,:,:)              ! mask & store 
     108         END SELECT 
     109         ! 
     110      ENDIF 
     111 
     112      IF( ctype == 'TRA' .AND. ktra == jp_sal ) THEN      !==  Salinity trends  ==! 
     113         ! 
     114         SELECT CASE( ktrd ) 
     115         !                            ! advection: transform the advective flux into a trend 
     116         !                            !            and send T & S trends to trd_tra_mng 
     117         CASE( jptra_xad  )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'X'  , ztrds )  
     118                                  CALL trd_tra_mng( trdtx, ztrds, ktrd, kt   ) 
     119         CASE( jptra_yad  )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'Y'  , ztrds )  
     120                                  CALL trd_tra_mng( trdty, ztrds, ktrd, kt   ) 
     121         CASE( jptra_zad  )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'Z'  , ztrds )  
     122                                  CALL trd_tra_mng( trdt , ztrds, ktrd, kt   ) 
     123         CASE( jptra_zdfp )           ! diagnose the "PURE" Kz trend (here: just before the swap) 
     124            !                         ! iso-neutral diffusion case otherwise jptra_zdf is "PURE" 
     125            CALL wrk_alloc( jpi, jpj, jpk, zwt, zws, ztrdt ) 
     126            ! 
     127            zwt(:,:, 1 ) = 0._wp   ;   zws(:,:, 1 ) = 0._wp            ! vertical diffusive fluxes 
     128            zwt(:,:,jpk) = 0._wp   ;   zws(:,:,jpk) = 0._wp 
     129            DO jk = 2, jpk 
     130               zwt(:,:,jk) =   avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk) 
     131               zws(:,:,jk) = fsavs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / fse3w(:,:,jk) * tmask(:,:,jk) 
     132            END DO 
     133            ! 
     134            ztrdt(:,:,jpk) = 0._wp   ;   ztrds(:,:,jpk) = 0._wp 
     135            DO jk = 1, jpkm1 
     136               ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / fse3t(:,:,jk) 
     137               ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / fse3t(:,:,jk)  
     138            END DO 
     139            CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt )   
     140            ! 
     141            CALL wrk_dealloc( jpi, jpj, jpk, zwt, zws, ztrdt ) 
     142            ! 
     143         CASE DEFAULT                 ! other trends: mask and send T & S trends to trd_tra_mng 
     144            ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 
     145            CALL trd_tra_mng( trdt, ztrds, ktrd, kt )   
     146         END SELECT 
     147      ENDIF 
     148 
     149      IF( ctype == 'TRC' ) THEN                           !==  passive tracer trend  ==! 
     150         ! 
     151         SELECT CASE( ktrd ) 
     152         !                            ! advection: transform the advective flux into a masked trend 
     153         CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'X', ztrds )  
     154         CASE( jptra_yad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'Y', ztrds )  
     155         CASE( jptra_zad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'Z', ztrds )  
     156         CASE DEFAULT                 ! other trends: just masked  
     157                                 ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 
     158         END SELECT 
     159         !                            ! send trend to trd_mod_trc 
     160         CALL trd_mod_trc( ztrds, ktra, ktrd, kt )  
    137161         ! 
    138162      ENDIF 
    … …  
    147171      !!                  ***  ROUTINE trd_tra_adv  *** 
    148172      !!  
    149       !! ** Purpose :   transformed the i-, j- or k-advective flux into thes 
    150       !!              i-, j- or k-advective trends, resp. 
    151       !! ** Method  :   i-advective trends = -un. di-1[T] = -( di-1[fi] - tn di-1[un] ) 
    152       !!                k-advective trends = -un. di-1[T] = -( dj-1[fi] - tn dj-1[un] ) 
    153       !!                k-advective trends = -un. di+1[T] = -( dk+1[fi] - tn dk+1[un] ) 
    154       !!---------------------------------------------------------------------- 
    155       REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   pf      ! advective flux in one direction 
    156       REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   pun     ! now velocity  in one direction 
    157       REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   ptn     ! now or before tracer  
    158       CHARACTER(len=1), INTENT(in )                         ::   cdir    ! X/Y/Z direction 
    159       REAL(wp)        , INTENT(out), DIMENSION(jpi,jpj,jpk) ::   ptrd    ! advective trend in one direction 
     173      !! ** Purpose :   transformed a advective flux into a masked advective trends 
     174      !! 
     175      !! ** Method  :   use the following transformation: -div(U.T) = - U grad(T) + T.div(U) 
     176      !!       i-advective trends = -un. di-1[T] = -( di-1[fi] - tn di-1[un] ) 
     177      !!       j-advective trends = -un. di-1[T] = -( dj-1[fi] - tn dj-1[un] ) 
     178      !!       k-advective trends = -un. di+1[T] = -( dk+1[fi] - tn dk+1[un] ) 
     179      !!                where fi is the incoming advective flux. 
     180      !!---------------------------------------------------------------------- 
     181      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pf      ! advective flux in one direction 
     182      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pun     ! now velocity   in one direction 
     183      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   ptn     ! now or before tracer  
     184      CHARACTER(len=1)                , INTENT(in   ) ::   cdir    ! X/Y/Z direction 
     185      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   ptrd    ! advective trend in one direction 
    160186      ! 
    161187      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    162       INTEGER  ::   ii, ij, ik   ! index shift function of the direction 
    163       REAL(wp) ::   zbtr         ! local scalar 
    164       !!---------------------------------------------------------------------- 
    165  
    166       SELECT CASE( cdir )            ! shift depending on the direction 
    167       CASE( 'X' )   ;   ii = 1   ; ij = 0   ;   ik = 0      ! i-advective trend 
    168       CASE( 'Y' )   ;   ii = 0   ; ij = 1   ;   ik = 0      ! j-advective trend 
    169       CASE( 'Z' )   ;   ii = 0   ; ij = 0   ;   ik =-1      ! k-advective trend 
     188      INTEGER  ::   ii, ij, ik   ! index shift as function of the direction 
     189      !!---------------------------------------------------------------------- 
     190      ! 
     191      SELECT CASE( cdir )      ! shift depending on the direction 
     192      CASE( 'X' )   ;   ii = 1   ;   ij = 0   ;   ik = 0      ! i-trend 
     193      CASE( 'Y' )   ;   ii = 0   ;   ij = 1   ;   ik = 0      ! j-trend 
     194      CASE( 'Z' )   ;   ii = 0   ;   ij = 0   ;   ik =-1      ! k-trend 
    170195      END SELECT 
    171  
    172       !                              ! set to zero uncomputed values 
    173       ptrd(jpi,:,:) = 0.e0   ;   ptrd(1,:,:) = 0.e0 
    174       ptrd(:,jpj,:) = 0.e0   ;   ptrd(:,1,:) = 0.e0 
    175       ptrd(:,:,jpk) = 0.e0 
    176       ! 
    177       ! 
    178       DO jk = 1, jpkm1 
     196      ! 
     197      !                        ! set to zero uncomputed values 
     198      ptrd(jpi,:,:) = 0._wp   ;   ptrd(1,:,:) = 0._wp 
     199      ptrd(:,jpj,:) = 0._wp   ;   ptrd(:,1,:) = 0._wp 
     200      ptrd(:,:,jpk) = 0._wp 
     201      ! 
     202      DO jk = 1, jpkm1         ! advective trend 
    179203         DO jj = 2, jpjm1 
    180204            DO ji = fs_2, fs_jpim1   ! vector opt. 
    181                zbtr    = 1.e0/ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    182                ptrd(ji,jj,jk) = - zbtr * (      pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                    & 
    183                  &                          - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk)  ) 
     205               ptrd(ji,jj,jk) = - (     pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                        & 
     206                 &                  - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk)  )   & 
     207                 &              / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )  * tmask(ji,jj,jk) 
    184208            END DO 
    185209         END DO 
    … …  
    188212   END SUBROUTINE trd_tra_adv 
    189213 
    190 #   else 
    191    !!---------------------------------------------------------------------- 
    192    !!   Default case :          Dummy module           No trend diagnostics 
    193    !!---------------------------------------------------------------------- 
    194    USE par_oce      ! ocean variables trends 
    195 CONTAINS 
    196    SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pu, ptra ) 
    197       !!---------------------------------------------------------------------- 
    198       INTEGER                         , INTENT(in)           ::  kt      ! time step 
    199       CHARACTER(len=3)                , INTENT(in)           ::  ctype   ! tracers trends type 'TRA'/'TRC' 
    200       INTEGER                         , INTENT(in)           ::  ktra    ! tracer index 
    201       INTEGER                         , INTENT(in)           ::  ktrd    ! tracer trend index 
    202       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::  ptrd    ! tracer trend  
    203       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pu      ! velocity  
    204       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variable  
    205       WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd(1,1,1), ptra(1,1,1), pu(1,1,1),   & 
    206          &                                                               ktrd, ktra, ctype, kt 
    207    END SUBROUTINE trd_tra 
    208 #   endif 
     214 
     215   SUBROUTINE trd_tra_mng( ptrdx, ptrdy, ktrd, kt ) 
     216      !!--------------------------------------------------------------------- 
     217      !!                  ***  ROUTINE trd_tra_mng  *** 
     218      !!  
     219      !! ** Purpose :   Dispatch all tracer trends computation, e.g. 3D output, 
     220      !!                integral constraints, potential energy, and/or  
     221      !!                mixed layer budget. 
     222      !!---------------------------------------------------------------------- 
     223      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdx   ! Temperature or U trend  
     224      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdy   ! Salinity    or V trend 
     225      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index 
     226      INTEGER                   , INTENT(in   ) ::   kt      ! time step 
     227      !!---------------------------------------------------------------------- 
     228 
     229      IF( neuler == 0 .AND. kt == nit000    ) THEN   ;   r2dt =      rdt      ! = rdtra (restart with Euler time stepping) 
     230      ELSEIF(               kt <= nit000 + 1) THEN   ;   r2dt = 2. * rdt      ! = 2 rdttra (leapfrog) 
     231      ENDIF 
     232 
     233      !                   ! 3D output of tracers trends using IOM interface 
     234      IF( ln_tra_trd )   CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt ) 
     235 
     236      !                   ! Integral Constraints Properties for tracers trends                                       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     237      IF( ln_glo_trd )   CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt ) 
     238 
     239      !                   ! Potential ENergy trends 
     240      IF( ln_PE_trd  )   CALL trd_pen( ptrdx, ptrdy, ktrd, kt, r2dt ) 
     241 
     242      !                   ! Mixed layer trends for active tracers 
     243      IF( ln_tra_mxl )   THEN    
     244         !----------------------------------------------------------------------------------------------- 
     245         ! W.A.R.N.I.N.G : 
     246         ! jptra_ldf : called by traldf.F90 
     247         !                 at this stage we store: 
     248         !                  - the lateral geopotential diffusion (here, lateral = horizontal) 
     249         !                  - and the iso-neutral diffusion if activated  
     250         ! jptra_zdf : called by trazdf.F90 
     251         !                 * in case of iso-neutral diffusion we store the vertical diffusion component in the  
     252         !                   lateral trend including the K_z contrib, which will be removed later (see trd_mxl) 
     253         !----------------------------------------------------------------------------------------------- 
     254 
     255         SELECT CASE ( ktrd ) 
     256         CASE ( jptra_xad )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_xad, '3D' )   ! zonal    advection 
     257         CASE ( jptra_yad )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_yad, '3D' )   ! merid.   advection 
     258         CASE ( jptra_zad )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_zad, '3D' )   ! vertical advection 
     259         CASE ( jptra_ldf )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_ldf, '3D' )   ! lateral  diffusion 
     260         CASE ( jptra_bbl )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_bbl, '3D' )   ! bottom boundary layer 
     261         CASE ( jptra_zdf ) 
     262            IF( ln_traldf_iso ) THEN ; CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_ldf, '3D' )   ! lateral  diffusion (K_z) 
     263            ELSE                   ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_zdf, '3D' )   ! vertical diffusion (K_z) 
     264            ENDIF 
     265         CASE ( jptra_dmp )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_dmp, '3D' )   ! internal 3D restoring (tradmp) 
     266         CASE ( jptra_qsr )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_for, '3D' )   ! air-sea : penetrative sol radiat 
     267         CASE ( jptra_nsr )        ;   ptrdx(:,:,2:jpk) = 0._wp   ;   ptrdy(:,:,2:jpk) = 0._wp 
     268                                       CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_for, '2D' )   ! air-sea : non penetr sol radiation 
     269         CASE ( jptra_bbc )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_bbc, '3D' )   ! bottom bound cond (geoth flux) 
     270         CASE ( jptra_npc )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_npc, '3D' )   ! non penetr convect adjustment 
     271         CASE ( jptra_atf )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_atf, '3D' )   ! asselin time filter (last trend) 
     272                                   ! 
     273                                       CALL trd_mxl( kt, r2dt )                             ! trends: Mixed-layer (output) 
     274         END SELECT 
     275         ! 
     276      ENDIF 
     277      ! 
     278   END SUBROUTINE trd_tra_mng 
     279 
     280 
     281   SUBROUTINE trd_tra_iom( ptrdx, ptrdy, ktrd, kt ) 
     282      !!--------------------------------------------------------------------- 
     283      !!                  ***  ROUTINE trd_tra_iom  *** 
     284      !!  
     285      !! ** Purpose :   output 3D tracer trends using IOM 
     286      !!---------------------------------------------------------------------- 
     287      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdx   ! Temperature or U trend  
     288      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdy   ! Salinity    or V trend 
     289      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index 
     290      INTEGER                   , INTENT(in   ) ::   kt      ! time step 
     291      !! 
     292      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     293      INTEGER ::   ikbu, ikbv   ! local integers 
     294      REAL(wp), POINTER, DIMENSION(:,:)   ::   z2dx, z2dy   ! 2D workspace  
     295      !!---------------------------------------------------------------------- 
     296      ! 
     297!!gm Rq: mask the trends already masked in trd_tra, but lbc_lnk should probably be added 
     298      ! 
     299      SELECT CASE( ktrd ) 
     300      CASE( jptra_xad  )   ;   CALL iom_put( "ttrd_xad" , ptrdx )        ! x- horizontal advection 
     301                               CALL iom_put( "strd_xad" , ptrdy ) 
     302      CASE( jptra_yad  )   ;   CALL iom_put( "ttrd_yad" , ptrdx )        ! y- horizontal advection 
     303                               CALL iom_put( "strd_yad" , ptrdy ) 
     304      CASE( jptra_zad  )   ;   CALL iom_put( "ttrd_zad" , ptrdx )        ! z- vertical   advection 
     305                               CALL iom_put( "strd_zad" , ptrdy ) 
     306                               IF( .NOT. lk_vvl ) THEN                   ! cst volume : adv flux through z=0 surface 
     307                                  CALL wrk_alloc( jpi, jpj, z2dx, z2dy ) 
     308                                  z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / fse3t(:,:,1) 
     309                                  z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / fse3t(:,:,1) 
     310                                  CALL iom_put( "ttrd_sad", z2dx ) 
     311                                  CALL iom_put( "strd_sad", z2dy ) 
     312                                  CALL wrk_dealloc( jpi, jpj, z2dx, z2dy ) 
     313                               ENDIF 
     314      CASE( jptra_ldf  )   ;   CALL iom_put( "ttrd_ldf" , ptrdx )        ! lateral diffusion 
     315                               CALL iom_put( "strd_ldf" , ptrdy ) 
     316      CASE( jptra_zdf  )   ;   CALL iom_put( "ttrd_zdf" , ptrdx )        ! vertical diffusion (including Kz contribution) 
     317                               CALL iom_put( "strd_zdf" , ptrdy ) 
     318      CASE( jptra_zdfp )   ;   CALL iom_put( "ttrd_zdfp", ptrdx )        ! PURE vertical diffusion (no isoneutral contribution) 
     319                               CALL iom_put( "strd_zdfp", ptrdy ) 
     320      CASE( jptra_dmp  )   ;   CALL iom_put( "ttrd_dmp" , ptrdx )        ! internal restoring (damping) 
     321                               CALL iom_put( "strd_dmp" , ptrdy ) 
     322      CASE( jptra_bbl  )   ;   CALL iom_put( "ttrd_bbl" , ptrdx )        ! bottom boundary layer 
     323                               CALL iom_put( "strd_bbl" , ptrdy ) 
     324      CASE( jptra_npc  )   ;   CALL iom_put( "ttrd_npc" , ptrdx )        ! static instability mixing 
     325                               CALL iom_put( "strd_npc" , ptrdy ) 
     326      CASE( jptra_nsr  )   ;   CALL iom_put( "ttrd_qns" , ptrdx )        ! surface forcing + runoff (ln_rnf=T) 
     327                               CALL iom_put( "strd_cdt" , ptrdy ) 
     328      CASE( jptra_qsr  )   ;   CALL iom_put( "ttrd_qsr" , ptrdx )        ! penetrative solar radiat. (only on temperature) 
     329      CASE( jptra_bbc  )   ;   CALL iom_put( "ttrd_bbc" , ptrdx )        ! geothermal heating   (only on temperature) 
     330      CASE( jptra_atf  )   ;   CALL iom_put( "ttrd_atf" , ptrdx )        ! asselin time Filter 
     331                               CALL iom_put( "strd_atf" , ptrdy ) 
     332      END SELECT 
     333      ! 
     334   END SUBROUTINE trd_tra_iom 
     335 
    209336   !!====================================================================== 
    210337END MODULE trdtra 

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

    r3294 r4619  
    44   !! Ocean diagnostics:  momentum trends 
    55   !!===================================================================== 
    6    !! History :  1.0  !  04-2006  (L. Brunier, A-M. Treguier) Original code  
    7    !!            2.0  !  04-2008  (C. Talandier) New trends organization 
     6   !! History :  1.0  !  2006-01  (L. Brunier, A-M. Treguier) Original code  
     7   !!            2.0  !  2008-04  (C. Talandier) New trends organization 
     8   !!            3.5  !  2012-02  (G. Madec) regroup beta.V computation with pvo trend 
    89   !!---------------------------------------------------------------------- 
    9 #if defined key_trdvor   ||   defined key_esopa 
    10    !!---------------------------------------------------------------------- 
    11    !!   'key_trdvor'   : momentum trend diagnostics 
     10 
    1211   !!---------------------------------------------------------------------- 
    1312   !!   trd_vor      : momentum trends averaged over the depth 
    … …  
    1716   USE oce             ! ocean dynamics and tracers variables 
    1817   USE dom_oce         ! ocean space and time domain variables 
    19    USE trdmod_oce      ! ocean variables trends 
     18   USE trd_oce         ! trends: ocean variables 
    2019   USE zdf_oce         ! ocean vertical physics 
    21    USE in_out_manager  ! I/O manager 
     20   USE sbc_oce         ! surface boundary condition: ocean 
    2221   USE phycst          ! Define parameters for the routines 
    2322   USE ldfdyn_oce      ! ocean active tracers: lateral physics 
    2423   USE dianam          ! build the name of file (routine) 
    2524   USE zdfmxl          ! mixed layer depth 
     25   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     26   USE in_out_manager  ! I/O manager 
    2627   USE ioipsl          ! NetCDF library 
    27    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2828   USE lib_mpp         ! MPP library 
    2929   USE wrk_nemo        ! Memory allocation 
    30  
    3130 
    3231   IMPLICIT NONE 
    … …  
    3736   END INTERFACE 
    3837 
    39    PUBLIC   trd_vor        ! routine called by step.F90 
    40    PUBLIC   trd_vor_zint   ! routine called by dynamics routines 
     38   PUBLIC   trd_vor        ! routine called by trddyn.F90 
    4139   PUBLIC   trd_vor_init   ! routine called by opa.F90 
    4240   PUBLIC   trd_vor_alloc  ! routine called by nemogcm.F90 
    … …  
    8078      IF( trd_vor_alloc /= 0 )   CALL ctl_warn('trd_vor_alloc: failed to allocate arrays') 
    8179   END FUNCTION trd_vor_alloc 
     80 
     81 
     82   SUBROUTINE trd_vor( putrd, pvtrd, ktrd, kt ) 
     83      !!---------------------------------------------------------------------- 
     84      !!                  ***  ROUTINE trd_vor  *** 
     85      !!  
     86      !! ** Purpose :  computation of cumulated trends over analysis period 
     87      !!               and make outputs (NetCDF or DIMG format) 
     88      !!---------------------------------------------------------------------- 
     89      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   putrd, pvtrd   ! U and V trends  
     90      INTEGER                   , INTENT(in   ) ::   ktrd           ! trend index 
     91      INTEGER                   , INTENT(in   ) ::   kt             ! time step 
     92      ! 
     93      INTEGER ::   ji, jj   ! dummy loop indices 
     94      REAL(wp), POINTER, DIMENSION(:,:) ::   ztswu, ztswv    ! 2D workspace  
     95      !!---------------------------------------------------------------------- 
     96 
     97      CALL wrk_alloc( jpi, jpj, ztswu, ztswv ) 
     98 
     99      SELECT CASE( ktrd )  
     100      CASE( jpdyn_hpg )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_prg )   ! Hydrostatique Pressure Gradient  
     101      CASE( jpdyn_keg )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_keg )   ! KE Gradient  
     102      CASE( jpdyn_rvo )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_rvo )   ! Relative Vorticity  
     103      CASE( jpdyn_pvo )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_pvo )   ! Planetary Vorticity Term  
     104      CASE( jpdyn_ldf )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_ldf )   ! Horizontal Diffusion  
     105      CASE( jpdyn_zad )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_zad )   ! Vertical Advection  
     106      CASE( jpdyn_spg )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_spg )   ! Surface Pressure Grad.  
     107      CASE( jpdyn_zdf )                                                      ! Vertical Diffusion  
     108         ztswu(:,:) = 0.e0   ;   ztswv(:,:) = 0.e0 
     109         DO jj = 2, jpjm1                                                             ! wind stress trends 
     110            DO ji = fs_2, fs_jpim1   ! vector opt. 
     111               ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( fse3u(ji,jj,1) * rau0 ) 
     112               ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( fse3v(ji,jj,1) * rau0 ) 
     113            END DO 
     114         END DO 
     115         ! 
     116         CALL trd_vor_zint( putrd, pvtrd, jpvor_zdf )                             ! zdf trend including surf./bot. stresses  
     117         CALL trd_vor_zint( ztswu, ztswv, jpvor_swf )                             ! surface wind stress  
     118      CASE( jpdyn_bfr ) 
     119         CALL trd_vor_zint( putrd, pvtrd, jpvor_bfr )                             ! Bottom stress 
     120         ! 
     121      CASE( jpdyn_atf )       ! last trends: perform the output of 2D vorticity trends 
     122         CALL trd_vor_iom( kt ) 
     123      END SELECT 
     124      ! 
     125      CALL wrk_dealloc( jpi, jpj, ztswu, ztswv ) 
     126      ! 
     127   END SUBROUTINE trd_vor 
    82128 
    83129 
    … …  
    109155      !!      trends output in netCDF format using ioipsl 
    110156      !!---------------------------------------------------------------------- 
    111       ! 
    112157      INTEGER                     , INTENT(in   ) ::   ktrd       ! ocean trend index 
    113158      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   putrdvor   ! u vorticity trend  
    … …  
    131176      !  ===================================== 
    132177 
    133       SELECT CASE (ktrd)  
    134       ! 
    135       CASE (jpvor_bfr)        ! bottom friction 
     178      SELECT CASE( ktrd )  
     179      ! 
     180      CASE( jpvor_bfr )        ! bottom friction 
    136181         DO jj = 2, jpjm1 
    137182            DO ji = fs_2, fs_jpim1  
    … …  
    143188         END DO 
    144189         ! 
    145       CASE (jpvor_swf)        ! wind stress 
     190      CASE( jpvor_swf )        ! wind stress 
    146191         zudpvor(:,:) = putrdvor(:,:) * fse3u(:,:,1) * e1u(:,:) * umask(:,:,1) 
    147192         zvdpvor(:,:) = pvtrdvor(:,:) * fse3v(:,:,1) * e2v(:,:) * vmask(:,:,1) 
    … …  
    154199    
    155200      ! Curl 
    156       DO ji=1,jpim1 
    157          DO jj=1,jpjm1 
     201      DO ji = 1, jpim1 
     202         DO jj = 1, jpjm1 
    158203            vortrd(ji,jj,ktrd) = (    zvdpvor(ji+1,jj) - zvdpvor(ji,jj)       & 
    159204                 &                - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) )   ) / ( e1f(ji,jj) * e2f(ji,jj) ) 
    … …  
    229274      END DO 
    230275 
    231       ! Save Beta.V term to avoid average before Curl 
    232       ! Beta.V : intergration, no average 
    233       IF( ktrd == jpvor_bev ) THEN  
     276      ! Planetary vorticity: 2nd computation (Beta.V term) store the vertical sum 
     277      ! as Beta.V term need intergration, not average 
     278      IF( ktrd == jpvor_pvo ) THEN  
    234279         zubet(:,:) = zudpvor(:,:) 
    235280         zvbet(:,:) = zvdpvor(:,:) 
    236       ENDIF 
    237  
    238       ! Average except for Beta.V 
     281         DO ji = 1, jpim1 
     282            DO jj = 1, jpjm1 
     283               vortrd(ji,jj,jpvor_bev) = (    zvbet(ji+1,jj) - zvbet(ji,jj)     & 
     284                  &                       - ( zubet(ji,jj+1) - zubet(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 
     285            END DO 
     286         END DO 
     287         ! Average of the Curl and Surface mask 
     288         vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * hur(:,:) * fmask(:,:,1) 
     289      ENDIF 
     290      ! 
     291      ! Average  
    239292      zudpvor(:,:) = zudpvor(:,:) * hur(:,:) 
    240293      zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:) 
    241     
     294      ! 
    242295      ! Curl 
    243296      DO ji=1,jpim1 
    … …  
    247300         END DO 
    248301      END DO 
    249  
    250302      ! Surface mask 
    251303      vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1) 
    252  
    253       ! Special treatement for the Beta.V term 
    254       ! Compute the Curl of the Beta.V term which is not averaged 
    255       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)     & 
    259                   &                       - ( zubet(ji,jj+1) - zubet(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 
    260             END DO 
    261          END DO 
    262  
    263          ! Average on the Curl 
    264          vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * hur(:,:) 
    265  
    266          ! Surface mask 
    267          vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * fmask(:,:,1) 
    268       ENDIF 
    269304    
    270305      IF( ndebug /= 0 ) THEN 
    … …  
    278313 
    279314 
    280    SUBROUTINE trd_vor( kt ) 
     315   SUBROUTINE trd_vor_iom( kt ) 
    281316      !!---------------------------------------------------------------------- 
    282317      !!                  ***  ROUTINE trd_vor  *** 
    … …  
    285320      !!               and make outputs (NetCDF or DIMG format) 
    286321      !!---------------------------------------------------------------------- 
    287       ! 
    288       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     322      INTEGER                   , INTENT(in   ) ::   kt             ! time step 
    289323      ! 
    290324      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    … …  
    305339 
    306340      IF( kt > nit000 )   vor_avrb(:,:) = vor_avr(:,:) 
    307  
    308       IF( ndebug /= 0 ) THEN 
    309           WRITE(numout,*) ' debuging trd_vor: I.1 done ' 
    310           CALL FLUSH(numout) 
    311       ENDIF 
    312341 
    313342      ! I.2 vertically integrated vorticity 
    … …  
    330359 
    331360      ! Curl 
    332       DO ji=1,jpim1 
    333          DO jj=1,jpjm1 
     361      DO ji = 1, jpim1 
     362         DO jj = 1, jpjm1 
    334363            vor_avr(ji,jj) = (  ( zvn(ji+1,jj) - zvn(ji,jj) )    & 
    335364               &              - ( zun(ji,jj+1) - zun(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1) 
    … …  
    337366      END DO 
    338367       
    339       IF( ndebug /= 0 ) THEN 
    340          WRITE(numout,*) ' debuging trd_vor: I.2 done' 
    341          CALL FLUSH(numout) 
    342       ENDIF 
    343  
    344368      !  ================================= 
    345369      !   II. Cumulated trends 
    … …  
    351375         vor_avrbb(:,:) = vor_avrb(:,:) 
    352376         vor_avrbn(:,:) = vor_avr (:,:) 
    353       ENDIF 
    354  
    355       IF( ndebug /= 0 ) THEN 
    356          WRITE(numout,*) ' debuging trd_vor: I1.1 done' 
    357          CALL FLUSH(numout) 
    358377      ENDIF 
    359378 
    … …  
    371390      ENDIF 
    372391 
    373       IF( ndebug /= 0 ) THEN 
    374          WRITE(numout,*) ' debuging trd_vor: II.2 done' 
    375          CALL FLUSH(numout) 
    376       ENDIF 
    377  
    378392      !  ============================================= 
    379393      !   III. Output in netCDF + residual computation 
    … …  
    391405         vor_avrtot(:,:) = (  vor_avr(:,:) - vor_avrbn(:,:) + vor_avrb(:,:) - vor_avrbb(:,:) ) * zmean 
    392406 
    393          IF( ndebug /= 0 ) THEN 
    394              WRITE(numout,*) ' zmean = ',zmean 
    395              WRITE(numout,*) ' debuging trd_vor: III.1 done' 
    396              CALL FLUSH(numout) 
    397          ENDIF 
    398407 
    399408         ! III.2 compute residual 
    … …  
    406415         CALL lbc_lnk( vor_avrres, 'F', 1. ) 
    407416 
    408          IF( ndebug /= 0 ) THEN 
    409             WRITE(numout,*) ' debuging trd_vor: III.2 done' 
    410             CALL FLUSH(numout) 
    411          ENDIF 
    412417 
    413418         ! III.3 time evolution array swap 
    … …  
    415420         vor_avrbb(:,:) = vor_avrb(:,:) 
    416421         vor_avrbn(:,:) = vor_avr (:,:) 
    417  
    418          IF( ndebug /= 0 ) THEN 
    419             WRITE(numout,*) ' debuging trd_vor: III.3 done' 
    420             CALL FLUSH(numout) 
    421          ENDIF 
    422422         ! 
    423423         nmoydpvor = 0 
    … …  
    463463      CALL wrk_dealloc( jpi, jpj, zun, zvn )                                    
    464464      ! 
    465    END SUBROUTINE trd_vor 
     465   END SUBROUTINE trd_vor_iom 
    466466 
    467467 
    … …  
    587587   END SUBROUTINE trd_vor_init 
    588588 
    589 #else 
    590    !!---------------------------------------------------------------------- 
    591    !!   Default option :                                       Empty module 
    592    !!---------------------------------------------------------------------- 
    593    INTERFACE trd_vor_zint 
    594       MODULE PROCEDURE trd_vor_zint_2d, trd_vor_zint_3d 
    595    END INTERFACE 
    596 CONTAINS 
    597    SUBROUTINE trd_vor( kt )        ! Empty routine 
    598       WRITE(*,*) 'trd_vor: You should not have seen this print! error?', kt 
    599    END SUBROUTINE trd_vor 
    600    SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd ) 
    601       REAL, DIMENSION(:,:), INTENT( inout ) ::   putrdvor, pvtrdvor 
    602       INTEGER, INTENT( in ) ::   ktrd         ! ocean trend index 
    603       WRITE(*,*) 'trd_vor_zint_2d: You should not have seen this print! error?', putrdvor(1,1), pvtrdvor(1,1), ktrd 
    604    END SUBROUTINE trd_vor_zint_2d 
    605    SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd ) 
    606       REAL, DIMENSION(:,:,:), INTENT( inout ) ::   putrdvor, pvtrdvor 
    607       INTEGER, INTENT( in ) ::   ktrd         ! ocean trend index 
    608       WRITE(*,*) 'trd_vor_zint_3d: You should not have seen this print! error?', putrdvor(1,1,1), pvtrdvor(1,1,1), ktrd 
    609    END SUBROUTINE trd_vor_zint_3d 
    610    SUBROUTINE trd_vor_init              ! Empty routine 
    611       WRITE(*,*) 'trd_vor_init: You should not have seen this print! error?' 
    612    END SUBROUTINE trd_vor_init 
    613 #endif 
    614589   !!====================================================================== 
    615590END MODULE trdvor 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor_oce.F90

    r2715 r4619  
    44   !! Ocean trends :   set vorticity trend variables 
    55   !!====================================================================== 
    6    !! History :  9.0  !  04-2006  (L. Brunier, A-M. Treguier) Original code  
     6   !! History :  1.0  !  04-2006  (L. Brunier, A-M. Treguier) Original code  
    77   !!---------------------------------------------------------------------- 
    8  
    9    !!---------------------------------------------------------------------- 
     8    
    109   USE par_oce      ! ocean parameters 
    1110 
    … …  
    1312   PRIVATE 
    1413 
    15 #if defined key_trdvor 
    16    LOGICAL, PUBLIC, PARAMETER ::   lk_trdvor = .TRUE.    !: momentum trend flag 
    17 #else 
    18    LOGICAL, PUBLIC, PARAMETER ::   lk_trdvor = .FALSE.   !: momentum trend flag 
    19 #endif 
    2014   !                                               !!* vorticity trends index 
    2115   INTEGER, PUBLIC, PARAMETER ::   jpltot_vor = 11  !: Number of vorticity trend terms 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90

    r4381 r4619  
    105105         IF ( ln_loglayer.AND.lk_vvl ) THEN ! "log layer" bottom friction coefficient 
    106106 
    107 #  if defined key_vectopt_loop 
    108             DO jj = 1, 1 
    109 !CDIR NOVERRCHK 
    110                DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    111 #  else 
    112 !CDIR NOVERRCHK 
    113107            DO jj = 1, jpj 
    114 !CDIR NOVERRCHK 
    115108               DO ji = 1, jpi 
    116 #  endif 
    117109                  ikbt = mbkt(ji,jj) 
    118 ! JC: possible WAD implementation should modify line below if layers vanish 
     110!! JC: possible WAD implementation should modify line below if layers vanish 
    119111                  ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp 
    120112                  zbfrt(ji,jj) = MAX(bfrcoef2d(ji,jj), ztmp) 
    … …  
    127119         ENDIF 
    128120 
    129 # if defined key_vectopt_loop 
    130          DO jj = 1, 1 
    131 !CDIR NOVERRCHK 
    132             DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    133 # else 
    134 !CDIR NOVERRCHK 
    135121         DO jj = 2, jpjm1 
    136 !CDIR NOVERRCHK 
    137122            DO ji = 2, jpim1 
    138 # endif 
    139123               ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points 
    140124               ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points) 
    … …  
    152136            END DO 
    153137         END DO 
    154  
    155138         ! 
    156139         CALL lbc_lnk( bfrua, 'U', 1. )   ;   CALL lbc_lnk( bfrva, 'V', 1. )      ! Lateral boundary condition 
    … …  
    265248         ! 
    266249         IF ( ln_loglayer.AND.(.NOT.lk_vvl) ) THEN ! set "log layer" bottom friction once for all 
    267 #  if defined key_vectopt_loop 
    268             DO jj = 1, 1 
    269 !CDIR NOVERRCHK 
    270                DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    271 #  else 
    272 !CDIR NOVERRCHK 
    273250            DO jj = 1, jpj 
    274 !CDIR NOVERRCHK 
    275251               DO ji = 1, jpi 
    276 #  endif 
    277252                  ikbt = mbkt(ji,jj) 
    278253                  ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp 
    … …  
    309284      zmaxbfr = -1.e10_wp    ! initialise tracker for maximum of bottom friction coefficient 
    310285      ! 
    311 #  if defined key_vectopt_loop 
    312       DO jj = 1, 1 
    313 !CDIR NOVERRCHK 
    314          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    315 #  else 
    316 !CDIR NOVERRCHK 
    317286      DO jj = 2, jpjm1 
    318 !CDIR NOVERRCHK 
    319287         DO ji = 2, jpim1 
    320 #  endif 
    321288             ikbu = mbku(ji,jj)       ! deepest ocean level at u- and v-points 
    322289             ikbv = mbkv(ji,jj) 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90

    r4147 r4619  
    66   !! History :  OPA  ! 2000-08  (G. Madec)  double diffusive mixing 
    77   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module 
    8    !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
     8   !!            3.3  ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
     9   !!            3.6  ! 2013-04  (G. Madec, F. Roquet) zrau compute locally using interpolation of alpha & beta 
    910   !!---------------------------------------------------------------------- 
    1011#if defined key_zdfddm   ||   defined key_esopa 
    … …  
    1819   USE dom_oce         ! ocean space and time domain variables  
    1920   USE zdf_oce         ! ocean vertical physics variables 
     21   USE eosbn2         ! equation of state 
     22   ! 
    2023   USE in_out_manager  ! I/O manager 
    2124   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    … …  
    3437   LOGICAL , PUBLIC, PARAMETER ::   lk_zdfddm = .TRUE.  !: double diffusive mixing flag 
    3538 
    36    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avs    !: salinity vertical diffusivity coeff. at w-point 
    37    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   rrau   !: heat/salt buoyancy flux ratio 
    38  
    39    !                      !!* Namelist namzdf_ddm : double diffusive mixing * 
    40    REAL(wp) ::   rn_avts   ! maximum value of avs for salt fingering 
    41    REAL(wp) ::   rn_hsbfr  ! heat/salt buoyancy flux ratio 
     39   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avs   !: salinity vertical diffusivity coeff. at w-point 
     40 
     41   !                       !!* Namelist namzdf_ddm : double diffusive mixing * 
     42   REAL(wp) ::   rn_avts    ! maximum value of avs for salt fingering 
     43   REAL(wp) ::   rn_hsbfr   ! heat/salt buoyancy flux ratio 
    4244 
    4345   !! * Substitutions 
     46#  include "domzgr_substitute.h90" 
    4447#  include "vectopt_loop_substitute.h90" 
    4548   !!---------------------------------------------------------------------- 
    46    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     49   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    4750   !! $Id$ 
    4851   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    5457      !!                ***  ROUTINE zdf_ddm_alloc  *** 
    5558      !!---------------------------------------------------------------------- 
    56       ALLOCATE( avs(jpi,jpj,jpk), rrau(jpi,jpj,jpk), STAT= zdf_ddm_alloc ) 
    57       ! 
     59      ALLOCATE( avs(jpi,jpj,jpk) , STAT= zdf_ddm_alloc ) 
    5860      IF( lk_mpp             )   CALL mpp_sum ( zdf_ddm_alloc ) 
    5961      IF( zdf_ddm_alloc /= 0 )   CALL ctl_warn('zdf_ddm_alloc: failed to allocate arrays') 
    … …  
    7173      !!      diffusive mixing (i.e. salt fingering and diffusive layering) 
    7274      !!      following Merryfield et al. (1999). The rate of double diffusive  
    73       !!      mixing depend on the buoyancy ratio: Rrau=alpha/beta dk[T]/dk[S] 
    74       !!      which is computed in rn2.F 
     75      !!      mixing depend on the buoyancy ratio (R=alpha/beta dk[T]/dk[S]): 
    7576      !!         * salt fingering (Schmitt 1981): 
    76       !!      for Rrau > 1 and rn2 > 0 : zavfs = rn_avts / ( 1 + (Rrau/rn_hsbfr)^6 ) 
    77       !!      for Rrau > 1 and rn2 > 0 : zavfs = O 
    78       !!      otherwise                : zavft = 0.7 zavs / Rrau 
     77      !!      for R > 1 and rn2 > 0 : zavfs = rn_avts / ( 1 + (R/rn_hsbfr)^6 ) 
     78      !!      for R > 1 and rn2 > 0 : zavfs = O 
     79      !!      otherwise                : zavft = 0.7 zavs / R 
    7980      !!         * diffusive layering (Federov 1988): 
    80       !!      for 0< Rrau < 1 and rn2 > 0 : zavdt = 1.3635e-6   
    81       !!                                 * exp( 4.6 exp(-0.54 (1/Rrau-1) ) ) 
     81      !!      for 0< R < 1 and N^2 > 0 : zavdt = 1.3635e-6 * exp( 4.6 exp(-0.54 (1/R-1) ) ) 
    8282      !!      otherwise                   : zavdt = 0  
    83       !!      for .5 < Rrau < 1 and rn2 > 0 : zavds = zavdt (1.885 Rrau -0.85) 
    84       !!      for  0 < Rrau <.5 and rn2 > 0 : zavds = zavdt 0.15 Rrau       
     83      !!      for .5 < R < 1 and N^2 > 0 : zavds = zavdt (1.885 R -0.85) 
     84      !!      for  0 < R <.5 and N^2 > 0 : zavds = zavdt 0.15 R       
    8585      !!      otherwise                     : zavds = 0  
    8686      !!         * update the eddy diffusivity: 
    … …  
    9696      ! 
    9797      INTEGER  ::   ji, jj , jk     ! dummy loop indices 
    98       REAL(wp) ::   zinr, zrr       ! temporary scalars 
    99       REAL(wp) ::   zavft, zavfs    !    -         - 
    100       REAL(wp) ::   zavdt, zavds    !    -         - 
    101       REAL(wp), POINTER, DIMENSION(:,:) ::   zmsks, zmskf, zmskd1, zmskd2, zmskd3 
     98      REAL(wp) ::   zaw, zbw, zrw   ! local scalars 
     99      REAL(wp) ::   zdt, zds 
     100      REAL(wp) ::   zinr, zrr       !   -      - 
     101      REAL(wp) ::   zavft, zavfs    !   -      - 
     102      REAL(wp) ::   zavdt, zavds    !   -      - 
     103      REAL(wp), POINTER, DIMENSION(:,:) ::   zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 
    102104      !!---------------------------------------------------------------------- 
    103105      ! 
    104106      IF( nn_timing == 1 )  CALL timing_start('zdf_ddm') 
    105107      ! 
    106       CALL wrk_alloc( jpi,jpj, zmsks, zmskf, zmskd1, zmskd2, zmskd3 ) 
    107  
     108      CALL wrk_alloc( jpi,jpj, zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 ) 
     109      ! 
    108110      !                                                ! =============== 
    109111      DO jk = 2, jpkm1                                 ! Horizontal slab 
    … …  
    111113         ! Define the mask  
    112114         ! --------------- 
    113          rrau(:,:,jk) = MAX( 1.e-20, rrau(:,:,jk) )         ! only retains positive value of rrau 
     115         DO jj = 1, jpj                                ! R=zrau = (alpha / beta) (dk[t] / dk[s]) 
     116            DO ji = 1, jpi 
     117               zrw =   ( fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk) )   & 
     118                  &  / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) )  
     119               ! 
     120               zaw = (  rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem) * zrw  ) * tmask(ji,jj,jk) 
     121               zbw = (  rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal) * zrw  ) * tmask(ji,jj,jk) 
     122               ! 
     123               zdt = zaw * ( tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) 
     124               zds = zbw * ( tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) )  
     125               IF( ABS( zds) <= 1.e-20_wp )   zds = 1.e-20_wp 
     126               zrau(ji,jj) = MAX(  1.e-20, zdt / zds  )    ! only retains positive value of zrau 
     127            END DO 
     128         END DO 
    114129 
    115130         DO jj = 1, jpj                                     ! indicators: 
    … …  
    119134               ELSE                                       ;   zmsks(ji,jj) = 1._wp 
    120135               ENDIF 
    121                ! salt fingering indicator: msksf=1 if rrau>1; 0 elsewhere             
    122                IF( rrau(ji,jj,jk) <= 1.          ) THEN   ;   zmskf(ji,jj) = 0._wp 
     136               ! salt fingering indicator: msksf=1 if R>1; 0 elsewhere             
     137               IF( zrau(ji,jj) <= 1.             ) THEN   ;   zmskf(ji,jj) = 0._wp 
    123138               ELSE                                       ;   zmskf(ji,jj) = 1._wp 
    124139               ENDIF 
    125140               ! diffusive layering indicators:  
    126                !     ! mskdl1=1 if 0<rrau<1; 0 elsewhere 
    127                IF( rrau(ji,jj,jk) >= 1.          ) THEN   ;   zmskd1(ji,jj) = 0._wp 
     141               !     ! mskdl1=1 if 0< R <1; 0 elsewhere 
     142               IF( zrau(ji,jj) >= 1.             ) THEN   ;   zmskd1(ji,jj) = 0._wp 
    128143               ELSE                                       ;   zmskd1(ji,jj) = 1._wp 
    129144               ENDIF 
    130                !     ! mskdl2=1 if 0<rrau<0.5; 0 elsewhere 
    131                IF( rrau(ji,jj,jk) >= 0.5         ) THEN   ;   zmskd2(ji,jj) = 0._wp 
     145               !     ! mskdl2=1 if 0< R <0.5; 0 elsewhere 
     146               IF( zrau(ji,jj) >= 0.5            ) THEN   ;   zmskd2(ji,jj) = 0._wp 
    132147               ELSE                                       ;   zmskd2(ji,jj) = 1._wp 
    133148               ENDIF 
    134                !   mskdl3=1 if 0.5<rrau<1; 0 elsewhere 
    135                IF( rrau(ji,jj,jk) <= 0.5 .OR. rrau(ji,jj,jk) >= 1. ) THEN   ;   zmskd3(ji,jj) = 0._wp 
    136                ELSE                                                         ;   zmskd3(ji,jj) = 1._wp 
     149               !   mskdl3=1 if 0.5< R <1; 0 elsewhere 
     150               IF( zrau(ji,jj) <= 0.5 .OR. zrau(ji,jj) >= 1. ) THEN   ;   zmskd3(ji,jj) = 0._wp 
     151               ELSE                                                   ;   zmskd3(ji,jj) = 1._wp 
    137152               ENDIF 
    138153            END DO 
    … …  
    149164!CDIR NOVERRCHK 
    150165            DO ji = 1, jpi 
    151                zinr = 1./rrau(ji,jj,jk) 
     166               zinr = 1._wp / zrau(ji,jj) 
    152167               ! salt fingering 
    153                zrr = rrau(ji,jj,jk)/rn_hsbfr 
     168               zrr = zrau(ji,jj) / rn_hsbfr 
    154169               zrr = zrr * zrr 
    155170               zavfs = rn_avts / ( 1 + zrr*zrr*zrr ) * zmsks(ji,jj) * zmskf(ji,jj) 
    … …  
    157172               ! diffusive layering 
    158173               zavdt = 1.3635e-6 * EXP(  4.6 * EXP( -0.54*(zinr-1.) )  ) * zmsks(ji,jj) * zmskd1(ji,jj) 
    159                zavds = zavdt * zmsks(ji,jj) * (  (1.85 * rrau(ji,jj,jk) - 0.85 ) * zmskd3(ji,jj)   & 
    160                   &                            +  0.15 * rrau(ji,jj,jk)          * zmskd2(ji,jj)  ) 
     174               zavds = zavdt * zmsks(ji,jj) * (  ( 1.85 * zrau(ji,jj) - 0.85 ) * zmskd3(ji,jj)   & 
     175                  &                             +  0.15 * zrau(ji,jj)          * zmskd2(ji,jj)  ) 
    161176               ! add to the eddy viscosity coef. previously computed 
    162177               avs (ji,jj,jk) = avt(ji,jj,jk) + zavfs + zavds 
    … …  
    212227      !!              called by zdf_ddm at the first timestep (nit000) 
    213228      !!---------------------------------------------------------------------- 
     229      INTEGER ::   ios   ! local integer 
     230      !! 
    214231      NAMELIST/namzdf_ddm/ rn_avts, rn_hsbfr 
    215       INTEGER  ::   ios                 ! Local integer output status for namelist read 
    216232      !!---------------------------------------------------------------------- 
    217233      ! 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90

    r3294 r4619  
    7878         ! 
    7979         DO jk = 1, jpkm1  
    80 #if defined key_vectopt_loop 
    81             DO jj = 1, 1                     ! big loop forced 
    82                DO ji = jpi+2, jpij    
    83 #else 
    8480            DO jj = 2, jpj             ! no vector opt. 
    8581               DO ji = 2, jpi 
    86 #endif 
    8782#if defined key_zdfkpp 
    8883                  ! no evd mixing in the boundary layer with KPP 
    … …  
    110105         DO jk = 1, jpkm1 
    111106!!!         WHERE( rn2(:,:,jk) <= -1.e-12 ) avt(:,:,jk) = tmask(:,:,jk) * avevd   ! agissant sur T SEUL!  
    112 #if defined key_vectopt_loop 
    113             DO jj = 1, 1                     ! big loop forced 
    114                DO ji = 1, jpij    
    115 #else 
    116107            DO jj = 1, jpj             ! loop over the whole domain (no lbc_lnk call) 
    117108               DO ji = 1, jpi 
    118 #endif 
    119109#if defined key_zdfkpp 
    120110                  ! no evd mixing in the boundary layer with KPP 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90

    r4147 r4619  
    2626   USE phycst         ! physical constants 
    2727   USE eosbn2         ! equation of state 
    28    USE zdfddm         ! double diffusion mixing 
     28   USE zdfddm         ! double diffusion mixing (avs array) 
     29   USE lib_mpp        ! MPP library 
     30   USE trd_oce        ! ocean trends definition 
     31   USE trdtra         ! tracers trends 
     32   ! 
    2933   USE in_out_manager ! I/O manager 
    30    USE lib_mpp        ! MPP library 
    31    USE wrk_nemo       ! work arrays 
    3234   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    3335   USE prtctl         ! Print control 
    34    USE trdmod_oce     ! ocean trends definition 
    35    USE trdtra         ! tracers trends 
     36   USE wrk_nemo       ! work arrays 
    3637   USE timing         ! Timing 
    37    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     38   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    3839 
    3940   IMPLICIT NONE 
    … …  
    246247      REAL(wp) ::   zdelta, zdelta2, zdzup, zdzdn, zdzh, zvath, zgat1, zdat1, zkm1m, zkm1t 
    247248#if defined key_zdfddm 
    248       REAL(wp) ::   zrrau, zds, zavdds, zavddt,zinr   ! double diffusion mixing 
    249       REAL(wp), POINTER, DIMENSION(:,:)   ::     zdifs 
     249      REAL(wp) ::   zrw, zkm1s                    ! local scalars 
     250      REAL(wp) ::   zrrau, zdt, zds, zavdds, zavddt, zinr   ! double diffusion mixing 
     251      REAL(wp), POINTER, DIMENSION(:,:)   ::   zdifs 
    250252      REAL(wp), POINTER, DIMENSION(:)     ::   za2s, za3s, zkmps 
    251       REAL(wp) ::                            zkm1s 
    252253      REAL(wp), POINTER, DIMENSION(:,:)   ::   zblcs 
    253254      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdiffus 
    … …  
    274275#endif 
    275276 
    276       zviscos(:,:,:) = 0. 
    277       zblcm  (:,:  ) = 0.  
    278       zdiffut(:,:,:) = 0. 
    279       zblct  (:,:  ) = 0.  
     277      zviscos(:,:,:) = 0._wp 
     278      zblcm  (:,:  ) = 0._wp 
     279      zdiffut(:,:,:) = 0._wp 
     280      zblct  (:,:  ) = 0._wp  
    280281#if defined key_zdfddm 
    281       zdiffus(:,:,:) = 0. 
    282       zblcs  (:,:  ) = 0.  
    283 #endif 
    284       ghats(:,:,:) = 0. 
    285       
    286       zBo   (:,:) = 0. 
    287       zBosol(:,:) = 0. 
    288       zustar(:,:) = 0. 
    289  
    290  
     282      zdiffus(:,:,:) = 0._wp 
     283      zblcs  (:,:  ) = 0._wp  
     284#endif 
     285      ghats  (:,:,:) = 0._wp 
     286      zBo    (:,:  ) = 0._wp 
     287      zBosol (:,:  ) = 0._wp 
     288      zustar (:,:  ) = 0._wp 
     289      ! 
    291290      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    292291      ! I. Interior diffusivity and viscosity at w points ( T interfaces) 
    … …  
    332331                  avt (ji,jj,jk) =  avt (ji,jj,jk) + rn_difri * zfri     
    333332               ENDIF 
     333               ! 
    334334#if defined key_zdfddm  
    335                avs (ji,jj,jk) =  avt (ji,jj,jk)               
     335               ! 
    336336               !  Double diffusion mixing ; NOT IN ROUTINE ZDFDDM.F90 
    337                ! ------------------------------------------------------------------ 
    338                ! only retains positive value of rrau 
    339                zrrau = MAX( rrau(ji,jj,jk), epsln ) 
    340                zds   = tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) 
    341                IF( zrrau > 1. .AND. zds > 0.) THEN 
    342                   ! 
    343                   ! Salt fingering case. 
    344                   !--------------------- 
    345                   ! Compute interior diffusivity for double diffusive mixing of 
    346                   ! salinity. Upper bound "zrrau" by "Rrho0"; (Rrho0=1.9, difcoefnuf=0.001). 
    347                   ! After that set interior diffusivity for double diffusive mixing 
    348                   ! of temperature 
     337               ! ------------------------- 
     338               avs (ji,jj,jk) =  avt (ji,jj,jk)    
     339 
     340               ! R=zrau = (alpha / beta) (dk[t] / dk[s]) 
     341               zrw =   ( fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk) )   & 
     342                  &  / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) )  
     343               ! 
     344               zaw = (  rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem) * zrw  ) * tmask(ji,jj,jk) 
     345               zbw = (  rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal) * zrw  ) * tmask(ji,jj,jk) 
     346               ! 
     347               zdt = zaw * ( tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) 
     348               zds = zbw * ( tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) )  
     349               IF( ABS( zds) <= 1.e-20_wp )   zds = 1.e-20_wp 
     350               zrrau = MAX(  epsln , zdt / zds  )    ! only retains positive value of zrau 
     351               ! 
     352               IF( zrrau > 1. .AND. zds > 0.) THEN                        ! Salt fingering case. 
     353                  !                                                       !--------------------- 
     354                  ! Compute interior diffusivity for double diffusive mixing of salinity.  
     355                  ! Upper bound "zrrau" by "Rrho0"; (Rrho0=1.9, difcoefnuf=0.001). 
     356                  ! After that set interior diffusivity for double diffusive mixing of temperature 
    349357                  zavdds = MIN( zrrau, Rrho0 ) 
    350358                  zavdds = ( zavdds - 1.0 ) / ( Rrho0 - 1.0 ) 
    … …  
    353361                  zavdds = difssf * zavdds  
    354362                  zavddt = 0.7 * zavdds 
    355                ELSEIF( zrrau < 1. .AND. zrrau > 0. .AND. zds < 0.) THEN 
    356363                  ! 
    357                   ! Diffusive convection case. 
    358                   !--------------------------- 
    359                   ! Compute interior diffusivity for double diffusive mixing of 
    360                   ! temperature (Marmorino and Caldwell, 1976);  
     364               ELSEIF( zrrau < 1. .AND. zrrau > 0. .AND. zds < 0.) THEN   ! Diffusive convection case. 
     365                  !                                                       !--------------------------- 
     366                  ! Compute interior diffusivity for double diffusive mixing of temperature (Marmorino and Caldwell, 1976);  
    361367                  ! Compute interior diffusivity for double diffusive mixing of salinity  
    362368                  zinr   = 1. / zrrau 
    363369                  zavddt = 0.909 * EXP( 4.6 * EXP( -0.54* ( zinr - 1. ) ) )  
    364370                  zavddt = difsdc * zavddt 
    365                   IF( zrrau < 0.5) THEN 
    366                      zavdds = zavddt * 0.15 * zrrau 
    367                   ELSE 
    368                      zavdds = zavddt * (1.85 * zrrau - 0.85 )  
     371                  IF( zrrau < 0.5) THEN   ;   zavdds = zavddt * 0.15 * zrrau 
     372                  ELSE                    ;   zavdds = zavddt * (1.85 * zrrau - 0.85 )  
    369373                  ENDIF 
    370374               ELSE 
    … …  
    385389      !--------------------------------------------------------------------- 
    386390      DO jj = 2, jpjm1 
    387          DO ji = fs_2, fs_jpim1      
    388             IF( nn_eos < 1) THEN    
    389                zt     = tsn(ji,jj,1,jp_tem) 
    390                zs     = tsn(ji,jj,1,jp_sal) - 35.0 
    391                zh     = fsdept(ji,jj,1) 
    392                !  potential volumic mass 
    393                zrhos  = rhop(ji,jj,1) 
    394                zalbet = ( ( ( - 0.255019e-07 * zt + 0.298357e-05 ) * zt   &   ! ratio alpha/beta 
    395                   &                               - 0.203814e-03 ) * zt   & 
    396                   &                               + 0.170907e-01 ) * zt   & 
    397                   &   + 0.665157e-01                                      & 
    398                   &   +     ( - 0.678662e-05 * zs                         & 
    399                   &           - 0.846960e-04 * zt + 0.378110e-02 ) * zs   & 
    400                   &   +   ( ( - 0.302285e-13 * zh                         & 
    401                   &           - 0.251520e-11 * zs                         & 
    402                   &           + 0.512857e-12 * zt * zt           ) * zh   & 
    403                   &           - 0.164759e-06 * zs                         & 
    404                   &        +(   0.791325e-08 * zt - 0.933746e-06 ) * zt   & 
    405                   &                               + 0.380374e-04 ) * zh 
    406  
    407                zbeta  = ( ( -0.415613e-09 * zt + 0.555579e-07 ) * zt      &   ! beta 
    408                   &                            - 0.301985e-05 ) * zt      & 
    409                   &   + 0.785567e-03                                      & 
    410                   &   + (     0.515032e-08 * zs                           & 
    411                   &         + 0.788212e-08 * zt - 0.356603e-06 ) * zs     & 
    412                   &   +(  (   0.121551e-17 * zh                           & 
    413                   &         - 0.602281e-15 * zs                           & 
    414                   &         - 0.175379e-14 * zt + 0.176621e-12 ) * zh     & 
    415                   &                             + 0.408195e-10   * zs     & 
    416                   &     + ( - 0.213127e-11 * zt + 0.192867e-09 ) * zt     & 
    417                   &                             - 0.121555e-07 ) * zh 
    418  
    419                zthermal = zbeta * zalbet / ( rcp * zrhos + epsln ) 
    420                zhalin   = zbeta * tsn(ji,jj,1,jp_sal) * rcs 
    421             ELSE 
    422                zrhos    = rhop(ji,jj,1) + rau0 * ( 1. - tmask(ji,jj,1) ) 
    423                zthermal = rn_alpha / ( rcp * zrhos + epsln ) 
    424                zhalin   = rn_beta * tsn(ji,jj,1,jp_sal) * rcs 
    425                zbeta    = rn_beta 
    426             ENDIF 
     391         DO ji = fs_2, fs_jpim1            
     392            zrhos    = rau0 * ( 1._wp + rhd(ji,jj,1) ) * tmask(ji,jj,1) 
     393            zthermal = rab_n(ji,jj,1,jp_tem) / ( rcp * zrhos + epsln ) 
     394            zbeta    = rab_n(ji,jj,1,jp_sal) 
     395            zhalin   = zbeta * tsn(ji,jj,1,jp_sal) * rcs 
     396            ! 
    427397            ! Radiative surface buoyancy force 
    428398            zBosol(ji,jj) = grav * zthermal * qsr(ji,jj) 
    … …  
    435405            ws0(ji,jj) = - ( ( emp(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal)                          & 
    436406               &             + sfx(ji,jj)                                     ) * rcs * tmask(ji,jj,1)  
    437          ENDDO 
    438       ENDDO 
     407         END DO 
     408      END DO 
    439409 
    440410      zflageos = 0.5 + SIGN( 0.5, nn_eos - 1. )  
    … …  
    447417            ! Friction velocity (zustar), at T-point : LMD94 eq. 2 
    448418            zustar(ji,jj) = SQRT( taum(ji,jj) / ( zrhos +  epsln ) ) 
    449          ENDDO 
    450       ENDDO 
     419         END DO 
     420      END DO 
    451421 
    452422!CDIR NOVERRCHK   
    … …  
    12701240         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 
    12711241!!bug gm jpttdzdf ==> jpttkpp 
    1272          CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_zdf, ztrdt ) 
    1273          CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_zdf, ztrds ) 
     1242         CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdf, ztrdt ) 
     1243         CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdf, ztrds ) 
    12741244         DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds ) 
    12751245      ENDIF 
    … …  
    13751345      !!---------------------------------------------------------------------- 
    13761346      INTEGER  ::   ji, jj, jk     ! dummy loop indices 
     1347      INTEGER  ::   ios            ! local integer 
    13771348#if ! defined key_kppcustom 
    13781349      INTEGER  ::   jm             ! dummy loop indices      
    … …  
    13821353      REAL(wp) ::   zustar, zucube, zustvk, zeta, zehat   ! tempory scalars 
    13831354#endif 
    1384       INTEGER  ::   ios            ! Local integer output status for namelist read 
    13851355      REAL(wp) ::   zhbf           ! tempory scalars 
    13861356      LOGICAL  ::   ll_kppcustom   ! 1st ocean level taken as surface layer 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90

    r4245 r4619  
    66   !! History :  1.0  ! 2003-08  (G. Madec)  original code 
    77   !!            3.2  ! 2009-07  (S. Masson, G. Madec)  IOM + merge of DO-loop 
     8   !!            3.7  ! 2012-03  (G. Madec)  make public the density criteria for trdmxl  
     9   !!             -   ! 2014-02  (F. Roquet)  mixed layer depth calculated using N2 instead of rhop  
    810   !!---------------------------------------------------------------------- 
    911   !!   zdf_mxl      : Compute the turbocline and mixed layer depths. 
    … …  
    2527   PUBLIC   zdf_mxl       ! called by step.F90 
    2628 
    27    REAL(wp), PUBLIC ::   rho_c = 0.01_wp    ! density criterion for mixed layer depth 
    28    REAL(wp), PUBLIC ::   avt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth 
    29  
    3029   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   nmln    !: number of level in the mixed layer (used by TOP) 
    3130   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmld    !: mixing layer depth (turbocline)      [m] 
    3231   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlp    !: mixed layer depth  (rho=rho0+zdcrit) [m] 
    3332   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlpt   !: mixed layer depth at t-points        [m] 
     33 
     34   REAL(wp), PUBLIC ::   rho_c = 0.01_wp    !: density criterion for mixed layer depth 
     35   REAL(wp)         ::   avt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth 
    3436 
    3537   !! * Substitutions 
    … …  
    7072      !!      eddy diffusivity coefficient (resulting from the vertical physics 
    7173      !!      alone, not the isopycnal part, see trazdf.F) fall below a given 
    72       !!      value defined locally (avt_c here taken equal to 5 cm/s2) 
     74      !!      value defined locally (avt_c here taken equal to 5 cm/s2 by default) 
    7375      !! 
    7476      !! ** Action  :   nmln, hmld, hmlp, hmlpt 
    7577      !!---------------------------------------------------------------------- 
    7678      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    77       !! 
    78       INTEGER  ::   ji, jj, jk          ! dummy loop indices 
    79       INTEGER  ::   iikn, iiki          ! temporary integer within a do loop 
    80       INTEGER, POINTER, DIMENSION(:,:) ::   imld                ! temporary workspace 
     79      ! 
     80      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     81      INTEGER  ::   iikn, iiki   ! local integer 
     82      REAL(wp) ::   zmult        ! local scalar 
     83      INTEGER, POINTER, DIMENSION(:,:) ::   imld   ! 2D workspace 
    8184      !!---------------------------------------------------------------------- 
    8285      ! 
    … …  
    9497 
    9598      ! w-level of the mixing and mixed layers 
    96       nmln(:,:) = mbkt(:,:) + 1        ! Initialization to the number of w ocean point 
    97       imld(:,:) = mbkt(:,:) + 1 
     99      nmln     (:,:)  = nlb10                ! Initialization to the number of w ocean point 
     100      hmlp     (:,:)  = 0._wp                ! used as a dummy variable, integrating vertically N2 
     101      zmult = rho_c * r1_rau0 * grav 
     102      DO jk = nlb10, jpkm1 
     103         DO jj = 1, jpj 
     104            DO ji = 1, jpi 
     105               hmlp(ji,jj) = hmlp(ji,jj) + rn2b(ji,jj,jk) * fse3w(ji,jj,jk) 
     106               IF( hmlp(ji,jj) < zmult )   nmln(ji,jj) = jk + 1    ! Mixed layer 
     107            END DO 
     108         END DO 
     109      END DO 
     110      ! 
     111      DO jj = 1, jpj                      ! bottom k-index of u- (v-) level 
     112         DO ji = 1, jpi 
     113            nmln(ji,jj) = MIN(  nmln(ji,jj) , mbkt(ji,jj) + 1  ) 
     114         END DO 
     115      END DO 
     116      !! end fabien 
     117      ! w-level of the turbocline 
     118      imld(:,:) = mbkt(:,:) + 1        ! Initialization to the number of w ocean point 
    98119      DO jk = jpkm1, nlb10, -1         ! from the bottom to nlb10 
    99120         DO jj = 1, jpj 
    100121            DO ji = 1, jpi 
    101                IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + rho_c )   nmln(ji,jj) = jk      ! Mixed layer 
    102122               IF( avt (ji,jj,jk) < avt_c                     )   imld(ji,jj) = jk      ! Turbocline  
    103123            END DO 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r4147 r4619  
    291291         END DO 
    292292         !                               ! finite LC depth 
    293 # if defined key_vectopt_loop 
    294          DO jj = 1, 1 
    295             DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    296 # else 
    297293         DO jj = 1, jpj  
    298294            DO ji = 1, jpi 
    299 # endif 
    300295               zhlc(ji,jj) = fsdepw(ji,jj,imlc(ji,jj)) 
    301296            END DO 
    302297         END DO 
    303298         zcof = 0.016 / SQRT( zrhoa * zcdrag ) 
    304 !CDIR NOVERRCHK 
    305299         DO jk = 2, jpkm1         !* TKE Langmuir circulation source term added to en 
    306 !CDIR NOVERRCHK 
    307             DO jj = 2, jpjm1 
    308 !CDIR NOVERRCHK 
     300            DO jj = 2, jpjm1 
    309301               DO ji = fs_2, fs_jpim1   ! vector opt. 
    310302                  zus  = zcof * SQRT( taum(ji,jj) )           ! Stokes drift 

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

    r4354 r4619  
    5151#endif 
    5252   USE tideini         ! tidal components initialization   (tide_ini routine) 
    53    USE bdyini          ! open boundary cond. initialization (bdy_init routine) 
    54    USE bdydta          ! open boundary cond. initialization (bdy_dta_init routine) 
    55    USE bdytides        ! open boundary cond. initialization (bdytide_init routine) 
     53   USE bdyini          ! open boundary cond. setting      (bdy_init routine) 
     54   USE bdydta          ! open boundary cond. setting  (bdy_dta_init routine) 
     55   USE bdytides        ! open boundary cond. setting  (bdytide_init routine) 
    5656   USE istate          ! initial state setting          (istate_init routine) 
    5757   USE ldfdyn          ! lateral viscosity setting      (ldfdyn_init routine) 
    … …  
    5959   USE zdfini          ! vertical physics setting          (zdf_init routine) 
    6060   USE phycst          ! physical constant                  (par_cst routine) 
    61    USE trdmod          ! momentum/tracers trends       (trd_mod_init routine) 
     61   USE trdini          ! dyn/tra trends initialization     (trd_init routine) 
    6262   USE asminc          ! assimilation increments      
    6363   USE asmbkg          ! writing out state trajectory 
    … …  
    121121      !!---------------------------------------------------------------------- 
    122122      ! 
    123  
    124123#if defined key_agrif 
    125124      CALL Agrif_Init_Grids()      ! AGRIF: set the meshes 
    … …  
    139138# endif 
    140139#endif 
    141  
    142140      ! check that all process are still there... If some process have an error, 
    143141      ! they will never enter in step and other processes will wait until the end of the cpu time! 
    … …  
    166164 
    167165         DO WHILE ( istp <= nitend .AND. nstop == 0 ) 
    168  
    169166#if defined key_agrif 
    170167            CALL Agrif_Step( stp )           ! AGRIF: time stepping 
    … …  
    172169            CALL stp( istp )                 ! standard time stepping 
    173170#endif 
    174  
    175171            istp = istp + 1 
    176172            IF( lk_mpp )   CALL mpp_max( nstop ) 
    … …  
    227223      INTEGER ::   ios 
    228224      CHARACTER(len=80), DIMENSION(16) ::   cltxt 
    229       !! 
    230       NAMELIST/namctl/ ln_ctl, nn_print, nn_ictls, nn_ictle,   & 
     225      ! 
     226      NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   & 
    231227         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   & 
    232228         &             nn_bench, nn_timing 
    … …  
    385381      IF( lk_tide       )   CALL    tide_init( nit000 )    ! Initialisation of the tidal harmonics 
    386382 
    387       IF( lk_bdy        )   CALL      bdy_init  ! Open boundaries initialisation 
    388       IF( lk_bdy        )   CALL  bdy_dta_init  ! Open boundaries initialisation of external data arrays 
     383      IF( lk_bdy        )   CALL     bdy_init   ! Open boundaries initialisation 
     384      IF( lk_bdy        )   CALL bdy_dta_init   ! Open boundaries initialisation of external data arrays 
    389385      IF( lk_bdy .AND. lk_tide )   & 
    390          &                  CALL  bdytide_init  ! Open boundaries initialisation of tidal harmonic forcing 
     386         &                  CALL bdytide_init   ! Open boundaries initialisation of tidal harmonic forcing 
    391387 
    392388                            CALL dyn_nept_init  ! simplified form of Neptune effect 
    … …  
    398394                            CALL     sbc_init   ! Forcings : surface module 
    399395      !                                         ! Vertical physics 
    400  
    401396                            CALL     zdf_init      ! namelist read 
    402  
    403397                            CALL zdf_bfr_init      ! bottom friction 
    404  
    405398      IF( lk_zdfric     )   CALL zdf_ric_init      ! Richardson number dependent Kz 
    406399      IF( lk_zdftke     )   CALL zdf_tke_init      ! TKE closure scheme 
    … …  
    441434                            CALL     trc_init 
    442435#endif 
    443       ! 
    444   
    445                                             ! Diagnostics 
     436      !                                     ! Diagnostics 
    446437      IF( lk_floats     )   CALL     flo_init   ! drifting Floats 
    447438      IF( lk_diaar5     )   CALL dia_ar5_init   ! ar5 diag 
    … …  
    449440      IF( lk_diadct     )   CALL dia_dct_init   ! Sections tranports 
    450441                            CALL dia_hsb_init   ! heat content, salt content and volume budgets 
    451                             CALL trd_mod_init   ! Mixed-layer/Vorticity/Integral constraints trends 
     442                            CALL     trd_init   ! Mixed-layer/Vorticity/Integral constraints trends 
    452443      IF( lk_diaobs     ) THEN                  ! Observation & model comparison 
    453444                            CALL dia_obs_init            ! Initialize observational data 
    454445                            CALL dia_obs( nit000 - 1 )   ! Observation operator for restart 
    455446      ENDIF 
     447 
    456448      !                                     ! Assimilation increments 
    457449      IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments 
    … …  
    655647      !! ** Method  : 
    656648      !!---------------------------------------------------------------------- 
    657       INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have 
     649      INTEGER, INTENT(in) ::   num_pes  ! The number of MPI processes we have 
    658650      ! 
    659651      INTEGER, PARAMETER :: nfactmax = 20 
    … …  
    664656      INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 
    665657      !!---------------------------------------------------------------------- 
    666  
     658      ! 
    667659      ierr = 0 
    668  
     660      ! 
    669661      CALL factorise( ifact, nfactmax, nfact, num_pes, ierr ) 
    670  
     662      ! 
    671663      IF( nfact <= 1 ) THEN 
    672664         WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' 
    … …  
    710702      INTEGER, PARAMETER :: ntest = 14 
    711703      INTEGER :: ilfax(ntest) 
    712  
     704      ! 
    713705      ! lfax contains the set of allowed factors. 
    714706      data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  & 
    … …  
    761753 
    762754#if defined key_mpp_mpi 
     755 
    763756   SUBROUTINE nemo_northcomms 
    764757      !!====================================================================== 
    … …  
    823816   END SUBROUTINE nemo_northcomms 
    824817#endif 
     818 
    825819   !!====================================================================== 
    826820END MODULE nemogcm 

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

    r4354 r4619  
    2020   !! dynamics and tracer fields                            ! before ! now    ! after  ! the after trends becomes the fields 
    2121   !! --------------------------                            ! fields ! fields ! trends ! only after tra_zdf and dyn_spg 
    22    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   ub   ,  un    , ua     !: i-horizontal velocity        [m/s] 
    23    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   vb   ,  vn    , va     !: j-horizontal velocity        [m/s] 
    24    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   ua_sv,  va_sv          !: Saved trends (time spliting) [m/s2] 
    25    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] 
    28    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsb  ,  tsn            !: 4D T-S fields        [Celcius,psu]  
    29    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rn2b ,  rn2            !: brunt-vaisala frequency**2   [s-2] 
    30    ! 
    31    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  tsa             !: 4D T-S trends fields & work array  
     22   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   ub   ,  un    , ua     !: i-horizontal velocity          [m/s] 
     23   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   vb   ,  vn    , va     !: j-horizontal velocity          [m/s] 
     24   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   ua_sv,  va_sv          !: Saved trends (time spliting)   [m/s2] 
     25   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] 
     28   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsb  ,  tsn   , tsa    !: 4D T-S fields                  [Celcius,psu]  
     29   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   rab_b,  rab_n          !: thermal/haline expansion coef. [Celcius-1,psu-1] 
     30   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rn2b ,  rn2            !: brunt-vaisala frequency**2     [s-2] 
    3231   ! 
    3332   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhd    !: in situ density anomalie rhd=(rho-rau0)/rau0  [no units] 
    … …  
    8180         &      hdivb(jpi,jpj,jpk)      , hdivn(jpi,jpj,jpk)      ,                             & 
    8281         &      tsb  (jpi,jpj,jpk,jpts) , tsn  (jpi,jpj,jpk,jpts) , tsa(jpi,jpj,jpk,jpts) ,     & 
     82         &      rab_b(jpi,jpj,jpk,jpts) , rab_n(jpi,jpj,jpk,jpts) ,                             & 
    8383         &      rn2b (jpi,jpj,jpk)      , rn2  (jpi,jpj,jpk)                              , STAT=ierr(1) ) 
    8484         ! 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/par_oce.F90

    r4205 r4619  
    9494#endif 
    9595 
    96 #if defined key_vectopt_loop 
    97    LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_loop = .TRUE.   !: vector optimization flag 
    98 #else 
    99    LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_loop = .FALSE.  !: vector optimization flag 
    100 #endif 
    101  
    10296   !!---------------------------------------------------------------------- 
    10397   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 

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

    r4491 r4619  
    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   !!                 !  2012-07  (J. Simeon, G. Madec, C. Ethe) Online coarsening of outputs 
     27   !!            3.7  !  2014-04  (F. Roquet, G. Madec) New equations of state 
    2728   !!---------------------------------------------------------------------- 
    2829 
    … …  
    3940   !! * Substitutions 
    4041#  include "domzgr_substitute.h90" 
    41 #  include "zdfddm_substitute.h90" 
    42    !!---------------------------------------------------------------------- 
    43    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     42!!gm   #  include "zdfddm_substitute.h90" 
     43   !!---------------------------------------------------------------------- 
     44   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    4445   !! $Id$ 
    4546   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    106107      ! Ocean physics update                (ua, va, tsa used as workspace) 
    107108      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    108                          CALL bn2( tsb, rn2b )        ! before Brunt-Vaisala frequency 
    109                          CALL bn2( tsn, rn2  )        ! now    Brunt-Vaisala frequency 
     109      !  THERMODYNAMICS 
     110                         CALL eos_rab( tsb, rab_b )       ! before local thermal/haline expension ratio at T-points 
     111                         CALL eos_rab( tsn, rab_n )       ! now    local thermal/haline expension ratio at T-points 
     112                         CALL bn2    ( tsb, rab_b, rn2b ) ! before Brunt-Vaisala frequency 
     113                         CALL bn2    ( tsn, rab_n, rn2  ) ! now    Brunt-Vaisala frequency 
    110114      ! 
    111115      !  VERTICAL PHYSICS 
    … …  
    220224#endif 
    221225 
     226 
    222227      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    223228      ! Active tracers                              (ua, va used as workspace) 
    … …  
    319324 
    320325      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    321       ! Trends                              (ua, va, tsa used as workspace) 
    322       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    323       IF( nstop == 0 ) THEN 
    324          IF( lk_trddyn     )   CALL trd_dwr( kstp )         ! trends: dynamics 
    325          IF( lk_trdtra     )   CALL trd_twr( kstp )         ! trends: active tracers 
    326          IF( lk_trdmld     )   CALL trd_mld( kstp )         ! trends: Mixed-layer 
    327          IF( lk_trdvor     )   CALL trd_vor( kstp )         ! trends: vorticity budget 
    328       ENDIF 
    329  
    330       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    331326      ! Coupled mode 
    332327      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 

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

    r4328 r4619  
    8484 
    8585   USE diawri           ! Standard run outputs             (dia_wri routine) 
    86    USE trdicp           ! Ocean momentum/tracers trends    (trd_wri routine) 
    87    USE trdmld           ! mixed-layer trends               (trd_mld routine) 
    88    USE trdmld_rst       ! restart for mixed-layer trends 
    89    USE trdmod_oce       ! ocean momentum/tracers trends 
    90    USE trdmod           ! momentum/tracers trends 
    91    USE trdvor           ! vorticity budget                 (trd_vor routine) 
    9286   USE diaptr           ! poleward transports              (dia_ptr routine) 
    9387   USE diadct           ! sections transports              (dia_dct routine) 

  • branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/vectopt_loop_substitute.h90

    r2528 r4619  
    22   !!                   ***  vectopt_loop_substitute  *** 
    33   !!---------------------------------------------------------------------- 
    4    !! ** purpose :   substitute the inner loop starting and inding indices  
    5    !!      to allow unrolling of do-loop using CPP macro. 
     4   !! ** purpose :   substitute the inner loop start/end indices with CPP macro 
     5   !!                allow unrolling of do-loop (useful with vector processors) 
    66   !!---------------------------------------------------------------------- 
    77   !!---------------------------------------------------------------------- 
    8    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     8   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    99   !! $Id$  
    1010   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1111   !!---------------------------------------------------------------------- 
    1212#if defined key_vectopt_loop 
    13 #  define fs_2     1 
    14 #  define fs_jpim1 jpi 
     13#  define   fs_2       1 
     14#  define   fs_jpim1  jpi 
    1515#else 
    16 #  define fs_2     2 
    17 #  define fs_jpim1 jpim1 
     16#  define   fs_2       2 
     17#  define   fs_jpim1  jpim1 
    1818#endif 
Note: See TracChangeset for help on using the changeset viewer.