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

Changeset 4896


Ignore:
Timestamp:
2014-11-27T15:58:54+01:00 (9 years ago)
Author:
cetlod
Message:

2014/dev_CNRS_2014 : merge the 1st branch onto dev_CNRS_2014, see ticket #1415

Location:
branches/2014/dev_CNRS_2014/NEMOGCM
Files:
12 deleted
103 edited
14 copied

Legend:

Unmodified
Added
Removed

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

    r4370 r4896  
    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_CNRS_2014/NEMOGCM/CONFIG/GYRE/cpp_GYRE.fcm

    r4230 r4896  
    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_CNRS_2014/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg

    r4370 r4896  
    206206&nameos        !   ocean physical parameters 
    207207!----------------------------------------------------------------------- 
    208    nn_eos      =   2       !  type of equation of state and Brunt-Vaisala frequency 
     208   nn_eos      =  0       !  type of equation of state and Brunt-Vaisala frequency 
     209                                 !  =-1, TEOS-10 
     210                                 !  = 0, EOS-80 
     211                                 !  = 1, S-EOS   (simplified eos) 
     212   ln_useCT    = .false.  ! use of Conservative Temp. ==> surface CT converted in Pot. Temp. in sbcssm 
     213   !                             ! 
     214   !                      ! S-EOS coefficients : 
     215   !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     216   rn_a0       =  1.6550e-1      !  thermal expension coefficient (nn_eos= 1) 
     217   rn_b0       =  7.6554e-1      !  saline  expension coefficient (nn_eos= 1) 
     218   rn_lambda1  =  5.9520e-2      !  cabbeling coeff in T^2  (=0 for linear eos) 
     219   rn_lambda2  =  7.4914e-4      !  cabbeling coeff in S^2  (=0 for linear eos) 
     220   rn_mu1      =  1.4970e-4      !  thermobaric coeff. in T (=0 for linear eos) 
     221   rn_mu2      =  1.1090e-5      !  thermobaric coeff. in S (=0 for linear eos) 
     222   rn_nu       =  2.4341e-3      !  cabbeling coeff in T*S  (=0 for linear eos) 
     223!!org GYRE   rn_alpha    =   2.0e-4  !  thermal expension coefficient (nn_eos= 1 or 2) 
     224!!org GYRE   rn_beta     =   7.7e-4  !  saline  expension coefficient (nn_eos= 2) 
     225!!org  caution  now a0 = alpha / rau0   with rau0 = 1026 
    209226/ 
    210227!----------------------------------------------------------------------- 

  • branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg

    r4370 r4896  
    121121&nameos        !   ocean physical parameters 
    122122!----------------------------------------------------------------------- 
    123    nn_eos      =   2       !  type of equation of state and Brunt-Vaisala frequency 
     123   nn_eos      =  0       !  type of equation of state and Brunt-Vaisala frequency 
     124                                 !  =-1, TEOS-10 
     125                                 !  = 0, EOS-80 
     126                                 !  = 1, S-EOS   (simplified eos) 
     127   ln_useCT    = .false.  ! use of Conservative Temp. ==> surface CT converted in Pot. Temp. in sbcssm 
     128   !                             ! 
     129   !                      ! S-EOS coefficients : 
     130   !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     131   rn_a0       =  1.6550e-1      !  thermal expension coefficient (nn_eos= 1) 
     132   rn_b0       =  7.6554e-1      !  saline  expension coefficient (nn_eos= 1) 
     133   rn_lambda1  =  5.9520e-2      !  cabbeling coeff in T^2  (=0 for linear eos) 
     134   rn_lambda2  =  7.4914e-4      !  cabbeling coeff in S^2  (=0 for linear eos) 
     135   rn_mu1      =  1.4970e-4      !  thermobaric coeff. in T (=0 for linear eos) 
     136   rn_mu2      =  1.1090e-5      !  thermobaric coeff. in S (=0 for linear eos) 
     137   rn_nu       =  2.4341e-3      !  cabbeling coeff in T*S  (=0 for linear eos) 
     138!!org GYRE   rn_alpha    =   2.0e-4  !  thermal expension coefficient (nn_eos= 1 or 2) 
     139!!org GYRE   rn_beta     =   7.7e-4  !  saline  expension coefficient (nn_eos= 2) 
     140!!org  caution  now a0 = alpha / rau0   with rau0 = 1026 
    124141/ 
    125142!----------------------------------------------------------------------- 

  • branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/GYRE_PISCES/cpp_GYRE_PISCES.fcm

    r4230 r4896  
    1 bld::tool::fppkeys  key_dynspg_flt key_ldfslp key_zdftke key_top key_pisces_reduced key_iomput key_mpp_mpi  
     1bld::tool::fppkeys  key_dynspg_flt key_ldfslp key_zdftke key_top key_pisces_reduced key_iomput key_mpp_mpi 

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

    r4565 r4896  
    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_CNRS_2014/NEMOGCM/CONFIG/SHARED/namelist_ref

    r4384 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90

    r3625 r4896  
    8686      zdiv0(:, 1 ) = 0._wp 
    8787      zdiv0(:,jpj) = 0._wp 
    88       IF( .NOT.lk_vopt_loop ) THEN 
    89          zflu (jpi,:) = 0._wp    
    90          zflv (jpi,:) = 0._wp 
    91          zdiv0(1,  :) = 0._wp 
    92          zdiv0(jpi,:) = 0._wp 
    93       ENDIF 
     88      zflu (jpi,:) = 0._wp    
     89      zflv (jpi,:) = 0._wp 
     90      zdiv0(1,  :) = 0._wp 
     91      zdiv0(jpi,:) = 0._wp 
    9492 
    9593      zconv = 1._wp           !==  horizontal diffusion using a Crant-Nicholson scheme  ==! 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90

    r4147 r4896  
    1414   !!   'key_lim2' :                                  LIM 2.0 sea-ice model 
    1515   !!---------------------------------------------------------------------- 
    16    !!---------------------------------------------------------------------- 
    1716   !!   lim_istate_2      :  Initialisation of diagnostics ice variables 
    1817   !!   lim_istate_init_2 :  initialization of ice state and namelist read 
    … …  
    3433   PUBLIC lim_istate_2      ! routine called by lim_init_2.F90 
    3534 
    36    !!! **  namelist (namiceini) ** 
    37    LOGICAL  ::   ln_limini   !: Ice initialization state 
     35   !                        !! **  namelist (namiceini) ** 
     36   LOGICAL  ::   ln_limini   ! Ice initialization state 
    3837   REAL(wp) ::   ttest       ! threshold water temperature for initial sea ice 
    3938   REAL(wp) ::   hninn       ! initial snow thickness in the north 
    … …  
    5150   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5251   !!---------------------------------------------------------------------- 
    53  
    5452CONTAINS 
    5553 
    … …  
    7169      IF( .NOT. ln_limini ) THEN   
    7270          
    73          tfu(:,:) = tfreez( tsn(:,:,1,jp_sal) ) * tmask(:,:,1)       ! freezing/melting point of sea water [Celcius] 
     71         tfu(:,:) = eos_fzp( tsn(:,:,1,jp_sal) ) * tmask(:,:,1)       ! freezing/melting point of sea water [Celcius] 
    7472 
    7573         DO jj = 1, jpj 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90

    r4333 r4896  
    8383      zdiv0(:, 1 ) = 0._wp 
    8484      zdiv0(:,jpj) = 0._wp 
    85       IF( .NOT.lk_vopt_loop ) THEN 
    86          zflu (jpi,:) = 0._wp    
    87          zflv (jpi,:) = 0._wp 
    88          zdiv0(1,  :) = 0._wp 
    89          zdiv0(jpi,:) = 0._wp 
    90       ENDIF 
     85      zflu (jpi,:) = 0._wp    
     86      zflv (jpi,:) = 0._wp 
     87      zdiv0(1,  :) = 0._wp 
     88      zdiv0(jpi,:) = 0._wp 
    9189 
    9290      zconv = 1._wp           !==  horizontal diffusion using a Crant-Nicholson scheme  ==! 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r4335 r4896  
    3636   PUBLIC   lim_istate      ! routine called by lim_init.F90 
    3737 
    38    !! * Module variables 
    3938   !                          !!** init namelist (namiceini) ** 
    4039   REAL(wp) ::   ttest   ! threshold water temperature for initial sea ice 
    … …  
    5352   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5453   !!---------------------------------------------------------------------- 
    55  
    5654CONTAINS 
    5755 
    … …  
    121119 
    122120      ! Basal temperature is set to the freezing point of seawater in Celsius 
    123       t_bo(:,:) = tfreez( tsn(:,:,1,jp_sal) ) * tmask(:,:,1)       ! freezing/melting point of sea water [Celcius] 
     121      t_bo(:,:) = eos_fzp( tsn(:,:,1,jp_sal) ) * tmask(:,:,1)       ! freezing/melting point of sea water [Celcius] 
    124122 
    125123      DO jj = 1, jpj                                       ! ice if sst <= t-freez + ttest 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90

    r4570 r4896  
    535535      !!--------------------------------------------------------------------- 
    536536#if defined key_ldfslp && ! defined key_c1d 
    537       CALL eos( pts, rhd, rhop, gdept_0(:,:,:) )   ! Time-filtered in situ density  
    538       CALL bn2( pts, rn2 )         ! before Brunt-Vaisala frequency 
     537      CALL eos_rab( pts, rab_n )       ! now local thermal/haline expension ratio at T-points 
     538      CALL bn2    ( pts, rab_n, rn2  ) ! now    Brunt-Vaisala 
    539539      IF( ln_zps )   & 
    540540         &  CALL zps_hde( kt, jpts, pts, gtsu, gtsv, rhd, gru, grv )  ! Partial steps: before Horizontal DErivative 

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

    r4313 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90

    r4367 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90

    r4313 r4896  
    7272      ! Ocean physics update                (ua, va, ta, sa used as workspace) 
    7373      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    74                          CALL bn2( tsb, rn2b )        ! before Brunt-Vaisala frequency 
    75                          CALL bn2( tsn, rn2  )        ! now    Brunt-Vaisala frequency 
     74                         CALL bn2( tsb, rab_b, rn2b ) ! before Brunt-Vaisala frequency 
     75                         CALL bn2( tsn, rab_n, rn2  ) ! now    Brunt-Vaisala frequency 
    7676      !  VERTICAL PHYSICS    
    7777                         CALL zdf_bfr( kstp )         ! bottom friction 
    … …  
    115115      ! Passive Tracer Model 
    116116      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    117                          CALL trc_stp( kstp )            ! time-stepping 
     117                        CALL trc_stp( kstp )       ! time-stepping 
    118118#endif 
    119119 
    … …  
    121121      ! Active tracers                              (ua, va used as workspace) 
    122122      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    123                              tsa(:,:,:,:) = 0.e0                ! set tracer trends to zero 
     123                        tsa(:,:,:,:) = 0._wp       ! set tracer trends to zero 
    124124 
    125                              CALL tra_sbc    ( kstp )        ! surface boundary condition 
    126       IF( ln_traqsr      )   CALL tra_qsr    ( kstp )        ! penetrative solar radiation qsr 
    127       IF( ln_tradmp      )   CALL tra_dmp    ( kstp )        ! internal damping trends- tracers 
    128       IF( lk_zdfkpp      )   CALL tra_kpp    ( kstp )        ! KPP non-local tracer fluxes 
    129                              CALL tra_zdf    ( kstp )        ! vertical mixing 
    130                              CALL tra_nxt    ( kstp )        ! tracer fields at next time step 
    131       IF( ln_zdfnpc      )   CALL tra_npc    ( kstp )        ! applied non penetrative convective adjustment on (t,s) 
    132                              CALL eos( tsb, rhd, rhop, gdept_0(:,:,:) )      ! now (swap=before) in situ density for dynhpg module 
     125                        CALL tra_sbc( kstp )       ! surface boundary condition 
     126      IF( ln_traqsr )   CALL tra_qsr( kstp )       ! penetrative solar radiation qsr 
     127      IF( ln_tradmp )   CALL tra_dmp( kstp )       ! internal damping trends- tracers 
     128      IF( lk_zdfkpp )   CALL tra_kpp( kstp )       ! KPP non-local tracer fluxes 
     129                        CALL tra_zdf( kstp )       ! vertical mixing 
     130                        CALL eos( tsn, rhd, rhop, gdept_0(:,:,:) )   ! now potential density for zdfmxl 
     131      IF( ln_zdfnpc )   CALL tra_npc( kstp )       ! applied non penetrative convective adjustment on (t,s) 
     132                        CALL tra_nxt( kstp )       ! tracer fields at next time step 
    133133 
    134134      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    135135      ! Dynamics                                    (ta, sa used as workspace) 
    136136      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    137                                ua(:,:,:) = 0.e0               ! set dynamics trends to zero 
    138                                va(:,:,:) = 0.e0 
     137                        ua(:,:,:) = 0._wp          ! set dynamics trends to zero 
     138                        va(:,:,:) = 0._wp 
    139139 
    140       IF( ln_dyndmp      )     CALL dyn_dmp    ( kstp )       ! internal damping trends- momentum 
    141                                CALL dyn_cor_c1d( kstp )       ! vorticity term including Coriolis 
    142                                CALL dyn_zdf    ( kstp )       ! vertical diffusion 
    143                                CALL dyn_nxt_c1d( kstp )       ! lateral velocity at next time step 
     140      IF( ln_dyndmp )   CALL dyn_dmp    ( kstp )   ! internal damping trends- momentum 
     141                        CALL dyn_cor_c1d( kstp )   ! vorticity term including Coriolis 
     142                        CALL dyn_zdf    ( kstp )   ! vertical diffusion 
     143                        CALL dyn_nxt_c1d( kstp )   ! lateral velocity at next time step 
    144144 
    145145      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    146146      ! Control and restarts 
    147147      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    148                                  CALL stp_ctl( kstp, indic ) 
    149       IF( kstp == nit000     )   CALL iom_close( numror )             ! close input  ocean restart file 
    150       IF( lrst_oce           )   CALL rst_write  ( kstp )             ! write output ocean restart file 
     148                             CALL stp_ctl( kstp, indic ) 
     149      IF( kstp == nit000 )   CALL iom_close( numror )      ! close input  ocean restart file 
     150      IF( lrst_oce       )   CALL rst_write( kstp )        ! write output ocean restart file 
    151151      ! 
    152152   END SUBROUTINE stp_c1d 

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

    r4292 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r4570 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    r4370 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90

    r3625 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90

    r3294 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90

    r4153 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90

    r3294 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r4292 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90

    r3294 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90

    r4522 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90

    r3634 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90

    r4488 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90

    r4488 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90

    r3294 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r4370 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r4496 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90

    r4328 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r4328 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r4496 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r4601 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90

    r3294 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90

    r3294 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

    r4370 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r4334 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90

    r3294 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r4488 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r4333 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

    r4161 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r4333 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r4306 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90

    r4292 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

    r4147 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r4292 r4896  
    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-09  (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   ! TEOS10/EOS80 parameters 
     83   REAL(wp) ::   r1_S0, r1_T0, r1_Z0, rdeltaS 
     84    
     85   ! EOS parameters 
     86   REAL(wp) ::   EOS000 , EOS100 , EOS200 , EOS300 , EOS400 , EOS500 , EOS600 
     87   REAL(wp) ::   EOS010 , EOS110 , EOS210 , EOS310 , EOS410 , EOS510 
     88   REAL(wp) ::   EOS020 , EOS120 , EOS220 , EOS320 , EOS420 
     89   REAL(wp) ::   EOS030 , EOS130 , EOS230 , EOS330 
     90   REAL(wp) ::   EOS040 , EOS140 , EOS240 
     91   REAL(wp) ::   EOS050 , EOS150 
     92   REAL(wp) ::   EOS060 
     93   REAL(wp) ::   EOS001 , EOS101 , EOS201 , EOS301 , EOS401 
     94   REAL(wp) ::   EOS011 , EOS111 , EOS211 , EOS311 
     95   REAL(wp) ::   EOS021 , EOS121 , EOS221 
     96   REAL(wp) ::   EOS031 , EOS131 
     97   REAL(wp) ::   EOS041 
     98   REAL(wp) ::   EOS002 , EOS102 , EOS202 
     99   REAL(wp) ::   EOS012 , EOS112 
     100   REAL(wp) ::   EOS022 
     101   REAL(wp) ::   EOS003 , EOS103 
     102   REAL(wp) ::   EOS013  
     103    
     104   ! ALPHA parameters 
     105   REAL(wp) ::   ALP000 , ALP100 , ALP200 , ALP300 , ALP400 , ALP500 
     106   REAL(wp) ::   ALP010 , ALP110 , ALP210 , ALP310 , ALP410 
     107   REAL(wp) ::   ALP020 , ALP120 , ALP220 , ALP320 
     108   REAL(wp) ::   ALP030 , ALP130 , ALP230 
     109   REAL(wp) ::   ALP040 , ALP140 
     110   REAL(wp) ::   ALP050 
     111   REAL(wp) ::   ALP001 , ALP101 , ALP201 , ALP301 
     112   REAL(wp) ::   ALP011 , ALP111 , ALP211 
     113   REAL(wp) ::   ALP021 , ALP121 
     114   REAL(wp) ::   ALP031 
     115   REAL(wp) ::   ALP002 , ALP102 
     116   REAL(wp) ::   ALP012 
     117   REAL(wp) ::   ALP003 
     118    
     119   ! BETA parameters 
     120   REAL(wp) ::   BET000 , BET100 , BET200 , BET300 , BET400 , BET500 
     121   REAL(wp) ::   BET010 , BET110 , BET210 , BET310 , BET410 
     122   REAL(wp) ::   BET020 , BET120 , BET220 , BET320 
     123   REAL(wp) ::   BET030 , BET130 , BET230 
     124   REAL(wp) ::   BET040 , BET140 
     125   REAL(wp) ::   BET050 
     126   REAL(wp) ::   BET001 , BET101 , BET201 , BET301 
     127   REAL(wp) ::   BET011 , BET111 , BET211 
     128   REAL(wp) ::   BET021 , BET121 
     129   REAL(wp) ::   BET031 
     130   REAL(wp) ::   BET002 , BET102 
     131   REAL(wp) ::   BET012 
     132   REAL(wp) ::   BET003 
     133 
     134   ! PEN parameters 
     135   REAL(wp) ::   PEN000 , PEN100 , PEN200 , PEN300 , PEN400 
     136   REAL(wp) ::   PEN010 , PEN110 , PEN210 , PEN310 
     137   REAL(wp) ::   PEN020 , PEN120 , PEN220 
     138   REAL(wp) ::   PEN030 , PEN130 
     139   REAL(wp) ::   PEN040 
     140   REAL(wp) ::   PEN001 , PEN101 , PEN201 
     141   REAL(wp) ::   PEN011 , PEN111 
     142   REAL(wp) ::   PEN021 
     143   REAL(wp) ::   PEN002 , PEN102 
     144   REAL(wp) ::   PEN012 
     145    
     146   ! ALPHA_PEN parameters 
     147   REAL(wp) ::   APE000 , APE100 , APE200 , APE300 
     148   REAL(wp) ::   APE010 , APE110 , APE210 
     149   REAL(wp) ::   APE020 , APE120 
     150   REAL(wp) ::   APE030 
     151   REAL(wp) ::   APE001 , APE101 
     152   REAL(wp) ::   APE011 
     153   REAL(wp) ::   APE002 
     154 
     155   ! BETA_PEN parameters 
     156   REAL(wp) ::   BPE000 , BPE100 , BPE200 , BPE300 
     157   REAL(wp) ::   BPE010 , BPE110 , BPE210 
     158   REAL(wp) ::   BPE020 , BPE120 
     159   REAL(wp) ::   BPE030 
     160   REAL(wp) ::   BPE001 , BPE101 
     161   REAL(wp) ::   BPE011 
     162   REAL(wp) ::   BPE002 
    65163 
    66164   !! * Substitutions 
    … …  
    68166#  include "vectopt_loop_substitute.h90" 
    69167   !!---------------------------------------------------------------------- 
    70    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     168   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    71169   !! $Id$ 
    72170   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    82180      !!       defined through the namelist parameter nn_eos. 
    83181      !! 
    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. 
     182      !! ** Method  :   prd(t,s,z) = ( rho(t,s,z) - rau0 ) / rau0 
     183      !!         with   prd    in situ density anomaly      no units 
     184      !!                t      TEOS10: CT or EOS80: PT      Celsius 
     185      !!                s      TEOS10: SA or EOS80: SP      TEOS10: g/kg or EOS80: psu 
     186      !!                z      depth                        meters 
     187      !!                rho    in situ density              kg/m^3 
     188      !!                rau0   reference density            kg/m^3 
     189      !! 
     190      !!     nn_eos = -1 : polynomial TEOS-10 equation of state is used for rho(t,s,z). 
     191      !!         Check value: rho = 1028.21993233072 kg/m^3 for z=3000 dbar, ct=3 Celcius, sa=35.5 g/kg 
     192      !! 
     193      !!     nn_eos =  0 : polynomial EOS-80 equation of state is used for rho(t,s,z). 
     194      !!         Check value: rho = 1028.35011066567 kg/m^3 for z=3000 dbar, pt=3 Celcius, sp=35.5 psu 
     195      !! 
     196      !!     nn_eos =  1 : simplified equation of state 
     197      !!              prd(t,s,z) = ( -a0*(1+lambda/2*(T-T0)+mu*z+nu*(S-S0))*(T-T0) + b0*(S-S0) ) / rau0 
     198      !!              linear case function of T only: rn_alpha<>0, other coefficients = 0 
     199      !!              linear eos function of T and S: rn_alpha and rn_beta<>0, other coefficients=0 
     200      !!              Vallis like equation: use default values of coefficients 
    107201      !! 
    108202      !! ** Action  :   compute prd , the in situ density (no units) 
    109203      !! 
    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 ) 
     204      !! References :   Roquet et al, Ocean Modelling, in preparation (2014) 
     205      !!                Vallis, Atmospheric and Oceanic Fluid Dynamics, 2006 
     206      !!                TEOS-10 Manual, 2010 
     207      !!---------------------------------------------------------------------- 
     208      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
     209      !                                                               ! 2 : salinity               [psu] 
     210      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd   ! in situ density            [-] 
     211      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep  ! depth                      [m] 
     212      ! 
     213      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     214      REAL(wp) ::   zt , zh , zs , ztm        ! local scalars 
     215      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      - 
     216      !!---------------------------------------------------------------------- 
     217      ! 
     218      IF( nn_timing == 1 )   CALL timing_start('eos-insitu') 
    131219      ! 
    132220      SELECT CASE( nn_eos ) 
    133221      ! 
    134       CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    135 !CDIR NOVERRCHK 
    136          zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 
     222      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    137223         ! 
    138224         DO jk = 1, jpkm1 
    139225            DO jj = 1, jpj 
    140226               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) 
     227                  ! 
     228                  zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
     229                  zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
     230                  zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     231                  ztm = tmask(ji,jj,jk)                                         ! tmask 
     232                  ! 
     233                  zn3 = EOS013*zt   & 
     234                     &   + EOS103*zs+EOS003 
     235                     ! 
     236                  zn2 = (EOS022*zt   & 
     237                     &   + EOS112*zs+EOS012)*zt   & 
     238                     &   + (EOS202*zs+EOS102)*zs+EOS002 
     239                     ! 
     240                  zn1 = (((EOS041*zt   & 
     241                     &   + EOS131*zs+EOS031)*zt   & 
     242                     &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   & 
     243                     &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   & 
     244                     &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
     245                     ! 
     246                  zn0 = (((((EOS060*zt   & 
     247                     &   + EOS150*zs+EOS050)*zt   & 
     248                     &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
     249                     &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
     250                     &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
     251                     &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
     252                     &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
     253                     ! 
     254                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     255                  ! 
     256                  prd(ji,jj,jk) = (  zn * r1_rau0 - 1._wp  ) * ztm  ! density anomaly (masked) 
     257                  ! 
    176258               END DO 
    177259            END DO 
    178260         END DO 
    179261         ! 
    180       CASE( 1 )                !==  Linear formulation function of temperature only  ==! 
     262      CASE( 1 )                !==  simplified EOS  ==! 
     263         ! 
    181264         DO jk = 1, jpkm1 
    182             prd(:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk) 
     265            DO jj = 1, jpj 
     266               DO ji = 1, jpi 
     267                  zt  = pts  (ji,jj,jk,jp_tem) - 10._wp 
     268                  zs  = pts  (ji,jj,jk,jp_sal) - 35._wp 
     269                  zh  = pdep (ji,jj,jk) 
     270                  ztm = tmask(ji,jj,jk) 
     271                  ! 
     272                  zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   & 
     273                     &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   & 
     274                     &  - rn_nu * zt * zs 
     275                     !                                  
     276                  prd(ji,jj,jk) = zn * r1_rau0 * ztm                ! density anomaly (masked) 
     277               END DO 
     278            END DO 
    183279         END DO 
    184280         ! 
    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          ! 
    190281      END SELECT 
    191282      ! 
    192       IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos  : ', ovlap=1, kdim=jpk ) 
    193       ! 
    194       CALL wrk_dealloc( jpi, jpj, jpk, zws ) 
    195       ! 
    196       IF( nn_timing == 1 ) CALL timing_stop('eos') 
     283      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu  : ', ovlap=1, kdim=jpk ) 
     284      ! 
     285      IF( nn_timing == 1 )   CALL timing_stop('eos-insitu') 
    197286      ! 
    198287   END SUBROUTINE eos_insitu 
    … …  
    208297      !!     namelist parameter nn_eos. 
    209298      !! 
    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       !! 
    241299      !! ** Action  : - prd  , the in situ density (no units) 
    242300      !!              - prhop, the potential volumic mass (Kg/m3) 
    243301      !! 
    244       !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 
    245       !!                Brown and Campana, Mon. Weather Rev., 1978 
    246       !!---------------------------------------------------------------------- 
    247       !! 
     302      !!---------------------------------------------------------------------- 
    248303      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celcius] 
    249304      !                                                                ! 2 : salinity               [psu] 
    … …  
    252307      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep   ! depth                      [m] 
    253308      ! 
    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 ) 
     309      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     310      REAL(wp) ::   zt , zh , zs , ztm        ! local scalars 
     311      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      - 
     312      !!---------------------------------------------------------------------- 
     313      ! 
     314      IF( nn_timing == 1 )   CALL timing_start('eos-pot') 
    263315      ! 
    264316      SELECT CASE ( nn_eos ) 
    265317      ! 
    266       CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    267 !CDIR NOVERRCHK 
    268          zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 
     318      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    269319         ! 
    270320         DO jk = 1, jpkm1 
    271321            DO jj = 1, jpj 
    272322               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) 
     323                  ! 
     324                  zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
     325                  zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
     326                  zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     327                  ztm = tmask(ji,jj,jk)                                         ! tmask 
     328                  ! 
     329                  zn3 = EOS013*zt   & 
     330                     &   + EOS103*zs+EOS003 
     331                     ! 
     332                  zn2 = (EOS022*zt   & 
     333                     &   + EOS112*zs+EOS012)*zt   & 
     334                     &   + (EOS202*zs+EOS102)*zs+EOS002 
     335                     ! 
     336                  zn1 = (((EOS041*zt   & 
     337                     &   + EOS131*zs+EOS031)*zt   & 
     338                     &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   & 
     339                     &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   & 
     340                     &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
     341                     ! 
     342                  zn0 = (((((EOS060*zt   & 
     343                     &   + EOS150*zs+EOS050)*zt   & 
     344                     &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
     345                     &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
     346                     &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
     347                     &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
     348                     &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
     349                     ! 
     350                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     351                  ! 
     352                  prhop(ji,jj,jk) = zn0 * ztm                           ! potential density referenced at the surface 
     353                  ! 
     354                  prd(ji,jj,jk) = (  zn * r1_rau0 - 1._wp  ) * ztm      ! density anomaly (masked) 
    311355               END DO 
    312356            END DO 
    313357         END DO 
    314358         ! 
    315       CASE( 1 )                !==  Linear formulation = F( temperature )  ==! 
     359      CASE( 1 )                !==  simplified EOS  ==! 
     360         ! 
    316361         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) 
     362            DO jj = 1, jpj 
     363               DO ji = 1, jpi 
     364                  zt  = pts  (ji,jj,jk,jp_tem) - 10._wp 
     365                  zs  = pts  (ji,jj,jk,jp_sal) - 35._wp 
     366                  zh  = pdep (ji,jj,jk) 
     367                  ztm = tmask(ji,jj,jk) 
     368                  !                                                     ! potential density referenced at the surface 
     369                  zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt   & 
     370                     &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs   & 
     371                     &  - rn_nu * zt * zs 
     372                  prhop(ji,jj,jk) = ( rau0 + zn ) * ztm 
     373                  !                                                     ! density anomaly (masked) 
     374                  zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh 
     375                  prd(ji,jj,jk) = zn * r1_rau0 * ztm 
     376                  ! 
     377               END DO 
     378            END DO 
    319379         END DO 
    320380         ! 
    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          ! 
    327381      END SELECT 
    328382      ! 
    329       IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-p: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk ) 
    330       ! 
    331       CALL wrk_dealloc( jpi, jpj, jpk, zws ) 
    332       ! 
    333       IF( nn_timing == 1 ) CALL timing_stop('eos-p') 
     383      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk ) 
     384      ! 
     385      IF( nn_timing == 1 )   CALL timing_stop('eos-pot') 
    334386      ! 
    335387   END SUBROUTINE eos_insitu_pot 
    … …  
    344396      !!      defined through the namelist parameter nn_eos. * 2D field case 
    345397      !! 
    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       !! 
     398      !! ** Action  : - prd , the in situ density (no units) (unmasked) 
     399      !! 
     400      !!---------------------------------------------------------------------- 
    375401      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
    376402      !                                                           ! 2 : salinity               [psu] 
    377       REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                  [m] 
     403      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                      [m] 
    378404      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  
     405      ! 
     406      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     407      REAL(wp) ::   zt , zh , zs              ! local scalars 
     408      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      - 
     409      !!---------------------------------------------------------------------- 
     410      ! 
     411      IF( nn_timing == 1 )   CALL timing_start('eos2d') 
     412      ! 
    391413      prd(:,:) = 0._wp 
    392  
     414      ! 
    393415      SELECT CASE( nn_eos ) 
    394416      ! 
    395       CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    396       ! 
    397 !CDIR NOVERRCHK 
     417      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
     418         ! 
    398419         DO jj = 1, jpjm1 
    399 !CDIR NOVERRCHK 
    400420            DO ji = 1, fs_jpim1   ! vector opt. 
    401                zws(ji,jj) = SQRT( ABS( pts(ji,jj,jp_sal) ) ) 
     421               ! 
     422               zh  = pdep(ji,jj) * r1_Z0                                  ! depth 
     423               zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature 
     424               zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     425               ! 
     426               zn3 = EOS013*zt   & 
     427                  &   + EOS103*zs+EOS003 
     428                  ! 
     429               zn2 = (EOS022*zt   & 
     430                  &   + EOS112*zs+EOS012)*zt   & 
     431                  &   + (EOS202*zs+EOS102)*zs+EOS002 
     432                  ! 
     433               zn1 = (((EOS041*zt   & 
     434                  &   + EOS131*zs+EOS031)*zt   & 
     435                  &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   & 
     436                  &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   & 
     437                  &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
     438                  ! 
     439               zn0 = (((((EOS060*zt   & 
     440                  &   + EOS150*zs+EOS050)*zt   & 
     441                  &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
     442                  &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
     443                  &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
     444                  &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
     445                  &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
     446                  ! 
     447               zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     448               ! 
     449               prd(ji,jj) = zn * r1_rau0 - 1._wp               ! unmasked in situ density anomaly 
     450               ! 
    402451            END DO 
    403452         END DO 
     453         ! 
     454      CASE( 1 )                !==  simplified EOS  ==! 
     455         ! 
    404456         DO jj = 1, jpjm1 
    405457            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 
     458               ! 
     459               zt    = pts  (ji,jj,jp_tem)  - 10._wp 
     460               zs    = pts  (ji,jj,jp_sal)  - 35._wp 
     461               zh    = pdep (ji,jj)                         ! depth at the partial step level 
     462               ! 
     463               zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   & 
     464                  &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   & 
     465                  &  - rn_nu * zt * zs 
     466                  ! 
     467               prd(ji,jj) = zn * r1_rau0               ! unmasked in situ density anomaly 
     468               ! 
    442469            END DO 
    443470         END DO 
    444471         ! 
    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          ! 
    459472      END SELECT 
    460  
     473      ! 
    461474      IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' ) 
    462475      ! 
    463       CALL wrk_dealloc( jpi, jpj, zws ) 
    464       ! 
    465       IF( nn_timing == 1 ) CALL timing_stop('eos2d') 
     476      IF( nn_timing == 1 )   CALL timing_stop('eos2d') 
    466477      ! 
    467478   END SUBROUTINE eos_insitu_2d 
    468479 
    469480 
    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 ] ) 
    485       !!       * nn_eos = 1  : linear equation of state (temperature only) 
    486       !!            N^2 = grav * rn_alpha * dk[ t ]/e3w 
    487       !!       * 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 
     481   SUBROUTINE rab_3d( pts, pab ) 
     482      !!---------------------------------------------------------------------- 
     483      !!                 ***  ROUTINE rab_3d  *** 
     484      !! 
     485      !! ** Purpose :   Calculates thermal/haline expansion ratio at T-points 
     486      !! 
     487      !! ** Method  :   calculates alpha / beta at T-points 
     488      !! 
     489      !! ** Action  : - pab     : thermal/haline expansion ratio at T-points 
     490      !!---------------------------------------------------------------------- 
     491      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! pot. temperature & salinity 
     492      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pab   ! thermal/haline expansion ratio 
     493      ! 
     494      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     495      REAL(wp) ::   zt , zh , zs , ztm        ! local scalars 
     496      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      - 
     497      !!---------------------------------------------------------------------- 
     498      ! 
     499      IF( nn_timing == 1 )   CALL timing_start('rab_3d') 
     500      ! 
     501      SELECT CASE ( nn_eos ) 
     502      ! 
     503      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
     504         ! 
     505         DO jk = 1, jpkm1 
    521506            DO jj = 1, jpj 
    522507               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 
    540                      ! 
    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 
    552                      ! 
    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 
     508                  ! 
     509                  zh  = fsdept(ji,jj,jk) * r1_Z0                                ! depth 
     510                  zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
     511                  zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     512                  ztm = tmask(ji,jj,jk)                                         ! tmask 
     513                  ! 
     514                  ! alpha 
     515                  zn3 = ALP003 
     516                  ! 
     517                  zn2 = ALP012*zt + ALP102*zs+ALP002 
     518                  ! 
     519                  zn1 = ((ALP031*zt   & 
     520                     &   + ALP121*zs+ALP021)*zt   & 
     521                     &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   & 
     522                     &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 
     523                     ! 
     524                  zn0 = ((((ALP050*zt   & 
     525                     &   + ALP140*zs+ALP040)*zt   & 
     526                     &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   & 
     527                     &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   & 
     528                     &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   & 
     529                     &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 
     530                     ! 
     531                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     532                  ! 
     533                  pab(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm 
     534                  ! 
     535                  ! beta 
     536                  zn3 = BET003 
     537                  ! 
     538                  zn2 = BET012*zt + BET102*zs+BET002 
     539                  ! 
     540                  zn1 = ((BET031*zt   & 
     541                     &   + BET121*zs+BET021)*zt   & 
     542                     &   + (BET211*zs+BET111)*zs+BET011)*zt   & 
     543                     &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 
     544                     ! 
     545                  zn0 = ((((BET050*zt   & 
     546                     &   + BET140*zs+BET040)*zt   & 
     547                     &   + (BET230*zs+BET130)*zs+BET030)*zt   & 
     548                     &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   & 
     549                     &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   & 
     550                     &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 
     551                     ! 
     552                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     553                  ! 
     554                  pab(ji,jj,jk,jp_sal) = zn / zs * r1_rau0 * ztm 
     555                  ! 
    562556               END DO 
    563557            END DO 
    564558         END DO 
    565559         ! 
    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]) 
     560      CASE( 1 )                  !==  simplified EOS  ==! 
     561         ! 
     562         DO jk = 1, jpkm1 
    579563            DO jj = 1, jpj 
    580564               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 
     565                  zt  = pts (ji,jj,jk,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0) 
     566                  zs  = pts (ji,jj,jk,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0) 
     567                  zh  = fsdept(ji,jj,jk)                 ! depth in meters at t-point 
     568                  ztm = tmask(ji,jj,jk)                  ! land/sea bottom mask = surf. mask 
     569                  ! 
     570                  zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 
     571                  pab(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm   ! alpha 
     572                  ! 
     573                  zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 
     574                  pab(ji,jj,jk,jp_sal) = zn * r1_rau0 * ztm   ! beta 
     575                  ! 
    584576               END DO 
    585577            END DO 
    586578         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 
    666579         ! 
    667580      CASE DEFAULT 
    … …  
    672585      END SELECT 
    673586      ! 
    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 ) 
     587      IF( nn_timing == 1 )   CALL timing_stop('rab_3d') 
     588      ! 
     589   END SUBROUTINE rab_3d 
     590 
     591 
     592   SUBROUTINE rab_2d( pts, pdep, pab ) 
     593      !!---------------------------------------------------------------------- 
     594      !!                 ***  ROUTINE rab_2d  *** 
     595      !! 
     596      !! ** Purpose :   Calculates thermal/haline expansion ratio for a 2d field (unmasked) 
     597      !! 
     598      !! ** Action  : - pab     : thermal/haline expansion ratio at T-points 
     599      !!---------------------------------------------------------------------- 
     600      REAL(wp), DIMENSION(jpi,jpj,jpts)    , INTENT(in   ) ::   pts    ! pot. temperature & salinity 
     601      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(in   ) ::   pdep   ! depth                  [m] 
     602      REAL(wp), DIMENSION(jpi,jpj,jpts)    , INTENT(  out) ::   pab    ! thermal/haline expansion ratio 
     603      ! 
     604      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     605      REAL(wp) ::   zt , zh , zs              ! local scalars 
     606      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      - 
     607      !!---------------------------------------------------------------------- 
     608      ! 
     609      IF( nn_timing == 1 ) CALL timing_start('rab_2d') 
     610      ! 
     611      pab(:,:,:) = 0._wp 
     612      ! 
     613      SELECT CASE ( nn_eos ) 
     614      ! 
     615      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
     616         ! 
     617         DO jj = 1, jpjm1 
     618            DO ji = 1, fs_jpim1   ! vector opt. 
     619               ! 
     620               zh  = pdep(ji,jj) * r1_Z0                                  ! depth 
     621               zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature 
     622               zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     623               ! 
     624               ! alpha 
     625               zn3 = ALP003 
     626               ! 
     627               zn2 = ALP012*zt + ALP102*zs+ALP002 
     628               ! 
     629               zn1 = ((ALP031*zt   & 
     630                  &   + ALP121*zs+ALP021)*zt   & 
     631                  &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   & 
     632                  &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 
     633                  ! 
     634               zn0 = ((((ALP050*zt   & 
     635                  &   + ALP140*zs+ALP040)*zt   & 
     636                  &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   & 
     637                  &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   & 
     638                  &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   & 
     639                  &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 
     640                  ! 
     641               zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     642               ! 
     643               pab(ji,jj,jp_tem) = zn * r1_rau0 
     644               ! 
     645               ! beta 
     646               zn3 = BET003 
     647               ! 
     648               zn2 = BET012*zt + BET102*zs+BET002 
     649               ! 
     650               zn1 = ((BET031*zt   & 
     651                  &   + BET121*zs+BET021)*zt   & 
     652                  &   + (BET211*zs+BET111)*zs+BET011)*zt   & 
     653                  &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 
     654                  ! 
     655               zn0 = ((((BET050*zt   & 
     656                  &   + BET140*zs+BET040)*zt   & 
     657                  &   + (BET230*zs+BET130)*zs+BET030)*zt   & 
     658                  &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   & 
     659                  &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   & 
     660                  &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 
     661                  ! 
     662               zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     663               ! 
     664               pab(ji,jj,jp_sal) = zn / zs * r1_rau0 
     665               ! 
     666               ! 
     667            END DO 
     668         END DO 
     669         ! 
     670      CASE( 1 )                  !==  simplified EOS  ==! 
     671         ! 
     672         DO jj = 1, jpjm1 
     673            DO ji = 1, fs_jpim1   ! vector opt. 
     674               ! 
     675               zt    = pts  (ji,jj,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0) 
     676               zs    = pts  (ji,jj,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0) 
     677               zh    = pdep (ji,jj)                   ! depth at the partial step level 
     678               ! 
     679               zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 
     680               pab(ji,jj,jp_tem) = zn * r1_rau0   ! alpha 
     681               ! 
     682               zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 
     683               pab(ji,jj,jp_sal) = zn * r1_rau0   ! beta 
     684               ! 
     685            END DO 
     686         END DO 
     687         ! 
     688      CASE DEFAULT 
     689         IF(lwp) WRITE(numout,cform_err) 
     690         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos 
     691         nstop = nstop + 1 
     692         ! 
     693      END SELECT 
     694      ! 
     695      IF( nn_timing == 1 )   CALL timing_stop('rab_2d') 
     696      ! 
     697   END SUBROUTINE rab_2d 
     698 
     699 
     700   SUBROUTINE bn2( pts, pab, pn2 ) 
     701      !!---------------------------------------------------------------------- 
     702      !!                  ***  ROUTINE bn2  *** 
     703      !! 
     704      !! ** Purpose :   Compute the local Brunt-Vaisala frequency at the  
     705      !!                time-step of the input arguments 
     706      !! 
     707      !! ** Method  :   pn2 = grav * (alpha dk[T] + beta dk[S] ) / e3w 
     708      !!      where alpha and beta are given in pab, and computed on T-points. 
     709      !!      N.B. N^2 is set one for all to zero at jk=1 in istate module. 
     710      !! 
     711      !! ** Action  :   pn2 : square of the brunt-vaisala frequency at w-point  
     712      !! 
     713      !!---------------------------------------------------------------------- 
     714      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pts   ! pot. temperature and salinity   [Celcius,psu] 
     715      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pab   ! thermal/haline expansion coef.  [Celcius-1,psu-1] 
     716      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::  pn2   ! Brunt-Vaisala frequency squared [1/s^2] 
     717      ! 
     718      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
     719      REAL(wp) ::   zaw, zbw, zrw   ! local scalars 
     720      !!---------------------------------------------------------------------- 
     721      ! 
     722      IF( nn_timing == 1 ) CALL timing_start('bn2') 
     723      ! 
     724      DO jk = 2, jpkm1           ! interior points only (2=< jk =< jpkm1 ) 
     725         DO jj = 1, jpj          ! surface and bottom value set to zero one for all in istate.F90 
     726            DO ji = 1, jpi 
     727               zrw =   ( fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk) )   & 
     728                  &  / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) )  
     729                  ! 
     730               zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw  
     731               zbw = pab(ji,jj,jk,jp_sal) * (1. - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw 
     732               ! 
     733               pn2(ji,jj,jk) = grav * (  zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )     & 
     734                  &                    - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )  )  & 
     735                  &            / fse3w(ji,jj,jk) * tmask(ji,jj,jk) 
     736            END DO 
     737         END DO 
     738      END DO 
     739      ! 
     740      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2  : ', ovlap=1, kdim=jpk ) 
     741      ! 
     742      IF( nn_timing == 1 )   CALL timing_stop('bn2') 
     743      ! 
     744   END SUBROUTINE bn2 
     745 
     746 
     747   FUNCTION eos_pt_from_ct( ctmp, psal ) RESULT( ptmp ) 
     748      !!---------------------------------------------------------------------- 
     749      !!                 ***  ROUTINE eos_pt_from_ct  *** 
     750      !! 
     751      !! ** Purpose :   Compute pot.temp. from cons. temp. [Celcius] 
     752      !! 
     753      !! ** Method  :   rational approximation (5/3th order) of TEOS-10 algorithm 
     754      !!       checkvalue: pt=20.02391895 Celsius for sa=35.7g/kg, ct=20degC 
     755      !! 
     756      !! Reference  :   TEOS-10, UNESCO 
     757      !!                Rational approximation to TEOS10 algorithm (rms error on WOA13 values: 4.0e-5 degC) 
     758      !!---------------------------------------------------------------------- 
     759      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ctmp   ! Cons. Temp [Celcius] 
     760      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity   [psu] 
     761      ! Leave result array automatic rather than making explicitly allocated 
     762      REAL(wp), DIMENSION(jpi,jpj) ::   ptmp   ! potential temperature [Celcius] 
     763      ! 
     764      INTEGER  ::   ji, jj               ! dummy loop indices 
     765      REAL(wp) ::   zt , zs , ztm        ! local scalars 
     766      REAL(wp) ::   zn , zd              ! local scalars 
     767      REAL(wp) ::   zdeltaS , z1_S0 , z1_T0 
     768      !!---------------------------------------------------------------------- 
     769      ! 
     770      IF ( nn_timing == 1 )   CALL timing_start('eos_pt_from_ct') 
     771      ! 
     772      zdeltaS = 5._wp 
     773      z1_S0   = 0.875_wp/35.16504_wp 
     774      z1_T0   = 1._wp/40._wp 
     775      ! 
     776      DO jj = 1, jpj 
     777         DO ji = 1, jpi 
     778            ! 
     779            zt  = ctmp   (ji,jj) * z1_T0 
     780            zs  = SQRT( ABS( psal(ji,jj) + zdeltaS ) * r1_S0 ) 
     781            ztm = tmask(ji,jj,1) 
     782            ! 
     783            zn = ((((-2.1385727895e-01_wp*zt   & 
     784               &   - 2.7674419971e-01_wp*zs+1.0728094330_wp)*zt   & 
     785               &   + (2.6366564313_wp*zs+3.3546960647_wp)*zs-7.8012209473_wp)*zt   & 
     786               &   + ((1.8835586562_wp*zs+7.3949191679_wp)*zs-3.3937395875_wp)*zs-5.6414948432_wp)*zt   & 
     787               &   + (((3.5737370589_wp*zs-1.5512427389e+01_wp)*zs+2.4625741105e+01_wp)*zs   & 
     788               &      +1.9912291000e+01_wp)*zs-3.2191146312e+01_wp)*zt   & 
     789               &   + ((((5.7153204649e-01_wp*zs-3.0943149543_wp)*zs+9.3052495181_wp)*zs   & 
     790               &      -9.4528934807_wp)*zs+3.1066408996_wp)*zs-4.3504021262e-01_wp 
     791               ! 
     792            zd = (2.0035003456_wp*zt   & 
     793               &   -3.4570358592e-01_wp*zs+5.6471810638_wp)*zt   & 
     794               &   + (1.5393993508_wp*zs-6.9394762624_wp)*zs+1.2750522650e+01_wp 
     795               ! 
     796            ptmp(ji,jj) = ( zt / z1_T0 + zn / zd ) * ztm 
     797               ! 
     798         END DO 
     799      END DO 
     800      ! 
     801      IF( nn_timing == 1 )   CALL timing_stop('eos_pt_from_ct') 
     802      ! 
     803   END FUNCTION eos_pt_from_ct 
     804 
     805 
     806   FUNCTION eos_fzp( psal, pdep ) RESULT( ptf ) 
     807      !!---------------------------------------------------------------------- 
     808      !!                 ***  ROUTINE eos_fzp  *** 
     809      !! 
     810      !! ** Purpose :   Compute the freezing point temperature [Celcius] 
     811      !! 
     812      !! ** Method  :   UNESCO freezing point (ptf) in Celcius is given by 
     813      !!       ptf(t,z) = (-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s - 7.53e-4*z 
     814      !!       checkvalue: tf=-2.588567 Celsius for s=40psu, z=500m 
     815      !! 
     816      !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978 
     817      !!---------------------------------------------------------------------- 
     818      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   )           ::   psal   ! salinity   [psu] 
     819      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ), OPTIONAL ::   pdep   ! depth      [m] 
     820      REAL(wp), DIMENSION(jpi,jpj)                          ::   ptf   ! freezing temperature [Celcius] 
     821      ! 
     822      INTEGER  ::   ji, jj   ! dummy loop indices 
     823      REAL(wp) ::   zt, zs   ! local scalars 
     824      !!---------------------------------------------------------------------- 
     825      ! 
     826      SELECT CASE ( nn_eos ) 
     827      ! 
     828      CASE ( -1, 1 )                !==  CT,SA (TEOS-10 formulation) ==! 
     829         ! 
     830         DO jj = 1, jpj 
     831            DO ji = 1, jpi 
     832               zs= SQRT( ABS( psal(ji,jj) ) * r1_S0 )           ! square root salinity 
     833               ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs & 
     834                  &          - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp 
     835            END DO 
     836         END DO 
     837         ptf(:,:) = ptf(:,:) * psal(:,:) 
     838         ! 
     839         IF( PRESENT( pdep ) )   ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 
     840         ! 
     841      CASE ( 0 )                     !==  PT,SP (UNESCO formulation)  ==! 
     842         ! 
     843         ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) )   & 
     844            &                     - 2.154996e-4_wp *       psal(:,:)   ) * psal(:,:) 
     845            ! 
     846         IF( PRESENT( pdep ) )   ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 
     847         ! 
     848      CASE DEFAULT 
     849         IF(lwp) WRITE(numout,cform_err) 
     850         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos 
     851         nstop = nstop + 1 
     852         ! 
     853      END SELECT 
     854      ! 
     855   END FUNCTION eos_fzp 
     856 
     857 
     858   SUBROUTINE eos_pen( pts, pab_pe, ppen ) 
     859      !!---------------------------------------------------------------------- 
     860      !!                 ***  ROUTINE eos_pen  *** 
     861      !! 
     862      !! ** Purpose :   Calculates nonlinear anomalies of alpha_PE, beta_PE and PE at T-points 
     863      !! 
     864      !! ** Method  :   PE is defined analytically as the vertical  
     865      !!                   primitive of EOS times -g integrated between 0 and z>0. 
     866      !!                pen is the nonlinear bsq-PE anomaly: pen = ( PE - rau0 gz ) / rau0 gz - rd 
     867      !!                                                      = 1/z * /int_0^z rd dz - rd  
     868      !!                                where rd is the density anomaly (see eos_rhd function) 
     869      !!                ab_pe are partial derivatives of PE anomaly with respect to T and S: 
     870      !!                    ab_pe(1) = - 1/(rau0 gz) * dPE/dT + drd/dT = - d(pen)/dT 
     871      !!                    ab_pe(2) =   1/(rau0 gz) * dPE/dS + drd/dS =   d(pen)/dS 
     872      !! 
     873      !! ** Action  : - pen         : PE anomaly given at T-points 
     874      !!            : - pab_pe  : given at T-points 
     875      !!                    pab_pe(:,:,:,jp_tem) is alpha_pe 
     876      !!                    pab_pe(:,:,:,jp_sal) is beta_pe 
     877      !!---------------------------------------------------------------------- 
     878      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts     ! pot. temperature & salinity 
     879      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pab_pe  ! alpha_pe and beta_pe 
     880      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   ppen     ! potential energy anomaly 
     881      ! 
     882      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     883      REAL(wp) ::   zt , zh , zs , ztm        ! local scalars 
     884      REAL(wp) ::   zn , zn0, zn1, zn2        !   -      - 
     885      !!---------------------------------------------------------------------- 
     886      ! 
     887      IF( nn_timing == 1 )   CALL timing_start('eos_pen') 
     888      ! 
     889      SELECT CASE ( nn_eos ) 
     890      ! 
     891      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
     892         ! 
     893         DO jk = 1, jpkm1 
     894            DO jj = 1, jpj 
     895               DO ji = 1, jpi 
     896                  ! 
     897                  zh  = fsdept(ji,jj,jk) * r1_Z0                                ! depth 
     898                  zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
     899                  zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     900                  ztm = tmask(ji,jj,jk)                                         ! tmask 
     901                  ! 
     902                  ! potential energy non-linear anomaly 
     903                  zn2 = (PEN012)*zt   & 
     904                     &   + PEN102*zs+PEN002 
     905                     ! 
     906                  zn1 = ((PEN021)*zt   & 
     907                     &   + PEN111*zs+PEN011)*zt   & 
     908                     &   + (PEN201*zs+PEN101)*zs+PEN001 
     909                     ! 
     910                  zn0 = ((((PEN040)*zt   & 
     911                     &   + PEN130*zs+PEN030)*zt   & 
     912                     &   + (PEN220*zs+PEN120)*zs+PEN020)*zt   & 
     913                     &   + ((PEN310*zs+PEN210)*zs+PEN110)*zs+PEN010)*zt   & 
     914                     &   + (((PEN400*zs+PEN300)*zs+PEN200)*zs+PEN100)*zs+PEN000 
     915                     ! 
     916                  zn  = ( zn2 * zh + zn1 ) * zh + zn0 
     917                  ! 
     918                  ppen(ji,jj,jk)  = zn * zh * r1_rau0 * ztm 
     919                  ! 
     920                  ! alphaPE non-linear anomaly 
     921                  zn2 = APE002 
     922                  ! 
     923                  zn1 = (APE011)*zt   & 
     924                     &   + APE101*zs+APE001 
     925                     ! 
     926                  zn0 = (((APE030)*zt   & 
     927                     &   + APE120*zs+APE020)*zt   & 
     928                     &   + (APE210*zs+APE110)*zs+APE010)*zt   & 
     929                     &   + ((APE300*zs+APE200)*zs+APE100)*zs+APE000 
     930                     ! 
     931                  zn  = ( zn2 * zh + zn1 ) * zh + zn0 
     932                  !                               
     933                  pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rau0 * ztm 
     934                  ! 
     935                  ! betaPE non-linear anomaly 
     936                  zn2 = BPE002 
     937                  ! 
     938                  zn1 = (BPE011)*zt   & 
     939                     &   + BPE101*zs+BPE001 
     940                     ! 
     941                  zn0 = (((BPE030)*zt   & 
     942                     &   + BPE120*zs+BPE020)*zt   & 
     943                     &   + (BPE210*zs+BPE110)*zs+BPE010)*zt   & 
     944                     &   + ((BPE300*zs+BPE200)*zs+BPE100)*zs+BPE000 
     945                     ! 
     946                  zn  = ( zn2 * zh + zn1 ) * zh + zn0 
     947                  !                               
     948                  pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rau0 * ztm 
     949                  ! 
     950               END DO 
     951            END DO 
     952         END DO 
     953         ! 
     954      CASE( 1 )                !==  Vallis (2006) simplified EOS  ==! 
     955         ! 
     956         DO jk = 1, jpkm1 
     957            DO jj = 1, jpj 
     958               DO ji = 1, jpi 
     959                  zt  = pts(ji,jj,jk,jp_tem) - 10._wp  ! temperature anomaly (t-T0) 
     960                  zs = pts (ji,jj,jk,jp_sal) - 35._wp  ! abs. salinity anomaly (s-S0) 
     961                  zh  = fsdept(ji,jj,jk)               ! depth in meters  at t-point 
     962                  ztm = tmask(ji,jj,jk)                ! tmask 
     963                  zn  = 0.5_wp * zh * r1_rau0 * ztm 
     964                  !                                    ! Potential Energy 
     965                  ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn 
     966                  !                                    ! alphaPE 
     967                  pab_pe(ji,jj,jk,jp_tem) = - rn_a0 * rn_mu1 * zn 
     968                  pab_pe(ji,jj,jk,jp_sal) =   rn_b0 * rn_mu2 * zn 
     969                  ! 
     970               END DO 
     971            END DO 
     972         END DO 
     973         ! 
     974      CASE DEFAULT 
     975         IF(lwp) WRITE(numout,cform_err) 
     976         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos 
     977         nstop = nstop + 1 
     978         ! 
     979      END SELECT 
     980      ! 
     981      IF( nn_timing == 1 )   CALL timing_stop('eos_pen') 
     982      ! 
     983   END SUBROUTINE eos_pen 
     984 
     985 
     986   SUBROUTINE eos_init 
    680987      !!---------------------------------------------------------------------- 
    681988      !!                 ***  ROUTINE eos_init  *** 
    682989      !! 
    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       !! 
    710990      !! ** Purpose :   initializations for the equation of state 
    711991      !! 
    712992      !! ** Method  :   Read the namelist nameos and control the parameters 
    713993      !!---------------------------------------------------------------------- 
    714       NAMELIST/nameos/ nn_eos, rn_alpha, rn_beta 
    715       !!---------------------------------------------------------------------- 
    716       INTEGER  ::   ios 
     994      INTEGER  ::   ios   ! local integer 
     995      !! 
     996      NAMELIST/nameos/ nn_eos, ln_useCT, rn_a0, rn_b0, rn_lambda1, rn_mu1,   & 
     997         &                                             rn_lambda2, rn_mu2, rn_nu 
     998      !!---------------------------------------------------------------------- 
    717999      ! 
    7181000      REWIND( numnam_ref )              ! Namelist nameos in reference namelist : equation of state 
    7191001      READ  ( numnam_ref, nameos, IOSTAT = ios, ERR = 901 ) 
    7201002901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in reference namelist', lwp ) 
    721  
     1003      ! 
    7221004      REWIND( numnam_cfg )              ! Namelist nameos in configuration namelist : equation of state 
    7231005      READ  ( numnam_cfg, nameos, IOSTAT = ios, ERR = 902 ) 
    7241006902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in configuration namelist', lwp ) 
    7251007      WRITE( numond, nameos ) 
     1008      ! 
     1009      rau0        = 1026._wp                 !: volumic mass of reference     [kg/m3] 
     1010      rcp         = 3991.86795711963_wp      !: heat capacity     [J/K] 
    7261011      ! 
    7271012      IF(lwp) THEN                ! Control print 
    … …  
    7311016         WRITE(numout,*) '          Namelist nameos : set eos parameters' 
    7321017         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 
     1018         IF( ln_useCT )   THEN 
     1019            WRITE(numout,*) '             model uses Conservative Temperature' 
     1020            WRITE(numout,*) '             Important: model must be initialized with CT and SA fields' 
     1021         ENDIF 
    7351022      ENDIF 
    7361023      ! 
    7371024      SELECT CASE( nn_eos )         ! check option 
    7381025      ! 
    739       CASE( 0 )                        !==  Jackett and McDougall (1994) formulation  ==! 
     1026      CASE( -1 )                       !==  polynomial TEOS-10  ==! 
    7401027         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 )  ==! 
     1028         IF(lwp) WRITE(numout,*) '          use of TEOS-10 equation of state (cons. temp. and abs. salinity)' 
     1029         ! 
     1030         rdeltaS = 32._wp 
     1031         r1_S0  = 0.875_wp/35.16504_wp 
     1032         r1_T0  = 1._wp/40._wp 
     1033         r1_Z0  = 1.e-4_wp 
     1034         ! 
     1035         EOS000 = 8.0189615746e+02_wp 
     1036         EOS100 = 8.6672408165e+02_wp 
     1037         EOS200 = -1.7864682637e+03_wp 
     1038         EOS300 = 2.0375295546e+03_wp 
     1039         EOS400 = -1.2849161071e+03_wp 
     1040         EOS500 = 4.3227585684e+02_wp 
     1041         EOS600 = -6.0579916612e+01_wp 
     1042         EOS010 = 2.6010145068e+01_wp 
     1043         EOS110 = -6.5281885265e+01_wp 
     1044         EOS210 = 8.1770425108e+01_wp 
     1045         EOS310 = -5.6888046321e+01_wp 
     1046         EOS410 = 1.7681814114e+01_wp 
     1047         EOS510 = -1.9193502195_wp 
     1048         EOS020 = -3.7074170417e+01_wp 
     1049         EOS120 = 6.1548258127e+01_wp 
     1050         EOS220 = -6.0362551501e+01_wp 
     1051         EOS320 = 2.9130021253e+01_wp 
     1052         EOS420 = -5.4723692739_wp 
     1053         EOS030 = 2.1661789529e+01_wp 
     1054         EOS130 = -3.3449108469e+01_wp 
     1055         EOS230 = 1.9717078466e+01_wp 
     1056         EOS330 = -3.1742946532_wp 
     1057         EOS040 = -8.3627885467_wp 
     1058         EOS140 = 1.1311538584e+01_wp 
     1059         EOS240 = -5.3563304045_wp 
     1060         EOS050 = 5.4048723791e-01_wp 
     1061         EOS150 = 4.8169980163e-01_wp 
     1062         EOS060 = -1.9083568888e-01_wp 
     1063         EOS001 = 1.9681925209e+01_wp 
     1064         EOS101 = -4.2549998214e+01_wp 
     1065         EOS201 = 5.0774768218e+01_wp 
     1066         EOS301 = -3.0938076334e+01_wp 
     1067         EOS401 = 6.6051753097_wp 
     1068         EOS011 = -1.3336301113e+01_wp 
     1069         EOS111 = -4.4870114575_wp 
     1070         EOS211 = 5.0042598061_wp 
     1071         EOS311 = -6.5399043664e-01_wp 
     1072         EOS021 = 6.7080479603_wp 
     1073         EOS121 = 3.5063081279_wp 
     1074         EOS221 = -1.8795372996_wp 
     1075         EOS031 = -2.4649669534_wp 
     1076         EOS131 = -5.5077101279e-01_wp 
     1077         EOS041 = 5.5927935970e-01_wp 
     1078         EOS002 = 2.0660924175_wp 
     1079         EOS102 = -4.9527603989_wp 
     1080         EOS202 = 2.5019633244_wp 
     1081         EOS012 = 2.0564311499_wp 
     1082         EOS112 = -2.1311365518e-01_wp 
     1083         EOS022 = -1.2419983026_wp 
     1084         EOS003 = -2.3342758797e-02_wp 
     1085         EOS103 = -1.8507636718e-02_wp 
     1086         EOS013 = 3.7969820455e-01_wp 
     1087         ! 
     1088         ALP000 = -6.5025362670e-01_wp 
     1089         ALP100 = 1.6320471316_wp 
     1090         ALP200 = -2.0442606277_wp 
     1091         ALP300 = 1.4222011580_wp 
     1092         ALP400 = -4.4204535284e-01_wp 
     1093         ALP500 = 4.7983755487e-02_wp 
     1094         ALP010 = 1.8537085209_wp 
     1095         ALP110 = -3.0774129064_wp 
     1096         ALP210 = 3.0181275751_wp 
     1097         ALP310 = -1.4565010626_wp 
     1098         ALP410 = 2.7361846370e-01_wp 
     1099         ALP020 = -1.6246342147_wp 
     1100         ALP120 = 2.5086831352_wp 
     1101         ALP220 = -1.4787808849_wp 
     1102         ALP320 = 2.3807209899e-01_wp 
     1103         ALP030 = 8.3627885467e-01_wp 
     1104         ALP130 = -1.1311538584_wp 
     1105         ALP230 = 5.3563304045e-01_wp 
     1106         ALP040 = -6.7560904739e-02_wp 
     1107         ALP140 = -6.0212475204e-02_wp 
     1108         ALP050 = 2.8625353333e-02_wp 
     1109         ALP001 = 3.3340752782e-01_wp 
     1110         ALP101 = 1.1217528644e-01_wp 
     1111         ALP201 = -1.2510649515e-01_wp 
     1112         ALP301 = 1.6349760916e-02_wp 
     1113         ALP011 = -3.3540239802e-01_wp 
     1114         ALP111 = -1.7531540640e-01_wp 
     1115         ALP211 = 9.3976864981e-02_wp 
     1116         ALP021 = 1.8487252150e-01_wp 
     1117         ALP121 = 4.1307825959e-02_wp 
     1118         ALP031 = -5.5927935970e-02_wp 
     1119         ALP002 = -5.1410778748e-02_wp 
     1120         ALP102 = 5.3278413794e-03_wp 
     1121         ALP012 = 6.2099915132e-02_wp 
     1122         ALP003 = -9.4924551138e-03_wp 
     1123         ! 
     1124         BET000 = 1.0783203594e+01_wp 
     1125         BET100 = -4.4452095908e+01_wp 
     1126         BET200 = 7.6048755820e+01_wp 
     1127         BET300 = -6.3944280668e+01_wp 
     1128         BET400 = 2.6890441098e+01_wp 
     1129         BET500 = -4.5221697773_wp 
     1130         BET010 = -8.1219372432e-01_wp 
     1131         BET110 = 2.0346663041_wp 
     1132         BET210 = -2.1232895170_wp 
     1133         BET310 = 8.7994140485e-01_wp 
     1134         BET410 = -1.1939638360e-01_wp 
     1135         BET020 = 7.6574242289e-01_wp 
     1136         BET120 = -1.5019813020_wp 
     1137         BET220 = 1.0872489522_wp 
     1138         BET320 = -2.7233429080e-01_wp 
     1139         BET030 = -4.1615152308e-01_wp 
     1140         BET130 = 4.9061350869e-01_wp 
     1141         BET230 = -1.1847737788e-01_wp 
     1142         BET040 = 1.4073062708e-01_wp 
     1143         BET140 = -1.3327978879e-01_wp 
     1144         BET050 = 5.9929880134e-03_wp 
     1145         BET001 = -5.2937873009e-01_wp 
     1146         BET101 = 1.2634116779_wp 
     1147         BET201 = -1.1547328025_wp 
     1148         BET301 = 3.2870876279e-01_wp 
     1149         BET011 = -5.5824407214e-02_wp 
     1150         BET111 = 1.2451933313e-01_wp 
     1151         BET211 = -2.4409539932e-02_wp 
     1152         BET021 = 4.3623149752e-02_wp 
     1153         BET121 = -4.6767901790e-02_wp 
     1154         BET031 = -6.8523260060e-03_wp 
     1155         BET002 = -6.1618945251e-02_wp 
     1156         BET102 = 6.2255521644e-02_wp 
     1157         BET012 = -2.6514181169e-03_wp 
     1158         BET003 = -2.3025968587e-04_wp 
     1159         ! 
     1160         PEN000 = -9.8409626043_wp 
     1161         PEN100 = 2.1274999107e+01_wp 
     1162         PEN200 = -2.5387384109e+01_wp 
     1163         PEN300 = 1.5469038167e+01_wp 
     1164         PEN400 = -3.3025876549_wp 
     1165         PEN010 = 6.6681505563_wp 
     1166         PEN110 = 2.2435057288_wp 
     1167         PEN210 = -2.5021299030_wp 
     1168         PEN310 = 3.2699521832e-01_wp 
     1169         PEN020 = -3.3540239802_wp 
     1170         PEN120 = -1.7531540640_wp 
     1171         PEN220 = 9.3976864981e-01_wp 
     1172         PEN030 = 1.2324834767_wp 
     1173         PEN130 = 2.7538550639e-01_wp 
     1174         PEN040 = -2.7963967985e-01_wp 
     1175         PEN001 = -1.3773949450_wp 
     1176         PEN101 = 3.3018402659_wp 
     1177         PEN201 = -1.6679755496_wp 
     1178         PEN011 = -1.3709540999_wp 
     1179         PEN111 = 1.4207577012e-01_wp 
     1180         PEN021 = 8.2799886843e-01_wp 
     1181         PEN002 = 1.7507069098e-02_wp 
     1182         PEN102 = 1.3880727538e-02_wp 
     1183         PEN012 = -2.8477365341e-01_wp 
     1184         ! 
     1185         APE000 = -1.6670376391e-01_wp 
     1186         APE100 = -5.6087643219e-02_wp 
     1187         APE200 = 6.2553247576e-02_wp 
     1188         APE300 = -8.1748804580e-03_wp 
     1189         APE010 = 1.6770119901e-01_wp 
     1190         APE110 = 8.7657703198e-02_wp 
     1191         APE210 = -4.6988432490e-02_wp 
     1192         APE020 = -9.2436260751e-02_wp 
     1193         APE120 = -2.0653912979e-02_wp 
     1194         APE030 = 2.7963967985e-02_wp 
     1195         APE001 = 3.4273852498e-02_wp 
     1196         APE101 = -3.5518942529e-03_wp 
     1197         APE011 = -4.1399943421e-02_wp 
     1198         APE002 = 7.1193413354e-03_wp 
     1199         ! 
     1200         BPE000 = 2.6468936504e-01_wp 
     1201         BPE100 = -6.3170583896e-01_wp 
     1202         BPE200 = 5.7736640125e-01_wp 
     1203         BPE300 = -1.6435438140e-01_wp 
     1204         BPE010 = 2.7912203607e-02_wp 
     1205         BPE110 = -6.2259666565e-02_wp 
     1206         BPE210 = 1.2204769966e-02_wp 
     1207         BPE020 = -2.1811574876e-02_wp 
     1208         BPE120 = 2.3383950895e-02_wp 
     1209         BPE030 = 3.4261630030e-03_wp 
     1210         BPE001 = 4.1079296834e-02_wp 
     1211         BPE101 = -4.1503681096e-02_wp 
     1212         BPE011 = 1.7676120780e-03_wp 
     1213         BPE002 = 1.7269476440e-04_wp 
     1214         ! 
     1215      CASE( 0 )                        !==  polynomial EOS-80 formulation  ==! 
     1216         ! 
    7451217         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 )' 
     1218         IF(lwp) WRITE(numout,*) '          use of EOS-80 equation of state (pot. temp. and pract. salinity)' 
     1219         ! 
     1220         rdeltaS = 20._wp 
     1221         r1_S0  = 1._wp/40._wp 
     1222         r1_T0  = 1._wp/40._wp 
     1223         r1_Z0  = 1.e-4_wp 
     1224         ! 
     1225         EOS000 = 9.5356891948e+02_wp 
     1226         EOS100 = 1.7136499189e+02_wp 
     1227         EOS200 = -3.7501039454e+02_wp 
     1228         EOS300 = 5.1856810420e+02_wp 
     1229         EOS400 = -3.7264470465e+02_wp 
     1230         EOS500 = 1.4302533998e+02_wp 
     1231         EOS600 = -2.2856621162e+01_wp 
     1232         EOS010 = 1.0087518651e+01_wp 
     1233         EOS110 = -1.3647741861e+01_wp 
     1234         EOS210 = 8.8478359933_wp 
     1235         EOS310 = -7.2329388377_wp 
     1236         EOS410 = 1.4774410611_wp 
     1237         EOS510 = 2.0036720553e-01_wp 
     1238         EOS020 = -2.5579830599e+01_wp 
     1239         EOS120 = 2.4043512327e+01_wp 
     1240         EOS220 = -1.6807503990e+01_wp 
     1241         EOS320 = 8.3811577084_wp 
     1242         EOS420 = -1.9771060192_wp 
     1243         EOS030 = 1.6846451198e+01_wp 
     1244         EOS130 = -2.1482926901e+01_wp 
     1245         EOS230 = 1.0108954054e+01_wp 
     1246         EOS330 = -6.2675951440e-01_wp 
     1247         EOS040 = -8.0812310102_wp 
     1248         EOS140 = 1.0102374985e+01_wp 
     1249         EOS240 = -4.8340368631_wp 
     1250         EOS050 = 1.2079167803_wp 
     1251         EOS150 = 1.1515380987e-01_wp 
     1252         EOS060 = -2.4520288837e-01_wp 
     1253         EOS001 = 1.0748601068e+01_wp 
     1254         EOS101 = -1.7817043500e+01_wp 
     1255         EOS201 = 2.2181366768e+01_wp 
     1256         EOS301 = -1.6750916338e+01_wp 
     1257         EOS401 = 4.1202230403_wp 
     1258         EOS011 = -1.5852644587e+01_wp 
     1259         EOS111 = -7.6639383522e-01_wp 
     1260         EOS211 = 4.1144627302_wp 
     1261         EOS311 = -6.6955877448e-01_wp 
     1262         EOS021 = 9.9994861860_wp 
     1263         EOS121 = -1.9467067787e-01_wp 
     1264         EOS221 = -1.2177554330_wp 
     1265         EOS031 = -3.4866102017_wp 
     1266         EOS131 = 2.2229155620e-01_wp 
     1267         EOS041 = 5.9503008642e-01_wp 
     1268         EOS002 = 1.0375676547_wp 
     1269         EOS102 = -3.4249470629_wp 
     1270         EOS202 = 2.0542026429_wp 
     1271         EOS012 = 2.1836324814_wp 
     1272         EOS112 = -3.4453674320e-01_wp 
     1273         EOS022 = -1.2548163097_wp 
     1274         EOS003 = 1.8729078427e-02_wp 
     1275         EOS103 = -5.7238495240e-02_wp 
     1276         EOS013 = 3.8306136687e-01_wp 
     1277         ! 
     1278         ALP000 = -2.5218796628e-01_wp 
     1279         ALP100 = 3.4119354654e-01_wp 
     1280         ALP200 = -2.2119589983e-01_wp 
     1281         ALP300 = 1.8082347094e-01_wp 
     1282         ALP400 = -3.6936026529e-02_wp 
     1283         ALP500 = -5.0091801383e-03_wp 
     1284         ALP010 = 1.2789915300_wp 
     1285         ALP110 = -1.2021756164_wp 
     1286         ALP210 = 8.4037519952e-01_wp 
     1287         ALP310 = -4.1905788542e-01_wp 
     1288         ALP410 = 9.8855300959e-02_wp 
     1289         ALP020 = -1.2634838399_wp 
     1290         ALP120 = 1.6112195176_wp 
     1291         ALP220 = -7.5817155402e-01_wp 
     1292         ALP320 = 4.7006963580e-02_wp 
     1293         ALP030 = 8.0812310102e-01_wp 
     1294         ALP130 = -1.0102374985_wp 
     1295         ALP230 = 4.8340368631e-01_wp 
     1296         ALP040 = -1.5098959754e-01_wp 
     1297         ALP140 = -1.4394226233e-02_wp 
     1298         ALP050 = 3.6780433255e-02_wp 
     1299         ALP001 = 3.9631611467e-01_wp 
     1300         ALP101 = 1.9159845880e-02_wp 
     1301         ALP201 = -1.0286156825e-01_wp 
     1302         ALP301 = 1.6738969362e-02_wp 
     1303         ALP011 = -4.9997430930e-01_wp 
     1304         ALP111 = 9.7335338937e-03_wp 
     1305         ALP211 = 6.0887771651e-02_wp 
     1306         ALP021 = 2.6149576513e-01_wp 
     1307         ALP121 = -1.6671866715e-02_wp 
     1308         ALP031 = -5.9503008642e-02_wp 
     1309         ALP002 = -5.4590812035e-02_wp 
     1310         ALP102 = 8.6134185799e-03_wp 
     1311         ALP012 = 6.2740815484e-02_wp 
     1312         ALP003 = -9.5765341718e-03_wp 
     1313         ! 
     1314         BET000 = 2.1420623987_wp 
     1315         BET100 = -9.3752598635_wp 
     1316         BET200 = 1.9446303907e+01_wp 
     1317         BET300 = -1.8632235232e+01_wp 
     1318         BET400 = 8.9390837485_wp 
     1319         BET500 = -1.7142465871_wp 
     1320         BET010 = -1.7059677327e-01_wp 
     1321         BET110 = 2.2119589983e-01_wp 
     1322         BET210 = -2.7123520642e-01_wp 
     1323         BET310 = 7.3872053057e-02_wp 
     1324         BET410 = 1.2522950346e-02_wp 
     1325         BET020 = 3.0054390409e-01_wp 
     1326         BET120 = -4.2018759976e-01_wp 
     1327         BET220 = 3.1429341406e-01_wp 
     1328         BET320 = -9.8855300959e-02_wp 
     1329         BET030 = -2.6853658626e-01_wp 
     1330         BET130 = 2.5272385134e-01_wp 
     1331         BET230 = -2.3503481790e-02_wp 
     1332         BET040 = 1.2627968731e-01_wp 
     1333         BET140 = -1.2085092158e-01_wp 
     1334         BET050 = 1.4394226233e-03_wp 
     1335         BET001 = -2.2271304375e-01_wp 
     1336         BET101 = 5.5453416919e-01_wp 
     1337         BET201 = -6.2815936268e-01_wp 
     1338         BET301 = 2.0601115202e-01_wp 
     1339         BET011 = -9.5799229402e-03_wp 
     1340         BET111 = 1.0286156825e-01_wp 
     1341         BET211 = -2.5108454043e-02_wp 
     1342         BET021 = -2.4333834734e-03_wp 
     1343         BET121 = -3.0443885826e-02_wp 
     1344         BET031 = 2.7786444526e-03_wp 
     1345         BET002 = -4.2811838287e-02_wp 
     1346         BET102 = 5.1355066072e-02_wp 
     1347         BET012 = -4.3067092900e-03_wp 
     1348         BET003 = -7.1548119050e-04_wp 
     1349         ! 
     1350         PEN000 = -5.3743005340_wp 
     1351         PEN100 = 8.9085217499_wp 
     1352         PEN200 = -1.1090683384e+01_wp 
     1353         PEN300 = 8.3754581690_wp 
     1354         PEN400 = -2.0601115202_wp 
     1355         PEN010 = 7.9263222935_wp 
     1356         PEN110 = 3.8319691761e-01_wp 
     1357         PEN210 = -2.0572313651_wp 
     1358         PEN310 = 3.3477938724e-01_wp 
     1359         PEN020 = -4.9997430930_wp 
     1360         PEN120 = 9.7335338937e-02_wp 
     1361         PEN220 = 6.0887771651e-01_wp 
     1362         PEN030 = 1.7433051009_wp 
     1363         PEN130 = -1.1114577810e-01_wp 
     1364         PEN040 = -2.9751504321e-01_wp 
     1365         PEN001 = -6.9171176978e-01_wp 
     1366         PEN101 = 2.2832980419_wp 
     1367         PEN201 = -1.3694684286_wp 
     1368         PEN011 = -1.4557549876_wp 
     1369         PEN111 = 2.2969116213e-01_wp 
     1370         PEN021 = 8.3654420645e-01_wp 
     1371         PEN002 = -1.4046808820e-02_wp 
     1372         PEN102 = 4.2928871430e-02_wp 
     1373         PEN012 = -2.8729602515e-01_wp 
     1374         ! 
     1375         APE000 = -1.9815805734e-01_wp 
     1376         APE100 = -9.5799229402e-03_wp 
     1377         APE200 = 5.1430784127e-02_wp 
     1378         APE300 = -8.3694846809e-03_wp 
     1379         APE010 = 2.4998715465e-01_wp 
     1380         APE110 = -4.8667669469e-03_wp 
     1381         APE210 = -3.0443885826e-02_wp 
     1382         APE020 = -1.3074788257e-01_wp 
     1383         APE120 = 8.3359333577e-03_wp 
     1384         APE030 = 2.9751504321e-02_wp 
     1385         APE001 = 3.6393874690e-02_wp 
     1386         APE101 = -5.7422790533e-03_wp 
     1387         APE011 = -4.1827210323e-02_wp 
     1388         APE002 = 7.1824006288e-03_wp 
     1389         ! 
     1390         BPE000 = 1.1135652187e-01_wp 
     1391         BPE100 = -2.7726708459e-01_wp 
     1392         BPE200 = 3.1407968134e-01_wp 
     1393         BPE300 = -1.0300557601e-01_wp 
     1394         BPE010 = 4.7899614701e-03_wp 
     1395         BPE110 = -5.1430784127e-02_wp 
     1396         BPE210 = 1.2554227021e-02_wp 
     1397         BPE020 = 1.2166917367e-03_wp 
     1398         BPE120 = 1.5221942913e-02_wp 
     1399         BPE030 = -1.3893222263e-03_wp 
     1400         BPE001 = 2.8541225524e-02_wp 
     1401         BPE101 = -3.4236710714e-02_wp 
     1402         BPE011 = 2.8711395266e-03_wp 
     1403         BPE002 = 5.3661089288e-04_wp 
     1404         ! 
     1405      CASE( 1 )                        !==  Simplified EOS     ==! 
     1406         IF(lwp) THEN 
     1407            WRITE(numout,*) 
     1408            WRITE(numout,*) '          use of simplified eos:    rhd(dT=T-10,dS=S-35,Z) = ' 
     1409            WRITE(numout,*) '             [-a0*(1+lambda1/2*dT+mu1*Z)*dT + b0*(1+lambda2/2*dT+mu2*Z)*dS - nu*dT*dS]/rau0' 
     1410            WRITE(numout,*) 
     1411            WRITE(numout,*) '             thermal exp. coef.    rn_a0      = ', rn_a0 
     1412            WRITE(numout,*) '             saline  cont. coef.   rn_b0      = ', rn_b0 
     1413            WRITE(numout,*) '             cabbeling coef.       rn_lambda1 = ', rn_lambda1 
     1414            WRITE(numout,*) '             cabbeling coef.       rn_lambda2 = ', rn_lambda2 
     1415            WRITE(numout,*) '             thermobar. coef.      rn_mu1     = ', rn_mu1 
     1416            WRITE(numout,*) '             thermobar. coef.      rn_mu2     = ', rn_mu2 
     1417            WRITE(numout,*) '             2nd cabbel. coef.     rn_nu      = ', rn_nu 
     1418            WRITE(numout,*) '               Caution: rn_beta0=0 incompatible with ddm parameterization ' 
     1419         ENDIF 
    7541420         ! 
    7551421      CASE DEFAULT                     !==  ERROR in nn_eos  ==! 
    … …  
    7591425      END SELECT 
    7601426      ! 
     1427      r1_rau0     = 1._wp / rau0 
     1428      r1_rcp      = 1._wp / rcp 
     1429      r1_rau0_rcp = 1._wp / ( rau0 * rcp ) 
     1430      ! 
     1431      IF(lwp) WRITE(numout,*) 
     1432      IF(lwp) WRITE(numout,*) '          volumic mass of reference           rau0  = ', rau0   , ' kg/m^3' 
     1433      IF(lwp) WRITE(numout,*) '          1. / rau0                        r1_rau0  = ', r1_rau0, ' m^3/kg' 
     1434      IF(lwp) WRITE(numout,*) '          ocean specific heat                 rcp   = ', rcp    , ' J/Kelvin' 
     1435      IF(lwp) WRITE(numout,*) '          1. / ( rau0 * rcp )           r1_rau0_rcp = ', r1_rau0_rcp 
     1436      ! 
    7611437   END SUBROUTINE eos_init 
    7621438 

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

    r4499 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    r4499 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90

    r4499 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r4499 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r4499 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    r4499 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

    r4147 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r4292 r4896  
    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 
    … …  
    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) 
     559         DO ji = 1, jpim1                 ! minimum of top & bottom e3u_0 (e3v_0) 
    624560            e3u_bbl_0(ji,jj) = MIN( e3u_0(ji,jj,mbkt(ji+1,jj  )), e3u_0(ji,jj,mbkt(ji,jj)) ) 
    625561            e3v_bbl_0(ji,jj) = MIN( e3v_0(ji,jj,mbkt(ji  ,jj+1)), e3v_0(ji,jj,mbkt(ji,jj)) ) 

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

    r4292 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90

    r4488 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90

    r3632 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90

    r4313 r4896  
    22   !!============================================================================== 
    33   !!                       ***  MODULE  tranpc  *** 
    4    !! Ocean active tracers:  non penetrative convection scheme 
     4   !! Ocean active tracers:  non penetrative convective adjustment scheme 
    55   !!============================================================================== 
    66   !! History :  1.0  ! 1990-09  (G. Madec)  Original code 
    … …  
    99   !!            3.0  ! 2008-06  (G. Madec)  applied on ta, sa and called before tranxt in step.F90 
    1010   !!            3.3  ! 2010-05  (C. Ethe, G. Madec)  merge TRC-TRA 
     11   !!            3.7  ! 2014-06  (L. Brodeau) new algorithm based on local Brunt-Vaisala freq. 
    1112   !!---------------------------------------------------------------------- 
    1213 
    … …  
    1415   !!   tra_npc : apply the non penetrative convection scheme 
    1516   !!---------------------------------------------------------------------- 
    16    USE oce             ! ocean dynamics and active tracers  
     17   USE oce             ! ocean dynamics and active tracers 
    1718   USE dom_oce         ! ocean space and time domain 
     19   USE phycst          ! physical constants 
    1820   USE zdf_oce         ! ocean vertical physics 
    19    USE trdmod_oce      ! ocean active tracer trends 
     21   USE trd_oce         ! ocean active tracer trends 
    2022   USE trdtra          ! ocean active tracer trends 
    21    USE eosbn2          ! equation of state (eos routine)  
     23   USE eosbn2          ! equation of state (eos routine) 
     24   ! 
    2225   USE lbclnk          ! lateral boundary conditions (or mpp link) 
    2326   USE in_out_manager  ! I/O manager 
    … …  
    2932   PRIVATE 
    3033 
    31    PUBLIC   tra_npc       ! routine called by step.F90 
     34   PUBLIC   tra_npc    ! routine called by step.F90 
    3235 
    3336   !! * Substitutions 
    3437#  include "domzgr_substitute.h90" 
    35    !!---------------------------------------------------------------------- 
    36    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    37    !! $Id$  
     38#  include "vectopt_loop_substitute.h90" 
     39   !!---------------------------------------------------------------------- 
     40   !! NEMO/OPA 3.6 , NEMO Consortium (2014) 
     41   !! $Id$ 
    3842   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3943   !!---------------------------------------------------------------------- 
    … …  
    4448      !!                  ***  ROUTINE tranpc  *** 
    4549      !! 
    46       !! ** Purpose :   Non penetrative convective adjustment scheme. solve  
     50      !! ** Purpose : Non-penetrative convective adjustment scheme. solve 
    4751      !!      the static instability of the water column on after fields 
    4852      !!      while conserving heat and salt contents. 
    4953      !! 
    50       !! ** Method  :   The algorithm used converges in a maximium of jpk  
    51       !!      iterations. instabilities are treated when the vertical density 
    52       !!      gradient is less than 1.e-5. 
    53       !!      l_trdtra=T: the trend associated with this algorithm is saved. 
     54      !! ** Method  : updated algorithm able to deal with non-linear equation of state 
     55      !!              (i.e. static stability computed locally) 
    5456      !! 
    5557      !! ** Action  : - (ta,sa) after the application od the npc scheme 
    56       !!              - save the associated trends (ttrd,strd) ('key_trdtra') 
     58      !!              - send the associated trends for on-line diagnostics (l_trdtra=T) 
    5759      !! 
    58       !! References : Madec, et al., 1991, JPO, 21, 9, 1349-1371. 
     60      !! References :     Madec, et al., 1991, JPO, 21, 9, 1349-1371. 
    5961      !!---------------------------------------------------------------------- 
    60       ! 
    6162      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    6263      ! 
    6364      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    6465      INTEGER  ::   inpcc        ! number of statically instable water column 
    65       INTEGER  ::   inpci        ! number of iteration for npc scheme 
    66       INTEGER  ::   jiter, jkdown, jkp        ! ??? 
    67       INTEGER  ::   ikbot, ik, ikup, ikdown   ! ??? 
    68       REAL(wp) ::   ze3tot, zta, zsa, zraua, ze3dwn 
    69       REAL(wp), POINTER, DIMENSION(:,:  ) :: zwx, zwy, zwz 
    70       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds, zrhop 
     66      INTEGER  ::   jiter, ikbot, ik, ikup, ikdown, ilayer, ikm   ! local integers 
     67      LOGICAL  ::   l_bottom_reached, l_column_treated 
     68      REAL(wp) ::   zta, zalfa, zsum_temp, zsum_alfa, zaw, zdz, zsum_z 
     69      REAL(wp) ::   zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw, z1_r2dt 
     70      REAL(wp), POINTER, DIMENSION(:)       ::   zvn2   ! vertical profile of N2 at 1 given point... 
     71      REAL(wp), POINTER, DIMENSION(:,:)     ::   zvts   ! vertical profile of T and S at 1 given point... 
     72      REAL(wp), POINTER, DIMENSION(:,:)     ::   zvab   ! vertical profile of alpha and beta 
     73      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zn2    ! N^2  
     74      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zab    ! alpha and beta 
     75      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   ztrdt, ztrds   ! 3D workspace 
     76      ! 
     77      !!LB debug: 
     78      LOGICAL, PARAMETER :: l_LB_debug = .FALSE. 
     79      INTEGER :: ilc1, jlc1, klc1, nncpu 
     80      LOGICAL :: lp_monitor_point = .FALSE. 
     81      !!LB debug. 
    7182      !!---------------------------------------------------------------------- 
    7283      ! 
    7384      IF( nn_timing == 1 )  CALL timing_start('tra_npc') 
    7485      ! 
    75       CALL wrk_alloc(jpi, jpj, jpk, zrhop ) 
    76       CALL wrk_alloc(jpi, jpk, zwx, zwy, zwz ) 
    77       ! 
    7886      IF( MOD( kt, nn_npc ) == 0 ) THEN 
    79  
    80          inpcc = 0 
    81          inpci = 0 
    82  
    83          CALL eos( tsa, rhd, zrhop, fsdept_n(:,:,:) )         ! Potential density 
    84  
    85          IF( l_trdtra )   THEN                    !* Save ta and sa trends 
     87         ! 
     88         CALL wrk_alloc( jpi, jpj, jpk, zn2 )    ! N2 
     89         CALL wrk_alloc( jpi, jpj, jpk, 2, zab ) ! Alpha and Beta 
     90         CALL wrk_alloc( jpk, 2, zvts, zvab )    ! 1D column vector at point ji,jj 
     91         CALL wrk_alloc( jpk, zvn2 )             ! 1D column vector at point ji,jj 
     92 
     93         IF( l_trdtra )   THEN                    !* Save initial after fields 
    8694            CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
    8795            ztrdt(:,:,:) = tsa(:,:,:,jp_tem)  
    … …  
    8997         ENDIF 
    9098 
    91          !                                                ! =============== 
    92          DO jj = 1, jpj                                   !  Vertical slab 
    93             !                                             ! =============== 
    94             !  Static instability pointer  
    95             ! ---------------------------- 
    96             DO jk = 1, jpkm1 
    97                DO ji = 1, jpi 
    98                   zwx(ji,jk) = ( zrhop(ji,jj,jk) - zrhop(ji,jj,jk+1) ) * tmask(ji,jj,jk+1) 
    99                END DO 
    100             END DO 
    101  
    102             ! 1.1 do not consider the boundary points 
    103  
    104             ! even if east-west cyclic b. c. do not considere ji=1 or jpi 
    105             DO jk = 1, jpkm1 
    106                zwx( 1 ,jk) = 0.e0 
    107                zwx(jpi,jk) = 0.e0 
    108             END DO 
    109             ! even if south-symmetric b. c. used, do not considere jj=1 
    110             IF( jj == 1 )   zwx(:,:) = 0.e0 
    111  
    112             DO jk = 1, jpkm1 
    113                DO ji = 1, jpi 
    114                   zwx(ji,jk) = 1. 
    115                   IF( zwx(ji,jk) < 1.e-5 ) zwx(ji,jk) = 0.e0 
    116                END DO 
    117             END DO 
    118  
    119             zwy(:,1) = 0.e0 
    120             DO ji = 1, jpi 
    121                DO jk = 1, jpkm1 
    122                   zwy(ji,1) = zwy(ji,1) + zwx(ji,jk) 
    123                END DO 
    124             END DO 
    125  
    126             zwz(1,1) = 0.e0 
    127             DO ji = 1, jpi 
    128                zwz(1,1) = zwz(1,1) + zwy(ji,1) 
    129             END DO 
    130  
    131             inpcc = inpcc + NINT( zwz(1,1) ) 
    132  
    133  
    134             ! 2. Vertical mixing for each instable portion of the density profil 
    135             ! ------------------------------------------------------------------ 
    136  
    137             IF( zwz(1,1) /= 0.e0 ) THEN         ! -->> the density profil is statically instable : 
    138                DO ji = 1, jpi 
    139                   IF( zwy(ji,1) /= 0.e0 ) THEN 
     99         !LB debug: 
     100         IF( lwp .AND. l_LB_debug ) THEN 
     101            WRITE(numout,*) 
     102            WRITE(numout,*) 'LOLO: entering tra_npc, kt, narea =', kt, narea 
     103         ENDIF 
     104         !LBdebug: Monitoring of 1 column subject to convection... 
     105         IF( l_LB_debug ) THEN 
     106            ! Location of 1 known convection spot to follow what's happening in the water column 
     107            ilc1 = 54 ;  jlc1 = 15 ; ! Labrador ORCA1 4x4 cpus: 
     108            nncpu = 15  ; ! the CPU domain contains the convection spot 
     109            !ilc1 = 14 ;  jlc1 = 13 ; ! Labrador ORCA1 8x8 cpus: 
     110            !nncpu = 54  ; ! the CPU domain contains the convection spot 
     111            klc1 =  mbkt(ilc1,jlc1) ! bottom of the ocean for debug point...           
     112         ENDIF 
     113         !LBdebug. 
     114 
     115         CALL eos_rab( tsa, zab )         ! after alpha and beta 
     116         CALL bn2    ( tsa, zab, zn2 )    ! after Brunt-Vaisala 
     117         
     118         inpcc = 0 
     119 
     120         DO jj = 2, jpjm1                 ! interior column only 
     121            DO ji = fs_2, fs_jpim1 
     122               ! 
     123               IF( tmask(ji,jj,2) == 1 ) THEN      ! At least 2 ocean points 
     124                  !                                     ! consider one ocean column  
     125                  zvts(:,jp_tem) = tsa(ji,jj,:,jp_tem)      ! temperature 
     126                  zvts(:,jp_sal) = tsa(ji,jj,:,jp_sal)      ! salinity 
     127 
     128                  zvab(:,jp_tem)  = zab(ji,jj,:,jp_tem)     ! Alpha  
     129                  zvab(:,jp_sal)  = zab(ji,jj,:,jp_sal)     ! Beta   
     130                  zvn2(:)         = zn2(ji,jj,:)            ! N^2  
     131                  
     132                  IF( l_LB_debug ) THEN                  !LB debug: 
     133                     lp_monitor_point = .FALSE. 
     134                     IF( ( ji == ilc1 ).AND.( jj == jlc1 ) ) lp_monitor_point = .TRUE. 
     135                     ! writing only if on CPU domain where conv region is: 
     136                     lp_monitor_point = (narea == nncpu).AND.lp_monitor_point  
     137                      
     138                     IF(lp_monitor_point) THEN 
     139                        WRITE(numout,*) '' ;WRITE(numout,*) '' ; 
     140                       WRITE(numout,'("Time step = ",i6.6," !!!")')  kt 
     141                        WRITE(numout,'(" *** BEFORE anything, N^2 for point ",i3,",",i3,":" )') , ji,jj 
     142                        DO jk = 1, klc1 
     143                           WRITE(numout,*) jk, zvn2(jk) 
     144                        END DO 
     145                        WRITE(numout,*) ' ' 
     146                     ENDIF 
     147                  ENDIF                                  !LB debug  end 
     148 
     149                  ikbot = mbkt(ji,jj)   ! ikbot: ocean bottom T-level 
     150                  ik = 1                ! because N2 is irrelevant at the surface level (will start at ik=2) 
     151                  ilayer = 0 
     152                  jiter  = 0 
     153                  l_column_treated = .FALSE. 
     154                  
     155                  DO WHILE ( .NOT. l_column_treated ) 
    140156                     ! 
    141                      ikbot = mbkt(ji,jj)        ! ikbot: ocean bottom T-level 
     157                     jiter = jiter + 1 
     158                     
     159                     IF( jiter >= 400 ) EXIT 
     160                     
     161                     l_bottom_reached = .FALSE. 
     162 
     163                     DO WHILE ( .NOT. l_bottom_reached ) 
     164 
     165                        ik = ik + 1 
     166                        
     167                        !! Checking level ik for instability 
     168                        !! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     169 
     170                        IF( zvn2(ik) < 0. ) THEN ! Instability found! 
     171 
     172                           ikm  = ik              ! first level whith negative N2 
     173                           ilayer = ilayer + 1    ! yet another layer found.... 
     174                           IF(jiter == 1) inpcc = inpcc + 1 
     175 
     176                           IF(l_LB_debug .AND. lp_monitor_point) & 
     177                              & WRITE(numout,*) 'Negative N2 at ik =', ikm, ' layer nb.', ilayer, & 
     178                              & ' inpcc =', inpcc 
     179 
     180                           !! Case we mix with upper regions where N2==0: 
     181                           !! All the points above ikup where N2 == 0 must also be mixed => we go 
     182                           !! upward to find a new ikup, where the layer doesn't have N2==0 
     183                           ikup = ikm 
     184                           DO jk = ikm, 2, -1 
     185                              ikup = ikup - 1 
     186                              IF( (zvn2(jk-1) > 0.).OR.(ikup == 1) ) EXIT 
     187                           END DO 
     188                           
     189                           ! adjusting ikup if the upper part of the unstable column was neutral (N2=0) 
     190                           IF((zvn2(ikup+1) == 0.).AND.(ikup /= 1)) ikup = ikup+1 ; 
     191 
     192                           
     193                           IF( lp_monitor_point )   WRITE(numout,*) ' => ikup is =', ikup, ' layer nb.', ilayer 
     194                           
     195                           zsum_temp = 0._wp 
     196                           zsum_sali = 0._wp 
     197                           zsum_alfa = 0._wp 
     198                           zsum_beta = 0._wp 
     199                           zsum_z    = 0._wp 
     200                                                     
     201                           DO jk = ikup, ikbot+1      ! Inside the instable (and overlying neutral) portion of the column 
     202                              ! 
     203                              IF(l_LB_debug .AND. lp_monitor_point) WRITE(numout,*) '     -> summing for jk =', jk 
     204                              ! 
     205                              zdz       = fse3t(ji,jj,jk) 
     206                              zsum_temp = zsum_temp + zvts(jk,jp_tem)*zdz 
     207                              zsum_sali = zsum_sali + zvts(jk,jp_sal)*zdz 
     208                              zsum_alfa = zsum_alfa + zvab(jk,jp_tem)*zdz 
     209                              zsum_beta = zsum_beta + zvab(jk,jp_sal)*zdz 
     210                              zsum_z    = zsum_z    + zdz 
     211                              ! 
     212                              !! EXIT if we found the bottom of the unstable portion of the water column     
     213                              IF( (zvn2(jk+1) > 0.).OR.(jk == ikbot ).OR.((jk==ikm).AND.(zvn2(jk+1) == 0.)) )   EXIT 
     214                           END DO 
     215                           
     216                           !ik     = jk !LB remove? 
     217                           ikdown = jk ! for the current unstable layer, ikdown is the deepest point with a negative N2 
     218                           
     219                           IF(l_LB_debug .AND. lp_monitor_point) & 
     220                              &    WRITE(numout,*) '  => ikdown =', ikdown, '  layer nb.', ilayer 
     221                           
     222                           ! Mixing Temperature and salinity between ikup and ikdown: 
     223                           zta   = zsum_temp/zsum_z 
     224                           zsa   = zsum_sali/zsum_z 
     225                           zalfa = zsum_alfa/zsum_z 
     226                           zbeta = zsum_beta/zsum_z 
     227 
     228                           IF(l_LB_debug .AND. lp_monitor_point) THEN 
     229                              WRITE(numout,*) '  => Mean temp. in that portion =', zta 
     230                              WRITE(numout,*) '  => Mean sali. in that portion =', zsa 
     231                              WRITE(numout,*) '  => Mean Alpha in that portion =', zalfa 
     232                              WRITE(numout,*) '  => Mean Beta  in that portion =', zbeta 
     233                           ENDIF 
     234 
     235                           !! Homogenaizing the temperature, salinity, alpha and beta in this portion of the column 
     236                           DO jk = ikup, ikdown 
     237                              zvts(jk,jp_tem) = zta 
     238                              zvts(jk,jp_sal) = zsa 
     239                              zvab(jk,jp_tem) = zalfa 
     240                              zvab(jk,jp_sal) = zbeta 
     241                           END DO 
     242                           ! 
     243                           !! Before updating N2, it is possible that another unstable 
     244                           !! layer exists underneath the one we just homogeneized! 
     245                           ik = ikdown 
     246                           !  
     247                        ENDIF  ! IF( zvn2(ik+1) < 0. ) THEN 
     248                        ! 
     249                        IF( ik == ikbot ) l_bottom_reached = .TRUE. 
     250                        ! 
     251                     END DO ! DO WHILE ( .NOT. l_bottom_reached ) 
     252 
     253                     IF( ik /= ikbot )   STOP 'ERROR: tranpc.F90 => PROBLEM #1' 
     254                     
     255                     ! ******* At this stage ik == ikbot ! ******* 
     256                     
     257                     IF( ilayer > 0 ) THEN 
     258                        !! least an unstable layer has been found 
     259                        !! Temperature, Salinity, Alpha and Beta have been homogenized in the unstable portion 
     260                        !! => Need to re-compute N2! will use Alpha and Beta! 
     261                        ! 
     262                        DO jk = ikup+1, ikdown+1   ! we must go 1 point deeper than ikdown!      
     263                           !! Doing exactly as in eosbn2.F90: 
     264                           !! * Except that we only are interested in the sign of N2 !!! 
     265                           !!   => just considering the vertical gradient of density 
     266                           zrw =   (fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk)) & 
     267                               & / (fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk)) 
     268                           zaw = zvab(jk,jp_tem) * (1._wp - zrw) + zvab(jk-1,jp_tem) * zrw 
     269                           zbw = zvab(jk,jp_sal) * (1._wp - zrw) + zvab(jk-1,jp_sal) * zrw 
     270                           
     271                           !zvn2(jk) = grav*( zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) )     & 
     272                           !     &           - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) )  )  & 
     273                           !     &       / fse3w(ji,jj,jk) * tmask(ji,jj,jk) 
     274                           zvn2(jk) = (  zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) )     & 
     275                                &      - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) )  )   
     276                        END DO 
     277 
     278                        IF(l_LB_debug .AND. lp_monitor_point) THEN 
     279                           WRITE(numout, '(" *** After iteration #",i3.3,", N^2 for point ",i3,",",i3,":" )') & 
     280                              & jiter, ji,jj 
     281                           DO jk = 1, klc1 
     282                              WRITE(numout,*) jk, zvn2(jk) 
     283                           END DO 
     284                           WRITE(numout,*) ' ' 
     285                        ENDIF 
     286 
     287                        ik     = 1  ! starting again at the surface for the next iteration 
     288                        ilayer = 0 
     289                     ENDIF 
    142290                     ! 
    143                      DO jiter = 1, jpk          ! vertical iteration 
    144                         ! 
    145                         ! search of ikup : the first static instability from the sea surface 
    146                         ! 
    147                         ik = 0 
    148 220                     CONTINUE 
    149                         ik = ik + 1 
    150                         IF( ik >= ikbot ) GO TO 200 
    151                         zwx(ji,ik) = zrhop(ji,jj,ik) - zrhop(ji,jj,ik+1) 
    152                         IF( zwx(ji,ik) <= 0.e0 ) GO TO 220 
    153                         ikup = ik 
    154                         ! the density profil is instable below ikup 
    155                         ! ikdown : bottom of the instable portion of the density profil 
    156                         ! search of ikdown and vertical mixing from ikup to ikdown 
    157                         ! 
    158                         ze3tot= fse3t(ji,jj,ikup) 
    159                         zta   = tsa  (ji,jj,ikup,jp_tem) 
    160                         zsa   = tsa  (ji,jj,ikup,jp_sal) 
    161                         zraua = zrhop(ji,jj,ikup) 
    162                         ! 
    163                         DO jkdown = ikup+1, ikbot-1 
    164                            IF( zraua <= zrhop(ji,jj,jkdown) ) THEN 
    165                               ikdown = jkdown 
    166                               GO TO 240 
    167                            ENDIF 
    168                            ze3dwn =  fse3t(ji,jj,jkdown) 
    169                            ze3tot =  ze3tot + ze3dwn 
    170                            zta   = ( zta*(ze3tot-ze3dwn) + tsa(ji,jj,jkdown,jp_tem)*ze3dwn )/ze3tot 
    171                            zsa   = ( zsa*(ze3tot-ze3dwn) + tsa(ji,jj,jkdown,jp_sal)*ze3dwn )/ze3tot 
    172                            zraua = ( zraua*(ze3tot-ze3dwn) + zrhop(ji,jj,jkdown)*ze3dwn )/ze3tot 
    173                            inpci = inpci+1 
    174                         END DO 
    175                         ikdown = ikbot-1 
    176 240                     CONTINUE 
    177                         ! 
    178                         DO jkp = ikup, ikdown-1 
    179                            tsa  (ji,jj,jkp,jp_tem) = zta 
    180                            tsa  (ji,jj,jkp,jp_sal) = zsa 
    181                            zrhop(ji,jj,jkp       ) = zraua 
    182                         END DO 
    183                         IF (ikdown == ikbot-1 .AND. zraua >= zrhop(ji,jj,ikdown) ) THEN 
    184                            tsa  (ji,jj,jkp,jp_tem) = zta 
    185                            tsa  (ji,jj,jkp,jp_sal) = zsa 
    186                            zrhop(ji,jj,ikdown    ) = zraua 
    187                         ENDIF 
    188                      END DO 
    189                   ENDIF 
    190 200               CONTINUE 
    191                END DO 
    192                ! <<-- no more static instability on slab jj 
    193             ENDIF 
    194             !                                             ! =============== 
    195          END DO                                           !   End of slab 
    196          !                                                ! =============== 
    197          !  
    198          IF( l_trdtra )   THEN         ! save the Non penetrative mixing trends for diagnostic 
    199             ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    200             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 ) 
     291                     IF( ik >= ikbot ) THEN 
     292                        IF(l_LB_debug .AND. lp_monitor_point) WRITE(numout,*) '    --- exiting jiter loop ---' 
     293                        l_column_treated = .TRUE. 
     294                     ENDIF 
     295                     ! 
     296                  END DO ! DO WHILE ( .NOT. l_column_treated ) 
     297 
     298                  !! Updating tsa: 
     299                  tsa(ji,jj,:,jp_tem) = zvts(:,jp_tem) 
     300                  tsa(ji,jj,:,jp_sal) = zvts(:,jp_sal) 
     301 
     302                  !! lolo:  Should we update something else???? 
     303                  !! => like alpha and beta? 
     304 
     305                  IF(l_LB_debug .AND. lp_monitor_point) WRITE(numout,*) '' 
     306 
     307               ENDIF ! IF( tmask(ji,jj,3) == 1 ) THEN 
     308 
     309            END DO ! ji 
     310         END DO ! jj 
     311         ! 
     312         IF( l_trdtra ) THEN         ! send the Non penetrative mixing trends for diagnostic 
     313            z1_r2dt = 1._wp / (2._wp * rdt) 
     314            ztrdt(:,:,:) = ( tsa(:,:,:,jp_tem) - ztrdt(:,:,:) ) * z1_r2dt 
     315            ztrds(:,:,:) = ( tsa(:,:,:,jp_sal) - ztrds(:,:,:) ) * z1_r2dt 
     316            CALL trd_tra( kt, 'TRA', jp_tem, jptra_npc, ztrdt ) 
     317            CALL trd_tra( kt, 'TRA', jp_sal, jptra_npc, ztrds ) 
    203318            CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
    204319         ENDIF 
    205        
    206          ! Lateral boundary conditions on ( ta, sa )   ( Unchanged sign) 
    207          ! ------------------------------============ 
     320         ! 
    208321         CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )   ;   CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. ) 
    209        
    210  
    211          !  2. non penetrative convective scheme statistics 
    212          !  ----------------------------------------------- 
    213          IF( nn_npcp /= 0 .AND. MOD( kt, nn_npcp ) == 0 ) THEN 
    214             IF(lwp) WRITE(numout,*)' kt=',kt, ' number of statically instable',   & 
    215                &                   ' water column : ',inpcc, ' number of iteration : ',inpci 
    216          ENDIF 
    217          ! 
    218       ENDIF 
    219       ! 
    220       CALL wrk_dealloc(jpi, jpj, jpk, zrhop ) 
    221       CALL wrk_dealloc(jpi, jpk, zwx, zwy, zwz ) 
     322         ! 
     323         IF(lwp) THEN 
     324            WRITE(numout,*) 'LOLO: exiting tra_npc, kt =', kt 
     325            WRITE(numout,*)' => number of statically instable water column : ',inpcc 
     326            WRITE(numout,*) '' ; WRITE(numout,*) '' 
     327         ENDIF 
     328         ! 
     329         CALL wrk_dealloc(jpi, jpj, jpk, zn2 ) 
     330         CALL wrk_dealloc(jpi, jpj, jpk, 2, zab ) 
     331         CALL wrk_dealloc(jpk, zvn2 ) 
     332         CALL wrk_dealloc(jpk, 2, zvts, zvab ) 
     333         ! 
     334      ENDIF   ! IF( MOD( kt, nn_npc ) == 0 ) THEN 
    222335      ! 
    223336      IF( nn_timing == 1 )  CALL timing_stop('tra_npc') 

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

    r4328 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r4333 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r3764 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90

    r3294 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90

    r3294 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90

    r3632 r4896  
    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 trdtrc         ! 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 (trdtrc) 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_trc 
     160         CALL trd_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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90

    r3294 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor_oce.F90

    r2715 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90

    r4381 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90

    r4147 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90

    r3294 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90

    r4147 r4896  
    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 
    … …  
    13401310         IF( l_trdtrc ) THEN         ! save the non-local tracer flux trends for diagnostic 
    13411311            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 
    1342             CALL trd_tra( kt, 'TRC', jn, jptra_trd_zdf, ztrtrd(:,:,:) ) 
     1312            CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:) ) 
    13431313         ENDIF 
    13441314         ! 
    … …  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90

    r4245 r4896  
    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. 
    … …  
    1416   USE in_out_manager  ! I/O manager 
    1517   USE prtctl          ! Print control 
     18   USE phycst          ! physical constants 
    1619   USE iom             ! I/O library 
    1720   USE lib_mpp         ! MPP library 
    … …  
    2528   PUBLIC   zdf_mxl       ! called by step.F90 
    2629 
    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  
    3030   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   nmln    !: number of level in the mixed layer (used by TOP) 
    3131   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmld    !: mixing layer depth (turbocline)      [m] 
    3232   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlp    !: mixed layer depth  (rho=rho0+zdcrit) [m] 
    3333   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlpt   !: mixed layer depth at t-points        [m] 
     34 
     35   REAL(wp), PUBLIC ::   rho_c = 0.01_wp    !: density criterion for mixed layer depth 
     36   REAL(wp)         ::   avt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth 
    3437 
    3538   !! * Substitutions 
    … …  
    7073      !!      eddy diffusivity coefficient (resulting from the vertical physics 
    7174      !!      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) 
     75      !!      value defined locally (avt_c here taken equal to 5 cm/s2 by default) 
    7376      !! 
    7477      !! ** Action  :   nmln, hmld, hmlp, hmlpt 
    7578      !!---------------------------------------------------------------------- 
    7679      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 
     80      ! 
     81      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     82      INTEGER  ::   iikn, iiki   ! local integer 
     83      REAL(wp) ::   zN2_c        ! local scalar 
     84      INTEGER, POINTER, DIMENSION(:,:) ::   imld   ! 2D workspace 
    8185      !!---------------------------------------------------------------------- 
    8286      ! 
    … …  
    9498 
    9599      ! w-level of the mixing and mixed layers 
    96       nmln(:,:) = mbkt(:,:) + 1        ! Initialization to the number of w ocean point 
    97       imld(:,:) = mbkt(:,:) + 1 
    98       DO jk = jpkm1, nlb10, -1         ! from the bottom to nlb10 
     100      nmln(:,:)  = nlb10               ! Initialization to the number of w ocean point 
     101      hmlp(:,:)  = 0._wp               ! here hmlp used as a dummy variable, integrating vertically N^2 
     102      zN2_c = grav * rho_c * r1_rau0   ! convert density criteria into N^2 criteria 
     103      DO jk = nlb10, jpkm1 
     104         DO jj = 1, jpj                ! Mixed layer level: w-level  
     105            DO ji = 1, jpi 
     106               hmlp(ji,jj) = hmlp(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * fse3w(ji,jj,jk) 
     107               IF( hmlp(ji,jj) < zN2_c )   nmln(ji,jj) = MIN( jk , mbkt(ji,jj) ) + 1   ! Mixed layer level 
     108            END DO 
     109         END DO 
     110      END DO 
     111      ! 
     112      ! w-level of the turbocline 
     113      imld(:,:) = mbkt(:,:) + 1        ! Initialization to the number of w ocean point 
     114      DO jk = jpkm1, nlb10, -1         ! from the bottom to nlb10  
    99115         DO jj = 1, jpj 
    100116            DO ji = 1, jpi 
    101                IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + rho_c )   nmln(ji,jj) = jk      ! Mixed layer 
    102                IF( avt (ji,jj,jk) < avt_c                     )   imld(ji,jj) = jk      ! Turbocline  
     117               IF( avt (ji,jj,jk) < avt_c )   imld(ji,jj) = jk      ! Turbocline  
    103118            END DO 
    104119         END DO 

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

    r4147 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r4354 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/oce.F90

    r4354 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/par_oce.F90

    r4205 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/step.F90

    r4491 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r4328 r4896  
    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_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/vectopt_loop_substitute.h90

    r2528 r4896  
    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 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90

    r3680 r4896  
    1818   USE par_trc       ! TOP parameters 
    1919   USE trc           ! TOP variables 
    20    USE trdmod_oce 
    21    USE trdmod_trc 
     20   USE trd_oce 
     21   USE trdtrc 
    2222   USE iom           ! I/O library 
    2323 
    … …  
    302302      ENDIF 
    303303 
    304       IF( l_trdtrc )  CALL trd_mod_trc( tra(:,:,:,jpc14), jpc14, jptra_trd_sms, kt )   ! save trends 
     304      IF( l_trdtrc )  CALL trd_trc( tra(:,:,:,jpc14), jpc14, jptra_sms, kt )   ! save trends 
    305305 
    306306      CALL wrk_dealloc( jpi, jpj,      zatmbc14 ) 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r3680 r4896  
    1818   USE par_trc       ! TOP parameters 
    1919   USE trc           ! TOP variables 
    20    USE trdmod_oce 
    21    USE trdmod_trc 
     20   USE trd_oce 
     21   USE trdtrc 
    2222   USE iom           ! I/O library 
    2323 
    … …  
    201201      IF( l_trdtrc ) THEN 
    202202          DO jn = jp_cfc0, jp_cfc1 
    203             CALL trd_mod_trc( tra(:,:,:,jn), jn, jptra_trd_sms, kt )   ! save trends 
     203            CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends 
    204204          END DO 
    205205      END IF 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90

    r3680 r4896  
    1616   USE oce_trc         ! Ocean variables 
    1717   USE trc             ! TOP variables 
    18    USE trdmod_oce 
    19    USE trdmod_trc 
     18   USE trd_oce 
     19   USE trdtrc 
    2020 
    2121   IMPLICIT NONE 
    … …  
    6565          DO jn = jp_myt0, jp_myt1 
    6666            ztrmyt(:,:,:) = tra(:,:,:,jn) 
    67             CALL trd_mod_trc( ztrmyt, jn, jptra_trd_sms, kt )   ! save trends 
     67            CALL trd_trc( ztrmyt, jn, jptra_sms, kt )   ! save trends 
    6868          END DO 
    6969          CALL wrk_dealloc( jpi, jpj, jpk, ztrmyt ) 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90

    r4147 r4896  
    2121   USE lbclnk          !  
    2222   USE prtctl_trc      ! Print control for debbuging 
    23    USE trdmod_oce 
    24    USE trdmod_trc 
     23   USE trd_oce 
     24   USE trdtrc 
    2525   USE iom 
    2626    
    … …  
    457457      IF( l_trdtrc ) THEN 
    458458         DO jl = jp_pcs0_trd, jp_pcs1_trd 
    459             CALL trd_mod_trc( trbio(:,:,:,jl), jl, kt )   ! handle the trend 
     459            CALL trd_trc( trbio(:,:,:,jl), jl, kt )   ! handle the trend 
    460460         END DO 
    461461      ENDIF 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90

    r3446 r4896  
    2222   USE lbclnk 
    2323   USE prtctl_trc      ! Print control for debbuging 
    24    USE trdmod_oce 
    25    USE trdmod_trc 
     24   USE trd_oce 
     25   USE trdtrc 
    2626   USE iom 
    2727 
    … …  
    164164         ztrbio(:,:,:) = tra(:,:,:,jpno3) - ztrbio(:,:,:) 
    165165         jl = jp_pcs0_trd + 16 
    166          CALL trd_mod_trc( ztrbio, jl, kt )   ! handle the trend 
     166         CALL trd_trc( ztrbio, jl, kt )   ! handle the trend 
    167167         CALL wrk_dealloc( jpi, jpj, jpk, ztrbio )   ! temporary save of trends 
    168168      ENDIF 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90

    r4147 r4896  
    128128              IF( etot(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk + 1  
    129129              !                                       ! nb. this is to ensure compatibility with 
    130               !                                       ! nmld_trc definition in trd_mld_trc_zint 
     130              !                                       ! nmld_trc definition in trd_mxl_trc_zint 
    131131           END DO 
    132132         END DO 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90

    r4609 r4896  
    1818   USE sms_pisces 
    1919   USE lbclnk 
    20    USE trdmod_oce 
    21    USE trdmod_trc 
     20   USE trd_oce 
     21   USE trdtrc 
    2222   USE iom 
    2323   USE prtctl_trc      ! Print control for debbuging 
    … …  
    128128         ztrbio(:,:,:) = tra(:,:,:,jpdet) - ztrbio(:,:,:) 
    129129         jl = jp_pcs0_trd + 7 
    130          CALL trd_mod_trc( ztrbio, jl, kt )   ! handle the trend 
     130         CALL trd_trc( ztrbio, jl, kt )   ! handle the trend 
    131131         CALL wrk_dealloc( jpi, jpj, jpk, ztrbio ) 
    132132      ENDIF 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90

    r4147 r4896  
    2020   USE p2zsed 
    2121   USE p2zexp 
    22    USE trdmod_oce 
    23    USE trdmod_trc_oce 
    24    USE trdmod_trc 
    25    USE trdmld_trc 
     22   USE trd_oce 
     23   USE trdtrc_oce 
     24   USE trdtrc 
     25   USE trdmxl_trc 
    2626 
    2727   IMPLICIT NONE 
    … …  
    6161      IF( l_trdtrc ) THEN 
    6262         DO jn = jp_pcs0, jp_pcs1 
    63            CALL trd_mod_trc( tra(:,:,:,jn), jn, jptra_trd_sms, kt )   ! save trends 
     63           CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends 
    6464         END DO 
    6565      END IF 
    6666 
    67       IF( lk_trdmld_trc )  CALL trd_mld_bio( kt )   ! trends: Mixed-layer 
     67      IF( lk_trdmxl_trc )  CALL trd_mxl_bio( kt )   ! trends: Mixed-layer 
    6868      ! 
    6969      IF ( kt == nittrc000 ) CALL FLUSH    ( numonp )     ! flush output namelist PISCES 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90

    r4361 r4896  
    205205              IF( etot(ji,jj,jk) * tmask(ji,jj,jk) >= 0.0043 * qsr(ji,jj) )  THEN 
    206206                 neln(ji,jj) = jk+1                    ! Euphotic level : 1rst T-level strictly below Euphotic layer 
    207                  !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint 
     207                 !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mxl_trc_zint 
    208208                 heup(ji,jj) = fsdepw(ji,jj,jk+1)      ! Euphotic layer depth 
    209209              ENDIF 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90

    r4162 r4896  
    1111   !!   'key_pisces'                                       PISCES bio-model 
    1212   !!---------------------------------------------------------------------- 
    13    !!   p4zsms        :  Time loop of passive tracers sms 
     13   !!   p4zsms         :  Time loop of passive tracers sms 
    1414   !!---------------------------------------------------------------------- 
    1515   USE oce_trc         !  shared variables between ocean and passive tracers 
    … …  
    2525   USE p4zint          !  time interpolation 
    2626   USE iom             !  I/O manager 
    27    USE trdmod_oce      !  Ocean trends variables 
    28    USE trdmod_trc      !  TOP trends variables 
     27   USE trd_oce         !  Ocean trends variables 
     28   USE trdtrc          !  TOP trends variables 
    2929   USE sedmodel        !  Sediment model 
    3030   USE prtctl_trc      !  print control for debugging 
    … …  
    3333   PRIVATE 
    3434 
    35    PUBLIC   p4z_sms_init    ! called in p4zsms.F90 
    36    PUBLIC   p4z_sms    ! called in p4zsms.F90 
     35   PUBLIC   p4z_sms_init   ! called in p4zsms.F90 
     36   PUBLIC   p4z_sms        ! called in p4zsms.F90 
    3737 
    3838   REAL(wp) :: alkbudget, no3budget, silbudget, ferbudget 
    … …  
    146146            jl = jn + jp_pcs0 - 1 
    147147             ztrdpis(:,:,:,jn) = ztrdpis(:,:,:,jn) + tra(:,:,:,jl) 
    148              CALL trd_mod_trc( ztrdpis(:,:,:,jn), jn, jptra_trd_sms, kt )   ! save trends 
     148             CALL trd_trc( ztrdpis(:,:,:,jn), jn, jptra_sms, kt )   ! save trends 
    149149          END DO 
    150150          CALL wrk_dealloc( jpi, jpj, jpk, jp_pisces, ztrdpis )  

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90

    r4319 r4896  
    1919   USE trc             ! TOP variables 
    2020   USE sms_pisces      ! sms trends 
    21    USE trdmod_trc_oce 
     21   USE trdtrc_oce 
    2222   USE iom             ! I/O manager 
    2323 
    … …  
    123123#if defined key_pisces_reduced 
    124124 
    125       IF( ( .NOT.lk_iomput .AND. ln_diabio ) .OR. lk_trdmld_trc ) THEN 
     125      IF( ( .NOT.lk_iomput .AND. ln_diabio ) .OR. lk_trdmxl_trc ) THEN 
    126126         ! 
    127127         ! Namelist nampisdbi 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90

    r4513 r4896  
    2525   USE trabbl              !  
    2626   USE prtctl_trc          ! Print control for debbuging 
    27    USE trdmod_oce 
     27   USE trd_oce 
    2828   USE trdtra 
    2929 
    … …  
    9393        DO jn = 1, jptra 
    9494           ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 
    95            CALL trd_tra( kt, 'TRC', jn, jptra_trd_bbl, ztrtrd(:,:,:,jn) ) 
     95           CALL trd_tra( kt, 'TRC', jn, jptra_bbl, ztrtrd(:,:,:,jn) ) 
    9696        END DO 
    9797        CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) ! temporary save of trends 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    r4359 r4896  
    2323   USE prtctl_trc      ! Print control for debbuging 
    2424   USE trdtra 
    25    USE trdmod_oce 
     25   USE trd_oce 
    2626 
    2727   IMPLICIT NONE 
    … …  
    7575      !! ** Action  : - update the tracer trends tra with the newtonian  
    7676      !!                damping trends. 
    77       !!              - save the trends ('key_trdmld_trc') 
     77      !!              - save the trends ('key_trdmxl_trc') 
    7878      !!---------------------------------------------------------------------- 
    7979      !! 
    … …  
    151151            IF( l_trdtrc ) THEN 
    152152               ztrtrd(:,:,:) = tra(:,:,:,jn) -  ztrtrd(:,:,:) 
    153                CALL trd_tra( kt, 'TRC', jn, jptra_trd_dmp, ztrtrd ) 
     153               CALL trd_tra( kt, 'TRC', jn, jptra_dmp, ztrtrd ) 
    154154            END IF 
    155155            !                                                       ! =========== 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90

    r3294 r4896  
    2525   USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine) 
    2626   USE traldf_lap      ! lateral mixing            (tra_ldf_lap routine) 
    27    USE trdmod_oce 
     27   USE trd_oce 
    2828   USE trdtra 
    2929   USE prtctl_trc      ! Print control 
    … …  
    105105        DO jn = 1, jptra 
    106106           ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 
    107            CALL trd_tra( kt, 'TRC', jn, jptra_trd_ldf, ztrtrd(:,:,:,jn) ) 
     107           CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) ) 
    108108        END DO 
    109109        CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90

    r4611 r4896  
    3030   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    3131   USE prtctl_trc      ! Print control for debbuging 
    32    USE trdmod_oce 
     32   USE trd_oce 
    3333   USE trdtra 
    3434   USE tranxt 
    … …  
    148148               zfact = 1.e0 / r2dt(jk)   
    149149               ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact  
    150                CALL trd_tra( kt, 'TRC', jn, jptra_trd_atf, ztrdt ) 
     150               CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt ) 
    151151            END DO 
    152152         END DO 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90

    r3680 r4896  
    1515   USE oce_trc             ! ocean dynamics and tracers variables 
    1616   USE trc                 ! ocean passive tracers variables 
    17    USE trdmod_oce 
     17   USE trd_oce 
    1818   USE trdtra 
    1919   USE prtctl_trc          ! Print control for debbuging 
    … …  
    156156               ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 
    157157               ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt  
    158                CALL trd_tra( kt, 'TRC', jn, jptra_trd_radb, ztrtrdb )       ! Asselin-like trend handling 
    159                CALL trd_tra( kt, 'TRC', jn, jptra_trd_radn, ztrtrdn )       ! standard     trend handling 
     158               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb )       ! Asselin-like trend handling 
     159               CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn )       ! standard     trend handling 
    160160              ! 
    161161            ENDIF 
    … …  
    187187               ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 
    188188               ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt  
    189                CALL trd_tra( kt, 'TRC', jn, jptra_trd_radb, ztrtrdb )       ! Asselin-like trend handling 
    190                CALL trd_tra( kt, 'TRC', jn, jptra_trd_radn, ztrtrdn )       ! standard     trend handling 
     189               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb )       ! Asselin-like trend handling 
     190               CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn )       ! standard     trend handling 
    191191              ! 
    192192            ENDIF 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r3719 r4896  
    1919   USE trc             ! ocean  passive tracers variables 
    2020   USE prtctl_trc      ! Print control for debbuging 
    21    USE trdmod_oce 
     21   USE trd_oce 
    2222   USE trdtra 
    2323 
    … …  
    104104         IF( l_trdtrc ) THEN 
    105105            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 
    106             CALL trd_tra( kt, 'TRC', jn, jptra_trd_nsr, ztrtrd ) 
     106            CALL trd_tra( kt, 'TRC', jn, jptra_nsr, ztrtrd ) 
    107107         END IF 
    108108         !                                                       ! =========== 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90

    r3680 r4896  
    1919   USE trazdf_exp      ! vertical diffusion: explicit (tra_zdf_exp     routine) 
    2020   USE trazdf_imp      ! vertical diffusion: implicit (tra_zdf_imp     routine) 
    21    USE trdmod_oce 
     21   USE trd_oce 
    2222   USE trdtra 
    2323   USE prtctl_trc      ! Print control 
    … …  
    106106               ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dt(jk) ) - ztrtrd(:,:,jk,jn) 
    107107            END DO 
    108             CALL trd_tra( kt, 'TRC', jn, jptra_trd_zdf, ztrtrd(:,:,:,jn) ) 
     108            CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) ) 
    109109         END DO 
    110110         CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90

    r4610 r4896  
    6666   USE oce , ONLY :   rhop    =>    rhop    !: potential volumic mass (kg m-3)  
    6767   USE oce , ONLY :   rhd     =>    rhd     !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 
     68#if defined key_offline 
     69   USE oce , ONLY :   rab_n   =>    rab_n   !: local thermal/haline expension ratio at T-points 
     70#endif 
    6871   USE oce , ONLY :   hdivn   =>    hdivn   !: horizontal divergence (1/s) 
    6972   USE oce , ONLY :   rotn    =>    rotn    !: relative vorticity    [s-1] 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r4607 r4896  
    192192      USE trcnxt        , ONLY:   trc_nxt_alloc 
    193193      USE trczdf        , ONLY:   trc_zdf_alloc 
    194       USE trdmod_trc_oce, ONLY:   trd_mod_trc_oce_alloc 
    195 #if defined key_trdmld_trc  
    196       USE trdmld_trc    , ONLY:   trd_mld_trc_alloc 
     194      USE trdtrc_oce    , ONLY:   trd_trc_oce_alloc 
     195#if defined key_trdmxl_trc  
     196      USE trdmxl_trc    , ONLY:   trd_mxl_trc_alloc 
    197197#endif 
    198198      ! 
    … …  
    204204      ierr = ierr + trc_nxt_alloc() 
    205205      ierr = ierr + trc_zdf_alloc() 
    206       ierr = ierr + trd_mod_trc_oce_alloc() 
    207 #if defined key_trdmld_trc  
    208       ierr = ierr + trd_mld_trc_alloc() 
     206      ierr = ierr + trd_trc_oce_alloc() 
     207#if defined key_trdmxl_trc  
     208      ierr = ierr + trd_mxl_trc_alloc() 
    209209#endif 
    210210      ! 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r4319 r4896  
    2525   USE trcnam_c14b       ! C14 SMS namelist 
    2626   USE trcnam_my_trc     ! MY_TRC SMS namelist 
    27    USE trdmod_oce        
    28    USE trdmod_trc_oce 
     27   USE trd_oce        
     28   USE trdtrc_oce 
    2929   USE iom               ! I/O manager 
    3030 
    … …  
    119119 
    120120 
    121 #if defined key_trdmld_trc || defined key_trdtrc 
     121#if defined key_trdmxl_trc || defined key_trdtrc 
    122122 
    123123         REWIND( numnat_ref )              ! Namelist namtrc_trd in reference namelist : Passive tracer trends 
    … …  
    132132         IF(lwp) THEN 
    133133            WRITE(numout,*) 
    134             WRITE(numout,*) ' trd_mld_trc_init : read namelist namtrc_trd                    ' 
     134            WRITE(numout,*) ' trd_mxl_trc_init : read namelist namtrc_trd                    ' 
    135135            WRITE(numout,*) ' ~~~~~~~~~~~~~~~~                                               ' 
    136136            WRITE(numout,*) '   * frequency of trends diagnostics   nn_trd_trc             = ', nn_trd_trc 
    137137            WRITE(numout,*) '   * control surface type              nn_ctls_trc            = ', nn_ctls_trc 
    138             WRITE(numout,*) '   * restart for ML diagnostics        ln_trdmld_trc_restart  = ', ln_trdmld_trc_restart 
     138            WRITE(numout,*) '   * restart for ML diagnostics        ln_trdmxl_trc_restart  = ', ln_trdmxl_trc_restart 
    139139            WRITE(numout,*) '   * flag to diagnose trends of                                 ' 
    140             WRITE(numout,*) '     instantantaneous or mean ML T/S   ln_trdmld_trc_instant  = ', ln_trdmld_trc_instant 
     140            WRITE(numout,*) '     instantantaneous or mean ML T/S   ln_trdmxl_trc_instant  = ', ln_trdmxl_trc_instant 
    141141            WRITE(numout,*) '   * unit conversion factor            rn_ucf_trc             = ', rn_ucf_trc 
    142142            DO jn = 1, jptra 
    … …  
    266266      !!--------------------------------------------------------------------- 
    267267      INTEGER ::  ierr 
    268 #if defined key_trdmld_trc  || defined key_trdtrc 
     268#if defined key_trdmxl_trc  || defined key_trdtrc 
    269269      NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & 
    270          &                ln_trdmld_trc_restart, ln_trdmld_trc_instant, & 
     270         &                ln_trdmxl_trc_restart, ln_trdmxl_trc_instant, & 
    271271         &                cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc 
    272272#endif 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r4152 r4896  
    137137          CALL trc_rst_stat            ! statistics 
    138138          CALL iom_close( numrtw )     ! close the restart file (only at last time step) 
    139 #if ! defined key_trdmld_trc 
     139#if ! defined key_trdmxl_trc 
    140140          lrst_trc = .FALSE. 
    141141#endif 

  • branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r4306 r4896  
    1919   USE trcwri 
    2020   USE trcrst 
    21    USE trdmod_trc_oce 
    22    USE trdmld_trc 
     21   USE trdtrc_oce 
     22   USE trdmxl_trc 
    2323   USE iom 
    2424   USE in_out_manager 
    … …  
    5959      IF( nn_timing == 1 )   CALL timing_start('trc_stp') 
    6060      ! 
    61       IF( kt == nittrc000 .AND. lk_trdmld_trc )  CALL trd_mld_trc_init    ! trends: Mixed-layer 
     61      IF( kt == nittrc000 .AND. lk_trdmxl_trc )  CALL trd_mxl_trc_init    ! trends: Mixed-layer 
    6262      ! 
    6363      IF( lk_vvl ) THEN                                                   ! update ocean volume due to ssh temporal evolution 
    … …  
    100100         ENDIF 
    101101         IF( lrst_trc )            CALL trc_rst_wri  ( kt )       ! write tracer restart file 
    102          IF( lk_trdmld_trc  )      CALL trd_mld_trc  ( kt )       ! trends: Mixed-layer 
     102         IF( lk_trdmxl_trc  )      CALL trd_mxl_trc  ( kt )       ! trends: Mixed-layer 
    103103         ! 
    104104         IF( nn_dttrc /= 1   )     CALL trc_sub_reset( kt )       ! resetting physical variables when sub-stepping 
Note: See TracChangeset for help on using the changeset viewer.