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

Changeset 4933


Ignore:
Timestamp:
2014-12-01T11:11:43+01:00 (9 years ago)
Author:
cetlod
Message:

dev_CNRS_CICE : merging CNRS and CICE branche

Location:
branches/2014/dev_CNRS_CICE/NEMOGCM
Files:
14 deleted
129 edited
14 copied

Legend:

Unmodified
Added
Removed

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

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

    r4230 r4933  
    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_CICE/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg

    r4370 r4933  
    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_CICE/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg

    r4370 r4933  
    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_CICE/NEMOGCM/CONFIG/GYRE_PISCES/cpp_GYRE_PISCES.fcm

    r4230 r4933  
    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_CICE/NEMOGCM/CONFIG/SHARED/field_def.xml

    r4762 r4933  
    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"/> 
    3130         <field id="heatc"        long_name="Heat content vertically integrated"        unit="J/m2"                      /> 
    3231         <field id="saltc"        long_name="Salt content vertically integrated"        unit="PSU*kg/m2"                /> 
    33     <field id="eken"         long_name="kinetic energy"                            unit="m2/s2" grid_ref="grid_T_3D"/> 
    34     <field id="hdiv"         long_name="horizontal divergence"                     unit="s-1"   grid_ref="grid_T_3D"/> 
     32         <!-- EOS --> 
     33         <field id="alpha"        long_name="thermal expansion"                         unit="1/degC" grid_ref="grid_T_3D"/> 
     34         <field id="beta"         long_name="haline contraction"                        unit="1/psu"  grid_ref="grid_T_3D"/> 
     35         <field id="bn2"          long_name="squared Brunt-Vaisala frequency"           unit="1/s"    grid_ref="grid_T_3D"/> 
     36         <field id="rhop"         long_name="potential density (sigma0)"                unit="kg/m3"  grid_ref="grid_T_3D"/> 
     37         <!-- Energy - horizontal divergence --> 
     38         <field id="eken"         long_name="kinetic energy"                            unit="m2/s2"  grid_ref="grid_T_3D"/> 
     39         <field id="hdiv"         long_name="horizontal divergence"                     unit="s-1"    grid_ref="grid_T_3D"/> 
    3540         <!-- variables available with MLE --> 
    3641         <field id="Lf_NHpf"      long_name="MLE: Lf = N H / f"                         unit="m"                        /> 
    … …  
    160165    
    161166         <!-- *_oce variables available with ln_blk_clio or ln_blk_core --> 
     167         <field id="qns_oce"      long_name="Non solar Downward Heat Flux over open ocean"                 unit="W/m2"     /> 
    162168         <field id="qlw_oce"      long_name="Longwave Downward Heat Flux over open ocean"                  unit="W/m2"     /> 
    163169         <field id="qsb_oce"      long_name="Sensible Downward Heat Flux over open ocean"                  unit="W/m2"     /> 
    … …  
    195201         <field id="ice_cover"    long_name="Ice fraction"                                                 unit="1"        /> 
    196202 
     203         <field id="ioceflxb"     long_name="Oceanic flux at the ice base"                                 unit="W/m2"     /> 
    197204         <field id="qsr_ai_cea"   long_name="Air-Ice downward solar heat flux (cell average)"              unit="W/m2"     /> 
    198205         <field id="qns_ai_cea"   long_name="Air-Ice downward non-solar heat flux (cell average)"          unit="W/m2"     /> 
    … …  
    205212         <field id="icethic_cea"  long_name="Ice thickness (cell average)"                                 unit="m"        /> 
    206213         <field id="iceprod_cea"  long_name="Ice production (cell average)"                                unit="m/s"      /> 
     214         <field id="iiceconc"     long_name="Ice concentration"                                            unit=""         /> 
    207215          
    208216         <field id="ice_pres"     long_name="Ice presence"                                                 unit="-"        /> 
    … …  
    219227         <field id="emp_x_sst"    long_name="Concentration/Dilution term on SST"                           unit="kgC/m2/s" /> 
    220228         <field id="emp_x_sss"    long_name="Concentration/Dilution term on SSS"                         unit="kgPSU/m2/s" />         
    221           
    222           
     229        
    223230         <field id="iceconc"      long_name="ice concentration"                                            unit="%"        /> 
    224231         <field id="uice_ipa"     long_name="Ice velocity along i-axis at I-point (ice presence average)"  unit="m/s"      /> 
    … …  
    306313         <field id="hfxdhc"    long_name="Heat content variation in snow and ice"   unit="W/m2" /> 
    307314         <field id="hfxtur"    long_name="turbulent heat flux at the ice base"      unit="W/m2"  /> 
    308  
     315   
     316          
    309317      </field_group> 
    310318 
    … …  
    386394 
    387395      <field_group id="scalar"  domain_ref="1point" > 
    388      <field id="voltot"     long_name="global mean volume"                         unit="m3"   /> 
    389      <field id="sshtot"     long_name="global mean ssh"                            unit="m"    /> 
    390      <field id="sshsteric"  long_name="global mean ssh steric"                     unit="m"    /> 
    391      <field id="sshthster"  long_name="global mean ssh thermosteric"               unit="m"    /> 
    392      <field id="masstot"    long_name="global mean mass"                           unit="kg"   /> 
    393      <field id="temptot"    long_name="global mean temperature"                    unit="degC" /> 
    394      <field id="saltot"     long_name="global mean salinity"                       unit="psu"  /> 
    395      <field id="fram_trans" long_name="Sea Ice Mass Transport Through Fram Strait" unit="kg/s" /> 
     396         <field id="voltot"     long_name="global mean volume"                         unit="m3"   /> 
     397         <field id="sshtot"     long_name="global mean ssh"                            unit="m"    /> 
     398         <field id="sshsteric"  long_name="global mean ssh steric"                     unit="m"    /> 
     399         <field id="sshthster"  long_name="global mean ssh thermosteric"               unit="m"    /> 
     400         <field id="masstot"    long_name="global mean mass"                           unit="kg"   /> 
     401         <field id="temptot"    long_name="global mean temperature"                    unit="degC" /> 
     402         <field id="saltot"     long_name="global mean salinity"                       unit="psu"  /> 
     403         <field id="fram_trans" long_name="Sea Ice Mass Transport Through Fram Strait" unit="kg/s" /> 
     404 
    396405       <!-- available with ln_diahsb --> 
    397     <field id="bgtemper" long_name="global mean temperature variation"            unit="degC"/> 
    398     <field id="bgsaline" long_name="global mean salinity variation"               unit="psu"/> 
    399     <field id="bgheatco" long_name="global mean heat content variation"           unit="10^20J"/> 
    400     <field id="bgsaltco" long_name="global mean salt content variation"           unit="psu*km3" /> 
    401     <field id="bgvolssh" long_name="global mean volume variation (ssh)"           unit="km3"/> 
    402     <field id="bgvole3t" long_name="global mean volume variation (e3t)"           unit="km3"/> 
    403     <field id="bgfrcvol" long_name="global mean volume variation from forcing"    unit="km3"/> 
    404     <field id="bgfrctem" long_name="global mean forcing from heat content variation"   unit="degC"/> 
    405     <field id="bgfrcsal" long_name="global mean forcing salt content variation"        unit="psu"/> 
    406     <field id="bgmistem" long_name="global mean temperature error due to free surface" unit="degC"/> 
    407     <field id="bgmissal" long_name="global mean salinity error due to free surface"    unit="psu"/> 
     406    <field id="bgtemper"     long_name="global mean temperature"                  unit="degC"   /> 
     407    <field id="bgsaline"     long_name="global mean salinity"                     unit="psu"    /> 
     408    <field id="bgheatco"     long_name="global mean heat content"                 unit="10^9J"  /> 
     409    <field id="bgsaltco"     long_name="global mean salt content"                 unit="psu*m3" /> 
     410    <field id="bgvolssh"     long_name="global mean ssh volume"                   unit="km3"     /> 
     411         <field id="bgvole3t"     long_name="global mean volume variation (e3t)"           unit="km3"/> 
     412    <field id="bgvoltot"     long_name="global mean volume"                       unit="km3"     /> 
     413    <field id="bgsshtot"     long_name="global mean ssh"                          unit="m"      /> 
     414    <field id="bgfrcvol"     long_name="global mean volume from forcing"          unit="km3"     /> 
     415    <field id="bgfrctem"     long_name="global mean heat content from forcing"    unit="10^9J"  /> 
     416    <field id="bgfrcsal"     long_name="global mean salt content from forcing"    unit="psu*km3" /> 
     417    <field id="bgmistem"     long_name="global mean temperature error due to free surface" unit="degC" /> 
     418    <field id="bgmissal"     long_name="global mean salinity error due to free surface"    unit="psu"  /> 
    408419      </field_group> 
    409420 
    … …  
    707718    </field_group> 
    708719     
     720    <!--  
     721============================================================================================================ 
     722                     Trend diagnostics : temperature, KE, PE, momentum 
     723============================================================================================================ 
     724    --> 
     725 
     726    <field_group id="trendT" grid_ref="grid_T_3D"> 
     727      <!-- variables available with ln_tra_trd --> 
     728      <field id="ttrd_xad"      long_name="temperature-trend: i-advection"                 unit="degC/s" /> 
     729      <field id="strd_xad"      long_name="salinity   -trend: i-advection"                 unit="psu/s"  /> 
     730      <field id="ttrd_yad"      long_name="temperature-trend: j-advection"                 unit="degC/s" /> 
     731      <field id="strd_yad"      long_name="salinity   -trend: j-advection"                 unit="psu/s"  /> 
     732      <field id="ttrd_zad"      long_name="temperature-trend: k-advection"                 unit="degC/s" /> 
     733      <field id="strd_zad"      long_name="salinity   -trend: k-advection"                 unit="psu/s"  /> 
     734      <field id="ttrd_sad"      long_name="temperature-trend: surface adv. (no-vvl)"       unit="degC/s" grid_ref="grid_T_2D" /> 
     735      <field id="strd_sad"      long_name="salinity   -trend: surface adv. (no-vvl)"       unit="psu/s"  grid_ref="grid_T_2D" /> 
     736      <field id="ttrd_ldf"      long_name="temperature-trend: lateral  diffusion"          unit="degC/s" /> 
     737      <field id="strd_ldf"      long_name="salinity   -trend: lateral  diffusion"          unit="psu/s"  /> 
     738      <field id="ttrd_zdf"      long_name="temperature-trend: vertical diffusion"          unit="degC/s" /> 
     739      <field id="strd_zdf"      long_name="salinity   -trend: vertical diffusion"          unit="psu/s"  /> 
     740      <!-- ln_traldf_iso=T only (iso-neutral diffusion) --> 
     741      <field id="ttrd_zdfp"     long_name="temperature-trend: pure vert. diffusion"        unit="degC/s" /> 
     742      <field id="strd_zdfp"     long_name="salinity   -trend: pure vert. diffusion"        unit="psu/s"  /> 
     743      <!-- --> 
     744      <field id="ttrd_dmp"      long_name="temperature-trend: interior restoring"          unit="degC/s" /> 
     745      <field id="strd_dmp"      long_name="salinity   -trend: interior restoring"          unit="psu/s"  /> 
     746      <field id="ttrd_bbl"      long_name="temperature-trend: bottom boundary layer"       unit="degC/s" /> 
     747      <field id="strd_bbl"      long_name="salinity   -trend: bottom boundary layer"       unit="psu/s"  /> 
     748      <field id="ttrd_npc"      long_name="temperature-trend: non-penetrative conv."       unit="degC/s" /> 
     749      <field id="strd_npc"      long_name="salinity   -trend: non-penetrative conv."       unit="psu/s"  /> 
     750      <field id="ttrd_qns"      long_name="temperature-trend: non-solar flux + runoff"     unit="degC/s" /> 
     751      <field id="strd_cdt"      long_name="salinity   -trend: C/D term       + runoff"     unit="degC/s" /> 
     752      <field id="ttrd_qsr"      long_name="temperature-trend: solar penetr. heating"       unit="degC/s" /> 
     753      <field id="ttrd_bbc"      long_name="temperature-trend: geothermal heating"          unit="degC/s" /> 
     754      <field id="ttrd_atf"      long_name="temperature-trend: asselin time filter"         unit="degC/s" /> 
     755      <field id="strd_atf"      long_name="salinity   -trend: asselin time filter"         unit="psu/s"  /> 
     756      <!-- variables available with ln_KE_trd --> 
     757      <field id="ketrd_hpg"     long_name="ke-trend: hydrostatic pressure gradient"        unit="W/s^3"  /> 
     758      <field id="ketrd_spg"     long_name="ke-trend: surface     pressure gradient"        unit="W/s^3"  /> 
     759      <field id="ketrd_spgexp"  long_name="ke-trend: surface pressure gradient (explicit)" unit="W/s^3"  /> 
     760      <field id="ketrd_spgflt"  long_name="ke-trend: surface pressure gradient (filter)"   unit="W/s^3"  /> 
     761      <field id="ssh_flt"       long_name="filtered contribution to ssh (dynspg_flt)"      unit="m"     grid_ref="grid_T_2D"   /> 
     762      <field id="w0"            long_name="surface vertical velocity"                      unit="m/s"   grid_ref="grid_T_2D"   /> 
     763      <field id="pw0_exp"       long_name="surface pressure flux due to ssh"               unit="W/s^2" grid_ref="grid_T_2D"   /> 
     764      <field id="pw0_flt"       long_name="surface pressure flux due to filtered ssh"      unit="W/s^2" grid_ref="grid_T_2D"   /> 
     765      <field id="ketrd_keg"     long_name="ke-trend: KE gradient         or hor. adv."     unit="W/s^3"  /> 
     766      <field id="ketrd_rvo"     long_name="ke-trend: relative  vorticity or metric term"   unit="W/s^3"  /> 
     767      <field id="ketrd_pvo"     long_name="ke-trend: planetary vorticity"                  unit="W/s^3"  /> 
     768      <field id="ketrd_zad"     long_name="ke-trend: vertical  advection"                  unit="W/s^3"  /> 
     769      <field id="ketrd_udx"     long_name="ke-trend: U.dx[U]"                              unit="W/s^3"  /> 
     770      <field id="ketrd_ldf"     long_name="ke-trend: lateral   diffusion"                  unit="W/s^3"  /> 
     771      <field id="ketrd_zdf"     long_name="ke-trend: vertical  diffusion"                  unit="W/s^3"  /> 
     772      <field id="ketrd_tau"     long_name="ke-trend: wind stress "                         unit="W/s^3" grid_ref="grid_T_2D"   /> 
     773      <field id="ketrd_bfr"     long_name="ke-trend: bottom friction (explicit)"           unit="W/s^3"  />    
     774      <field id="ketrd_bfri"    long_name="ke-trend: bottom friction (implicit)"           unit="W/s^3"  />    
     775      <field id="ketrd_atf"     long_name="ke-trend: asselin time filter trend"            unit="W/s^3"  />   
     776      <field id="ketrd_convP2K" long_name="ke-trend: conversion (potential to kinetic)"    unit="W/s^3"  /> 
     777      <field id="KE"            long_name="kinetic energy: u(n)*u(n+1)/2"                  unit="W/s^2"  />    
     778      <!-- variables available with ln_PE_trd --> 
     779      <field id="petrd_xad"     long_name="pe-trend: i-advection"                          unit="W/m^3"  /> 
     780      <field id="petrd_yad"     long_name="pe-trend: j-advection"                          unit="W/m^3"  /> 
     781      <field id="petrd_zad"     long_name="pe-trend: k-advection"                          unit="W/m^3"  /> 
     782      <field id="petrd_sad"     long_name="pe-trend: surface adv. (no-vvl)"                unit="W/m^3"  grid_ref="grid_T_2D" /> 
     783      <field id="petrd_ldf"     long_name="pe-trend: lateral  diffusion"                   unit="W/m^3"  /> 
     784      <field id="petrd_zdf"     long_name="pe-trend: vertical diffusion"                   unit="W/m^3"  /> 
     785      <field id="petrd_zdfp"    long_name="pe-trend: pure vert. diffusion"                 unit="W/m^3"  /> 
     786      <field id="petrd_dmp"     long_name="pe-trend: interior restoring"                   unit="W/m^3"  /> 
     787      <field id="petrd_bbl"     long_name="pe-trend: bottom boundary layer"                unit="W/m^3"  /> 
     788      <field id="petrd_npc"     long_name="pe-trend: non-penetrative conv."                unit="W/m^3"  /> 
     789      <field id="petrd_nsr"     long_name="pe-trend: surface forcing + runoff"             unit="W/m^3"  /> 
     790      <field id="petrd_qsr"     long_name="pe-trend: solar penetr. heating"                unit="W/m^3"  /> 
     791      <field id="petrd_bbc"     long_name="pe-trend: geothermal heating"                   unit="W/m^3"  /> 
     792      <field id="petrd_atf"     long_name="pe-trend: asselin time filter"                  unit="W/m^3"  /> 
     793      <field id="PEanom"        long_name="potential energy anomaly"                       unit="SI"     />    
     794      <field id="alphaPE"       long_name="- partial deriv. of PEanom wrt T"               unit="/degC"  />    
     795      <field id="betaPE"        long_name="partial deriv. of PEanom wrt S"                 unit="/psu"   />    
     796    </field_group> 
     797 
     798    <field_group id="trendU" grid_ref="grid_U_3D"> 
     799     <!-- variables available with ln_dyn_trd --> 
     800     <field id="utrd_hpg"       long_name="i-trend: hydrostatic pressure gradient"         unit="m/s^2"                      /> 
     801     <field id="utrd_spg"       long_name="i-trend: surface     pressure gradient"         unit="m/s^2"                      /> 
     802     <field id="utrd_spgexp"    long_name="i-trend: surface pressure gradient (explicit)"  unit="m/s^2"                      /> 
     803     <field id="utrd_spgflt"    long_name="i-trend: surface pressure gradient (filtered)"  unit="m/s^2"                      /> 
     804     <field id="utrd_keg"       long_name="i-trend: KE gradient         or hor. adv."      unit="m/s^2"                      /> 
     805     <field id="utrd_rvo"       long_name="i-trend: relative  vorticity or metric term"    unit="m/s^2"                      /> 
     806     <field id="utrd_pvo"       long_name="i-trend: planetary vorticity"                   unit="m/s^2"                      /> 
     807     <field id="utrd_zad"       long_name="i-trend: vertical  advection"                   unit="m/s^2"                      /> 
     808     <field id="utrd_udx"       long_name="i-trend: U.dx[U]"                               unit="m/s^2"                      /> 
     809     <field id="utrd_ldf"       long_name="i-trend: lateral   diffusion"                   unit="m/s^2"                      /> 
     810     <field id="utrd_zdf"       long_name="i-trend: vertical  diffusion"                   unit="m/s^2"                      /> 
     811     <field id="utrd_tau"       long_name="i-trend: wind stress "                          unit="m/s^2" grid_ref="grid_U_2D" /> 
     812     <field id="utrd_bfr"       long_name="i-trend: bottom friction (explicit)"            unit="m/s^2"                      />    
     813     <field id="utrd_bfri"      long_name="i-trend: bottom friction (implicit)"            unit="m/s^2"                      />    
     814     <field id="utrd_tot"       long_name="i-trend: total momentum trend before atf"       unit="m/s^2"                      />    
     815     <field id="utrd_atf"       long_name="i-trend: asselin time filter trend"             unit="m/s^2"                      />    
     816    </field_group> 
     817 
     818    <field_group id="trendV" grid_ref="grid_V_3D"> 
     819     <!-- variables available with ln_dyn_trd --> 
     820     <field id="vtrd_hpg"       long_name="j-trend: hydrostatic pressure gradient"         unit="m/s^2"                      /> 
     821     <field id="vtrd_spg"       long_name="j-trend: surface     pressure gradient"         unit="m/s^2"                      /> 
     822     <field id="vtrd_spgexp"    long_name="j-trend: surface pressure gradient (explicit)"  unit="m/s^2"                      /> 
     823     <field id="vtrd_spgflt"    long_name="j-trend: surface pressure gradient (filtered)"  unit="m/s^2"                      /> 
     824     <field id="vtrd_keg"       long_name="j-trend: KE gradient         or hor. adv."      unit="m/s^2"                      /> 
     825     <field id="vtrd_rvo"       long_name="j-trend: relative  vorticity or metric term"    unit="m/s^2"                      /> 
     826     <field id="vtrd_pvo"       long_name="j-trend: planetary vorticity"                   unit="m/s^2"                      /> 
     827     <field id="vtrd_zad"       long_name="j-trend: vertical  advection"                   unit="m/s^2"                      /> 
     828     <field id="vtrd_vdy"       long_name="i-trend: V.dx[V]"                               unit="m/s^2"                      /> 
     829     <field id="vtrd_ldf"       long_name="j-trend: lateral   diffusion"                   unit="m/s^2"                      /> 
     830     <field id="vtrd_zdf"       long_name="j-trend: vertical  diffusion"                   unit="m/s^2"                      /> 
     831     <field id="vtrd_tau"       long_name="j-trend: wind stress "                          unit="m/s^2" grid_ref="grid_V_2D" /> 
     832     <field id="vtrd_bfr"       long_name="j-trend: bottom friction (explicit)"            unit="m/s^2"                      />    
     833     <field id="vtrd_bfri"      long_name="j-trend: bottom friction (implicit)"            unit="m/s^2"                      />    
     834     <field id="vtrd_tot"       long_name="j-trend: total momentum trend before atf"       unit="m/s^2"                      />    
     835     <field id="vtrd_atf"       long_name="j-trend: asselin time filter trend"            unit="m/s^2"                       />    
     836    </field_group> 
     837 
    709838    </field_definition> 

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

    r4773 r4933  
    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 
    … …  
    230231   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
    231232   ln_blk_mfs  = .false.   !  MFS bulk formulation                      (T => fill namsbc_mfs ) 
    232    ln_cpl      = .false.   !  Coupled formulation                       (T => fill namsbc_cpl ) 
    233233   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr ) 
    234234   nn_ice      = 2         !  =0 no ice boundary condition   , 
    235235                           !  =1 use observed ice-cover      , 
    236                            !  =2 ice-model used                         ("key_lim3" or "key_lim2) 
     236                           !  =2 ice-model used                         ("key_lim3" or "key_lim2") 
    237237   nn_ice_embd = 1         !  =0 levitating ice (no mass exchange, concentration/dilution effect) 
    238238                           !  =1 levitating ice with mass and salt exchange but no presure effect 
    … …  
    249249   nn_lsm  = 0             !  =0 land/sea mask for input fields is not applied (keep empty land/sea mask filename field) , 
    250250                           !  =1:n number of iterations of land/sea mask application for input fields (fill land/sea mask filename field) 
    251    cn_iceflx = 'linear'    !  redistribution of solar input into ice categories during coupling ice/atm. 
     251   nn_limflx = -1          !  LIM3 Multi-category heat flux formulation (use -1 if LIM3 is not used) 
     252                           !  =-1  Use per-category fluxes, bypass redistributor, forced mode only, not yet implemented coupled 
     253                           !  = 0  Average per-category fluxes (forced and coupled mode) 
     254                           !  = 1  Average and redistribute per-category fluxes, forced mode only, not yet implemented coupled 
     255                           !  = 2  Redistribute a single flux over categories (coupled mode only) 
    252256/ 
    253257!----------------------------------------------------------------------- 
    … …  
    305309 
    306310   cn_dir      = './'      !  root directory for the location of the bulk files 
    307    ln_2m       = .false.   !  air temperature and humidity referenced at 2m (T) instead 10m (F) 
    308311   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data 
    309    ln_bulk2z   = .false.   !  Air temperature/humidity and wind vectors are referenced at heights rn_zqt and rn_zu 
    310    rn_zqt      = 3.        !  Air temperature and humidity reference height (m) (ln_bulk2z) 
    311    rn_zu       = 4.        !  Wind vector reference height (m)                  (ln_bulk2z) 
     312   rn_zqt      = 10.        !  Air temperature and humidity reference height (m) 
     313   rn_zu       = 10.        !  Wind vector reference height (m)                  
    312314   rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow) 
    313315   rn_efac     = 1.        !  multiplicative factor for evaporation (0. or 1.) 
    … …  
    336338!                    !                       ! categories !  reference  !    orientation       ! grids  ! 
    337339! send 
    338 sn_snd_temp   =       'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   '' 
    339 sn_snd_alb    =       'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   '' 
    340 sn_snd_thick  =       'none'                 ,    'no'   ,     ''      ,         ''           ,   '' 
    341 sn_snd_crt    =       'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T' 
    342 sn_snd_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''           ,   '' 
     340   sn_snd_temp   =       'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   '' 
     341   sn_snd_alb    =       'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   '' 
     342   sn_snd_thick  =       'none'                 ,    'no'   ,     ''      ,         ''           ,   '' 
     343   sn_snd_crt    =       'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T' 
     344   sn_snd_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''           ,   '' 
    343345! receive 
    344 sn_rcv_w10m   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   '' 
    345 sn_rcv_taumod =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
    346 sn_rcv_tau    =       'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V' 
    347 sn_rcv_dqnsdt =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
    348 sn_rcv_qsr    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   '' 
    349 sn_rcv_qns    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   '' 
    350 sn_rcv_emp    =       'conservative'         ,    'no'    ,     ''      ,         ''          ,   '' 
    351 sn_rcv_rnf    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
    352 sn_rcv_cal    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
    353 sn_rcv_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     346   sn_rcv_w10m   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   '' 
     347   sn_rcv_taumod =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     348   sn_rcv_tau    =       'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V' 
     349   sn_rcv_dqnsdt =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     350   sn_rcv_qsr    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   '' 
     351   sn_rcv_qns    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   '' 
     352   sn_rcv_emp    =       'conservative'         ,    'no'    ,     ''      ,         ''          ,   '' 
     353   sn_rcv_rnf    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     354   sn_rcv_cal    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     355   sn_rcv_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     356! 
     357   nn_cplmodel   =     1     !  Maximum number of models to/from which NEMO is potentialy sending/receiving data 
     358   ln_usecplmask = .false.   !  use a coupling mask file to merge data received from several models 
     359                             !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
    354360/ 
    355361!----------------------------------------------------------------------- 
    … …  
    659665!!   nameos        equation of state 
    660666!!   namtra_adv    advection scheme 
     667!!   namtra_adv_mle   mixed layer eddy param. (Fox-Kemper param.) 
    661668!!   namtra_ldf    lateral diffusion scheme 
    662669!!   namtra_dmp    T & S newtonian damping 
    … …  
    666673&nameos        !   ocean physical parameters 
    667674!----------------------------------------------------------------------- 
    668    nn_eos      =   0       !  type of equation of state and Brunt-Vaisala frequency 
    669                            !     = 0, UNESCO (formulation of Jackett and McDougall (1994) and of McDougall (1987) ) 
    670                            !     = 1, linear: rho(T)   = rau0 * ( 1.028 - ralpha * T ) 
    671                            !     = 2, linear: rho(T,S) = rau0 * ( rbeta * S - ralpha * T ) 
    672    rn_alpha    =   2.0e-4  !  thermal expension coefficient (nn_eos= 1 or 2) 
    673    rn_beta     =   7.7e-4  !  saline  expension coefficient (nn_eos= 2) 
     675   nn_eos      =  -1     !  type of equation of state and Brunt-Vaisala frequency 
     676                                 !  =-1, TEOS-10  
     677                                 !  = 0, EOS-80  
     678                                 !  = 1, S-EOS   (simplified eos) 
     679   ln_useCT    = .true.  ! use of Conservative Temp. ==> surface CT converted in Pot. Temp. in sbcssm 
     680   !                             ! 
     681   !                     ! S-EOS coefficients : 
     682   !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     683   rn_a0       =  1.6550e-1      !  thermal expension coefficient (nn_eos= 1) 
     684   rn_b0       =  7.6554e-1      !  saline  expension coefficient (nn_eos= 1) 
     685   rn_lambda1  =  5.9520e-2      !  cabbeling coeff in T^2  (=0 for linear eos) 
     686   rn_lambda2  =  7.4914e-4      !  cabbeling coeff in S^2  (=0 for linear eos) 
     687   rn_mu1      =  1.4970e-4      !  thermobaric coeff. in T (=0 for linear eos) 
     688   rn_mu2      =  1.1090e-5      !  thermobaric coeff. in S (=0 for linear eos) 
     689   rn_nu       =  2.4341e-3      !  cabbeling coeff in T*S  (=0 for linear eos) 
    674690/ 
    675691!----------------------------------------------------------------------- 
    676692&namtra_adv    !   advection scheme for tracer 
    677693!----------------------------------------------------------------------- 
    678    ln_traadv_cen2   =  .false.  !  2nd order centered scheme 
    679    ln_traadv_tvd    =  .true.   !  TVD scheme 
    680    ln_traadv_muscl  =  .false.  !  MUSCL scheme 
    681    ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries 
    682    ln_traadv_ubs    =  .false.  !  UBS scheme 
    683    ln_traadv_qck    =  .false.  !  QUICKEST scheme 
    684    ln_traadv_msc_ups=  .false.  !  use upstream scheme within muscl 
     694   ln_traadv_cen2   =  .false.   !  2nd order centered scheme 
     695   ln_traadv_tvd    =  .true.    !  TVD scheme 
     696   ln_traadv_muscl  =  .false.   !  MUSCL scheme 
     697   ln_traadv_muscl2 =  .false.   !  MUSCL2 scheme + cen2 at boundaries 
     698   ln_traadv_ubs    =  .false.   !  UBS scheme 
     699   ln_traadv_qck    =  .false.   !  QUICKEST scheme 
     700   ln_traadv_msc_ups=  .false.   !  use upstream scheme within muscl 
    685701/ 
    686702!----------------------------------------------------------------------- 
    … …  
    938954!!                  ***  Miscellaneous namelists  *** 
    939955!!====================================================================== 
     956!!   namsol            elliptic solver / island / free surface 
    940957!!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi) 
    941958!!   namctl            Control prints & Benchmark 
    942 !!   namsol            elliptic solver / island / free surface 
     959!!   namc1d            1D configuration options                         ("key_c1d") 
     960!!   namc1d_uvd        data: U & V currents                             ("key_c1d") 
     961!!   namc1d_dyndmp     U & V newtonian damping                          ("key_c1d") 
    943962!!====================================================================== 
    944963! 
    … …  
    9991018   ln_dyndmp   =  .false.  !  add a damping term (T) or not (F) 
    10001019/ 
     1020 
    10011021!!====================================================================== 
    10021022!!                  ***  Diagnostics namelists  *** 
    10031023!!====================================================================== 
    10041024!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4") 
    1005 !!   namtrd       dynamics and/or tracer trends                         ("key_trddyn","key_trdtra","key_trdmld") 
     1025!!   namtrd       dynamics and/or tracer trends 
    10061026!!   namflo       float parameters                                      ("key_float") 
    10071027!!   namptr       Poleward Transport Diagnostics 
    … …  
    10211041/ 
    10221042!----------------------------------------------------------------------- 
    1023 &namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra") 
    1024 !              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor") 
    1025 !----------------------------------------------------------------------- 
    1026    nn_trd      = 365       !  time step frequency dynamics and tracers trends 
    1027    nn_ctls     =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk) 
    1028    rn_ucf      =   1.      !  unit conversion factor (=1 -> /seconds ; =86400. -> /day) 
    1029    cn_trdrst_in      = "restart_mld"   ! suffix of ocean restart name (input) 
    1030    cn_trdrst_out     = "restart_mld"   ! suffix of ocean restart name (output) 
    1031    ln_trdmld_restart = .false.         !  restart for ML diagnostics 
    1032    ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S 
    1033 / 
     1043&namtrd        !   diagnostics on dynamics and/or tracer trends 
     1044!              !       and/or mixed-layer trends and/or barotropic vorticity 
     1045!----------------------------------------------------------------------- 
     1046   ln_glo_trd  = .false.   ! (T) global domain averaged diag for T, T^2, KE, and PE 
     1047   ln_dyn_trd  = .false.   ! (T) 3D momentum trend output 
     1048   ln_dyn_mxl  = .FALSE.   ! (T) 2D momentum trends averaged over the mixed layer (not coded yet) 
     1049   ln_vor_trd  = .FALSE.   ! (T) 2D barotropic vorticity trends (not coded yet) 
     1050   ln_KE_trd   = .false.   ! (T) 3D Kinetic   Energy     trends 
     1051   ln_PE_trd   = .false.   ! (T) 3D Potential Energy     trends 
     1052   ln_tra_trd  = .FALSE.   ! (T) 3D tracer trend output 
     1053   ln_tra_mxl  = .false.   ! (T) 2D tracer trends averaged over the mixed layer (not coded yet) 
     1054   nn_trd      = 365       !  print frequency (ln_glo_trd=T) (unit=time step) 
     1055/ 
     1056!!gm   nn_ctls     =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk) 
     1057!!gm   rn_ucf      =   1.      !  unit conversion factor (=1 -> /seconds ; =86400. -> /day) 
     1058!!gm   cn_trdrst_in      = "restart_mld"   ! suffix of ocean restart name (input) 
     1059!!gm   cn_trdrst_out     = "restart_mld"   ! suffix of ocean restart name (output) 
     1060!!gm   ln_trdmld_restart = .false.         !  restart for ML diagnostics 
     1061!!gm   ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S 
     1062!!gm 
    10341063!----------------------------------------------------------------------- 
    10351064&namflo       !   float parameters                                      ("key_float") 

  • branches/2014/dev_CNRS_CICE/NEMOGCM/CONFIG/cfg.txt

    r4927 r4933  
    11GYRE_PISCES OPA_SRC TOP_SRC 
    22ORCA2_LIM_CFC_C14b OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 
    3 GYRE OPA_SRC 
    43GYRE_XIOS OPA_SRC 
    5 ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC 
    64ORCA2_SAS_LIM OPA_SRC SAS_SRC LIM_SRC_2 NST_SRC 
    75C1D_PAPA OPA_SRC 
    86ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 
     7GYRE_BFM OPA_SRC TOP_SRC 
    98AMM12 OPA_SRC 
    10 GYRE_BFM OPA_SRC TOP_SRC 
     9ORCA2_LIM3 OPA_SRC LIM_SRC_3 NST_SRC 
     10ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC 
    1111ORCA2_LIM_PISCES OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 
    12 ORCA2_LIM3 OPA_SRC LIM_SRC_3 NST_SRC 
     12GYRE OPA_SRC 

  • branches/2014/dev_CNRS_CICE/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90

    r3625 r4933  
    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_CICE/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90

    r4624 r4933  
    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_CICE/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90

    r4306 r4933  
    3030   USE sbc_oce          ! surface boundary condition: ocean 
    3131   USE sbccpl 
    32    USE cpl_oasis3, ONLY : lk_cpl 
    3332   USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass  
    3433   USE albedo           ! albedo parameters 
    … …  
    9796      !!              - emp     : freshwater budget: mass flux  
    9897      !!              - sfx     : freshwater budget: salt flux due to Freezing/Melting 
    99       !!              - utau    : sea surface i-stress (ocean referential) 
    100       !!              - vtau    : sea surface j-stress (ocean referential) 
    10198      !!              - fr_i    : ice fraction 
    10299      !!              - tn_ice  : sea-ice surface temperature 
    103       !!              - alb_ice : sea-ice alberdo (lk_cpl=T) 
     100      !!              - alb_ice : sea-ice albedo (lk_cpl=T) 
    104101      !! 
    105102      !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. 
    … …  
    183180 
    184181            !   computation the solar flux at ocean surface 
    185 #if defined key_coupled  
    186             zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 
    187 #else 
    188             zqsr = pfrld(ji,jj) * qsr(ji,jj)  + ( 1.  - pfrld(ji,jj) ) * fstric(ji,jj) 
    189 #endif             
     182            IF( lk_cpl ) THEN 
     183               zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 
     184            ELSE 
     185               zqsr = pfrld(ji,jj) * qsr(ji,jj)  + ( 1.  - pfrld(ji,jj) ) * fstric(ji,jj) 
     186            ENDIF 
    190187            !  computation the non solar heat flux at ocean surface 
    191188            zqns    =  - ( 1. - thcm(ji,jj) ) * zqsr                                              &   ! part of the solar energy used in leads 
    … …  
    206203            ! 
    207204            ! mass flux at the ocean-atmosphere interface (open ocean fraction = leads area) 
    208 #if defined key_coupled 
    209205            !                                                  ! coupled mode:  
    210             zemp = + emp_tot(ji,jj)                            &     ! net mass flux over the grid cell (ice+ocean area) 
    211                &   - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )          ! minus the mass flux intercepted by sea-ice 
    212 #else 
    213             !                                                  ! forced  mode:  
    214             zemp = + emp(ji,jj)     *         frld(ji,jj)      &     ! mass flux over open ocean fraction  
    215                &   - tprecip(ji,jj) * ( 1. -  frld(ji,jj) )    &     ! liquid precip. over ice reaches directly the ocean 
    216                &   + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )          ! snow is intercepted by sea-ice (previous frld) 
    217 #endif             
     206            IF( lk_cpl ) THEN 
     207               zemp = + emp_tot(ji,jj)                            &     ! net mass flux over the grid cell (ice+ocean area) 
     208                  &   - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )          ! minus the mass flux intercepted by sea-ice 
     209            ELSE 
     210               !                                                  ! forced  mode:  
     211               zemp = + emp(ji,jj)     *         frld(ji,jj)      &     ! mass flux over open ocean fraction  
     212                  &   - tprecip(ji,jj) * ( 1. -  frld(ji,jj) )    &     ! liquid precip. over ice reaches directly the ocean 
     213                  &   + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )          ! snow is intercepted by sea-ice (previous frld) 
     214            ENDIF 
    218215            ! 
    219216            ! mass flux at the ocean/ice interface (sea ice fraction) 
    … …  
    259256      !-----------------------------------------------! 
    260257 
    261 #if defined key_coupled 
    262       tn_ice(:,:,1) = sist(:,:)          ! sea-ice surface temperature        
    263       ht_i(:,:,1) = hicif(:,:) 
    264       ht_s(:,:,1) = hsnif(:,:) 
    265       a_i(:,:,1) = fr_i(:,:) 
    266       !                                  ! Computation of snow/ice and ocean albedo 
    267       CALL albedo_ice( tn_ice, ht_i, ht_s, zalbp, zalb ) 
    268       alb_ice(:,:,1) =  0.5 * ( zalbp(:,:,1) + zalb (:,:,1) )   ! Ice albedo (mean clear and overcast skys) 
    269       CALL iom_put( "icealb_cea", alb_ice(:,:,1) * fr_i(:,:) )  ! ice albedo 
    270 #endif 
     258      IF( lk_cpl) THEN 
     259         tn_ice(:,:,1) = sist(:,:)          ! sea-ice surface temperature        
     260         ht_i(:,:,1) = hicif(:,:) 
     261         ht_s(:,:,1) = hsnif(:,:) 
     262         a_i(:,:,1) = fr_i(:,:) 
     263         !                                  ! Computation of snow/ice and ocean albedo 
     264         CALL albedo_ice( tn_ice, ht_i, ht_s, zalbp, zalb ) 
     265         alb_ice(:,:,1) =  0.5 * ( zalbp(:,:,1) + zalb (:,:,1) )   ! Ice albedo (mean clear and overcast skys) 
     266         CALL iom_put( "icealb_cea", alb_ice(:,:,1) * fr_i(:,:) )  ! ice albedo 
     267      ENDIF 
    271268 
    272269      IF(ln_ctl) THEN            ! control print 
    273270         CALL prt_ctl(tab2d_1=qsr   , clinfo1=' lim_sbc: qsr    : ', tab2d_2=qns   , clinfo2=' qns     : ') 
    274271         CALL prt_ctl(tab2d_1=emp   , clinfo1=' lim_sbc: emp    : ', tab2d_2=sfx   , clinfo2=' sfx     : ') 
    275          CALL prt_ctl(tab2d_1=utau  , clinfo1=' lim_sbc: utau   : ', mask1=umask,   & 
    276             &         tab2d_2=vtau  , clinfo2=' vtau    : '        , mask2=vmask ) 
    277272         CALL prt_ctl(tab2d_1=fr_i  , clinfo1=' lim_sbc: fr_i   : ', tab2d_2=tn_ice(:,:,1), clinfo2=' tn_ice  : ') 
    278273      ENDIF  

  • branches/2014/dev_CNRS_CICE/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90

    r4696 r4933  
    3333   USE limtab_2 
    3434   USE prtctl           ! Print control 
    35    USE cpl_oasis3, ONLY :   lk_cpl 
    3635   USE diaar5    , ONLY :   lk_diaar5 
    3736   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    … …  
    219218                         
    220219            !  partial computation of the lead energy budget (qldif) 
    221 #if defined key_coupled  
    222             qldif(ji,jj)   = tms(ji,jj) * rdt_ice                                                  & 
    223                &    * (   ( qsr_tot(ji,jj) - qsr_ice(ji,jj,1) * zfricp ) * ( 1.0 - thcm(ji,jj) )   & 
    224                &        + ( qns_tot(ji,jj) - qns_ice(ji,jj,1) * zfricp )                           & 
    225                &        + frld(ji,jj) * ( fdtcn(ji,jj) + ( 1.0 - zindb ) * fsbbq(ji,jj) )   ) 
    226 #else 
    227             qldif(ji,jj)   = tms(ji,jj) * rdt_ice * frld(ji,jj)                    & 
    228                &                        * (  qsr(ji,jj) * ( 1.0 - thcm(ji,jj) )    & 
    229                &                           + qns(ji,jj)  +  fdtcn(ji,jj)           & 
    230                &                           + ( 1.0 - zindb ) * fsbbq(ji,jj)      ) 
    231 #endif 
     220            IF( lk_cpl ) THEN  
     221               qldif(ji,jj)   = tms(ji,jj) * rdt_ice                                                  & 
     222                  &    * (   ( qsr_tot(ji,jj) - qsr_ice(ji,jj,1) * zfricp ) * ( 1.0 - thcm(ji,jj) )   & 
     223                  &        + ( qns_tot(ji,jj) - qns_ice(ji,jj,1) * zfricp )                           & 
     224                  &        + frld(ji,jj) * ( fdtcn(ji,jj) + ( 1.0 - zindb ) * fsbbq(ji,jj) )   ) 
     225            ELSE 
     226               qldif(ji,jj)   = tms(ji,jj) * rdt_ice * frld(ji,jj)                    & 
     227                  &                        * (  qsr(ji,jj) * ( 1.0 - thcm(ji,jj) )    & 
     228                  &                           + qns(ji,jj)  +  fdtcn(ji,jj)           & 
     229                  &                           + ( 1.0 - zindb ) * fsbbq(ji,jj)      ) 
     230            ENDIF 
    232231            !  parlat : percentage of energy used for lateral ablation (0.0)  
    233232            zfntlat        = 1.0 - MAX( rzero , SIGN( rone ,  - qldif(ji,jj) ) ) 
    … …  
    449448      zztmp = 1.0 / rdt_ice 
    450449      CALL iom_put( 'iceprod_cea' , hicifp (:,:) * zztmp     )   ! Ice produced               [m/s] 
     450      CALL iom_put( 'iiceconc'    , fr_i(:,:)                )   ! Ice concentration          [-] 
    451451      IF( lk_diaar5 ) THEN 
    452452         CALL iom_put( 'snowmel_cea' , rdm_snw(:,:) * zztmp     )   ! Snow melt                  [kg/m2/s] 

  • branches/2014/dev_CNRS_CICE/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90

    r4306 r4933  
    1818   USE ice_2 
    1919   USE limistate_2 
    20    USE cpl_oasis3, ONLY : lk_cpl 
     20   USE sbc_oce, ONLY : lk_cpl 
    2121   USE in_out_manager 
    2222   USE lib_mpp          ! MPP library 

  • branches/2014/dev_CNRS_CICE/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90

    r4927 r4933  
    7575 
    7676      ! 1/area 
    77       z1_area = 1.d0 / MAX( glob_sum( area(:,:) * tms(:,:) ), epsi06 ) 
     77      z1_area = 1._wp / MAX( glob_sum( area(:,:) * tms(:,:) ), epsi06 ) 
    7878 
    7979      zinda = MAX( 0._wp , SIGN( 1._wp , glob_sum( area(:,:) * tms(:,:) ) - epsi06 ) ) 
    … …  
    244244      ! 2 - initial conservation variables ! 
    245245      ! ---------------------------------- ! 
    246       !frc_vol = 0.d0                                           ! volume       trend due to forcing 
    247       !frc_sal = 0.d0                                           ! salt content   -    -   -    -          
    248       !bg_grme = 0.d0                                           ! ice growth + melt volume trend 
     246      !frc_vol = 0._wp                                          ! volume       trend due to forcing 
     247      !frc_sal = 0._wp                                          ! salt content   -    -   -    -          
     248      !bg_grme = 0._wp                                          ! ice growth + melt volume trend 
    249249      ! 
    250250      CALL lim_diahsb_rst( nstart, 'READ' )  !* read or initialize all required files 
    … …  
    280280           IF(lwp) WRITE(numout,*) ' lim_diahsb at initial state ' 
    281281           IF(lwp) WRITE(numout,*) '~~~~~~~' 
    282            frc_vol  = 0.d0                                            
    283            frc_sal  = 0.d0                                                   
    284            bg_grme  = 0.d0                                         
    285        ENDIF    
     282           frc_vol  = 0._wp                                           
     283           frc_sal  = 0._wp                                                  
     284           bg_grme  = 0._wp                                        
     285       ENDIF 
    286286 
    287287     ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file 

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

    r4333 r4933  
    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_CICE/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r4927 r4933  
    66   !! History :  2.0  ! 2004-01 (C. Ethe, G. Madec)  Original code 
    77   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation 
    8    !!             -   ! 2012    (C. Rousset) add par_oce (for jp_sal)...bug? 
     8   !!             -   ! 2014    (C. Rousset) add N/S initializations 
    99   !!---------------------------------------------------------------------- 
    1010#if defined key_lim3 
    … …  
    2929   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3030   USE wrk_nemo         ! work arrays 
    31    USE cpl_oasis3, ONLY : lk_cpl 
    3231 
    3332   IMPLICIT NONE 
    … …  
    3635   PUBLIC   lim_istate      ! routine called by lim_init.F90 
    3736 
    38    !! * Module variables 
    3937   !                          !!** init namelist (namiceini) ** 
    4038   REAL(wp) ::   thres_sst   ! threshold water temperature for initial sea ice 
    … …  
    5654   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5755   !!---------------------------------------------------------------------- 
    58  
    5956CONTAINS 
    6057 
    … …  
    8077      !! 
    8178      !! ** Notes   : o_i, t_su, t_s, t_i, s_i must be filled everywhere, even 
    82       !!              where there is no ice (clem: I do not know why but it is mandatory)  
     79      !!              where there is no ice (clem: I do not know why, is it mandatory?)  
    8380      !! 
    8481      !! History : 
    … …  
    116113      CALL lim_istate_init     !  reading the initials parameters of the ice 
    117114 
    118 # if defined key_coupled 
    119       albege(:,:)   = 0.8 * tms(:,:) 
    120 # endif 
    121  
    122115      ! surface temperature 
    123116      DO jl = 1, jpl ! loop over categories 
    … …  
    125118         tn_ice(:,:,jl) = rtt * tms(:,:) 
    126119      END DO 
    127       ! Basal temperature is set to the freezing point of seawater in Kelvin 
    128       t_bo(:,:) = ( tfreez( tsn(:,:,1,jp_sal) ) + rt0 ) * tms(:,:)  
     120 
     121      ! basal temperature (considered at freezing point) 
     122      t_bo(:,:) = ( eos_fzp( tsn(:,:,1,jp_sal) ) + rt0 ) * tms(:,:)  
    129123 
    130124      IF( ln_limini ) THEN 
    … …  
    133127      ! 2) Basal temperature, ice mask and hemispheric index 
    134128      !-------------------------------------------------------------------- 
    135       ! ice if sst <= t-freez + thres_sst 
    136       DO jj = 1, jpj                                        
     129 
     130      DO jj = 1, jpj                                       ! ice if sst <= t-freez + ttest 
    137131         DO ji = 1, jpi 
    138132            IF( ( tsn(ji,jj,1,jp_tem)  - ( t_bo(ji,jj) - rt0 ) ) * tms(ji,jj) >= thres_sst ) THEN  
    … …  
    146140 
    147141      ! Hemispheric index 
    148       ! MV 2011 new initialization 
    149142      DO jj = 1, jpj 
    150143         DO ji = 1, jpi 
    … …  
    156149         END DO 
    157150      END DO 
    158       ! END MV 2011 new initialization 
    159151 
    160152      !-------------------------------------------------------------------- 

  • branches/2014/dev_CNRS_CICE/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r4872 r4933  
    3232   USE sbc_oce          ! Surface boundary condition: ocean fields 
    3333   USE sbccpl 
    34    USE cpl_oasis3, ONLY : lk_cpl 
    35    USE oce       , ONLY : iatte, oatte, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 
     34   USE oce       , ONLY : fraqsr_1lev, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 
    3635   USE albedo           ! albedo parameters 
    3736   USE lbclnk           ! ocean lateral boundary condition - MPP exchanges 
    … …  
    9897      !!              - fr_i    : ice fraction 
    9998      !!              - tn_ice  : sea-ice surface temperature 
    100       !!              - alb_ice : sea-ice alberdo (lk_cpl=T) 
     99      !!              - alb_ice : sea-ice albedo (lk_cpl=T) 
    101100      !! 
    102101      !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. 
    103102      !!              Tartinville et al. 2001 Ocean Modelling, 3, 95-108. 
     103      !!              These refs are now obsolete since everything has been revised 
     104      !!              The ref should be Rousset et al., 2015? 
    104105      !!--------------------------------------------------------------------- 
    105       INTEGER, INTENT(in) ::   kt    ! number of iteration 
    106       ! 
    107       INTEGER  ::   ji, jj, jl, jk           ! dummy loop indices 
    108       REAL(wp) ::   zinda, zemp      ! local scalars 
    109       REAL(wp) ::   zf_mass         ! Heat flux associated with mass exchange ice->ocean (W.m-2) 
    110       REAL(wp) ::   zfcm1           ! New solar flux received by the ocean 
    111       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalbp     ! 2D/3D workspace 
     106      INTEGER, INTENT(in) ::   kt                                   ! number of iteration 
     107      ! 
     108      INTEGER  ::   ji, jj, jl, jk                                  ! dummy loop indices 
     109      ! 
     110      REAL(wp) ::   zinda, zemp                                     !  local scalars 
     111      REAL(wp) ::   zf_mass                                         ! Heat flux associated with mass exchange ice->ocean (W.m-2) 
     112      REAL(wp) ::   zfcm1                                           ! New solar flux received by the ocean 
     113      ! 
     114      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb_cs, zalb_os     ! 2D/3D workspace 
    112115      !!--------------------------------------------------------------------- 
    113        
    114       IF( lk_cpl )   CALL wrk_alloc( jpi, jpj, jpl, zalb, zalbp ) 
    115116 
    116117      ! make calls for heat fluxes before it is modified 
    … …  
    134135            ! Solar heat flux reaching the ocean = zfcm1 (W.m-2)  
    135136            !--------------------------------------------------- 
    136             IF( lk_cpl ) THEN ! be carfeful: not been tested yet 
    137                ! original line 
     137            IF( lk_cpl ) THEN  
     138               !!! LIM2 version zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 
    138139               zfcm1 = qsr_tot(ji,jj) 
    139                !!!zfcm1 = qsr_tot(ji,jj) + ftr_ice(ji,jj) * ( 1._wp - pfrld(ji,jj) ) / ( 1._wp - zinda + zinda * iatte(ji,jj) ) 
    140140               DO jl = 1, jpl 
    141                   zfcm1 = zfcm1 - ( qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) ) * a_i_b(ji,jj,jl) 
     141                  zfcm1 = zfcm1 + ( ftr_ice(ji,jj,jl) - qsr_ice(ji,jj,jl) ) * a_i_b(ji,jj,jl) 
    142142               END DO 
    143143            ELSE 
    144                !!!zfcm1   = pfrld(ji,jj) * qsr(ji,jj)  + & 
    145                !!!     &    ( 1._wp - pfrld(ji,jj) ) * ftr_ice(ji,jj) / ( 1._wp - zinda + zinda * iatte(ji,jj) ) 
     144               !!! LIM2 version zqsr = pfrld(ji,jj) * qsr(ji,jj)  + ( 1.  - pfrld(ji,jj) ) * fstric(ji,jj) 
    146145               zfcm1   = pfrld(ji,jj) * qsr(ji,jj) 
    147146               DO jl = 1, jpl 
    … …  
    217216 
    218217      !------------------------------------------------! 
    219       !    Computation of snow/ice and ocean albedo    ! 
     218      !    Snow/ice albedo (only if sent to coupler)   ! 
    220219      !------------------------------------------------! 
    221220      IF( lk_cpl ) THEN          ! coupled case 
    222          CALL albedo_ice( t_su, ht_i, ht_s, zalbp, zalb )                  ! snow/ice albedo 
    223          alb_ice(:,:,:) =  0.5_wp * zalbp(:,:,:) + 0.5_wp * zalb (:,:,:)   ! Ice albedo (mean clear and overcast skys) 
     221 
     222            CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 
     223 
     224            CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos 
     225 
     226            alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     227 
     228            CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 
     229 
    224230      ENDIF 
    225231 
    … …  
    231237         CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl ) 
    232238      ENDIF 
    233       ! 
    234       IF( lk_cpl )   CALL wrk_dealloc( jpi, jpj, jpl, zalb, zalbp ) 
    235       !  
     239 
    236240   END SUBROUTINE lim_sbc_flx 
    237241 
    … …  
    346350      ! clem modif 
    347351      IF( .NOT. ln_rstart ) THEN 
    348          iatte(:,:) = 1._wp 
    349          oatte(:,:) = 1._wp 
     352         fraqsr_1lev(:,:) = 1._wp 
    350353      ENDIF 
    351354      ! 

  • branches/2014/dev_CNRS_CICE/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r4872 r4933  
    2222   USE phycst         ! physical constants 
    2323   USE dom_oce        ! ocean space and time domain variables 
    24    USE oce     , ONLY :  iatte, oatte 
     24   USE oce     , ONLY : fraqsr_1lev  
    2525   USE ice            ! LIM: sea-ice variables 
    2626   USE par_ice        ! LIM: sea-ice parameters 
    … …  
    4343   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    4444   USE timing         ! Timing 
    45    USE cpl_oasis3, ONLY : lk_cpl 
    4645   USE limcons        ! conservation tests 
    4746 
    … …  
    6867      !!                ***  ROUTINE lim_thd  ***        
    6968      !!   
    70       !! ** Purpose : This routine manages the ice thermodynamic. 
     69      !! ** Purpose : This routine manages ice thermodynamics 
    7170      !!          
    7271      !! ** Action : - Initialisation of some variables 
    … …  
    7473      !!               at the ice base, snow acc.,heat budget of the leads) 
    7574      !!             - selection of the icy points and put them in an array 
    76       !!             - call lim_vert_ther for vert ice thermodynamic 
    77       !!             - back to the geographic grid 
    78       !!             - selection of points for lateral accretion 
    79       !!             - call lim_lat_acc  for the ice accretion 
     75      !!             - call lim_thd_dif  for vertical heat diffusion 
     76      !!             - call lim_thd_dh   for vertical ice growth and melt 
     77      !!             - call lim_thd_ent  for enthalpy remapping 
     78      !!             - call lim_thd_sal  for ice desalination 
     79      !!             - call lim_thd_temp to  retrieve temperature from ice enthalpy 
    8080      !!             - back to the geographic grid 
    8181      !!      
    82       !! ** References : H. Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90 
     82      !! ** References :  
    8383      !!--------------------------------------------------------------------- 
    8484      INTEGER, INTENT(in) ::   kt    ! number of iteration 
    … …  
    9393      ! 
    9494      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
     95      ! 
     96      REAL(wp), POINTER, DIMENSION(:,:) ::  zqsr, zqns 
    9597      !!------------------------------------------------------------------- 
     98      CALL wrk_alloc( jpi, jpj, zqsr, zqns ) 
     99 
    96100      IF( nn_timing == 1 )  CALL timing_start('limthd') 
    97101 
    … …  
    137141      !-----------------------------------------------------------------------------! 
    138142 
     143      !--- Ocean solar and non solar fluxes to be used in zqld 
     144      IF ( .NOT. lk_cpl ) THEN   ! --- forced case, fluxes to the lead are the same as over the ocean 
     145         ! 
     146         zqsr(:,:) = qsr(:,:)      ; zqns(:,:) = qns(:,:) 
     147         ! 
     148      ELSE                       ! --- coupled case, fluxes to the lead are total - intercepted 
     149         ! 
     150         zqsr(:,:) = qsr_tot(:,:)  ; zqns(:,:) = qns_tot(:,:) 
     151         ! 
     152         DO jl = 1, jpl 
     153            DO jj = 1, jpj 
     154               DO ji = 1, jpi 
     155                  zqsr(ji,jj) = zqsr(ji,jj) - qsr_ice(ji,jj,jl) * a_i_b(ji,jj,jl) 
     156                  zqns(ji,jj) = zqns(ji,jj) - qns_ice(ji,jj,jl) * a_i_b(ji,jj,jl) 
     157               END DO 
     158            END DO 
     159         END DO 
     160         ! 
     161      ENDIF 
     162 
    139163!CDIR NOVERRCHK 
    140164      DO jj = 1, jpj 
    … …  
    149173            !           !  temperature and turbulent mixing (McPhee, 1992) 
    150174            ! 
     175 
    151176            ! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- ! 
    152             zqld =  tms(ji,jj) * rdt_ice *                                       & 
    153                &  ( pfrld(ji,jj)         * ( qsr(ji,jj) * oatte(ji,jj)           &   ! solar heat + clem modif 
    154                &                           + qns(ji,jj) )                        &   ! non solar heat 
    155                ! latent heat of precip (note that precip is included in qns but not in qns_ice) 
    156                &    + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj)         & 
    157                &    * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )    & 
    158                &    + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) )  & 
    159                &    * rcp * ( tatm_ice(ji,jj) - rtt ) ) 
     177            ! REMARK valid at least in forced mode from clem 
     178            ! precip is included in qns but not in qns_ice 
     179            IF ( lk_cpl ) THEN 
     180               zqld =  tms(ji,jj) * rdt_ice *  & 
     181                  &    (   zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj)               &   ! pfrld already included in coupled mode 
     182                  &    + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj)  *     &   ! heat content of precip 
     183                  &      ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )   & 
     184                  &    + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) ) 
     185            ELSE 
     186               zqld =  tms(ji,jj) * rdt_ice *  & 
     187                  &      ( pfrld(ji,jj) * ( zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj) )    & 
     188                  &    + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj)  *             &  ! heat content of precip 
     189                  &      ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )           & 
     190                  &    + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) ) 
     191            ENDIF 
    160192 
    161193            !-- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 
    … …  
    187219            hfx_in(ji,jj) = hfx_in(ji,jj)                                                                                         &  
    188220               ! heat flux above the ocean 
    189                &    +             pfrld(ji,jj)   * ( qns(ji,jj) + qsr(ji,jj) )                                                    & 
     221               &    +             pfrld(ji,jj)   * ( zqns(ji,jj) + zqsr(ji,jj) )                                                  & 
    190222               ! latent heat of precip (note that precip is included in qns but not in qns_ice) 
    191223               &    +   ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  & 
    … …  
    198230            !     Second step in limthd_dh      :  heat remaining if total melt (zq_rema)  
    199231            !     Third  step in limsbc         :  heat from ice-ocean mass exchange (zf_mass) + solar 
    200             hfx_out(ji,jj) = hfx_out(ji,jj)                                                                                   &  
     232            hfx_out(ji,jj) = hfx_out(ji,jj)                                                                                       &  
    201233               ! Non solar heat flux received by the ocean 
    202                &    +        pfrld(ji,jj) * qns(ji,jj)                                                                        & 
     234               &    +        pfrld(ji,jj) * qns(ji,jj)                                                                            & 
    203235               ! latent heat of precip (note that precip is included in qns but not in qns_ice) 
    204                &    +      ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj)                                            & 
    205                &    * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )                                            & 
    206                &    +      ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt )   & 
     236               &    +      ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj)       & 
     237               &         * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  & 
     238               &    +      ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt )       & 
    207239               ! heat flux taken from the ocean where there is open water ice formation 
    208                &    -      qlead(ji,jj) * r1_rdtice                                                                           & 
     240               &    -      qlead(ji,jj) * r1_rdtice                                                                               & 
    209241               ! heat flux taken from the ocean during bottom growth/melt (fhld should be 0 while bott growth) 
    210                &    -      at_i(ji,jj) * fhtur(ji,jj)                                                                         & 
     242               &    -      at_i(ji,jj) * fhtur(ji,jj)                                                                             & 
    211243               &    -      at_i(ji,jj) *  fhld(ji,jj) 
    212244 
    … …  
    309341            CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri         , jpi, jpj, npb(1:nbpb) ) 
    310342            CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res         , jpi, jpj, npb(1:nbpb) ) 
    311  
    312             CALL tab_2d_1d( nbpb, iatte_1d   (1:nbpb), iatte           , jpi, jpj, npb(1:nbpb) )  
    313             CALL tab_2d_1d( nbpb, oatte_1d   (1:nbpb), oatte           , jpi, jpj, npb(1:nbpb) )  
    314343 
    315344            CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd         , jpi, jpj, npb(1:nbpb) ) 
    … …  
    485514      ENDIF 
    486515      ! 
     516      ! 
     517      CALL wrk_dealloc( jpi, jpj, zqsr, zqns ) 
     518 
     519      ! 
    487520      ! conservation test 
    488521      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    489522      ! 
    490523      IF( nn_timing == 1 )  CALL timing_stop('limthd') 
     524 
    491525   END SUBROUTINE lim_thd  
    492526 
    … …  
    555589902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicethd in configuration namelist', lwp ) 
    556590      IF(lwm) WRITE ( numoni, namicethd ) 
     591 
     592      IF( lk_cpl .AND. parsub /= 0.0 )   CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' ) 
    557593      ! 
    558594      IF(lwp) THEN                          ! control print 

  • branches/2014/dev_CNRS_CICE/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

    r4873 r4933  
    2626   USE wrk_nemo       ! work arrays 
    2727   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    28    USE cpl_oasis3, ONLY : lk_cpl 
    2928    
    3029   IMPLICIT NONE 
    … …  
    169168         ztmelts       = zinda * rtt + ( 1._wp - zinda ) * rtt 
    170169 
    171          zfdum     = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji)  
    172          zf_tt(ji) = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji)  
     170         zfdum      = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji)  
     171         zf_tt(ji)  = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji)  
    173172 
    174173         zq_su (ji) = MAX( 0._wp, zfdum     * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - ztmelts ) ) 

  • branches/2014/dev_CNRS_CICE/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90

    r4873 r4933  
    2525   USE wrk_nemo       ! work arrays 
    2626   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    27    USE cpl_oasis3, ONLY : lk_cpl 
     27   USE sbc_oce, ONLY : lk_cpl 
    2828 
    2929   IMPLICIT NONE 
    … …  
    146146      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrid     ! tridiagonal system terms 
    147147      ! diag errors on heat 
    148       REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini 
    149       REAL(wp)                        :: zhfx_err 
     148      REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini, zhfx_err 
    150149      !!------------------------------------------------------------------      
    151150      !  
    … …  
    158157      CALL wrk_alloc( jpij, nlay_i+3, 3, ztrid ) 
    159158 
    160       CALL wrk_alloc( jpij, zdq, zq_ini ) 
     159      CALL wrk_alloc( jpij, zdq, zq_ini, zhfx_err ) 
    161160 
    162161      ! --- diag error on heat diffusion - PART 1 --- ! 
    … …  
    272271 
    273272      DO ji = kideb, kiut           ! Radiation transmitted below the ice 
    274          !!!ftr_ice_1d(ji) = ftr_ice_1d(ji) + iatte_1d(ji) * zradtr_i(ji,nlay_i) * a_i_1d(ji) / at_i_1d(ji) ! clem modif 
    275273         ftr_ice_1d(ji) = zradtr_i(ji,nlay_i)  
    276274      END DO 
    … …  
    408406         !------------------------------------------------------------------------------| 
    409407         ! 
    410          DO ji = kideb , kiut 
    411             ! update of the non solar flux according to the update in T_su 
    412             qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( t_su_1d(ji) - ztsubit(ji) ) 
    413  
     408         IF( .NOT. lk_cpl ) THEN   !--- forced atmosphere case 
     409            DO ji = kideb , kiut 
     410               ! update of the non solar flux according to the update in T_su 
     411               qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( t_su_1d(ji) - ztsubit(ji) ) 
     412            END DO 
     413         ENDIF 
     414 
     415         ! Update incoming flux 
     416         DO ji = kideb , kiut 
    414417            ! update incoming flux 
    415418            zf(ji)    =   zfsw(ji)              & ! net absorbed solar radiation 
    416                + qns_ice_1d(ji)                  ! non solar total flux  
     419               + qns_ice_1d(ji)                   ! non solar total flux  
    417420            ! (LWup, LWdw, SH, LH) 
    418421         END DO 
    … …  
    740743      CALL lim_thd_enmelt( kideb, kiut ) 
    741744 
    742       ! --- diag error on heat diffusion - PART 2 --- ! 
     745      ! --- diag conservation imbalance on heat diffusion - PART 2 --- ! 
    743746      DO ji = kideb, kiut 
    744747         zdq(ji)        = - zq_ini(ji) + ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) / REAL( nlay_i ) +  & 
    745748            &                              SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) / REAL( nlay_s ) ) 
    746          zhfx_err    = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice )  
    747          hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err * a_i_1d(ji) 
    748          ! --- correction of qns_ice and surface conduction flux --- ! 
    749          qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err  
    750          fc_su     (ji) = fc_su     (ji) - zhfx_err  
    751          ! --- Heat flux at the ice surface in W.m-2 --- ! 
     749         zhfx_err(ji)   = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice )  
     750         hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err(ji) * a_i_1d(ji) 
     751      END DO  
     752 
     753      ! diagnose external surface (forced case) or bottom (forced case) from heat conservation 
     754      IF( .NOT. lk_cpl ) THEN   ! --- forced case: qns_ice and fc_su are diagnosed 
     755         ! 
     756         DO ji = kideb, kiut 
     757            qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err(ji) 
     758            fc_su     (ji) = fc_su(ji)      - zhfx_err(ji) 
     759         END DO 
     760         ! 
     761      ELSE                      ! --- coupled case: ocean turbulent heat flux is diagnosed 
     762         ! 
     763         DO ji = kideb, kiut 
     764            fhtur_1d  (ji) = fhtur_1d(ji)   - zhfx_err(ji) 
     765         END DO 
     766         ! 
     767      ENDIF 
     768 
     769      ! --- compute diagnostic net heat flux at the surface of the snow-ice system (W.m2) 
     770      DO ji = kideb, kiut 
    752771         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
    753772         hfx_in (ii,ij) = hfx_in (ii,ij) + a_i_1d(ji) * ( qsr_ice_1d(ji) + qns_ice_1d(ji) ) 
    … …  
    763782      CALL wrk_dealloc( jpij, nlay_i+3, zindterm, zindtbis, zdiagbis ) 
    764783      CALL wrk_dealloc( jpij, nlay_i+3, 3, ztrid ) 
    765       CALL wrk_dealloc( jpij, zdq, zq_ini ) 
     784      CALL wrk_dealloc( jpij, zdq, zq_ini, zhfx_err ) 
    766785 
    767786   END SUBROUTINE lim_thd_dif 

  • branches/2014/dev_CNRS_CICE/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90

    r4873 r4933  
    112112      REAL(wp), POINTER, DIMENSION(:,:) ::   zsmv_i_1d ! 1-D version of smv_i 
    113113 
    114       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze_i_1d !: 1-D version of e_i 
     114      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze_i_1d   !: 1-D version of e_i 
    115115 
    116116      REAL(wp), POINTER, DIMENSION(:,:) ::   zvrel                   ! relative ice / frazil velocity 
    … …  
    133133                  !Energy of melting q(S,T) [J.m-3] 
    134134                  zindb = 1._wp - MAX(  0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) + epsi10 )  )   !0 if no ice and 1 if yes 
    135                   e_i(ji,jj,jk,jl) = zindb * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) ,  epsi10 ) ) * REAL( nlay_i, wp ) 
     135                  e_i(ji,jj,jk,jl) = zindb * e_i(ji,jj,jk,jl) & 
     136                      &   / ( area(ji,jj) * MAX( v_i(ji,jj,jl) ,  epsi10 ) ) * REAL( nlay_i, wp ) 
    136137                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac 
    137138               END DO 
    … …  
    478479               qh_i_old(ji,nlay_i+1) = ze_newice(ji) * zv_newfra 
    479480            ENDDO 
    480  
    481481            ! --- Ice enthalpy remapping --- ! 
    482482            CALL lim_thd_ent( 1, nbpac, ze_i_1d(1:nbpac,:,jl) )  

  • branches/2014/dev_CNRS_CICE/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90

    r4873 r4933  
    114114   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   s_i_new       !: Salinity of new ice at the bottom 
    115115 
    116    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   iatte_1d   !: attenuation coef of the input solar flux (unitless) 
    117    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   oatte_1d   !: attenuation coef of the input solar flux (unitless) 
    118  
    119116   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_s_1d   !: corresponding to the 2D var  t_s 
    120117   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_i_1d   !: corresponding to the 2D var  t_i 
    … …  
    148145         &      qsr_ice_1d (jpij) ,     & 
    149146         &      fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qns_ice_1d(jpij) ,     & 
    150          &      t_bo_1d   (jpij) , iatte_1d  (jpij) , oatte_1d (jpij) ,     & 
    151          &      hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij),     & 
     147         &      t_bo_1d   (jpij) ,                                          & 
     148         &      hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) ,     &  
    152149         &      hfx_dif_1d(jpij) ,hfx_opw_1d(jpij) , & 
    153150         &      hfx_thd_1d(jpij) , hfx_spr_1d(jpij) , & 

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

    r4624 r4933  
    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_CICE/NEMOGCM/NEMO/OOO_SRC/nemogcm.F90

    r4624 r4933  
    5454   USE icbini          ! handle bergs, initialisation 
    5555   USE icbstp          ! handle bergs, calving, themodynamics and transport 
    56 #if defined key_oasis3 
    5756   USE cpl_oasis3      ! OASIS3 coupling 
    58 #elif defined key_oasis4 
    59    USE cpl_oasis4      ! OASIS4 coupling (not working) 
    60 #endif 
    6157   USE lib_mpp         ! distributed memory computing 
    6258#if defined key_iomput 
    … …  
    166162#if defined key_iomput 
    167163      IF( Agrif_Root() ) THEN 
    168 # if defined key_oasis3 || defined key_oasis4 
    169          CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis 
    170          CALL xios_initialize( "oceanx",local_comm=ilocal_comm ) 
    171 # else 
    172          CALL  xios_initialize( "nemo",return_comm=ilocal_comm ) 
    173 # endif 
     164         IF( lk_cpl ) THEN 
     165            CALL cpl_init( ilocal_comm )                               ! nemo local communicator given by oasis 
     166            CALL xios_initialize( "oceanx",local_comm=ilocal_comm )    ! send nemo communicator to xios 
     167         ELSE 
     168            CALL  xios_initialize( "nemo",return_comm=ilocal_comm )    ! nemo local communicator given by xios 
     169         ENDIF 
     170      ENDIF 
    174171      ENDIF 
    175172      narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection 
    176173#else 
    177 # if defined key_oasis3 || defined key_oasis4 
    178       IF( Agrif_Root() ) THEN 
    179          CALL cpl_prism_init( ilocal_comm )                 ! nemo local communicator given by oasis 
    180       ENDIF 
    181       narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt) 
    182 # else 
    183       ilocal_comm = 0 
    184       narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt) 
    185 # endif 
     174      IF( lk_cpl ) THEN 
     175         IF( Agrif_Root() ) THEN 
     176            CALL cpl_init( ilocal_comm )                               ! nemo local communicator given by oasis 
     177         ENDIF 
     178         narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt) 
     179      ELSE 
     180         ilocal_comm = 0 
     181         narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt) 
     182      ENDIF 
    186183#endif 
    187184      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 ) 

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

    r4624 r4933  
    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_CICE/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90

    r4624 r4933  
    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_CICE/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90

    r4313 r4933  
    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_CICE/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90

    r4147 r4933  
    77   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module 
    88   !!            9.0  !  05-11  (V. Garnier) Surface pressure gradient organization 
    9    !!---------------------------------------------------------------------- 
    10 #if ! defined key_coupled 
    11   
     9   !!----------------------------------------------------------------------  
    1210   !!---------------------------------------------------------------------- 
    1311   !!   Only for ORCA2 ORCA1 and ORCA025 
    … …  
    2927 
    3028   PUBLIC dia_fwb    ! routine called by step.F90 
    31  
    32    LOGICAL, PUBLIC, PARAMETER ::   lk_diafwb = .TRUE.    !: fresh water budget flag 
    3329 
    3430   REAL(wp)               ::   a_fwf ,          & 
    … …  
    453449   END SUBROUTINE dia_fwb 
    454450 
    455 #else 
    456    !!---------------------------------------------------------------------- 
    457    !!   Default option :                                       Dummy Module 
    458    !!---------------------------------------------------------------------- 
    459    LOGICAL, PUBLIC, PARAMETER ::   lk_diafwb = .FALSE.    !: fresh water budget flag 
    460 CONTAINS 
    461    SUBROUTINE dia_fwb( kt )        ! Empty routine 
    462       WRITE(*,*) 'dia_fwb: : You should not have seen this print! error?', kt 
    463    END SUBROUTINE dia_fwb 
    464 #endif 
    465  
    466451   !!====================================================================== 
    467452END MODULE diafwb 

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

    r4624 r4933  
    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_CICE/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r4840 r4933  
    8888      INTEGER, DIMENSION(2) :: ierr 
    8989      !!---------------------------------------------------------------------- 
    90       ! 
    9190      ierr = 0 
    92       ! 
    9391      ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) ,     & 
    9492         &      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 
    … …  
    539538         ENDIF 
    540539 
    541 #if ! defined key_coupled  
    542          CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
    543             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    544          CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
    545             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    546          CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping"         , "Kg/m2/s",   &  ! erp * sn 
    547             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    548 #endif 
    549  
    550  
    551  
    552 #if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 )  
    553          CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
    554             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    555          CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
    556             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    557          CALL histdef( nid_T, "sosafldp", "Surface salt flux: Damping"         , "Kg/m2/s",   &  ! erp * sn 
    558             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    559 #endif 
     540         IF( .NOT. lk_cpl ) THEN 
     541            CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
     542               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     543            CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
     544               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     545            CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping"         , "Kg/m2/s",   &  ! erp * sn 
     546               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     547         ENDIF 
     548 
     549         IF( lk_cpl .AND. nn_ice <= 1 ) THEN 
     550            CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
     551               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     552            CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
     553               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     554            CALL histdef( nid_T, "sosafldp", "Surface salt flux: Damping"         , "Kg/m2/s",   &  ! erp * sn 
     555               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     556         ENDIF 
     557          
    560558         clmx ="l_max(only(x))"    ! max index on a period 
    561559         CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX  
    … …  
    572570#endif 
    573571 
    574 #if defined key_coupled  
    575 # if defined key_lim3 
    576          Must be adapted to LIM3 
    577 # endif  
    578 # if defined key_lim2 
    579          CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice 
    580             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    581          CALL histdef( nid_T,"soicealb" , "Ice Albedo"                         , "[0,1]"  ,   &  ! alb_ice 
    582             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    583 # endif  
    584 #endif  
     572         IF( lk_cpl .AND. nn_ice == 2 ) THEN 
     573            CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice 
     574               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     575            CALL histdef( nid_T,"soicealb" , "Ice Albedo"                         , "[0,1]"  ,   &  ! alb_ice 
     576               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     577         ENDIF 
    585578 
    586579         CALL histend( nid_T, snc4chunks=snc4set ) 
    … …  
    734727      ENDIF 
    735728 
    736 #if ! defined key_coupled 
    737       CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    738       CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    739       IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    740       CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    741 #endif 
    742 #if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 )  
    743       CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    744       CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
     729      IF( .NOT. lk_cpl ) THEN 
     730         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
     731         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    745732         IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    746       CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    747 #endif 
     733         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
     734      ENDIF 
     735      IF( lk_cpl .AND. nn_ice <= 1 ) THEN 
     736         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
     737         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
     738         IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
     739         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
     740      ENDIF 
    748741      zw2d(:,:) = FLOAT( nmln(:,:) ) * tmask(:,:,1) 
    749742      CALL histwrite( nid_T, "sobowlin", it, zw2d          , ndim_hT, ndex_hT )   ! ??? 
    … …  
    756749#endif 
    757750 
    758 #if defined key_coupled  
    759 # if defined key_lim3 
    760       Must be adapted for LIM3 
    761       CALL histwrite( nid_T, "soicetem", it, tn_ice        , ndim_hT, ndex_hT )   ! surf. ice temperature 
    762       CALL histwrite( nid_T, "soicealb", it, alb_ice       , ndim_hT, ndex_hT )   ! ice albedo 
    763 # endif 
    764 # if defined key_lim2 
    765       CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT )   ! surf. ice temperature 
    766       CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT )   ! ice albedo 
    767 # endif 
    768 #endif 
    769          ! Write fields on U grid 
     751      IF( lk_cpl .AND. nn_ice == 2 ) THEN 
     752         CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT )   ! surf. ice temperature 
     753         CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT )   ! ice albedo 
     754      ENDIF 
     755 
     756      ! Write fields on U grid 
    770757      CALL histwrite( nid_U, "vozocrtx", it, un            , ndim_U , ndex_U )    ! i-current 
    771758      IF( ln_traldf_gdia ) THEN 

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

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

    r4689 r4933  
    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/kg/K] 
    57    REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                    [kg.K/J] 
     51   REAL(wp), PUBLIC ::   rcp                         !: ocean specific heat           [J/Kelvin] 
     52   REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                    [Kelvin/J] 
    5853   REAL(wp), PUBLIC ::   r1_rau0_rcp                 !: = 1. / ( rau0 * rcp ) 
    5954 
    … …  
    6964#if defined key_lim3 || defined key_cice 
    7065   REAL(wp), PUBLIC ::   rhoic    =  917._wp         !: volumic mass of sea ice                               [kg/m3] 
    71    REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: thermal conductivity of fresh ice                     [W/m/K] 
    72    REAL(wp), PUBLIC ::   rcdsn    =    0.31_wp       !: thermal conductivity of snow                          [W/m/K]  
    73    REAL(wp), PUBLIC ::   cpic     = 2067.0_wp        !: specific heat for ice                                 [J/kg/K] 
     66   REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: thermal conductivity of fresh ice 
     67   REAL(wp), PUBLIC ::   rcdsn    =    0.31_wp       !: thermal conductivity of snow 
     68   REAL(wp), PUBLIC ::   cpic     = 2067.0_wp        !: specific heat for ice  
    7469   REAL(wp), PUBLIC ::   lsub     =    2.834e+6_wp   !: pure ice latent heat of sublimation                   [J/kg] 
    7570   REAL(wp), PUBLIC ::   lfus     =    0.334e+6_wp   !: latent heat of fusion of fresh ice                    [J/kg] 
    76    REAL(wp), PUBLIC ::   tmut     =    0.054_wp      !: decrease of seawater meltpoint with salinity          [degC/ppt] 
     71   REAL(wp), PUBLIC ::   tmut     =    0.054_wp      !: decrease of seawater meltpoint with salinity 
    7772   REAL(wp), PUBLIC ::   xlsn                        !: = lfus*rhosn (volumetric latent heat fusion of snow)  [J/m3] 
    7873#else 
    … …  
    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_CICE/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90

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

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

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

    r4624 r4933  
    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_CICE/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90

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

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

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

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

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

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

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

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

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

    r4328 r4933  
    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_CICE/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r4624 r4933  
    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_CICE/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90

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

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

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

    r4693 r4933  
    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 
    … …  
    134134#endif 
    135135                  IF( lk_lim3 ) THEN 
    136                      CALL iom_rstput( kt, nitrst, numrow, 'iatte'  , iatte     ) !clem modif 
    137                      CALL iom_rstput( kt, nitrst, numrow, 'oatte'  , oatte     ) !clem modif 
     136                     CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev'  , fraqsr_1lev     ) !clem modif 
    138137                  ENDIF 
    139138      IF( kt == nitrst ) THEN 
    140139         CALL iom_close( numrow )     ! close the restart file (only at last time step) 
    141          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. 
    142143      ENDIF 
    143144      ! 
    144145   END SUBROUTINE rst_write 
     146 
    145147 
    146148   SUBROUTINE rst_read_open 
    … …  
    156158      LOGICAL  ::   llok 
    157159      !!---------------------------------------------------------------------- 
    158  
    159       IF( numror .LE. 0 ) THEN 
     160      ! 
     161      IF( numror <= 0 ) THEN 
    160162         IF(lwp) THEN                                             ! Contol prints 
    161163            WRITE(numout,*) 
    … …  
    255257      ! 
    256258      IF( lk_lim3 ) THEN 
    257          CALL iom_get( numror, jpdom_autoglo, 'iatte' , iatte ) ! clem modif 
    258          CALL iom_get( numror, jpdom_autoglo, 'oatte' , oatte ) ! clem modif 
     259         CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev ) 
    259260      ENDIF 
    260261      ! 

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

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

    r4488 r4933  
    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_CICE/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r4806 r4933  
    22   !!====================================================================== 
    33   !!                    ***  MODULE cpl_oasis  *** 
    4    !! Coupled O/A : coupled ocean-atmosphere case using OASIS3 V. prism_2_4 
    5    !!               special case: NEMO OPA/LIM coupled to ECHAM5 
     4   !! Coupled O/A : coupled ocean-atmosphere case using OASIS3-MCT 
    65   !!===================================================================== 
    76   !! History :    
    … …  
    1514   !!   3.4  !  11-11  (C. Harris) Changes to allow mutiple category fields 
    1615   !!---------------------------------------------------------------------- 
     16   !!---------------------------------------------------------------------- 
     17   !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3 
     18   !!---------------------------------------------------------------------- 
     19   !!   cpl_init     : initialization of coupled mode communication 
     20   !!   cpl_define   : definition of grid and fields 
     21   !!   cpl_snd     : snd out fields in coupled mode 
     22   !!   cpl_rcv     : receive fields in coupled mode 
     23   !!   cpl_finalize : finalize the coupled mode communication 
     24   !!---------------------------------------------------------------------- 
    1725#if defined key_oasis3 
    18    !!---------------------------------------------------------------------- 
    19    !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3 
    20    !!---------------------------------------------------------------------- 
    21    !!   cpl_prism_init     : initialization of coupled mode communication 
    22    !!   cpl_prism_define   : definition of grid and fields 
    23    !!   cpl_prism_snd     : snd out fields in coupled mode 
    24    !!   cpl_prism_rcv     : receive fields in coupled mode 
    25    !!   cpl_prism_finalize : finalize the coupled mode communication 
    26    !!---------------------------------------------------------------------- 
    27    USE mod_prism_proto              ! OASIS3 prism module 
    28    USE mod_prism_def_partition_proto! OASIS3 prism module for partitioning 
    29    USE mod_prism_put_proto          ! OASIS3 prism module for snding 
    30    USE mod_prism_get_proto          ! OASIS3 prism module for receiving 
    31    USE mod_comprism_proto           ! OASIS3 prism module to get coupling frequency 
     26   USE mod_oasis                    ! OASIS3-MCT module 
     27#endif 
    3228   USE par_oce                      ! ocean parameters 
    3329   USE dom_oce                      ! ocean space and time domain 
    … …  
    3834   PRIVATE 
    3935 
    40    PUBLIC   cpl_prism_init 
    41    PUBLIC   cpl_prism_define 
    42    PUBLIC   cpl_prism_snd 
    43    PUBLIC   cpl_prism_rcv 
    44    PUBLIC   cpl_prism_freq 
    45    PUBLIC   cpl_prism_finalize 
    46  
    47    LOGICAL, PUBLIC, PARAMETER ::   lk_cpl = .TRUE.   !: coupled flag 
     36   PUBLIC   cpl_init 
     37   PUBLIC   cpl_define 
     38   PUBLIC   cpl_snd 
     39   PUBLIC   cpl_rcv 
     40   PUBLIC   cpl_freq 
     41   PUBLIC   cpl_finalize 
     42 
    4843   INTEGER, PUBLIC            ::   OASIS_Rcv  = 1    !: return code if received field 
    4944   INTEGER, PUBLIC            ::   OASIS_idle = 0    !: return code if nothing done by oasis 
    50    INTEGER                    ::   ncomp_id          ! id returned by prism_init_comp 
     45   INTEGER                    ::   ncomp_id          ! id returned by oasis_init_comp 
    5146   INTEGER                    ::   nerror            ! return error code 
    52  
    53    INTEGER, PARAMETER ::   nmaxfld=40    ! Maximum number of coupling fields 
     47#if ! defined key_oasis3 
     48   ! OASIS Variables not used. defined only for compilation purpose 
     49   INTEGER                    ::   OASIS_Out         = -1 
     50   INTEGER                    ::   OASIS_REAL        = -1 
     51   INTEGER                    ::   OASIS_Ok          = -1 
     52   INTEGER                    ::   OASIS_In          = -1 
     53   INTEGER                    ::   OASIS_Sent        = -1 
     54   INTEGER                    ::   OASIS_SentOut     = -1 
     55   INTEGER                    ::   OASIS_ToRest      = -1 
     56   INTEGER                    ::   OASIS_ToRestOut   = -1 
     57   INTEGER                    ::   OASIS_Recvd       = -1 
     58   INTEGER                    ::   OASIS_RecvOut     = -1 
     59   INTEGER                    ::   OASIS_FromRest    = -1 
     60   INTEGER                    ::   OASIS_FromRestOut = -1 
     61#endif 
     62 
     63   INTEGER, PARAMETER ::   nmaxfld=40        ! Maximum number of coupling fields 
     64   INTEGER, PARAMETER ::   nmaxcat=5    ! Maximum number of coupling fields 
     65   INTEGER, PARAMETER ::   nmaxcpl=5    ! Maximum number of coupling fields 
    5466    
    5567   TYPE, PUBLIC ::   FLD_CPL               !: Type for coupling field information 
    … …  
    5870      CHARACTER(len = 1)    ::   clgrid    ! Grid type   
    5971      REAL(wp)              ::   nsgn      ! Control of the sign change 
    60       INTEGER, DIMENSION(9) ::   nid       ! Id of the field (no more than 9 categories) 
     72      INTEGER, DIMENSION(nmaxcat,nmaxcpl) ::   nid   ! Id of the field (no more than 9 categories and 9 extrena models) 
    6173      INTEGER               ::   nct       ! Number of categories in field 
     74      INTEGER               ::   ncplmodel ! Maximum number of models to/from which this variable may be sent/received 
    6275   END TYPE FLD_CPL 
    6376 
    … …  
    7386CONTAINS 
    7487 
    75    SUBROUTINE cpl_prism_init( kl_comm ) 
     88   SUBROUTINE cpl_init( kl_comm ) 
    7689      !!------------------------------------------------------------------- 
    77       !!             ***  ROUTINE cpl_prism_init  *** 
     90      !!             ***  ROUTINE cpl_init  *** 
    7891      !! 
    7992      !! ** Purpose :   Initialize coupled mode communication for ocean 
    … …  
    89102 
    90103      !------------------------------------------------------------------ 
    91       ! 1st Initialize the PRISM system for the application 
     104      ! 1st Initialize the OASIS system for the application 
    92105      !------------------------------------------------------------------ 
    93       CALL prism_init_comp_proto ( ncomp_id, 'oceanx', nerror ) 
    94       IF ( nerror /= PRISM_Ok ) & 
    95          CALL prism_abort_proto (ncomp_id, 'cpl_prism_init', 'Failure in prism_init_comp_proto') 
     106      CALL oasis_init_comp ( ncomp_id, 'oceanx', nerror ) 
     107      IF ( nerror /= OASIS_Ok ) & 
     108         CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp') 
    96109 
    97110      !------------------------------------------------------------------ 
    … …  
    99112      !------------------------------------------------------------------ 
    100113 
    101       CALL prism_get_localcomm_proto ( kl_comm, nerror ) 
    102       IF ( nerror /= PRISM_Ok ) & 
    103          CALL prism_abort_proto (ncomp_id, 'cpl_prism_init','Failure in prism_get_localcomm_proto' ) 
    104       ! 
    105    END SUBROUTINE cpl_prism_init 
    106  
    107  
    108    SUBROUTINE cpl_prism_define( krcv, ksnd ) 
     114      CALL oasis_get_localcomm ( kl_comm, nerror ) 
     115      IF ( nerror /= OASIS_Ok ) & 
     116         CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' ) 
     117      ! 
     118   END SUBROUTINE cpl_init 
     119 
     120 
     121   SUBROUTINE cpl_define( krcv, ksnd, kcplmodel ) 
    109122      !!------------------------------------------------------------------- 
    110       !!             ***  ROUTINE cpl_prism_define  *** 
     123      !!             ***  ROUTINE cpl_define  *** 
    111124      !! 
    112125      !! ** Purpose :   Define grid and field information for ocean 
    … …  
    116129      !!-------------------------------------------------------------------- 
    117130      INTEGER, INTENT(in) ::   krcv, ksnd     ! Number of received and sent coupling fields 
     131      INTEGER, INTENT(in) ::   kcplmodel      ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
    118132      ! 
    119133      INTEGER :: id_part 
    120134      INTEGER :: paral(5)       ! OASIS3 box partition 
    121135      INTEGER :: ishape(2,2)    ! shape of arrays passed to PSMILe 
    122       INTEGER :: ji,jc          ! local loop indicees 
    123       CHARACTER(LEN=8) :: zclname 
     136      INTEGER :: ji,jc,jm       ! local loop indicees 
     137      CHARACTER(LEN=64) :: zclname 
     138      CHARACTER(LEN=2) :: cli2 
    124139      !!-------------------------------------------------------------------- 
    125140 
    126141      IF(lwp) WRITE(numout,*) 
    127       IF(lwp) WRITE(numout,*) 'cpl_prism_define : initialization in coupled ocean/atmosphere case' 
     142      IF(lwp) WRITE(numout,*) 'cpl_define : initialization in coupled ocean/atmosphere case' 
    128143      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~' 
    129144      IF(lwp) WRITE(numout,*) 
    130145 
     146      IF( kcplmodel > nmaxcpl ) THEN 
     147         CALL oasis_abort ( ncomp_id, 'cpl_define', 'kcplmodel is larger than nmaxcpl, increase nmaxcpl')   ;   RETURN 
     148      ENDIF 
    131149      ! 
    132150      ! ... Define the shape for the area that excludes the halo 
    … …  
    141159      ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror) 
    142160      IF( nerror > 0 ) THEN 
    143          CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in allocating exfld')   ;   RETURN 
     161         CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld')   ;   RETURN 
    144162      ENDIF 
    145163      ! 
    … …  
    161179      ENDIF 
    162180       
    163       CALL prism_def_partition_proto ( id_part, paral, nerror ) 
     181      CALL oasis_def_partition ( id_part, paral, nerror ) 
    164182      ! 
    165183      ! ... Announce send variables.  
    166184      ! 
     185      ssnd(:)%ncplmodel = kcplmodel 
     186      ! 
    167187      DO ji = 1, ksnd 
    168          IF ( ssnd(ji)%laction ) THEN  
     188         IF ( ssnd(ji)%laction ) THEN 
     189 
     190            IF( ssnd(ji)%nct > nmaxcat ) THEN 
     191               CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '//   & 
     192                  &              TRIM(ssnd(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' ) 
     193               RETURN 
     194            ENDIF 
     195             
    169196            DO jc = 1, ssnd(ji)%nct 
    170                IF ( ssnd(ji)%nct .gt. 1 ) THEN 
    171                   WRITE(zclname,'( a7, i1)') ssnd(ji)%clname,jc 
    172                ELSE 
    173                   zclname=ssnd(ji)%clname 
    174                ENDIF 
    175                WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_Out 
    176                CALL prism_def_var_proto (ssnd(ji)%nid(jc), zclname, id_part, (/ 2, 0/),   & 
    177                     PRISM_Out, ishape, PRISM_REAL, nerror) 
    178                IF ( nerror /= PRISM_Ok ) THEN 
    179                   WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 
    180                   CALL prism_abort_proto ( ssnd(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var') 
    181                ENDIF 
     197               DO jm = 1, kcplmodel 
     198 
     199                  IF ( ssnd(ji)%nct .GT. 1 ) THEN 
     200                     WRITE(cli2,'(i2.2)') jc 
     201                     zclname = TRIM(ssnd(ji)%clname)//'_cat'//cli2 
     202                  ELSE 
     203                     zclname = ssnd(ji)%clname 
     204                  ENDIF 
     205                  IF ( kcplmodel  > 1 ) THEN 
     206                     WRITE(cli2,'(i2.2)') jm 
     207                     zclname = 'model'//cli2//'_'//TRIM(zclname) 
     208                  ENDIF 
     209#if defined key_agrif 
     210                  IF( agrif_fixed() /= 0 ) THEN  
     211                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 
     212                  END IF 
     213#endif 
     214                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out 
     215                  CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 0 /),   & 
     216                     &                OASIS_Out          , ishape , OASIS_REAL, nerror ) 
     217                  IF ( nerror /= OASIS_Ok ) THEN 
     218                     WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 
     219                     CALL oasis_abort ( ssnd(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 
     220                  ENDIF 
     221                  IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple" 
     222                  IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple" 
     223               END DO 
    182224            END DO 
    183225         ENDIF 
    … …  
    188230      DO ji = 1, krcv 
    189231         IF ( srcv(ji)%laction ) THEN  
     232             
     233            IF( srcv(ji)%nct > nmaxcat ) THEN 
     234               CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '//   & 
     235                  &              TRIM(srcv(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' ) 
     236               RETURN 
     237            ENDIF 
     238             
    190239            DO jc = 1, srcv(ji)%nct 
    191                IF ( srcv(ji)%nct .gt. 1 ) THEN 
    192                   WRITE(zclname,'( a7, i1)') srcv(ji)%clname,jc 
    193                ELSE 
    194                   zclname=srcv(ji)%clname 
    195                ENDIF 
    196                WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_In 
    197                CALL prism_def_var_proto ( srcv(ji)%nid(jc), zclname, id_part, (/ 2, 0/),   & 
    198                     &                      PRISM_In    , ishape   , PRISM_REAL, nerror) 
    199                IF ( nerror /= PRISM_Ok ) THEN 
    200                   WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 
    201                   CALL prism_abort_proto ( srcv(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var') 
    202                ENDIF 
     240               DO jm = 1, kcplmodel 
     241                   
     242                  IF ( srcv(ji)%nct .GT. 1 ) THEN 
     243                     WRITE(cli2,'(i2.2)') jc 
     244                     zclname = TRIM(srcv(ji)%clname)//'_cat'//cli2 
     245                  ELSE 
     246                     zclname = srcv(ji)%clname 
     247                  ENDIF 
     248                  IF ( kcplmodel  > 1 ) THEN 
     249                     WRITE(cli2,'(i2.2)') jm 
     250                     zclname = 'model'//cli2//'_'//TRIM(zclname) 
     251                  ENDIF 
     252#if defined key_agrif 
     253                  IF( agrif_fixed() /= 0 ) THEN  
     254                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 
     255                  END IF 
     256#endif 
     257                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In 
     258                  CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 0 /),   & 
     259                     &                OASIS_In           , ishape , OASIS_REAL, nerror ) 
     260                  IF ( nerror /= OASIS_Ok ) THEN 
     261                     WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 
     262                     CALL oasis_abort ( srcv(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 
     263                  ENDIF 
     264                  IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple" 
     265                  IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple" 
     266 
     267               END DO 
    203268            END DO 
    204269         ENDIF 
    … …  
    209274      !------------------------------------------------------------------ 
    210275       
    211       CALL prism_enddef_proto(nerror) 
    212       IF( nerror /= PRISM_Ok )   CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef') 
    213       ! 
    214    END SUBROUTINE cpl_prism_define 
     276      CALL oasis_enddef(nerror) 
     277      IF( nerror /= OASIS_Ok )   CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 
     278      ! 
     279   END SUBROUTINE cpl_define 
    215280    
    216281    
    217    SUBROUTINE cpl_prism_snd( kid, kstep, pdata, kinfo ) 
     282   SUBROUTINE cpl_snd( kid, kstep, pdata, kinfo ) 
    218283      !!--------------------------------------------------------------------- 
    219       !!              ***  ROUTINE cpl_prism_snd  *** 
     284      !!              ***  ROUTINE cpl_snd  *** 
    220285      !! 
    221286      !! ** Purpose : - At each coupling time-step,this routine sends fields 
    … …  
    227292      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pdata 
    228293      !! 
    229       INTEGER                                   ::   jc        ! local loop index 
     294      INTEGER                                   ::   jc,jm     ! local loop index 
    230295      !!-------------------------------------------------------------------- 
    231296      ! 
    … …  
    233298      ! 
    234299      DO jc = 1, ssnd(kid)%nct 
    235  
    236          CALL prism_put_proto ( ssnd(kid)%nid(jc), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 
    237           
    238          IF ( ln_ctl ) THEN         
    239             IF ( kinfo == PRISM_Sent     .OR. kinfo == PRISM_ToRest .OR.   & 
    240                  & kinfo == PRISM_SentOut  .OR. kinfo == PRISM_ToRestOut ) THEN 
    241                WRITE(numout,*) '****************' 
    242                WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname 
    243                WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid(jc) 
    244                WRITE(numout,*) 'prism_put_proto:  kstep ', kstep 
    245                WRITE(numout,*) 'prism_put_proto:   info ', kinfo 
    246                WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc)) 
    247                WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc)) 
    248                WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc)) 
    249                WRITE(numout,*) '****************' 
     300         DO jm = 1, ssnd(kid)%ncplmodel 
     301         
     302            IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN 
     303               CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 
     304                
     305               IF ( ln_ctl ) THEN         
     306                  IF ( kinfo == OASIS_Sent     .OR. kinfo == OASIS_ToRest .OR.   & 
     307                     & kinfo == OASIS_SentOut  .OR. kinfo == OASIS_ToRestOut ) THEN 
     308                     WRITE(numout,*) '****************' 
     309                     WRITE(numout,*) 'oasis_put: Outgoing ', ssnd(kid)%clname 
     310                     WRITE(numout,*) 'oasis_put: ivarid ', ssnd(kid)%nid(jc,jm) 
     311                     WRITE(numout,*) 'oasis_put:  kstep ', kstep 
     312                     WRITE(numout,*) 'oasis_put:   info ', kinfo 
     313                     WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc)) 
     314                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc)) 
     315                     WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc)) 
     316                     WRITE(numout,*) '****************' 
     317                  ENDIF 
     318               ENDIF 
     319                
    250320            ENDIF 
    251          ENDIF 
    252  
     321             
     322         ENDDO 
    253323      ENDDO 
    254324      ! 
    255     END SUBROUTINE cpl_prism_snd 
    256  
    257  
    258    SUBROUTINE cpl_prism_rcv( kid, kstep, pdata, kinfo ) 
     325    END SUBROUTINE cpl_snd 
     326 
     327 
     328   SUBROUTINE cpl_rcv( kid, kstep, pdata, pmask, kinfo ) 
    259329      !!--------------------------------------------------------------------- 
    260       !!              ***  ROUTINE cpl_prism_rcv  *** 
     330      !!              ***  ROUTINE cpl_rcv  *** 
    261331      !! 
    262332      !! ** Purpose : - At each coupling time-step,this routine receives fields 
    … …  
    266336      INTEGER                   , INTENT(in   ) ::   kstep     ! ocean time-step in seconds 
    267337      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdata     ! IN to keep the value if nothing is done 
     338      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pmask     ! coupling mask 
    268339      INTEGER                   , INTENT(  out) ::   kinfo     ! OASIS3 info argument 
    269340      !! 
    270       INTEGER                                   ::   jc        ! local loop index 
    271       LOGICAL                                   ::   llaction 
     341      INTEGER                                   ::   jc,jm     ! local loop index 
     342      LOGICAL                                   ::   llaction, llfisrt 
    272343      !!-------------------------------------------------------------------- 
    273344      ! 
    274345      ! receive local data from OASIS3 on every process 
    275346      ! 
     347      kinfo = OASIS_idle 
     348      ! 
    276349      DO jc = 1, srcv(kid)%nct 
    277  
    278          CALL prism_get_proto ( srcv(kid)%nid(jc), kstep, exfld, kinfo )          
    279           
    280          llaction = .false. 
    281          IF( kinfo == PRISM_Recvd   .OR. kinfo == PRISM_FromRest .OR.   & 
    282               kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut )   llaction = .TRUE. 
    283           
    284          IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc) 
    285           
    286          IF ( llaction ) THEN 
     350         llfisrt = .TRUE. 
     351 
     352         DO jm = 1, srcv(kid)%ncplmodel 
     353 
     354            IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 
     355 
     356               CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo )          
     357                
     358               llaction =  kinfo == OASIS_Recvd   .OR. kinfo == OASIS_FromRest .OR.   & 
     359                  &        kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 
     360                
     361               IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 
     362                
     363               IF ( llaction ) THEN 
     364                   
     365                  kinfo = OASIS_Rcv 
     366                  IF( llfisrt ) THEN  
     367                     pdata(nldi:nlei,nldj:nlej,jc) =                                 exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 
     368                     llfisrt = .FALSE. 
     369                  ELSE 
     370                     pdata(nldi:nlei,nldj:nlej,jc) = pdata(nldi:nlei,nldj:nlej,jc) + exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 
     371                  ENDIF 
     372                   
     373                  IF ( ln_ctl ) THEN         
     374                     WRITE(numout,*) '****************' 
     375                     WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 
     376                     WRITE(numout,*) 'oasis_get: ivarid '  , srcv(kid)%nid(jc,jm) 
     377                     WRITE(numout,*) 'oasis_get:   kstep', kstep 
     378                     WRITE(numout,*) 'oasis_get:   info ', kinfo 
     379                     WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc)) 
     380                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc)) 
     381                     WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc)) 
     382                     WRITE(numout,*) '****************' 
     383                  ENDIF 
     384                   
     385               ENDIF 
     386                
     387            ENDIF 
    287388             
    288             pdata(nldi:nlei, nldj:nlej,jc) = exfld(:,:) 
    289              
    290             !--- Fill the overlap areas and extra hallows (mpp) 
    291             !--- check periodicity conditions (all cases) 
    292             CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )    
    293              
    294             IF ( ln_ctl ) THEN         
    295                WRITE(numout,*) '****************' 
    296                WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname 
    297                WRITE(numout,*) 'prism_get_proto: ivarid '  , srcv(kid)%nid(jc) 
    298                WRITE(numout,*) 'prism_get_proto:   kstep', kstep 
    299                WRITE(numout,*) 'prism_get_proto:   info ', kinfo 
    300                WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc)) 
    301                WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc)) 
    302                WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc)) 
    303                WRITE(numout,*) '****************' 
    304             ENDIF 
    305  
    306             ! Ideally we would not reuse kinfo, but define a separate variable 
    307             ! for use as the return code from this routine to avoid confusion 
    308             ! with the return code previously obtained from the coupler. 
    309             kinfo = OASIS_Rcv 
    310              
    311          ELSE 
    312             kinfo = OASIS_idle      
    313          ENDIF 
    314           
     389         ENDDO 
     390 
     391         !--- Fill the overlap areas and extra hallows (mpp) 
     392         !--- check periodicity conditions (all cases) 
     393         IF( .not. llfisrt )   CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )    
     394  
    315395      ENDDO 
    316396      ! 
    317    END SUBROUTINE cpl_prism_rcv 
    318  
    319  
    320    INTEGER FUNCTION cpl_prism_freq( kid )   
     397   END SUBROUTINE cpl_rcv 
     398 
     399 
     400   INTEGER FUNCTION cpl_freq( kid )   
    321401      !!--------------------------------------------------------------------- 
    322       !!              ***  ROUTINE cpl_prism_freq  *** 
     402      !!              ***  ROUTINE cpl_freq  *** 
    323403      !! 
    324404      !! ** Purpose : - send back the coupling frequency for a particular field 
    325405      !!---------------------------------------------------------------------- 
    326       INTEGER,INTENT(in) ::   kid   ! variable index  
     406      INTEGER,INTENT(in) ::   kid   ! variable index 
     407      !! 
     408      INTEGER :: info 
    327409      !!---------------------------------------------------------------------- 
    328       cpl_prism_freq = ig_def_freq( kid ) 
    329       ! 
    330    END FUNCTION cpl_prism_freq 
    331  
    332  
    333    SUBROUTINE cpl_prism_finalize 
     410      CALL oasis_get_freqs(kid, 1, cpl_freq, info) 
     411      ! 
     412   END FUNCTION cpl_freq 
     413 
     414 
     415   SUBROUTINE cpl_finalize 
    334416      !!--------------------------------------------------------------------- 
    335       !!              ***  ROUTINE cpl_prism_finalize  *** 
     417      !!              ***  ROUTINE cpl_finalize  *** 
    336418      !! 
    337419      !! ** Purpose : - Finalizes the coupling. If MPI_init has not been 
    338       !!      called explicitly before cpl_prism_init it will also close 
     420      !!      called explicitly before cpl_init it will also close 
    339421      !!      MPI communication. 
    340422      !!---------------------------------------------------------------------- 
    341423      ! 
    342424      DEALLOCATE( exfld ) 
    343       CALL prism_terminate_proto( nerror )          
    344       ! 
    345    END SUBROUTINE cpl_prism_finalize 
    346  
    347 #else 
    348    !!---------------------------------------------------------------------- 
    349    !!   Default case          Dummy module          Forced Ocean/Atmosphere 
    350    !!---------------------------------------------------------------------- 
    351    USE in_out_manager               ! I/O manager 
    352    LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .FALSE.   !: coupled flag 
    353    PUBLIC cpl_prism_init 
    354    PUBLIC cpl_prism_finalize 
    355 CONTAINS 
    356    SUBROUTINE cpl_prism_init (kl_comm)  
    357       INTEGER, INTENT(out)   :: kl_comm       ! local communicator of the model 
    358       kl_comm = -1 
    359       WRITE(numout,*) 'cpl_prism_init: Error you sould not be there...' 
    360    END SUBROUTINE cpl_prism_init 
    361    SUBROUTINE cpl_prism_finalize 
    362       WRITE(numout,*) 'cpl_prism_finalize: Error you sould not be there...' 
    363    END SUBROUTINE cpl_prism_finalize 
     425      IF (nstop == 0) THEN 
     426         CALL oasis_terminate( nerror )          
     427      ELSE 
     428         CALL oasis_abort( ncomp_id, "cpl_finalize", "NEMO ABORT STOP" ) 
     429      ENDIF        
     430      ! 
     431   END SUBROUTINE cpl_finalize 
     432 
     433#if ! defined key_oasis3 
     434 
     435   !!---------------------------------------------------------------------- 
     436   !!   No OASIS Library          OASIS3 Dummy module... 
     437   !!---------------------------------------------------------------------- 
     438 
     439   SUBROUTINE oasis_init_comp(k1,cd1,k2) 
     440      CHARACTER(*), INTENT(in   ) ::  cd1 
     441      INTEGER     , INTENT(  out) ::  k1,k2 
     442      k1 = -1 ; k2 = -1 
     443      WRITE(numout,*) 'oasis_init_comp: Error you sould not be there...', cd1 
     444   END SUBROUTINE oasis_init_comp 
     445 
     446   SUBROUTINE oasis_abort(k1,cd1,cd2) 
     447      INTEGER     , INTENT(in   ) ::  k1 
     448      CHARACTER(*), INTENT(in   ) ::  cd1,cd2 
     449      WRITE(numout,*) 'oasis_abort: Error you sould not be there...', cd1, cd2 
     450   END SUBROUTINE oasis_abort 
     451 
     452   SUBROUTINE oasis_get_localcomm(k1,k2) 
     453      INTEGER     , INTENT(  out) ::  k1,k2 
     454      k1 = -1 ; k2 = -1 
     455      WRITE(numout,*) 'oasis_get_localcomm: Error you sould not be there...' 
     456   END SUBROUTINE oasis_get_localcomm 
     457 
     458   SUBROUTINE oasis_def_partition(k1,k2,k3) 
     459      INTEGER     , INTENT(  out) ::  k1,k3 
     460      INTEGER     , INTENT(in   ) ::  k2(5) 
     461      k1 = k2(1) ; k3 = k2(5) 
     462      WRITE(numout,*) 'oasis_def_partition: Error you sould not be there...' 
     463   END SUBROUTINE oasis_def_partition 
     464 
     465   SUBROUTINE oasis_def_var(k1,cd1,k2,k3,k4,k5,k6,k7) 
     466      CHARACTER(*), INTENT(in   ) ::  cd1 
     467      INTEGER     , INTENT(in   ) ::  k2,k3(2),k4,k5(2,2),k6 
     468      INTEGER     , INTENT(  out) ::  k1,k7 
     469      k1 = -1 ; k7 = -1 
     470      WRITE(numout,*) 'oasis_def_var: Error you sould not be there...', cd1 
     471   END SUBROUTINE oasis_def_var 
     472 
     473   SUBROUTINE oasis_enddef(k1) 
     474      INTEGER     , INTENT(  out) ::  k1 
     475      k1 = -1 
     476      WRITE(numout,*) 'oasis_enddef: Error you sould not be there...' 
     477   END SUBROUTINE oasis_enddef 
     478   
     479   SUBROUTINE oasis_put(k1,k2,p1,k3) 
     480      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::  p1 
     481      INTEGER                 , INTENT(in   ) ::  k1,k2 
     482      INTEGER                 , INTENT(  out) ::  k3 
     483      k3 = -1 
     484      WRITE(numout,*) 'oasis_put: Error you sould not be there...' 
     485   END SUBROUTINE oasis_put 
     486 
     487   SUBROUTINE oasis_get(k1,k2,p1,k3) 
     488      REAL(wp), DIMENSION(:,:), INTENT(  out) ::  p1 
     489      INTEGER                 , INTENT(in   ) ::  k1,k2 
     490      INTEGER                 , INTENT(  out) ::  k3 
     491      p1(1,1) = -1. ; k3 = -1 
     492      WRITE(numout,*) 'oasis_get: Error you sould not be there...' 
     493   END SUBROUTINE oasis_get 
     494 
     495   SUBROUTINE oasis_get_freqs(k1,k2,k3,k4) 
     496      INTEGER     , INTENT(in   ) ::  k1,k2 
     497      INTEGER     , INTENT(  out) ::  k3,k4 
     498      k3 = k1 ; k4 = k2 
     499      WRITE(numout,*) 'oasis_get_freqs: Error you sould not be there...' 
     500   END SUBROUTINE oasis_get_freqs 
     501 
     502   SUBROUTINE oasis_terminate(k1) 
     503      INTEGER     , INTENT(  out) ::  k1 
     504      k1 = -1 
     505      WRITE(numout,*) 'oasis_terminate: Error you sould not be there...' 
     506   END SUBROUTINE oasis_terminate 
     507    
    364508#endif 
    365509 

  • branches/2014/dev_CNRS_CICE/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r4927 r4933  
    1414   !!---------------------------------------------------------------------- 
    1515   USE par_oce          ! ocean parameters 
     16   USE sbc_oce          ! surface boundary condition: ocean 
    1617# if defined key_lim3 
    1718   USE par_ice          ! LIM-3 parameters 
    … …  
    5657 
    5758#if defined key_lim3 || defined key_lim2  
    58    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qns_ice       !: non solar heat flux over ice                  [W/m2] 
    59    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice       !: solar heat flux over ice                      [W/m2] 
    60    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice_mean  !: dauly mean solar heat flux over ice       [W/m2] 
    61    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qla_ice       !: latent flux over ice                          [W/m2] 
    62    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqla_ice      !: latent sensibility over ice                 [W/m2/K] 
    63    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqns_ice      !: non solar heat flux over ice (LW+SEN+LA)    [W/m2/K] 
    64    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice        !: ice surface temperature                          [K] 
    65    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   alb_ice       !: albedo of ice 
    66  
    67    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   utau_ice  !: atmos-ice u-stress. VP: I-pt ; EVP: U,V-pts   [N/m2] 
    68    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   vtau_ice  !: atmos-ice v-stress. VP: I-pt ; EVP: U,V-pts   [N/m2] 
    69    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr1_i0    !: 1st Qsr fraction penetrating inside ice cover    [-] 
    70    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr2_i0    !: 2nd Qsr fraction penetrating inside ice cover    [-] 
    71    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice   !: sublimation-snow budget over ice             [kg/m2] 
     59   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qns_ice        !: non solar heat flux over ice                  [W/m2] 
     60   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice        !: solar heat flux over ice                      [W/m2] 
     61   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice_mean   !: daily mean solar heat flux over ice           [W/m2] 
     62   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qla_ice        !: latent flux over ice                          [W/m2] 
     63   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqla_ice       !: latent sensibility over ice                 [W/m2/K] 
     64   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqns_ice       !: non solar heat flux over ice (LW+SEN+LA)    [W/m2/K] 
     65   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice         !: ice surface temperature                          [K] 
     66   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   alb_ice        !: ice albedo                                       [-] 
     67 
     68   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   utau_ice       !: atmos-ice u-stress. VP: I-pt ; EVP: U,V-pts   [N/m2] 
     69   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   vtau_ice       !: atmos-ice v-stress. VP: I-pt ; EVP: U,V-pts   [N/m2] 
     70   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr1_i0         !: Solar surface transmission parameter, thick ice  [-] 
     71   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr2_i0         !: Solar surface transmission parameter, thin ice   [-] 
     72   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice        !: sublimation - precip over sea ice            [kg/m2] 
     73   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qemp_ice       !: heat associated with emp over sea ice         [W/m2] 
    7274 
    7375# if defined key_lim3 
    74    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice  !: air temperature 
     76   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice       !: air temperature [K] 
    7577# endif 
    7678 
    … …  
    98100   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt            !: category topmelt 
    99101   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   botmelt            !: category botmelt 
    100 #endif 
     102 
     103   ! variables used in the coupled interface 
     104   INTEGER , PUBLIC, PARAMETER ::   jpl = ncat 
     105   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice,fr1_i0,fr2_i0          ! jpi, jpj 
     106   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice, qns_ice, dqns_ice  ! (jpi,jpj,jpl) 
     107   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice 
     108   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice 
     109#endif 
     110    
     111#if defined key_lim2 
     112   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i 
     113#endif 
     114 
     115#if ! defined key_lim3 
     116   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  ht_i, ht_s 
     117#endif 
     118 
     119#if ! defined key_cice 
     120   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  topmelt, botmelt 
     121#endif 
     122 
     123   REAL(wp), PUBLIC, SAVE ::   cldf_ice = 0.81    !: cloud fraction over sea ice, summer CLIO value   [-] 
    101124 
    102125   !!---------------------------------------------------------------------- 
    … …  
    111134      !!                     ***  FUNCTION sbc_ice_alloc  *** 
    112135      !!---------------------------------------------------------------------- 
    113       INTEGER :: ierr(2) 
     136      INTEGER :: ierr(5) 
    114137      !!---------------------------------------------------------------------- 
    115138      ierr(:) = 0 
    … …  
    123146         &      fr1_i0  (jpi,jpj)     , fr2_i0  (jpi,jpj)     ,     & 
    124147#if defined key_lim3 
    125          &      emp_ice(jpi,jpj)      , tatm_ice(jpi,jpj)     , STAT= ierr(1) ) 
    126 #else 
    127          &      emp_ice(jpi,jpj)                              , STAT= ierr(1) ) 
    128 #endif 
     148         &      tatm_ice(jpi,jpj)     ,                             & 
     149#endif 
     150         &      emp_ice(jpi,jpj)      , qemp_ice(jpi,jpj)     , STAT= ierr(1) ) 
    129151#elif defined key_cice 
    130152      ALLOCATE( qla_ice(jpi,jpj,1)    , qlw_ice(jpi,jpj,1)    , qsr_ice(jpi,jpj,1)    , & 
    … …  
    132154                wndj_ice(jpi,jpj)     , nfrzmlt(jpi,jpj)      , ss_iou(jpi,jpj)       , & 
    133155                ss_iov(jpi,jpj)       , fr_iu(jpi,jpj)        , fr_iv(jpi,jpj)        , & 
    134                 a_i(jpi,jpj,ncat)     , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat), STAT= ierr(1) ) 
     156                a_i(jpi,jpj,ncat)     , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , & 
     157                STAT= ierr(1) ) 
     158      IF( lk_cpl )   ALLOCATE( u_ice(jpi,jpj)        , fr1_i0(jpi,jpj)       , tn_ice (jpi,jpj,1)    , & 
     159         &                     v_ice(jpi,jpj)        , fr2_i0(jpi,jpj)       , alb_ice(jpi,jpj,1)    , & 
     160         &                     emp_ice(jpi,jpj)      , qns_ice(jpi,jpj,1)    , dqns_ice(jpi,jpj,1)   , & 
     161         &                     STAT= ierr(2) ) 
     162       
    135163#endif 
    136164         ! 
    137165#if defined key_lim2 
    138       IF( ltrcdm2dc_ice )THEN 
    139          ALLOCATE( qsr_ice_mean (jpi,jpj,jpl), STAT=ierr(2) ) 
    140       ENDIF 
     166      IF( ltrcdm2dc_ice )   ALLOCATE( qsr_ice_mean (jpi,jpj,jpl), STAT=ierr(3) ) 
    141167#endif 
    142168         ! 
     169#if defined key_lim2 
     170      ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(4) ) 
     171#endif 
     172 
     173#if defined key_cice || defined key_lim2 
     174      IF( lk_cpl )   ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) ) 
     175#endif 
     176 
    143177      sbc_ice_alloc = MAXVAL( ierr ) 
    144178      IF( lk_mpp            )   CALL mpp_sum ( sbc_ice_alloc ) 
    … …  
    150184   !!   Default option                      NO LIM 2.0 or 3.0 or CICE sea-ice model 
    151185   !!---------------------------------------------------------------------- 
     186   USE in_out_manager   ! I/O manager 
    152187   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2 ice model 
    153188   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3 ice model 
    154189   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE  ice model 
    155190   CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = '-'      !: no grid ice-velocity 
     191   REAL            , PUBLIC, PARAMETER ::   cldf_ice = 0.81       !: cloud fraction over sea ice, summer CLIO value   [-] 
     192   INTEGER         , PUBLIC, PARAMETER ::   jpl = 1  
     193   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice,fr1_i0,fr2_i0          ! jpi, jpj 
     194   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice, qns_ice, dqns_ice  ! (jpi,jpj,jpl) 
     195   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i 
     196   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice 
     197   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice 
     198   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ht_i, ht_s 
     199   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt, botmelt 
    156200#endif 
    157201 

  • branches/2014/dev_CNRS_CICE/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r4306 r4933  
    3535   LOGICAL , PUBLIC ::   ln_blk_core    !: CORE bulk formulation 
    3636   LOGICAL , PUBLIC ::   ln_blk_mfs     !: MFS  bulk formulation 
    37    LOGICAL , PUBLIC ::   ln_cpl         !: coupled   formulation (overwritten by key_sbc_coupled ) 
     37#if defined key_oasis3 
     38   LOGICAL , PUBLIC ::   lk_cpl = .TRUE.  !: coupled formulation 
     39#else 
     40   LOGICAL , PUBLIC ::   lk_cpl = .FALSE. !: coupled formulation 
     41#endif 
    3842   LOGICAL , PUBLIC ::   ln_dm2dc       !: Daily mean to Diurnal Cycle short wave (qsr) 
    3943   LOGICAL , PUBLIC ::   ln_rnf         !: runoffs / runoff mouths 
    … …  
    4549   !                                             !: =1 levitating ice with mass and salt exchange but no presure effect 
    4650   !                                             !: =2 embedded sea-ice (full salt and mass exchanges and pressure) 
     51   INTEGER , PUBLIC :: nn_limflx        !: LIM3 Multi-category heat flux formulation 
     52   !                                             !: =-1  Use of per-category fluxes 
     53   !                                             !: = 0  Average per-category fluxes 
     54   !                                             !: = 1  Average then redistribute per-category fluxes 
     55   !                                             !: = 2  Redistribute a single flux over categories 
    4756   INTEGER , PUBLIC ::   nn_fwb         !: FreshWater Budget:  
    4857   !                                             !:  = 0 unchecked  
    … …  
    5564   LOGICAL , PUBLIC ::   ln_icebergs    !: Icebergs 
    5665   ! 
    57    CHARACTER (len=8), PUBLIC :: cn_iceflx  !: Flux handling over ice categories 
    58    LOGICAL, PUBLIC :: ln_iceflx_ave     ! Average heat fluxes over all ice categories 
    59    LOGICAL, PUBLIC :: ln_iceflx_linear  ! Redistribute mean heat fluxes over all ice categories, using ice temperature and albedo 
    60    ! 
    61    INTEGER , PUBLIC ::   nn_lsm        !: Number of iteration if seaoverland is applied 
     66   INTEGER , PUBLIC ::   nn_lsm         !: Number of iteration if seaoverland is applied 
     67   !!---------------------------------------------------------------------- 
     68   !!           switch definition (improve readability) 
     69   !!---------------------------------------------------------------------- 
     70   INTEGER , PUBLIC, PARAMETER ::   jp_gyre    = 0        !: GYRE analytical formulation 
     71   INTEGER , PUBLIC, PARAMETER ::   jp_ana     = 1        !: analytical      formulation 
     72   INTEGER , PUBLIC, PARAMETER ::   jp_flx     = 2        !: flux            formulation 
     73   INTEGER , PUBLIC, PARAMETER ::   jp_clio    = 3        !: CLIO bulk       formulation 
     74   INTEGER , PUBLIC, PARAMETER ::   jp_core    = 4        !: CORE bulk       formulation 
     75   INTEGER , PUBLIC, PARAMETER ::   jp_cpl     = 5        !: Coupled         formulation 
     76   INTEGER , PUBLIC, PARAMETER ::   jp_mfs     = 6        !: MFS  bulk       formulation 
     77   INTEGER , PUBLIC, PARAMETER ::   jp_esopa   = -1       !: esopa test, ALL formulations 
     78    
    6279   !!---------------------------------------------------------------------- 
    6380   !!              Ocean Surface Boundary Condition fields 

  • branches/2014/dev_CNRS_CICE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

    r4624 r4933  
    114114      !!              - utau, vtau  i- and j-component of the wind stress 
    115115      !!              - taum        wind stress module at T-point 
    116       !!              - wndm        10m wind module at T-point 
     116      !!              - wndm        10m wind module at T-point over free ocean or leads in presence of sea-ice 
    117117      !!              - qns         non-solar heat flux including latent heat of solid  
    118118      !!                            precip. melting and emp heat content 
    … …  
    204204      !!               - utau, vtau  i- and j-component of the wind stress 
    205205      !!               - taum        wind stress module at T-point 
    206       !!               - wndm        10m wind module at T-point 
     206      !!               - wndm        10m wind module at T-point over free ocean or leads in presence of sea-ice 
    207207      !!               - qns         non-solar heat flux including latent heat of solid  
    208208      !!                             precip. melting and emp heat content 
    … …  
    398398 
    399399 
    400    SUBROUTINE blk_ice_clio(  pst   , palb_cs, palb_os ,       & 
     400   SUBROUTINE blk_ice_clio(  pst   , palb_cs, palb_os, palb,  & 
    401401      &                      p_taui, p_tauj, p_qns , p_qsr,   & 
    402402      &                      p_qla , p_dqns, p_dqla,          & 
    … …  
    427427      !!---------------------------------------------------------------------- 
    428428      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   pst      ! ice surface temperature                   [Kelvin] 
    429       REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_cs  ! ice albedo (clear    sky) (alb_ice_cs)         [%] 
    430       REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_os  ! ice albedo (overcast sky) (alb_ice_os)         [%] 
     429      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_cs  ! ice albedo (clear    sky) (alb_ice_cs)         [-] 
     430      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_os  ! ice albedo (overcast sky) (alb_ice_os)         [-] 
     431      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   palb     ! ice albedo (actual value)                      [-] 
    431432      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_taui   ! surface ice stress at I-point (i-component) [N/m2] 
    432433      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_tauj   ! surface ice stress at I-point (j-component) [N/m2] 
    … …  
    438439      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_tpr    ! total precipitation          (T-point)   [Kg/m2/s] 
    439440      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_spr    ! solid precipitation          (T-point)   [Kg/m2/s] 
    440       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr1    ! 1sr fraction of qsr penetration in ice         [%] 
    441       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr2    ! 2nd fraction of qsr penetration in ice         [%] 
     441      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr1    ! 1sr fraction of qsr penetration in ice         [-] 
     442      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr2    ! 2nd fraction of qsr penetration in ice         [-] 
    442443      CHARACTER(len=1), INTENT(in   )             ::   cd_grid  ! type of sea-ice grid ("C" or "B" grid) 
    443444      INTEGER, INTENT(in   )                      ::   pdim     ! number of ice categories 
    … …  
    542543      !-----------------------------------------------------------! 
    543544      CALL blk_clio_qsr_ice( palb_cs, palb_os, p_qsr ) 
     545       
     546      DO jl = 1, ijpl 
     547         palb(:,:,jl) = ( palb_cs(:,:,jl) * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) )   & 
     548            &         +   palb_os(:,:,jl) * sf(jp_ccov)%fnow(ji,jj,1) ) 
     549      END DO 
    544550 
    545551      !                                     ! ========================== ! 

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

    r4689 r4933  
    55   !!===================================================================== 
    66   !! History :  1.0  !  2004-08  (U. Schweckendiek)  Original code 
    7    !!            2.0  !  2005-04  (L. Brodeau, A.M. Treguier) additions:  
     7   !!            2.0  !  2005-04  (L. Brodeau, A.M. Treguier) additions: 
    88   !!                           -  new bulk routine for efficiency 
    99   !!                           -  WINDS ARE NOW ASSUMED TO BE AT T POINTS in input files !!!! 
    10    !!                           -  file names and file characteristics in namelist  
    11    !!                           -  Implement reading of 6-hourly fields    
    12    !!            3.0  !  2006-06  (G. Madec) sbc rewritting    
    13    !!             -   !  2006-12  (L. Brodeau) Original code for TURB_CORE_2Z 
     10   !!                           -  file names and file characteristics in namelist 
     11   !!                           -  Implement reading of 6-hourly fields 
     12   !!            3.0  !  2006-06  (G. Madec) sbc rewritting 
     13   !!             -   !  2006-12  (L. Brodeau) Original code for turb_core_2z 
    1414   !!            3.2  !  2009-04  (B. Lemaire)  Introduce iom_put 
    1515   !!            3.3  !  2010-10  (S. Masson)  add diurnal cycle 
    1616   !!            3.4  !  2011-11  (C. Harris) Fill arrays required by CICE 
     17   !!            3.7  !  2014-06  (L. Brodeau) simplification and optimization of CORE bulk 
    1718   !!---------------------------------------------------------------------- 
    1819 
    1920   !!---------------------------------------------------------------------- 
    20    !!   sbc_blk_core  : bulk formulation as ocean surface boundary condition 
    21    !!                   (forced mode, CORE bulk formulea) 
    22    !!   blk_oce_core  : ocean: computes momentum, heat and freshwater fluxes 
    23    !!   blk_ice_core  : ice  : computes momentum, heat and freshwater fluxes 
    24    !!   turb_core     : computes the CORE turbulent transfer coefficients  
     21   !!   sbc_blk_core    : bulk formulation as ocean surface boundary condition (forced mode, CORE bulk formulea) 
     22   !!   blk_oce_core    : computes momentum, heat and freshwater fluxes over ocean 
     23   !!   blk_ice_core    : computes momentum, heat and freshwater fluxes over ice 
     24   !!   blk_bio_meanqsr : compute daily mean short wave radiation over the ocean 
     25   !!   blk_ice_meanqsr : compute daily mean short wave radiation over the ice 
     26   !!   turb_core_2z    : Computes turbulent transfert coefficients 
     27   !!   cd_neutral_10m  : Estimate of the neutral drag coefficient at 10m 
     28   !!   psi_m           : universal profile stability function for momentum 
     29   !!   psi_h           : universal profile stability function for temperature and humidity 
    2530   !!---------------------------------------------------------------------- 
    2631   USE oce             ! ocean dynamics and tracers 
    … …  
    3843   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    3944   USE prtctl          ! Print control 
    40    USE sbcwave,ONLY :  cdn_wave !wave module  
    41 #if defined key_lim3 || defined key_cice 
     45   USE sbcwave, ONLY   :  cdn_wave ! wave module 
    4246   USE sbc_ice         ! Surface boundary condition: ice fields 
    43 #endif 
    4447   USE lib_fortran     ! to use key_nosignedzero 
    4548 
    … …  
    5255   PUBLIC   turb_core_2z         ! routine calles in sbcblk_mfs module 
    5356 
    54    INTEGER , PARAMETER ::   jpfld   = 9           ! maximum number of files to read  
     57   INTEGER , PARAMETER ::   jpfld   = 9           ! maximum number of files to read 
    5558   INTEGER , PARAMETER ::   jp_wndi = 1           ! index of 10m wind velocity (i-component) (m/s)    at T-point 
    5659   INTEGER , PARAMETER ::   jp_wndj = 2           ! index of 10m wind velocity (j-component) (m/s)    at T-point 
    … …  
    6265   INTEGER , PARAMETER ::   jp_snow = 8           ! index of snow (solid prcipitation)       (kg/m2/s) 
    6366   INTEGER , PARAMETER ::   jp_tdif = 9           ! index of tau diff associated to HF tau   (N/m2)   at T-point 
    64     
     67 
    6568   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input fields (file informations, fields read) 
    66           
     69 
    6770   !                                             !!! CORE bulk parameters 
    6871   REAL(wp), PARAMETER ::   rhoa =    1.22        ! air density 
    … …  
    7578 
    7679   !                                  !!* Namelist namsbc_core : CORE bulk parameters 
    77    LOGICAL  ::   ln_2m       ! logical flag for height of air temp. and hum 
    7880   LOGICAL  ::   ln_taudif   ! logical flag to use the "mean of stress module - module of mean stress" data 
    7981   REAL(wp) ::   rn_pfac     ! multiplication factor for precipitation 
    8082   REAL(wp) ::   rn_efac     ! multiplication factor for evaporation (clem) 
    8183   REAL(wp) ::   rn_vfac     ! multiplication factor for ice/ocean velocity in the calculation of wind stress (clem) 
    82    LOGICAL  ::   ln_bulk2z   ! logical flag for case where z(q,t) and z(u) are specified in the namelist 
    8384   REAL(wp) ::   rn_zqt      ! z(q,t) : height of humidity and temperature measurements 
    8485   REAL(wp) ::   rn_zu       ! z(u)   : height of wind measurements 
    … …  
    8889#  include "vectopt_loop_substitute.h90" 
    8990   !!---------------------------------------------------------------------- 
    90    !! NEMO/OPA 3.3 , NEMO-consortium (2010)  
     91   !! NEMO/OPA 3.7 , NEMO-consortium (2014) 
    9192   !! $Id$ 
    9293   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    9798      !!--------------------------------------------------------------------- 
    9899      !!                    ***  ROUTINE sbc_blk_core  *** 
    99       !!                    
     100      !! 
    100101      !! ** Purpose :   provide at each time step the surface ocean fluxes 
    101       !!      (momentum, heat, freshwater and runoff)  
     102      !!      (momentum, heat, freshwater and runoff) 
    102103      !! 
    103104      !! ** Method  : (1) READ each fluxes in NetCDF files: 
    … …  
    118119      !! ** Action  :   defined at each time-step at the air-sea interface 
    119120      !!              - utau, vtau  i- and j-component of the wind stress 
    120       !!              - taum, wndm  wind stress and 10m wind modules at T-point 
     121      !!              - taum        wind stress module at T-point 
     122      !!              - wndm        wind speed  module at T-point over free ocean or leads in presence of sea-ice 
    121123      !!              - qns, qsr    non-solar and solar heat fluxes 
    122124      !!              - emp         upward mass flux (evapo. - precip.) 
    123125      !!              - sfx         salt flux due to freezing/melting (non-zero only if ice is present) 
    124126      !!                            (set in limsbc(_2).F90) 
     127      !! 
     128      !! ** References :   Large & Yeager, 2004 / Large & Yeager, 2008 
     129      !!                   Brodeau et al. Ocean Modelling 2010 
    125130      !!---------------------------------------------------------------------- 
    126131      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    127       !! 
     132      ! 
    128133      INTEGER  ::   ierror   ! return error code 
    129134      INTEGER  ::   ifpr     ! dummy loop indice 
    130135      INTEGER  ::   jfld     ! dummy loop arguments 
    131136      INTEGER  ::   ios      ! Local integer output status for namelist read 
    132       !! 
     137      ! 
    133138      CHARACTER(len=100) ::  cn_dir   !   Root directory for location of core files 
    134139      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i     ! array of namelist informations on the fields to read 
    … …  
    136141      TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow      !   "                                 " 
    137142      TYPE(FLD_N) ::   sn_tdif                                 !   "                                 " 
    138       NAMELIST/namsbc_core/ cn_dir , ln_2m  , ln_taudif, rn_pfac, rn_efac, rn_vfac,  & 
     143      NAMELIST/namsbc_core/ cn_dir , ln_taudif, rn_pfac, rn_efac, rn_vfac,  & 
    139144         &                  sn_wndi, sn_wndj, sn_humi  , sn_qsr ,           & 
    140145         &                  sn_qlw , sn_tair, sn_prec  , sn_snow,           & 
    141          &                  sn_tdif, rn_zqt , ln_bulk2z, rn_zu 
    142       !!--------------------------------------------------------------------- 
    143  
     146         &                  sn_tdif, rn_zqt, rn_zu 
     147      !!--------------------------------------------------------------------- 
     148      ! 
    144149      !                                         ! ====================== ! 
    145150      IF( kt == nit000 ) THEN                   !  First call kt=nit000  ! 
    … …  
    149154         READ  ( numnam_ref, namsbc_core, IOSTAT = ios, ERR = 901) 
    150155901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_core in reference namelist', lwp ) 
    151  
     156         ! 
    152157         REWIND( numnam_cfg )              ! Namelist namsbc_core in configuration namelist : CORE bulk parameters 
    153158         READ  ( numnam_cfg, namsbc_core, IOSTAT = ios, ERR = 902 ) 
    154159902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_core in configuration namelist', lwp ) 
    155160 
    156          IF(lwm) WRITE ( numond, namsbc_core ) 
     161         WRITE ( numond, namsbc_core ) 
    157162         !                                         ! check: do we plan to use ln_dm2dc with non-daily forcing? 
    158          IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 )   &  
    159             &   CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' )  
     163         IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 )   & 
     164            &   CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' ) 
    160165         IF( ln_dm2dc .AND. sn_qsr%ln_tint ) THEN 
    161166            CALL ctl_warn( 'sbc_blk_core: ln_dm2dc is taking care of the temporal interpolation of daily qsr',   & 
    162                  &         '              ==> We force time interpolation = .false. for qsr' ) 
     167               &         '              ==> We force time interpolation = .false. for qsr' ) 
    163168            sn_qsr%ln_tint = .false. 
    164169         ENDIF 
    … …  
    169174         slf_i(jp_prec) = sn_prec   ;   slf_i(jp_snow) = sn_snow 
    170175         slf_i(jp_tdif) = sn_tdif 
    171          !                  
     176         ! 
    172177         lhftau = ln_taudif                        ! do we use HF tau information? 
    173178         jfld = jpfld - COUNT( (/.NOT. lhftau/) ) 
    … …  
    191196      IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce_core( kt, sf, sst_m, ssu_m, ssv_m ) 
    192197 
    193       ! If diurnal cycle is activated, compute a daily mean short waves flux for biogeochemistery  
     198      ! If diurnal cycle is activated, compute a daily mean short waves flux for biogeochemistery 
    194199      IF( ltrcdm2dc )   CALL blk_bio_meanqsr 
    195200 
    … …  
    226231      !!              - qsr     : Solar heat flux over the ocean        (W/m2) 
    227232      !!              - qns     : Non Solar heat flux over the ocean    (W/m2) 
    228       !!              - evap    : Evaporation over the ocean            (kg/m2/s) 
    229233      !!              - emp     : evaporation minus precipitation       (kg/m2/s) 
    230234      !! 
    … …  
    269273      zwnd_j(:,:) = 0.e0 
    270274#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 ! 
     275      CALL wnd_cyc( kt, zwnd_i, zwnd_j )    ! add analytical tropical cyclone (Vincent et al. JGR 2012) 
    275276      DO jj = 2, jpjm1 
    276277         DO ji = fs_2, fs_jpim1   ! vect. opt. 
    … …  
    279280         END DO 
    280281      END DO 
    281 #endif 
    282 #if defined key_vectopt_loop 
    283 !CDIR COLLAPSE 
    284282#endif 
    285283      DO jj = 2, jpjm1 
    … …  
    292290      CALL lbc_lnk( zwnd_j(:,:) , 'T', -1. ) 
    293291      ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked) 
    294 !CDIR NOVERRCHK 
    295 !CDIR COLLAPSE 
    296292      wndm(:,:) = SQRT(  zwnd_i(:,:) * zwnd_i(:,:)   & 
    297293         &             + zwnd_j(:,:) * zwnd_j(:,:)  ) * tmask(:,:,1) 
    … …  
    300296      !      I   Radiative FLUXES                                                     ! 
    301297      ! ----------------------------------------------------------------------------- ! 
    302      
     298 
    303299      ! ocean albedo assumed to be constant + modify now Qsr to include the diurnal cycle                    ! Short Wave 
    304300      zztmp = 1. - albo 
    … …  
    306302      ELSE                  ;   qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1) 
    307303      ENDIF 
    308 !CDIR COLLAPSE 
    309304      zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave 
    310305      ! ----------------------------------------------------------------------------- ! 
    … …  
    313308 
    314309      ! ... specific humidity at SST and IST 
    315 !CDIR NOVERRCHK 
    316 !CDIR COLLAPSE 
    317       zqsatw(:,:) = zcoef_qsatw * EXP( -5107.4 / zst(:,:) )  
     310      zqsatw(:,:) = zcoef_qsatw * EXP( -5107.4 / zst(:,:) ) 
    318311 
    319312      ! ... NCAR Bulk formulae, computation of Cd, Ch, Ce at T-point : 
    320       IF( ln_2m ) THEN 
    321          !! If air temp. and spec. hum. are given at different height (2m) than wind (10m) : 
    322          CALL TURB_CORE_2Z(2.,10., zst   , sf(jp_tair)%fnow,         & 
    323             &                      zqsatw, sf(jp_humi)%fnow, wndm,   & 
    324             &                      Cd    , Ch              , Ce  ,   & 
    325             &                      zt_zu , zq_zu                   ) 
    326       ELSE IF( ln_bulk2z ) THEN 
    327          !! If the height of the air temp./spec. hum. and wind are to be specified by hand : 
    328          IF( rn_zqt == rn_zu ) THEN 
    329             !! If air temp. and spec. hum. are at the same height as wind : 
    330             CALL TURB_CORE_1Z( rn_zu, zst   , sf(jp_tair)%fnow(:,:,1),       & 
    331                &                      zqsatw, sf(jp_humi)%fnow(:,:,1), wndm, & 
    332                &                      Cd    , Ch                     , Ce  ) 
    333          ELSE 
    334             !! If air temp. and spec. hum. are at a different height to wind : 
    335             CALL TURB_CORE_2Z(rn_zqt, rn_zu , zst   , sf(jp_tair)%fnow,         & 
    336                &                              zqsatw, sf(jp_humi)%fnow, wndm,   & 
    337                &                              Cd    , Ch              , Ce  ,   & 
    338                &                              zt_zu , zq_zu                 ) 
    339          ENDIF 
    340       ELSE 
    341          !! If air temp. and spec. hum. are given at same height than wind (10m) : 
    342 !gm bug?  at the compiling phase, add a copy in temporary arrays...  ==> check perf 
    343 !         CALL TURB_CORE_1Z( 10., zst   (:,:), sf(jp_tair)%fnow(:,:),              & 
    344 !            &                    zqsatw(:,:), sf(jp_humi)%fnow(:,:), wndm(:,:),   & 
    345 !            &                    Cd    (:,:),             Ch  (:,:), Ce  (:,:)  ) 
    346 !gm bug 
    347 ! ARPDBG - this won't compile with gfortran. Fix but check performance 
    348 ! as per comment above. 
    349          CALL TURB_CORE_1Z( 10., zst   , sf(jp_tair)%fnow(:,:,1),       & 
    350             &                    zqsatw, sf(jp_humi)%fnow(:,:,1), wndm, & 
    351             &                    Cd    , Ch              , Ce    ) 
    352       ENDIF 
    353  
     313      CALL turb_core_2z( rn_zqt, rn_zu, zst, sf(jp_tair)%fnow, zqsatw, sf(jp_humi)%fnow, wndm,   & 
     314         &               Cd, Ch, Ce, zt_zu, zq_zu ) 
     315     
    354316      ! ... tau module, i and j component 
    355317      DO jj = 1, jpj 
    … …  
    363325 
    364326      ! ... add the HF tau contribution to the wind stress module? 
    365       IF( lhftau ) THEN  
    366 !CDIR COLLAPSE 
     327      IF( lhftau ) THEN 
    367328         taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1) 
    368329      ENDIF 
    … …  
    380341      CALL lbc_lnk( vtau(:,:), 'V', -1. ) 
    381342 
     343     
    382344      !  Turbulent fluxes over ocean 
    383345      ! ----------------------------- 
    384       IF( ln_2m .OR. ( ln_bulk2z .AND. rn_zqt /= rn_zu ) ) THEN 
    385          ! Values of temp. and hum. adjusted to height of wind must be used 
    386          zevap(:,:) = rn_efac * MAX( 0.e0, rhoa    *Ce(:,:)*( zqsatw(:,:) - zq_zu(:,:) ) * wndm(:,:) )  ! Evaporation 
    387          zqsb (:,:) =                      rhoa*cpa*Ch(:,:)*( zst   (:,:) - zt_zu(:,:) ) * wndm(:,:)     ! Sensible Heat 
     346      IF( ABS( rn_zu - rn_zqt) < 0.01_wp ) THEN 
     347         !! q_air and t_air are (or "are almost") given at 10m (wind reference height) 
     348         zevap(:,:) = rn_efac*MAX( 0._wp,     rhoa*Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) )*wndm(:,:) ) ! Evaporation 
     349         zqsb (:,:) =                     cpa*rhoa*Ch(:,:)*( zst   (:,:) - sf(jp_tair)%fnow(:,:,1) )*wndm(:,:)   ! Sensible Heat 
    388350      ELSE 
    389 !CDIR COLLAPSE 
    390          zevap(:,:) = rn_efac * MAX( 0.e0, rhoa    *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) ) * wndm(:,:) )   ! Evaporation 
    391 !CDIR COLLAPSE 
    392          zqsb (:,:) =            rhoa*cpa*Ch(:,:)*( zst   (:,:) - sf(jp_tair)%fnow(:,:,1) ) * wndm(:,:)     ! Sensible Heat 
     351         !! q_air and t_air are not given at 10m (wind reference height) 
     352         ! Values of temp. and hum. adjusted to height of wind during bulk algorithm iteration must be used!!! 
     353         zevap(:,:) = rn_efac*MAX( 0._wp,     rhoa*Ce(:,:)*( zqsatw(:,:) - zq_zu(:,:) )*wndm(:,:) )   ! Evaporation 
     354         zqsb (:,:) =                     cpa*rhoa*Ch(:,:)*( zst   (:,:) - zt_zu(:,:) )*wndm(:,:)     ! Sensible Heat 
    393355      ENDIF 
    394 !CDIR COLLAPSE 
    395356      zqla (:,:) = Lv * zevap(:,:)                                                              ! Latent Heat 
    396357 
    … …  
    409370      !     III    Total FLUXES                                                       ! 
    410371      ! ----------------------------------------------------------------------------- ! 
    411       
    412 !CDIR COLLAPSE 
     372      ! 
    413373      emp (:,:) = (  zevap(:,:)                                          &   ! mass flux (evap. - precip.) 
    414374         &         - sf(jp_prec)%fnow(:,:,1) * rn_pfac  ) * tmask(:,:,1) 
    415 !CDIR COLLAPSE 
    416375      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                &   ! Downward Non Solar flux 
    417376         &     - sf(jp_snow)%fnow(:,:,1) * rn_pfac * lfus                         &   ! remove latent melting heat for solid precip 
    418377         &     - zevap(:,:) * pst(:,:) * rcp                                      &   ! remove evap heat content at SST 
    419378         &     + ( sf(jp_prec)%fnow(:,:,1) - sf(jp_snow)%fnow(:,:,1) ) * rn_pfac  &   ! add liquid precip heat content at Tair 
    420          &     * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp                          &    
     379         &     * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp                          & 
    421380         &     + sf(jp_snow)%fnow(:,:,1) * rn_pfac                                &   ! add solid  precip heat content at min(Tair,Tsnow) 
    422381         &     * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic  
    … …  
    442401      ! 
    443402   END SUBROUTINE blk_oce_core 
    444    
    445    SUBROUTINE blk_bio_meanqsr 
    446       !!--------------------------------------------------------------------- 
    447       !!                     ***  ROUTINE blk_bio_meanqsr 
    448       !!                      
    449       !! ** Purpose :   provide daily qsr_mean for PISCES when 
    450       !!                analytic diurnal cycle is applied in physic 
    451       !!                 
    452       !! ** Method  :   add part where there is no ice 
    453       !!  
    454       !!--------------------------------------------------------------------- 
    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  
    461    END SUBROUTINE blk_bio_meanqsr 
    462   
    463   
    464    SUBROUTINE blk_ice_meanqsr(palb,p_qsr_mean,pdim) 
    465       !!--------------------------------------------------------------------- 
    466       !! 
    467       !! ** Purpose :   provide the daily qsr_mean over sea_ice for PISCES when 
    468       !!                analytic diurnal cycle is applied in physic 
    469       !! 
    470       !! ** Method  :   compute qsr 
    471       !!  
    472       !!--------------------------------------------------------------------- 
    473       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb       ! ice albedo (clear sky) (alb_ice_cs)               [%] 
    474       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qsr_mean !     solar heat flux over ice (T-point)         [W/m2] 
    475       INTEGER                   , INTENT(in   ) ::   pdim       ! number of ice categories 
    476       !! 
    477       INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays) 
    478       INTEGER  ::   ji, jj, jl    ! dummy loop indices 
    479       REAL(wp) ::   zztmp         ! temporary variable 
    480       !!--------------------------------------------------------------------- 
    481       IF( nn_timing == 1 )  CALL timing_start('blk_ice_meanqsr') 
    482       ! 
    483       ijpl  = pdim                            ! number of ice categories 
    484       zztmp = 1. / ( 1. - albo ) 
    485       !                                     ! ========================== ! 
    486       DO jl = 1, ijpl                       !  Loop over ice categories  ! 
    487          !                                  ! ========================== ! 
    488          DO jj = 1 , jpj 
    489             DO ji = 1, jpi 
    490                   p_qsr_mean(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr_mean(ji,jj) 
    491             END DO 
    492          END DO 
    493       END DO 
    494       ! 
    495       IF( nn_timing == 1 )  CALL timing_stop('blk_ice_meanqsr') 
    496       ! 
    497    END SUBROUTINE blk_ice_meanqsr   
    498403  
    499404    
    … …  
    518423      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pui      ! ice surface velocity (i- and i- components      [m/s] 
    519424      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pvi      !    at I-point (B-grid) or U & V-point (C-grid) 
    520       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb     ! ice albedo (clear sky) (alb_ice_cs)               [%] 
     425      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb     ! ice albedo (all skies)                            [%] 
    521426      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_taui   ! i- & j-components of surface ice stress        [N/m2] 
    522427      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_tauj   !   at I-point (B-grid) or U & V-point (C-grid) 
    … …  
    538443      REAL(wp) ::   zcoef_wnorm, zcoef_wnorm2, zcoef_dqlw, zcoef_dqla, zcoef_dqsb 
    539444      REAL(wp) ::   zztmp                                        ! temporary variable 
    540       REAL(wp) ::   zcoef_frca                                   ! fractional cloud amount 
    541445      REAL(wp) ::   zwnorm_f, zwndi_f , zwndj_f                  ! relative wind module and components at F-point 
    542446      REAL(wp) ::             zwndi_t , zwndj_t                  ! relative wind components at T-point 
    … …  
    562466      zcoef_dqla   = -Ls * Cice * 11637800. * (-5897.8) 
    563467      zcoef_dqsb   = rhoa * cpa * Cice 
    564       zcoef_frca   = 1.0  - 0.3 
    565       ! MV 2014 the proper cloud fraction (mean summer months from the CLIO climato, NH+SH) is 0.19 
    566       zcoef_frca   = 1.0  - 0.19 
    567468 
    568469!!gm brutal.... 
    … …  
    581482      CASE( 'I' )                  ! B-grid ice dynamics :   I-point (i.e. F-point with sea-ice indexation) 
    582483         !                           and scalar wind at T-point ( = | U10m - U_ice | ) (masked) 
    583 !CDIR NOVERRCHK 
    584484         DO jj = 2, jpjm1 
    585485            DO ji = 2, jpim1   ! B grid : NO vector opt 
    … …  
    606506         ! 
    607507      CASE( 'C' )                  ! C-grid ice dynamics :   U & V-points (same as ocean) 
    608 #if defined key_vectopt_loop 
    609 !CDIR COLLAPSE 
    610 #endif 
    611508         DO jj = 2, jpj 
    612509            DO ji = fs_2, jpi   ! vect. opt. 
    … …  
    616513            END DO 
    617514         END DO 
    618 #if defined key_vectopt_loop 
    619 !CDIR COLLAPSE 
    620 #endif 
    621515         DO jj = 2, jpjm1 
    622516            DO ji = fs_2, fs_jpim1   ! vect. opt. 
    … …  
    637531      DO jl = 1, ijpl                       !  Loop over ice categories  ! 
    638532         !                                  ! ========================== ! 
    639 !CDIR NOVERRCHK 
    640 !CDIR COLLAPSE 
    641533         DO jj = 1 , jpj 
    642 !CDIR NOVERRCHK 
    643534            DO ji = 1, jpi 
    644535               ! ----------------------------! 
    … …  
    665556                  &                         * (  11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) ) 
    666557               ! Latent heat sensitivity for ice (Dqla/Dt) 
    667                ! MV we also have to cap the sensitivity if the flux is zero 
    668                IF ( p_qla(ji,jj,jl) .GT. 0.0 ) THEN 
     558               IF( p_qla(ji,jj,jl) > 0._wp ) THEN 
    669559                  p_dqla(ji,jj,jl) = rn_efac * zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) 
    670560               ELSE 
    671                   p_dqla(ji,jj,jl) = 0.0 
     561                  p_dqla(ji,jj,jl) = 0._wp 
    672562               ENDIF 
    673                               
     563 
    674564               ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 
    675565               z_dqsb(ji,jj,jl) = zcoef_dqsb * z_wnds_t(ji,jj) 
    … …  
    679569               ! ----------------------------! 
    680570               ! Downward Non Solar flux 
    681                p_qns (ji,jj,jl) =     z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - p_qla (ji,jj,jl)       
     571               p_qns (ji,jj,jl) =     z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - p_qla (ji,jj,jl) 
    682572               ! Total non solar heat flux sensitivity for ice 
    683                p_dqns(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + p_dqla(ji,jj,jl) )     
     573               p_dqns(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + p_dqla(ji,jj,jl) ) 
    684574            END DO 
    685575            ! 
    … …  
    692582      ! thin surface layer and penetrates inside the ice cover 
    693583      ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 ) 
    694      
    695 !CDIR COLLAPSE 
    696       p_fr1(:,:) = ( 0.18 * ( 1.0 - zcoef_frca ) + 0.35 * zcoef_frca ) 
    697 !CDIR COLLAPSE 
    698       p_fr2(:,:) = ( 0.82 * ( 1.0 - zcoef_frca ) + 0.65 * zcoef_frca ) 
    699         
    700 !CDIR COLLAPSE 
     584      ! 
     585      p_fr1(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 
     586      p_fr2(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
     587      ! 
    701588      p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac      ! total precipitation [kg/m2/s] 
    702 !CDIR COLLAPSE 
    703589      p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac      ! solid precipitation [kg/m2/s] 
    704       CALL iom_put( 'snowpre', p_spr * 86400. )                  ! Snow precipitation  
    705       CALL iom_put( 'precip', p_tpr * 86400. )                   ! Total precipitation  
     590      CALL iom_put( 'snowpre', p_spr * 86400. )                  ! Snow precipitation 
     591      CALL iom_put( 'precip' , p_tpr * 86400. )                  ! Total precipitation 
    706592      ! 
    707593      IF(ln_ctl) THEN 
    … …  
    716602      ENDIF 
    717603 
    718       CALL wrk_dealloc( jpi,jpj, z_wnds_t ) 
    719       CALL wrk_dealloc( jpi,jpj,pdim, z_qlw, z_qsb, z_dqlw, z_dqsb )  
     604      CALL wrk_dealloc( jpi,jpj,   z_wnds_t ) 
     605      CALL wrk_dealloc( jpi,jpj,   pdim, z_qlw, z_qsb, z_dqlw, z_dqsb ) 
    720606      ! 
    721607      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_core') 
    722608      ! 
    723609   END SUBROUTINE blk_ice_core 
    724    
    725  
    726    SUBROUTINE TURB_CORE_1Z(zu, sst, T_a, q_sat, q_a,   & 
    727       &                        dU , Cd , Ch   , Ce   ) 
     610 
     611 
     612   SUBROUTINE blk_bio_meanqsr 
     613      !!--------------------------------------------------------------------- 
     614      !!                     ***  ROUTINE blk_bio_meanqsr 
     615      !!                      
     616      !! ** Purpose :   provide daily qsr_mean for PISCES when 
     617      !!                analytic diurnal cycle is applied in physic 
     618      !!                 
     619      !! ** Method  :   add part where there is no ice 
     620      !!  
     621      !!--------------------------------------------------------------------- 
     622      IF( nn_timing == 1 )  CALL timing_start('blk_bio_meanqsr') 
     623      ! 
     624      qsr_mean(:,:) = (1. - albo ) *  sf(jp_qsr)%fnow(:,:,1) 
     625      ! 
     626      IF( nn_timing == 1 )  CALL timing_stop('blk_bio_meanqsr') 
     627      ! 
     628   END SUBROUTINE blk_bio_meanqsr 
     629  
     630  
     631   SUBROUTINE blk_ice_meanqsr( palb, p_qsr_mean, pdim ) 
     632      !!--------------------------------------------------------------------- 
     633      !! 
     634      !! ** Purpose :   provide the daily qsr_mean over sea_ice for PISCES when 
     635      !!                analytic diurnal cycle is applied in physic 
     636      !! 
     637      !! ** Method  :   compute qsr 
     638      !!  
     639      !!--------------------------------------------------------------------- 
     640      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb       ! ice albedo (clear sky) (alb_ice_cs)               [%] 
     641      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qsr_mean !     solar heat flux over ice (T-point)         [W/m2] 
     642      INTEGER                   , INTENT(in   ) ::   pdim       ! number of ice categories 
     643      ! 
     644      INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays) 
     645      INTEGER  ::   ji, jj, jl    ! dummy loop indices 
     646      REAL(wp) ::   zztmp         ! temporary variable 
     647      !!--------------------------------------------------------------------- 
     648      IF( nn_timing == 1 )  CALL timing_start('blk_ice_meanqsr') 
     649      ! 
     650      ijpl  = pdim                            ! number of ice categories 
     651      zztmp = 1. / ( 1. - albo ) 
     652      !                                     ! ========================== ! 
     653      DO jl = 1, ijpl                       !  Loop over ice categories  ! 
     654         !                                  ! ========================== ! 
     655         DO jj = 1 , jpj 
     656            DO ji = 1, jpi 
     657                  p_qsr_mean(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr_mean(ji,jj) 
     658            END DO 
     659         END DO 
     660      END DO 
     661      ! 
     662      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_meanqsr') 
     663      ! 
     664   END SUBROUTINE blk_ice_meanqsr   
     665 
     666 
     667   SUBROUTINE turb_core_2z( zt, zu, sst, T_zt, q_sat, q_zt, dU,    & 
     668      &                      Cd, Ch, Ce , T_zu, q_zu ) 
    728669      !!---------------------------------------------------------------------- 
    729670      !!                      ***  ROUTINE  turb_core  *** 
    730671      !! 
    731672      !! ** Purpose :   Computes turbulent transfert coefficients of surface 
    732       !!                fluxes according to Large & Yeager (2004) 
    733       !! 
    734       !! ** Method  :   I N E R T I A L   D I S S I P A T I O N   M E T H O D 
    735       !!      Momentum, Latent and sensible heat exchange coefficients 
    736       !!      Caution: this procedure should only be used in cases when air 
    737       !!      temperature (T_air), air specific humidity (q_air) and wind (dU) 
    738       !!      are provided at the same height 'zzu'! 
    739       !! 
    740       !! References :   Large & Yeager, 2004 : ??? 
    741       !!---------------------------------------------------------------------- 
    742       REAL(wp)                , INTENT(in   ) ::   zu      ! altitude of wind measurement       [m] 
    743       REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   sst     ! sea surface temperature         [Kelvin] 
    744       REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   T_a     ! potential air temperature       [Kelvin] 
    745       REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   q_sat   ! sea surface specific humidity   [kg/kg] 
    746       REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   q_a     ! specific air humidity           [kg/kg] 
    747       REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   dU      ! wind module |U(zu)-U(0)|        [m/s] 
    748       REAL(wp), DIMENSION(:,:), INTENT(  out) ::   Cd      ! transfert coefficient for momentum       (tau) 
    749       REAL(wp), DIMENSION(:,:), INTENT(  out) ::   Ch      ! transfert coefficient for temperature (Q_sens) 
    750       REAL(wp), DIMENSION(:,:), INTENT(  out) ::   Ce      ! transfert coefficient for evaporation  (Q_lat) 
    751       !! 
    752       INTEGER :: j_itt 
    753       INTEGER , PARAMETER ::   nb_itt = 3 
    754       REAL(wp), PARAMETER ::   grav   = 9.8   ! gravity                        
    755       REAL(wp), PARAMETER ::   kappa  = 0.4   ! von Karman s constant 
    756  
    757       REAL(wp), DIMENSION(:,:), POINTER  ::   dU10          ! dU                                   [m/s] 
    758       REAL(wp), DIMENSION(:,:), POINTER  ::   dT            ! air/sea temperature differeence      [K] 
    759       REAL(wp), DIMENSION(:,:), POINTER  ::   dq            ! air/sea humidity difference          [K] 
    760       REAL(wp), DIMENSION(:,:), POINTER  ::   Cd_n10        ! 10m neutral drag coefficient 
    761       REAL(wp), DIMENSION(:,:), POINTER  ::   Ce_n10        ! 10m neutral latent coefficient 
    762       REAL(wp), DIMENSION(:,:), POINTER  ::   Ch_n10        ! 10m neutral sensible coefficient 
    763       REAL(wp), DIMENSION(:,:), POINTER  ::   sqrt_Cd_n10   ! root square of Cd_n10 
    764       REAL(wp), DIMENSION(:,:), POINTER  ::   sqrt_Cd       ! root square of Cd 
    765       REAL(wp), DIMENSION(:,:), POINTER  ::   T_vpot        ! virtual potential temperature        [K] 
    766       REAL(wp), DIMENSION(:,:), POINTER  ::   T_star        ! turbulent scale of tem. fluct. 
    767       REAL(wp), DIMENSION(:,:), POINTER  ::   q_star        ! turbulent humidity of temp. fluct. 
    768       REAL(wp), DIMENSION(:,:), POINTER  ::   U_star        ! turb. scale of velocity fluct. 
    769       REAL(wp), DIMENSION(:,:), POINTER  ::   L             ! Monin-Obukov length                  [m] 
    770       REAL(wp), DIMENSION(:,:), POINTER  ::   zeta          ! stability parameter at height zu 
    771       REAL(wp), DIMENSION(:,:), POINTER  ::   U_n10         ! neutral wind velocity at 10m         [m]    
    772       REAL(wp), DIMENSION(:,:), POINTER  ::   xlogt, xct, zpsi_h, zpsi_m 
    773        
    774       INTEGER , DIMENSION(:,:), POINTER  ::   stab          ! 1st guess stability test integer 
    775       !!---------------------------------------------------------------------- 
    776       ! 
    777       IF( nn_timing == 1 )  CALL timing_start('TURB_CORE_1Z') 
    778       ! 
    779       CALL wrk_alloc( jpi,jpj, stab )   ! integer 
    780       CALL wrk_alloc( jpi,jpj, dU10, dT, dq, Cd_n10, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd, L ) 
    781       CALL wrk_alloc( jpi,jpj, T_vpot, T_star, q_star, U_star, zeta, U_n10, xlogt, xct, zpsi_h, zpsi_m ) 
    782  
    783       !! * Start 
    784       !! Air/sea differences 
    785       dU10 = max(0.5, dU)     ! we don't want to fall under 0.5 m/s 
    786       dT = T_a - sst          ! assuming that T_a is allready the potential temp. at zzu 
    787       dq = q_a - q_sat 
    788       !!     
    789       !! Virtual potential temperature 
    790       T_vpot = T_a*(1. + 0.608*q_a) 
    791       !! 
    792       !! Neutral Drag Coefficient 
    793       stab    = 0.5 + sign(0.5,dT)    ! stable : stab = 1 ; unstable : stab = 0  
    794       IF  ( ln_cdgw ) THEN 
    795         cdn_wave = cdn_wave - rsmall*(tmask(:,:,1)-1) 
    796         Cd_n10(:,:) =   cdn_wave 
    797       ELSE 
    798         Cd_n10  = 1.e-3 * ( 2.7/dU10 + 0.142 + dU10/13.09 )    !   L & Y eq. (6a) 
    799       ENDIF 
    800       sqrt_Cd_n10 = sqrt(Cd_n10) 
    801       Ce_n10  = 1.e-3 * ( 34.6 * sqrt_Cd_n10 )               !   L & Y eq. (6b) 
    802       Ch_n10  = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1.-stab)) !   L & Y eq. (6c), (6d) 
    803       !! 
    804       !! Initializing transfert coefficients with their first guess neutral equivalents : 
    805       Cd = Cd_n10 ;  Ce = Ce_n10 ;  Ch = Ch_n10 ;  sqrt_Cd = sqrt(Cd) 
    806  
    807       !! * Now starting iteration loop 
    808       DO j_itt=1, nb_itt 
    809          !! Turbulent scales : 
    810          U_star  = sqrt_Cd*dU10                !   L & Y eq. (7a) 
    811          T_star  = Ch/sqrt_Cd*dT               !   L & Y eq. (7b) 
    812          q_star  = Ce/sqrt_Cd*dq               !   L & Y eq. (7c) 
    813  
    814          !! Estimate the Monin-Obukov length : 
    815          L  = (U_star**2)/( kappa*grav*(T_star/T_vpot + q_star/(q_a + 1./0.608)) ) 
    816  
    817          !! Stability parameters : 
    818          zeta  = zu/L ;  zeta   = sign( min(abs(zeta),10.0), zeta ) 
    819          zpsi_h  = psi_h(zeta) 
    820          zpsi_m  = psi_m(zeta) 
    821  
    822          IF  ( ln_cdgw ) THEN 
    823            sqrt_Cd=kappa/((kappa/sqrt_Cd_n10) - zpsi_m) ; Cd=sqrt_Cd*sqrt_Cd; 
    824          ELSE 
    825            !! Shifting the wind speed to 10m and neutral stability :  L & Y eq. (9a) 
    826            !   In very rare low-wind conditions, the old way of estimating the 
    827            !   neutral wind speed at 10m leads to a negative value that causes the code 
    828            !   to crash. To prevent this a threshold of 0.25m/s is now imposed. 
    829            U_n10 = MAX( 0.25 , dU10/(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m)) ) 
    830  
    831            !! Updating the neutral 10m transfer coefficients : 
    832            Cd_n10  = 1.e-3 * (2.7/U_n10 + 0.142 + U_n10/13.09)              !  L & Y eq. (6a) 
    833            sqrt_Cd_n10 = sqrt(Cd_n10) 
    834            Ce_n10  = 1.e-3 * (34.6 * sqrt_Cd_n10)                           !  L & Y eq. (6b) 
    835            stab    = 0.5 + sign(0.5,zeta) 
    836            Ch_n10  = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1.-stab))           !  L & Y eq. (6c), (6d) 
    837  
    838            !! Shifting the neutral  10m transfer coefficients to ( zu , zeta ) : 
    839            !! 
    840            xct = 1. + sqrt_Cd_n10/kappa*(log(zu/10) - zpsi_m) 
    841            Cd  = Cd_n10/(xct*xct) ;  sqrt_Cd = sqrt(Cd) 
    842          ENDIF 
    843          !! 
    844          xlogt = log(zu/10.) - zpsi_h 
    845          !! 
    846          xct = 1. + Ch_n10*xlogt/kappa/sqrt_Cd_n10 
    847          Ch  = Ch_n10*sqrt_Cd/sqrt_Cd_n10/xct 
    848          !! 
    849          xct = 1. + Ce_n10*xlogt/kappa/sqrt_Cd_n10 
    850          Ce  = Ce_n10*sqrt_Cd/sqrt_Cd_n10/xct 
    851          !! 
    852       END DO 
    853       !! 
    854       CALL wrk_dealloc( jpi,jpj, stab )   ! integer 
    855       CALL wrk_dealloc( jpi,jpj, dU10, dT, dq, Cd_n10, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd, L ) 
    856       CALL wrk_dealloc( jpi,jpj, T_vpot, T_star, q_star, U_star, zeta, U_n10, xlogt, xct, zpsi_h, zpsi_m ) 
    857       ! 
    858       IF( nn_timing == 1 )  CALL timing_stop('TURB_CORE_1Z') 
    859       ! 
    860     END SUBROUTINE TURB_CORE_1Z 
    861  
    862  
    863     SUBROUTINE TURB_CORE_2Z(zt, zu, sst, T_zt, q_sat, q_zt, dU, Cd, Ch, Ce, T_zu, q_zu) 
    864       !!---------------------------------------------------------------------- 
    865       !!                      ***  ROUTINE  turb_core  *** 
    866       !! 
    867       !! ** Purpose :   Computes turbulent transfert coefficients of surface  
    868       !!                fluxes according to Large & Yeager (2004). 
    869       !! 
    870       !! ** Method  :   I N E R T I A L   D I S S I P A T I O N   M E T H O D 
    871       !!      Momentum, Latent and sensible heat exchange coefficients 
    872       !!      Caution: this procedure should only be used in cases when air 
    873       !!      temperature (T_air) and air specific humidity (q_air) are at a 
    874       !!      different height to wind (dU). 
    875       !! 
    876       !! References :   Large & Yeager, 2004 : ??? 
     673      !!                fluxes according to Large & Yeager (2004) and Large & Yeager (2008) 
     674      !!                If relevant (zt /= zu), adjust temperature and humidity from height zt to zu 
     675      !! 
     676      !! ** Method : Monin Obukhov Similarity Theory  
     677      !!             + Large & Yeager (2004,2008) closure: CD_n10 = f(U_n10) 
     678      !! 
     679      !! ** References :   Large & Yeager, 2004 / Large & Yeager, 2008 
     680      !! 
     681      !! ** Last update: Laurent Brodeau, June 2014: 
     682      !!    - handles both cases zt=zu and zt/=zu 
     683      !!    - optimized: less 2D arrays allocated and less operations 
     684      !!    - better first guess of stability by checking air-sea difference of virtual temperature 
     685      !!       rather than temperature difference only... 
     686      !!    - added function "cd_neutral_10m" that uses the improved parametrization of  
     687      !!      Large & Yeager 2008. Drag-coefficient reduction for Cyclone conditions! 
     688      !!    - using code-wide physical constants defined into "phycst.mod" rather than redifining them 
     689      !!      => 'vkarmn' and 'grav' 
    877690      !!---------------------------------------------------------------------- 
    878691      REAL(wp), INTENT(in   )                     ::   zt       ! height for T_zt and q_zt                   [m] 
    … …  
    882695      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_sat    ! sea surface specific humidity         [kg/kg] 
    883696      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity                 [kg/kg] 
    884       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   dU       ! relative wind module |U(zu)-U(0)|       [m/s] 
     697      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   dU       ! relative wind module at zu            [m/s] 
    885698      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cd       ! transfer coefficient for momentum         (tau) 
    886699      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ch       ! transfer coefficient for sensible heat (Q_sens) 
    … …  
    888701      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   T_zu     ! air temp. shifted at zu                     [K] 
    889702      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. hum.  shifted at zu               [kg/kg] 
    890  
    891       INTEGER :: j_itt 
    892       INTEGER , PARAMETER :: nb_itt = 5              ! number of itterations 
    893       REAL(wp), PARAMETER ::   grav   = 9.8          ! gravity                        
    894       REAL(wp), PARAMETER ::   kappa  = 0.4          ! von Karman's constant 
    895        
    896       REAL(wp), DIMENSION(:,:), POINTER ::   dU10          ! dU                                [m/s] 
    897       REAL(wp), DIMENSION(:,:), POINTER ::   dT            ! air/sea temperature differeence   [K] 
    898       REAL(wp), DIMENSION(:,:), POINTER ::   dq            ! air/sea humidity difference       [K] 
    899       REAL(wp), DIMENSION(:,:), POINTER ::   Cd_n10        ! 10m neutral drag coefficient 
     703      ! 
     704      INTEGER ::   j_itt 
     705      INTEGER , PARAMETER ::   nb_itt = 5       ! number of itterations 
     706      LOGICAL ::   l_zt_equal_zu = .FALSE.      ! if q and t are given at different height than U 
     707      ! 
     708      REAL(wp), DIMENSION(:,:), POINTER ::   U_zu          ! relative wind at zu                            [m/s] 
    900709      REAL(wp), DIMENSION(:,:), POINTER ::   Ce_n10        ! 10m neutral latent coefficient 
    901710      REAL(wp), DIMENSION(:,:), POINTER ::   Ch_n10        ! 10m neutral sensible coefficient 
    902711      REAL(wp), DIMENSION(:,:), POINTER ::   sqrt_Cd_n10   ! root square of Cd_n10 
    903712      REAL(wp), DIMENSION(:,:), POINTER ::   sqrt_Cd       ! root square of Cd 
    904       REAL(wp), DIMENSION(:,:), POINTER ::   T_vpot        ! virtual potential temperature        [K] 
    905       REAL(wp), DIMENSION(:,:), POINTER ::   T_star        ! turbulent scale of tem. fluct. 
    906       REAL(wp), DIMENSION(:,:), POINTER ::   q_star        ! turbulent humidity of temp. fluct. 
    907       REAL(wp), DIMENSION(:,:), POINTER ::   U_star        ! turb. scale of velocity fluct. 
    908       REAL(wp), DIMENSION(:,:), POINTER ::   L             ! Monin-Obukov length                  [m] 
    909713      REAL(wp), DIMENSION(:,:), POINTER ::   zeta_u        ! stability parameter at height zu 
    910714      REAL(wp), DIMENSION(:,:), POINTER ::   zeta_t        ! stability parameter at height zt 
    911       REAL(wp), DIMENSION(:,:), POINTER ::   U_n10         ! neutral wind velocity at 10m        [m] 
    912       REAL(wp), DIMENSION(:,:), POINTER ::   xlogt, xct, zpsi_hu, zpsi_ht, zpsi_m 
    913  
    914       INTEGER , DIMENSION(:,:), POINTER ::   stab          ! 1st stability test integer 
     715      REAL(wp), DIMENSION(:,:), POINTER ::   zpsi_h_u, zpsi_m_u 
     716      REAL(wp), DIMENSION(:,:), POINTER ::   ztmp0, ztmp1, ztmp2 
     717      REAL(wp), DIMENSION(:,:), POINTER ::   stab          ! 1st stability test integer 
    915718      !!---------------------------------------------------------------------- 
    916       ! 
    917       IF( nn_timing == 1 )  CALL timing_start('TURB_CORE_2Z') 
    918       ! 
    919       CALL wrk_alloc( jpi,jpj, dU10, dT, dq, Cd_n10, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd, L ) 
    920       CALL wrk_alloc( jpi,jpj, T_vpot, T_star, q_star, U_star, zeta_u, zeta_t, U_n10 ) 
    921       CALL wrk_alloc( jpi,jpj, xlogt, xct, zpsi_hu, zpsi_ht, zpsi_m ) 
    922       CALL wrk_alloc( jpi,jpj, stab )   ! interger 
    923  
    924       !! Initial air/sea differences 
    925       dU10 = max(0.5, dU)      !  we don't want to fall under 0.5 m/s 
    926       dT = T_zt - sst  
    927       dq = q_zt - q_sat 
    928  
    929       !! Neutral Drag Coefficient : 
    930       stab = 0.5 + sign(0.5,dT)                 ! stab = 1  if dT > 0  -> STABLE 
    931       IF( ln_cdgw ) THEN 
    932         cdn_wave = cdn_wave - rsmall*(tmask(:,:,1)-1) 
    933         Cd_n10(:,:) =   cdn_wave 
     719 
     720      IF( nn_timing == 1 )  CALL timing_start('turb_core_2z') 
     721     
     722      CALL wrk_alloc( jpi,jpj, U_zu, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd ) 
     723      CALL wrk_alloc( jpi,jpj, zeta_u, stab ) 
     724      CALL wrk_alloc( jpi,jpj, zpsi_h_u, zpsi_m_u, ztmp0, ztmp1, ztmp2 ) 
     725 
     726      l_zt_equal_zu = .FALSE. 
     727      IF( ABS(zu - zt) < 0.01 ) l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision 
     728 
     729      IF( .NOT. l_zt_equal_zu )   CALL wrk_alloc( jpi,jpj, zeta_t ) 
     730 
     731      U_zu = MAX( 0.5 , dU )   !  relative wind speed at zu (normally 10m), we don't want to fall under 0.5 m/s 
     732 
     733      !! First guess of stability:  
     734      ztmp0 = T_zt*(1. + 0.608*q_zt) - sst*(1. + 0.608*q_sat) ! air-sea difference of virtual pot. temp. at zt 
     735      stab  = 0.5 + sign(0.5,ztmp0)                           ! stab = 1 if dTv > 0  => STABLE, 0 if unstable 
     736 
     737      !! Neutral coefficients at 10m: 
     738      IF( ln_cdgw ) THEN      ! wave drag case 
     739         cdn_wave(:,:) = cdn_wave(:,:) + rsmall * ( 1._wp - tmask(:,:,1) ) 
     740         ztmp0   (:,:) = cdn_wave(:,:) 
    934741      ELSE 
    935         Cd_n10  = 1.e-3*( 2.7/dU10 + 0.142 + dU10/13.09 )  
     742         ztmp0 = cd_neutral_10m( U_zu ) 
    936743      ENDIF 
    937       sqrt_Cd_n10 = sqrt(Cd_n10) 
     744      sqrt_Cd_n10 = SQRT( ztmp0 ) 
    938745      Ce_n10  = 1.e-3*( 34.6 * sqrt_Cd_n10 ) 
    939746      Ch_n10  = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab)) 
    940  
     747     
    941748      !! Initializing transf. coeff. with their first guess neutral equivalents : 
    942       Cd = Cd_n10 ;  Ce = Ce_n10 ;  Ch = Ch_n10 ;  sqrt_Cd = sqrt(Cd) 
    943  
    944       !! Initializing z_u values with z_t values : 
    945       T_zu = T_zt ;  q_zu = q_zt 
     749      Cd = ztmp0   ;   Ce = Ce_n10   ;   Ch = Ch_n10   ;   sqrt_Cd = sqrt_Cd_n10 
     750 
     751      !! Initializing values at z_u with z_t values: 
     752      T_zu = T_zt   ;   q_zu = q_zt 
    946753 
    947754      !!  * Now starting iteration loop 
    948755      DO j_itt=1, nb_itt 
    949          dT = T_zu - sst ;  dq = q_zu - q_sat ! Updating air/sea differences 
    950          T_vpot = T_zu*(1. + 0.608*q_zu)    ! Updating virtual potential temperature at zu 
    951          U_star = sqrt_Cd*dU10                ! Updating turbulent scales :   (L & Y eq. (7)) 
    952          T_star  = Ch/sqrt_Cd*dT              ! 
    953          q_star  = Ce/sqrt_Cd*dq              ! 
    954          !! 
    955          L = (U_star*U_star) &                ! Estimate the Monin-Obukov length at height zu 
    956               & / (kappa*grav/T_vpot*(T_star*(1.+0.608*q_zu) + 0.608*T_zu*q_star)) 
     756         ! 
     757         ztmp1 = T_zu - sst   ! Updating air/sea differences 
     758         ztmp2 = q_zu - q_sat  
     759 
     760         ! Updating turbulent scales :   (L&Y 2004 eq. (7)) 
     761         ztmp1  = Ch/sqrt_Cd*ztmp1    ! theta* 
     762         ztmp2  = Ce/sqrt_Cd*ztmp2    ! q* 
     763        
     764         ztmp0 = T_zu*(1. + 0.608*q_zu) ! virtual potential temperature at zu 
     765 
     766         ! Estimate the inverse of Monin-Obukov length (1/L) at height zu: 
     767         ztmp0 =  (vkarmn*grav/ztmp0*(ztmp1*(1.+0.608*q_zu) + 0.608*T_zu*ztmp2)) / (Cd*U_zu*U_zu)  
     768         !                                                                     ( Cd*U_zu*U_zu is U*^2 at zu) 
     769 
    957770         !! Stability parameters : 
    958          zeta_u  = zu/L  ;  zeta_u = sign( min(abs(zeta_u),10.0), zeta_u ) 
    959          zeta_t  = zt/L  ;  zeta_t = sign( min(abs(zeta_t),10.0), zeta_t ) 
    960          zpsi_hu = psi_h(zeta_u) 
    961          zpsi_ht = psi_h(zeta_t) 
    962          zpsi_m  = psi_m(zeta_u) 
    963          !! 
    964          !! Shifting the wind speed to 10m and neutral stability : L & Y eq.(9a) 
    965          !   In very rare low-wind conditions, the old way of estimating the 
    966          !   neutral wind speed at 10m leads to a negative value that causes the code 
    967          !   to crash. To prevent this a threshold of 0.25m/s is now imposed. 
    968          U_n10 = MAX( 0.25 , dU10/(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m)) ) 
    969          !! 
    970          !! Shifting temperature and humidity at zu :          (L & Y eq. (9b-9c)) 
    971 !        T_zu = T_zt - T_star/kappa*(log(zt/zu) + psi_h(zeta_u) - psi_h(zeta_t)) 
    972          T_zu = T_zt - T_star/kappa*(log(zt/zu) + zpsi_hu - zpsi_ht) 
    973 !        q_zu = q_zt - q_star/kappa*(log(zt/zu) + psi_h(zeta_u) - psi_h(zeta_t)) 
    974          q_zu = q_zt - q_star/kappa*(log(zt/zu) + zpsi_hu - zpsi_ht) 
    975          !! 
    976          !! q_zu cannot have a negative value : forcing 0 
    977          stab = 0.5 + sign(0.5,q_zu) ;  q_zu = stab*q_zu 
    978          !! 
    979          IF( ln_cdgw ) THEN 
    980             sqrt_Cd=kappa/((kappa/sqrt_Cd_n10) - zpsi_m) ; Cd=sqrt_Cd*sqrt_Cd; 
     771         zeta_u   = zu*ztmp0   ;  zeta_u = sign( min(abs(zeta_u),10.0), zeta_u ) 
     772         zpsi_h_u = psi_h( zeta_u ) 
     773         zpsi_m_u = psi_m( zeta_u ) 
     774        
     775         !! Shifting temperature and humidity at zu (L&Y 2004 eq. (9b-9c)) 
     776         IF ( .NOT. l_zt_equal_zu ) THEN 
     777            zeta_t = zt*ztmp0 ;  zeta_t = sign( min(abs(zeta_t),10.0), zeta_t ) 
     778            stab = LOG(zu/zt) - zpsi_h_u + psi_h(zeta_t)  ! stab just used as temp array!!! 
     779            T_zu = T_zt + ztmp1/vkarmn*stab    ! ztmp1 is still theta* 
     780            q_zu = q_zt + ztmp2/vkarmn*stab    ! ztmp2 is still q* 
     781            q_zu = max(0., q_zu) 
     782         END IF 
     783        
     784         IF( ln_cdgw ) THEN      ! surface wave case 
     785            sqrt_Cd = vkarmn / ( vkarmn / sqrt_Cd_n10 - zpsi_m_u )  
     786            Cd      = sqrt_Cd * sqrt_Cd 
    981787         ELSE 
    982            !! Updating the neutral 10m transfer coefficients : 
    983            Cd_n10  = 1.e-3 * (2.7/U_n10 + 0.142 + U_n10/13.09)    ! L & Y eq. (6a) 
    984            sqrt_Cd_n10 = sqrt(Cd_n10) 
    985            Ce_n10  = 1.e-3 * (34.6 * sqrt_Cd_n10)                 ! L & Y eq. (6b) 
    986            stab    = 0.5 + sign(0.5,zeta_u) 
    987            Ch_n10  = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1.-stab)) ! L & Y eq. (6c-6d) 
    988            !! 
    989            !! 
    990            !! Shifting the neutral 10m transfer coefficients to (zu,zeta_u) : 
    991            xct = 1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m)   ! L & Y eq. (10a) 
    992            Cd = Cd_n10/(xct*xct) ; sqrt_Cd = sqrt(Cd) 
     788           ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)... 
     789           !   In very rare low-wind conditions, the old way of estimating the 
     790           !   neutral wind speed at 10m leads to a negative value that causes the code 
     791           !   to crash. To prevent this a threshold of 0.25m/s is imposed. 
     792           ztmp0 = MAX( 0.25 , U_zu/(1. + sqrt_Cd_n10/vkarmn*(LOG(zu/10.) - zpsi_m_u)) ) !  U_n10 
     793           ztmp0 = cd_neutral_10m(ztmp0)                                                 ! Cd_n10 
     794           sqrt_Cd_n10 = sqrt(ztmp0) 
     795        
     796           Ce_n10  = 1.e-3 * (34.6 * sqrt_Cd_n10)                     ! L&Y 2004 eq. (6b) 
     797           stab    = 0.5 + sign(0.5,zeta_u)                           ! update stability 
     798           Ch_n10  = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab))  ! L&Y 2004 eq. (6c-6d) 
     799 
     800           !! Update of transfer coefficients: 
     801           ztmp1 = 1. + sqrt_Cd_n10/vkarmn*(LOG(zu/10.) - zpsi_m_u)   ! L&Y 2004 eq. (10a) 
     802           Cd      = ztmp0 / ( ztmp1*ztmp1 )    
     803           sqrt_Cd = SQRT( Cd ) 
    993804         ENDIF 
    994          !! 
    995          xlogt = log(zu/10.) - zpsi_hu 
    996          !! 
    997          xct = 1. + Ch_n10*xlogt/kappa/sqrt_Cd_n10               ! L & Y eq. (10b) 
    998          Ch  = Ch_n10*sqrt_Cd/sqrt_Cd_n10/xct 
    999          !! 
    1000          xct = 1. + Ce_n10*xlogt/kappa/sqrt_Cd_n10               ! L & Y eq. (10c) 
    1001          Ce  = Ce_n10*sqrt_Cd/sqrt_Cd_n10/xct 
    1002          !! 
    1003          !! 
     805         ! 
     806         ztmp0 = (LOG(zu/10.) - zpsi_h_u) / vkarmn / sqrt_Cd_n10 
     807         ztmp2 = sqrt_Cd / sqrt_Cd_n10 
     808         ztmp1 = 1. + Ch_n10*ztmp0                
     809         Ch  = Ch_n10*ztmp2 / ztmp1  ! L&Y 2004 eq. (10b) 
     810         ! 
     811         ztmp1 = 1. + Ce_n10*ztmp0                
     812         Ce  = Ce_n10*ztmp2 / ztmp1  ! L&Y 2004 eq. (10c) 
     813         ! 
    1004814      END DO 
    1005       !! 
    1006       CALL wrk_dealloc( jpi,jpj, dU10, dT, dq, Cd_n10, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd, L ) 
    1007       CALL wrk_dealloc( jpi,jpj, T_vpot, T_star, q_star, U_star, zeta_u, zeta_t, U_n10 ) 
    1008       CALL wrk_dealloc( jpi,jpj, xlogt, xct, zpsi_hu, zpsi_ht, zpsi_m ) 
    1009       CALL wrk_dealloc( jpi,jpj, stab )   ! interger 
    1010       ! 
    1011       IF( nn_timing == 1 )  CALL timing_stop('TURB_CORE_2Z') 
    1012       ! 
    1013     END SUBROUTINE TURB_CORE_2Z 
    1014  
    1015  
    1016     FUNCTION psi_m(zta)   !! Psis, L & Y eq. (8c), (8d), (8e) 
     815 
     816      CALL wrk_dealloc( jpi,jpj, U_zu, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd ) 
     817      CALL wrk_dealloc( jpi,jpj, zeta_u, stab ) 
     818      CALL wrk_dealloc( jpi,jpj, zpsi_h_u, zpsi_m_u, ztmp0, ztmp1, ztmp2 ) 
     819 
     820      IF( .NOT. l_zt_equal_zu ) CALL wrk_dealloc( jpi,jpj, zeta_t ) 
     821 
     822      IF( nn_timing == 1 )  CALL timing_stop('turb_core_2z') 
     823      ! 
     824   END SUBROUTINE turb_core_2z 
     825 
     826 
     827   FUNCTION cd_neutral_10m( zw10 ) 
     828      !!---------------------------------------------------------------------- 
     829      !! Estimate of the neutral drag coefficient at 10m as a function  
     830      !! of neutral wind  speed at 10m 
     831      !! 
     832      !! Origin: Large & Yeager 2008 eq.(11a) and eq.(11b) 
     833      !! 
     834      !! Author: L. Brodeau, june 2014 
     835      !!----------------------------------------------------------------------     
     836      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   zw10           ! scalar wind speed at 10m (m/s) 
     837      REAL(wp), DIMENSION(jpi,jpj)             ::   cd_neutral_10m 
     838      ! 
     839      REAL(wp), DIMENSION(:,:), POINTER ::   rgt33 
     840      !!----------------------------------------------------------------------     
     841      ! 
     842      CALL wrk_alloc( jpi,jpj, rgt33 ) 
     843      ! 
     844      !! When wind speed > 33 m/s => Cyclone conditions => special treatment 
     845      rgt33 = 0.5_wp + SIGN( 0.5_wp, (zw10 - 33._wp) )   ! If zw10 < 33. => 0, else => 1   
     846      cd_neutral_10m = 1.e-3 * ( & 
     847         &       (rgt33 + 1._wp)*( 2.7_wp/zw10 + 0.142_wp + zw10/13.09_wp - 3.14807E-10*zw10**6) & ! zw10< 33. 
     848         &      + rgt33         *      2.34   )                                                    ! zw10 >= 33. 
     849      ! 
     850      CALL wrk_dealloc( jpi,jpj, rgt33) 
     851      ! 
     852   END FUNCTION cd_neutral_10m 
     853 
     854 
     855   FUNCTION psi_m(pta)   !! Psis, L&Y 2004 eq. (8c), (8d), (8e) 
    1017856      !------------------------------------------------------------------------------- 
    1018       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: zta 
    1019  
    1020       REAL(wp), PARAMETER :: pi = 3.141592653589793_wp 
     857      ! universal profile stability function for momentum 
     858      !------------------------------------------------------------------------------- 
     859      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pta 
     860      ! 
    1021861      REAL(wp), DIMENSION(jpi,jpj)             :: psi_m 
    1022862      REAL(wp), DIMENSION(:,:), POINTER        :: X2, X, stabit 
    1023863      !------------------------------------------------------------------------------- 
    1024  
     864      ! 
    1025865      CALL wrk_alloc( jpi,jpj, X2, X, stabit ) 
    1026  
    1027       X2 = sqrt(abs(1. - 16.*zta))  ;  X2 = max(X2 , 1.0) ;  X  = sqrt(X2) 
    1028       stabit    = 0.5 + sign(0.5,zta) 
    1029       psi_m = -5.*zta*stabit  &                                                          ! Stable 
    1030          &    + (1. - stabit)*(2*log((1. + X)/2) + log((1. + X2)/2) - 2*atan(X) + pi/2)  ! Unstable  
    1031  
     866      ! 
     867      X2 = SQRT( ABS( 1. - 16.*pta ) )  ;  X2 = MAX( X2 , 1. )   ;   X = SQRT( X2 ) 
     868      stabit = 0.5 + SIGN( 0.5 , pta ) 
     869      psi_m = -5.*pta*stabit  &                                                          ! Stable 
     870         &    + (1. - stabit)*(2.*LOG((1. + X)*0.5) + LOG((1. + X2)*0.5) - 2.*ATAN(X) + rpi*0.5)  ! Unstable 
     871      ! 
    1032872      CALL wrk_dealloc( jpi,jpj, X2, X, stabit ) 
    1033873      ! 
    1034     END FUNCTION psi_m 
    1035  
    1036  
    1037     FUNCTION psi_h( zta )    !! Psis, L & Y eq. (8c), (8d), (8e) 
     874   END FUNCTION psi_m 
     875 
     876 
     877   FUNCTION psi_h( pta )    !! Psis, L&Y 2004 eq. (8c), (8d), (8e) 
    1038878      !------------------------------------------------------------------------------- 
    1039       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   zta 
     879      ! universal profile stability function for temperature and humidity 
     880      !------------------------------------------------------------------------------- 
     881      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pta 
    1040882      ! 
    1041883      REAL(wp), DIMENSION(jpi,jpj)             ::   psi_h 
    1042       REAL(wp), DIMENSION(:,:), POINTER        :: X2, X, stabit 
     884      REAL(wp), DIMENSION(:,:), POINTER        ::   X2, X, stabit 
    1043885      !------------------------------------------------------------------------------- 
    1044  
     886      ! 
    1045887      CALL wrk_alloc( jpi,jpj, X2, X, stabit ) 
    1046  
    1047       X2 = sqrt(abs(1. - 16.*zta))  ;  X2 = max(X2 , 1.) ;  X  = sqrt(X2) 
    1048       stabit    = 0.5 + sign(0.5,zta) 
    1049       psi_h = -5.*zta*stabit  &                                       ! Stable 
    1050          &    + (1. - stabit)*(2.*log( (1. + X2)/2. ))                 ! Unstable 
    1051  
     888      ! 
     889      X2 = SQRT( ABS( 1. - 16.*pta ) )   ;   X2 = MAX( X2 , 1. )   ;   X = SQRT( X2 ) 
     890      stabit = 0.5 + SIGN( 0.5 , pta ) 
     891      psi_h = -5.*pta*stabit   &                                       ! Stable 
     892         &    + (1. - stabit)*(2.*LOG( (1. + X2)*0.5 ))                ! Unstable 
     893      ! 
    1052894      CALL wrk_dealloc( jpi,jpj, X2, X, stabit ) 
    1053895      ! 
    1054     END FUNCTION psi_h 
    1055    
     896   END FUNCTION psi_h 
     897 
    1056898   !!====================================================================== 
    1057899END MODULE sbcblk_core 

  • branches/2014/dev_CNRS_CICE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90

    r4624 r4933  
    8282      !!              - utau, vtau  i- and j-component of the wind stress 
    8383      !!              - taum        wind stress module at T-point 
    84       !!              - wndm        10m wind module at T-point 
     84      !!              - wndm        10m wind module at T-point over free ocean or leads in presence of sea-ice 
    8585      !!              - qns, qsr    non-slor and solar heat flux 
    8686      !!              - emp         evaporation minus precipitation 

  • branches/2014/dev_CNRS_CICE/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r4664 r4933  
    99   !!            3.4  ! 2011_11  (C. Harris) more flexibility + multi-category fields 
    1010   !!---------------------------------------------------------------------- 
    11 #if defined key_oasis3 || defined key_oasis4 
    12    !!---------------------------------------------------------------------- 
    13    !!   'key_oasis3' or 'key_oasis4'   Coupled Ocean/Atmosphere formulation 
    1411   !!---------------------------------------------------------------------- 
    1512   !!   namsbc_cpl      : coupled formulation namlist 
    … …  
    3431   USE ice_2           ! ice variables 
    3532#endif 
    36 #if defined key_oasis3 
    3733   USE cpl_oasis3      ! OASIS3 coupling 
    38 #endif 
    39 #if defined key_oasis4 
    40    USE cpl_oasis4      ! OASIS4 coupling 
    41 #endif 
    4234   USE geo2ocean       !  
    4335   USE oce   , ONLY : tsn, un, vn 
    … …  
    5850   IMPLICIT NONE 
    5951   PRIVATE 
    60  
     52!EM XIOS-OASIS-MCT compliance 
     53   PUBLIC   sbc_cpl_init       ! routine called by sbcmod.F90 
    6154   PUBLIC   sbc_cpl_rcv        ! routine called by sbc_ice_lim(_2).F90 
    6255   PUBLIC   sbc_cpl_snd        ! routine called by step.F90 
    … …  
    129122   TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf 
    130123   TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2                         
     124   ! Other namelist parameters                        ! 
     125   INTEGER     ::   nn_cplmodel            ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
     126   LOGICAL     ::   ln_usecplmask          !  use a coupling mask file to merge data received from several models 
     127                                           !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
     128 
     129   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: xcplmask 
    131130 
    132131   TYPE ::   DYNARR      
    … …  
    139138 
    140139   INTEGER , ALLOCATABLE, SAVE, DIMENSION(    :) ::   nrcvinfo           ! OASIS info argument 
    141  
    142 #if ! defined key_lim2   &&   ! defined key_lim3 
    143    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice,fr1_i0,fr2_i0          ! jpi, jpj 
    144    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice, qns_ice, dqns_ice  ! (jpi,jpj,jpl) 
    145 #endif 
    146  
    147 #if defined key_cice 
    148    INTEGER, PARAMETER ::   jpl = ncat 
    149 #elif ! defined key_lim2   &&   ! defined key_lim3 
    150    INTEGER, PARAMETER ::   jpl = 1  
    151    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice 
    152    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice 
    153 #endif 
    154  
    155 #if ! defined key_lim3   &&  ! defined key_cice 
    156    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i 
    157 #endif 
    158  
    159 #if ! defined key_lim3 
    160    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  ht_i, ht_s 
    161 #endif 
    162  
    163 #if ! defined key_cice 
    164    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  topmelt, botmelt 
    165 #endif 
    166140 
    167141   !! Substitution 
    … …  
    179153      !!             ***  FUNCTION sbc_cpl_alloc  *** 
    180154      !!---------------------------------------------------------------------- 
    181       INTEGER :: ierr(4),jn 
     155      INTEGER :: ierr(3) 
    182156      !!---------------------------------------------------------------------- 
    183157      ierr(:) = 0 
    184158      ! 
    185159      ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv),  STAT=ierr(1) ) 
    186       ! 
    187 #if ! defined key_lim2 && ! defined key_lim3 
    188       ! quick patch to be able to run the coupled model without sea-ice... 
    189       ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) ,     & 
    190                 v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1),      & 
    191                 emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , STAT=ierr(2) ) 
     160       
     161#if ! defined key_lim3 && ! defined key_lim2 && ! defined key_cice 
     162      ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) 
    192163#endif 
    193  
    194 #if ! defined key_lim3 && ! defined key_cice 
    195       ALLOCATE( a_i(jpi,jpj,jpl) , STAT=ierr(3) ) 
    196 #endif 
    197  
    198 #if defined key_cice || defined key_lim2 
    199       ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(4) ) 
    200 #endif 
     164      ALLOCATE( xcplmask(jpi,jpj,nn_cplmodel) , STAT=ierr(3) ) 
     165      ! 
    201166      sbc_cpl_alloc = MAXVAL( ierr ) 
    202167      IF( lk_mpp            )   CALL mpp_sum ( sbc_cpl_alloc ) 
    … …  
    210175      !!             ***  ROUTINE sbc_cpl_init  *** 
    211176      !! 
    212       !! ** Purpose :   Initialisation of send and recieved information from 
     177      !! ** Purpose :   Initialisation of send and received information from 
    213178      !!                the atmospheric component 
    214179      !! 
    … …  
    222187      INTEGER ::   jn   ! dummy loop index 
    223188      INTEGER ::   ios  ! Local integer output status for namelist read 
     189      INTEGER ::   inum  
    224190      REAL(wp), POINTER, DIMENSION(:,:) ::   zacs, zaos 
    225191      !! 
    226       NAMELIST/namsbc_cpl/  sn_snd_temp, sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2,   & 
    227          &                  sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr,   & 
    228          &                  sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf  , sn_rcv_cal   , sn_rcv_iceflx  , sn_rcv_co2 
     192      NAMELIST/namsbc_cpl/  sn_snd_temp, sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2,      & 
     193         &                  sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr,      & 
     194         &                  sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf  , sn_rcv_cal   , sn_rcv_iceflx,   & 
     195         &                  sn_rcv_co2 , nn_cplmodel  , ln_usecplmask 
    229196      !!--------------------------------------------------------------------- 
    230197      ! 
    … …  
    274241         WRITE(numout,*)'                      - mesh          = ', sn_snd_crt%clvgrd 
    275242         WRITE(numout,*)'      oce co2 flux                    = ', TRIM(sn_snd_co2%cldes   ), ' (', TRIM(sn_snd_co2%clcat   ), ')' 
     243         WRITE(numout,*)'  nn_cplmodel                         = ', nn_cplmodel 
     244         WRITE(numout,*)'  ln_usecplmask                       = ', ln_usecplmask 
    276245      ENDIF 
    277246 
    … …  
    604573      ! ================================ ! 
    605574 
    606       CALL cpl_prism_define(jprcv, jpsnd)             
    607       ! 
    608       IF( ln_dm2dc .AND. ( cpl_prism_freq( jpr_qsroce ) + cpl_prism_freq( jpr_qsrmix ) /= 86400 ) )   & 
     575      CALL cpl_define(jprcv, jpsnd,nn_cplmodel)             
     576      IF (ln_usecplmask) THEN  
     577         xcplmask(:,:,:) = 0. 
     578         CALL iom_open( 'cplmask', inum ) 
     579         CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:nlci,1:nlcj,1:nn_cplmodel),   & 
     580            &          kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,nn_cplmodel /) ) 
     581         CALL iom_close( inum ) 
     582      ELSE 
     583         xcplmask(:,:,:) = 1. 
     584      ENDIF 
     585      ! 
     586      IF( ln_dm2dc .AND. ( cpl_freq( jpr_qsroce ) + cpl_freq( jpr_qsrmix ) /= 86400 ) )   & 
    609587         &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 
    610588 
    … …  
    654632      !! 
    655633      !! ** Action  :   update  utau, vtau   ocean stress at U,V grid  
    656       !!                        taum, wndm   wind stres and wind speed module at T-point 
     634      !!                        taum         wind stress module at T-point 
     635      !!                        wndm         wind speed  module at T-point over free ocean or leads in presence of sea-ice 
    657636      !!                        qns          non solar heat fluxes including emp heat content    (ocean only case) 
    658637      !!                                     and the latent heat flux of solid precip. melting 
    … …  
    678657      ! 
    679658      CALL wrk_alloc( jpi,jpj, ztx, zty ) 
    680  
    681       IF( kt == nit000 )   CALL sbc_cpl_init( k_ice )          ! initialisation 
    682  
    683659      !                                                 ! Receive all the atmos. fields (including ice information) 
    684660      isec = ( kt - nit000 ) * NINT( rdttra(1) )             ! date of exchanges 
    685661      DO jn = 1, jprcv                                       ! received fields sent by the atmosphere 
    686          IF( srcv(jn)%laction )   CALL cpl_prism_rcv( jn, isec, frcv(jn)%z3, nrcvinfo(jn) ) 
     662         IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask, nrcvinfo(jn) ) 
    687663      END DO 
    688664 
    … …  
    848824         IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
    849825         IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
    850          ! add the latent heat of solid precip. melting 
    851          IF( srcv(jpr_snow  )%laction )   THEN                         ! update qns over the free ocean with: 
    852               qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus  & ! energy for melting solid precipitation over the free ocean 
    853            &           - emp(:,:) * sst_m(:,:) * rcp                   ! remove heat content due to mass flux (assumed to be at SST) 
     826         ! update qns over the free ocean with: 
     827         qns(:,:) =  qns(:,:) - emp(:,:) * sst_m(:,:) * rcp            ! remove heat content due to mass flux (assumed to be at SST) 
     828         IF( srcv(jpr_snow  )%laction )   THEN 
     829              qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus    ! energy for melting solid precipitation over the free ocean 
    854830         ENDIF 
    855831 
    … …  
    914890      CALL wrk_alloc( jpi,jpj, ztx, zty ) 
    915891 
    916 !AC Pour eviter un stress nul sur la glace dans le cas mixed oce-ice 
    917       IF( srcv(jpr_itx1)%laction .AND. TRIM( sn_rcv_tau%cldes ) == 'oce and ice') THEN   ;   itx =  jpr_itx1    
     892      IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1    
    918893      ELSE                                ;   itx =  jpr_otx1 
    919894      ENDIF 
    … …  
    922897      IF(  nrcvinfo(itx) == OASIS_Rcv ) THEN 
    923898 
    924          !                                                                                              ! ======================= ! 
    925 !AC Pour eviter un stress nul sur la glace dans le cas mixes oce-ice 
    926          IF( srcv(jpr_itx1)%laction .AND. TRIM( sn_rcv_tau%cldes ) == 'oce and ice') THEN               !   ice stress received   ! 
    927             !                                                                                           ! ======================= ! 
     899         !                                                      ! ======================= ! 
     900         IF( srcv(jpr_itx1)%laction ) THEN                      !   ice stress received   ! 
     901            !                                                   ! ======================= ! 
    928902            !   
    929903            IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN            ! 2 components on the sphere 
    … …  
    11251099      REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   p_frld     ! lead fraction                [0 to 1] 
    11261100      ! optional arguments, used only in 'mixed oce-ice' case 
    1127       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! ice albedo  
    1128       REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature     [Celcius] 
     1101      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! all skies ice albedo  
     1102      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature     [Celsius] 
    11291103      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature     [Kelvin] 
    11301104      ! 
    … …  
    12961270      ENDIF 
    12971271 
    1298       SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) 
     1272      !                                                      ! ========================= ! 
     1273      SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) )             !          d(qns)/dt        ! 
     1274      !                                                      ! ========================= ! 
    12991275      CASE ('coupled') 
    13001276         IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 
    … …  
    13081284      END SELECT 
    13091285 
    1310       SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) 
     1286      !                                                      ! ========================= ! 
     1287      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) )             !    topmelt and botmelt    ! 
     1288      !                                                      ! ========================= ! 
    13111289      CASE ('coupled') 
    13121290         topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:) 
    … …  
    13141292      END SELECT 
    13151293 
    1316       !    Ice Qsr penetration used (only?)in lim2 or lim3  
    1317       ! fraction of net shortwave radiation which is not absorbed in the thin surface layer  
    1318       ! and penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 
     1294      ! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 ) 
     1295      ! Used for LIM2 and LIM3 
    13191296      ! Coupled case: since cloud cover is not received from atmosphere  
    1320       !               ===> defined as constant value -> definition done in sbc_cpl_init 
    1321       fr1_i0(:,:) = 0.18 
    1322       fr2_i0(:,:) = 0.82 
    1323  
     1297      !               ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 
     1298      fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 
     1299      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
    13241300 
    13251301      CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr ) 
    … …  
    13361312      !! ** Purpose :   provide the ocean-ice informations to the atmosphere 
    13371313      !! 
    1338       !! ** Method  :   send to the atmosphere through a call to cpl_prism_snd 
     1314      !! ** Method  :   send to the atmosphere through a call to cpl_snd 
    13391315      !!              all the needed fields (as defined in sbc_cpl_init) 
    13401316      !!---------------------------------------------------------------------- 
    … …  
    13551331 
    13561332      zfr_l(:,:) = 1.- fr_i(:,:) 
    1357  
    13581333      !                                                      ! ------------------------- ! 
    13591334      !                                                      !    Surface temperature    !   in Kelvin 
    … …  
    13801355         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 
    13811356         END SELECT 
    1382          IF( ssnd(jps_toce)%laction )   CALL cpl_prism_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
    1383          IF( ssnd(jps_tice)%laction )   CALL cpl_prism_snd( jps_tice, isec, ztmp3, info ) 
    1384          IF( ssnd(jps_tmix)%laction )   CALL cpl_prism_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
    1385       ENDIF 
    1386       ! 
     1357         IF( ssnd(jps_toce)%laction )   CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     1358         IF( ssnd(jps_tice)%laction )   CALL cpl_snd( jps_tice, isec, ztmp3, info ) 
     1359         IF( ssnd(jps_tmix)%laction )   CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     1360      ENDIF 
    13871361      !                                                      ! ------------------------- ! 
    13881362      !                                                      !           Albedo          ! 
    … …  
    13901364      IF( ssnd(jps_albice)%laction ) THEN                         ! ice  
    13911365         ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
    1392          CALL cpl_prism_snd( jps_albice, isec, ztmp3, info ) 
     1366         CALL cpl_snd( jps_albice, isec, ztmp3, info ) 
    13931367      ENDIF 
    13941368      IF( ssnd(jps_albmix)%laction ) THEN                         ! mixed ice-ocean 
    … …  
    13971371            ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl) 
    13981372         ENDDO 
    1399          CALL cpl_prism_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     1373         CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
    14001374      ENDIF 
    14011375      !                                                      ! ------------------------- ! 
    … …  
    14091383         CASE default    ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 
    14101384         END SELECT 
    1411          CALL cpl_prism_snd( jps_fice, isec, ztmp3, info ) 
     1385         CALL cpl_snd( jps_fice, isec, ztmp3, info ) 
    14121386      ENDIF 
    14131387 
    … …  
    14341408         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 
    14351409         END SELECT 
    1436          IF( ssnd(jps_hice)%laction )   CALL cpl_prism_snd( jps_hice, isec, ztmp3, info ) 
    1437          IF( ssnd(jps_hsnw)%laction )   CALL cpl_prism_snd( jps_hsnw, isec, ztmp4, info ) 
     1410         IF( ssnd(jps_hice)%laction )   CALL cpl_snd( jps_hice, isec, ztmp3, info ) 
     1411         IF( ssnd(jps_hsnw)%laction )   CALL cpl_snd( jps_hsnw, isec, ztmp4, info ) 
    14381412      ENDIF 
    14391413      ! 
    … …  
    14421416      !                                                      !  CO2 flux from PISCES     !  
    14431417      !                                                      ! ------------------------- ! 
    1444       IF( ssnd(jps_co2)%laction )   CALL cpl_prism_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 
     1418      IF( ssnd(jps_co2)%laction )   CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 
    14451419      ! 
    14461420#endif 
    … …  
    15651539         ENDIF 
    15661540         ! 
    1567          IF( ssnd(jps_ocx1)%laction )   CALL cpl_prism_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid 
    1568          IF( ssnd(jps_ocy1)%laction )   CALL cpl_prism_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid 
    1569          IF( ssnd(jps_ocz1)%laction )   CALL cpl_prism_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info )   ! ocean z current 1st grid 
     1541         IF( ssnd(jps_ocx1)%laction )   CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid 
     1542         IF( ssnd(jps_ocy1)%laction )   CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid 
     1543         IF( ssnd(jps_ocz1)%laction )   CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info )   ! ocean z current 1st grid 
    15701544         ! 
    1571          IF( ssnd(jps_ivx1)%laction )   CALL cpl_prism_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info )   ! ice   x current 1st grid 
    1572          IF( ssnd(jps_ivy1)%laction )   CALL cpl_prism_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info )   ! ice   y current 1st grid 
    1573          IF( ssnd(jps_ivz1)%laction )   CALL cpl_prism_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info )   ! ice   z current 1st grid 
     1545         IF( ssnd(jps_ivx1)%laction )   CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info )   ! ice   x current 1st grid 
     1546         IF( ssnd(jps_ivy1)%laction )   CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info )   ! ice   y current 1st grid 
     1547         IF( ssnd(jps_ivz1)%laction )   CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info )   ! ice   z current 1st grid 
    15741548         !  
    15751549      ENDIF 
    … …  
    15821556   END SUBROUTINE sbc_cpl_snd 
    15831557    
    1584 #else 
    1585    !!---------------------------------------------------------------------- 
    1586    !!   Dummy module                                            NO coupling 
    1587    !!---------------------------------------------------------------------- 
    1588    USE par_kind        ! kind definition 
    1589 CONTAINS 
    1590    SUBROUTINE sbc_cpl_snd( kt ) 
    1591       WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', kt 
    1592    END SUBROUTINE sbc_cpl_snd 
    1593    ! 
    1594    SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )      
    1595       WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', kt, k_fsbc, k_ice 
    1596    END SUBROUTINE sbc_cpl_rcv 
    1597    ! 
    1598    SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )      
    1599       REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_taui   ! i- & j-components of atmos-ice stress [N/m2] 
    1600       REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_tauj   ! at I-point (B-grid) or U & V-point (C-grid) 
    1601       p_taui(:,:) = 0.   ;   p_tauj(:,:) = 0. ! stupid definition to avoid warning message when compiling... 
    1602       WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?' 
    1603    END SUBROUTINE sbc_cpl_ice_tau 
    1604    ! 
    1605    SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi   , psst    , pist  ) 
    1606       REAL(wp), INTENT(in   ), DIMENSION(:,:  ) ::   p_frld     ! lead fraction                [0 to 1] 
    1607       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! ice albedo 
    1608       REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature      [Celcius] 
    1609       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature      [Kelvin] 
    1610       WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', p_frld(1,1), palbi(1,1,1), psst(1,1), pist(1,1,1)  
    1611    END SUBROUTINE sbc_cpl_ice_flx 
    1612     
    1613 #endif 
    1614  
    16151558   !!====================================================================== 
    16161559END MODULE sbccpl 

  • branches/2014/dev_CNRS_CICE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r4927 r4933  
    105105   END FUNCTION sbc_ice_cice_alloc 
    106106 
    107    SUBROUTINE sbc_ice_cice( kt, nsbc ) 
     107   SUBROUTINE sbc_ice_cice( kt, ksbc ) 
    108108      !!--------------------------------------------------------------------- 
    109109      !!                  ***  ROUTINE sbc_ice_cice  *** 
    … …  
    123123      !!--------------------------------------------------------------------- 
    124124      INTEGER, INTENT(in) ::   kt      ! ocean time step 
    125       INTEGER, INTENT(in) ::   nsbc    ! surface forcing type 
     125      INTEGER, INTENT(in) ::   ksbc    ! surface forcing type 
    126126      !!---------------------------------------------------------------------- 
    127127      ! 
    … …  
    133133 
    134134         ! Make sure any fluxes required for CICE are set 
    135          IF ( nsbc == 2 ) THEN 
     135         IF      ( ksbc == jp_flx ) THEN 
    136136            CALL cice_sbc_force(kt) 
    137          ELSE IF ( nsbc == 5 ) THEN 
     137         ELSE IF ( ksbc == jp_cpl ) THEN 
    138138            CALL sbc_cpl_ice_flx( 1.0-fr_i  ) 
    139139         ENDIF 
    140140 
    141          CALL cice_sbc_in ( kt, nsbc ) 
     141         CALL cice_sbc_in  ( kt, ksbc ) 
    142142         CALL CICE_Run 
    143          CALL cice_sbc_out ( kt, nsbc ) 
    144  
    145          IF ( nsbc == 5 )  CALL cice_sbc_hadgam(kt+1) 
     143         CALL cice_sbc_out ( kt, ksbc ) 
     144 
     145         IF ( ksbc == jp_cpl )  CALL cice_sbc_hadgam(kt+1) 
    146146 
    147147      ENDIF                                          ! End sea-ice time step only 
    … …  
    151151   END SUBROUTINE sbc_ice_cice 
    152152 
    153    SUBROUTINE cice_sbc_init (nsbc) 
     153   SUBROUTINE cice_sbc_init (ksbc) 
    154154      !!--------------------------------------------------------------------- 
    155155      !!                    ***  ROUTINE cice_sbc_init  *** 
    156156      !! ** Purpose: Initialise ice related fields for NEMO and coupling 
    157157      !! 
    158       INTEGER, INTENT( in  ) ::   nsbc                ! surface forcing type 
     158      INTEGER, INTENT( in  ) ::   ksbc                ! surface forcing type 
    159159      REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 
    160160      REAL(wp) ::   zcoefu, zcoefv, zcoeff            ! local scalar 
    … …  
    184184 
    185185! Do some CICE consistency checks 
    186       IF ( (nsbc == 2) .OR. (nsbc == 5) ) THEN 
     186      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_cpl) ) THEN 
    187187         IF ( calc_strair .OR. calc_Tsfc ) THEN 
    188188            CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' ) 
    189189         ENDIF 
    190       ELSEIF (nsbc == 4) THEN 
     190      ELSEIF (ksbc == jp_core) THEN 
    191191         IF ( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN 
    192192            CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=T and calc_Tsfc=T in ice_in' ) 
    … …  
    209209 
    210210      CALL cice2nemo(aice,fr_i, 'T', 1. ) 
    211       IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN 
     211      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_cpl) ) THEN 
    212212         DO jl=1,ncat 
    213213            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 
    … …  
    286286 
    287287    
    288    SUBROUTINE cice_sbc_in (kt, nsbc) 
     288   SUBROUTINE cice_sbc_in (kt, ksbc) 
    289289      !!--------------------------------------------------------------------- 
    290290      !!                    ***  ROUTINE cice_sbc_in  *** 
    … …  
    292292      !!--------------------------------------------------------------------- 
    293293      INTEGER, INTENT(in   ) ::   kt   ! ocean time step 
    294       INTEGER, INTENT(in   ) ::   nsbc ! surface forcing type 
     294      INTEGER, INTENT(in   ) ::   ksbc ! surface forcing type 
    295295 
    296296      INTEGER  ::   ji, jj, jl                   ! dummy loop indices       
    … …  
    316316! forced and coupled case  
    317317 
    318       IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN 
     318      IF ( (ksbc == jp_flx).OR.(ksbc == jp_cpl) ) THEN 
    319319 
    320320         ztmpn(:,:,:)=0.0 
    … …  
    341341 
    342342! Surface downward latent heat flux (CI_5) 
    343          IF (nsbc == 2) THEN 
     343         IF (ksbc == jp_flx) THEN 
    344344            DO jl=1,ncat 
    345345               ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl) 
    … …  
    370370! GBM conductive flux through ice (CI_6) 
    371371!  Convert to GBM 
    372             IF (nsbc == 2) THEN 
     372            IF (ksbc == jp_flx) THEN 
    373373               ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl) 
    374374            ELSE 
    … …  
    379379! GBM surface heat flux (CI_7) 
    380380!  Convert to GBM 
    381             IF (nsbc == 2) THEN 
     381            IF (ksbc == jp_flx) THEN 
    382382               ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl)  
    383383            ELSE 
    … …  
    387387         ENDDO 
    388388 
    389       ELSE IF (nsbc == 4) THEN 
     389      ELSE IF (ksbc == jp_core) THEN 
    390390 
    391391! Pass CORE forcing fields to CICE (which will calculate heat fluxes etc itself) 
    … …  
    514514 
    515515 
    516    SUBROUTINE cice_sbc_out (kt,nsbc) 
     516   SUBROUTINE cice_sbc_out (kt,ksbc) 
    517517      !!--------------------------------------------------------------------- 
    518518      !!                    ***  ROUTINE cice_sbc_out  *** 
    … …  
    520520      !!--------------------------------------------------------------------- 
    521521      INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
    522       INTEGER, INTENT( in  ) ::   nsbc ! surface forcing type 
     522      INTEGER, INTENT( in  ) ::   ksbc ! surface forcing type 
    523523       
    524524      INTEGER  ::   ji, jj, jl                 ! dummy loop indices 
    … …  
    566566! Freshwater fluxes  
    567567 
    568       IF (nsbc == 2) THEN 
     568      IF (ksbc == jp_flx) THEN 
    569569! Note that emp from the forcing files is evap*(1-aice)-(tprecip-aice*sprecip) 
    570570! What we want here is evap*(1-aice)-tprecip*(1-aice) hence manipulation below 
    … …  
    572572! Better to use evap and tprecip? (but for now don't read in evap in this case) 
    573573         emp(:,:)  = emp(:,:)+fr_i(:,:)*(tprecip(:,:)-sprecip(:,:)) 
    574       ELSE IF (nsbc == 4) THEN 
     574      ELSE IF (ksbc == jp_core) THEN 
    575575         emp(:,:)  = (1.0-fr_i(:,:))*emp(:,:)         
    576       ELSE IF (nsbc ==5) THEN 
     576      ELSE IF (ksbc == jp_cpl) THEN 
    577577! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above)  
    578578! This is currently as required with the coupling fields from the UM atmosphere 
    … …  
    605605! Scale qsr and qns according to ice fraction (bulk formulae only) 
    606606 
    607       IF (nsbc == 4) THEN 
     607      IF (ksbc == jp_core) THEN 
    608608         qsr(:,:)=qsr(:,:)*(1.0-fr_i(:,:)) 
    609609         qns(:,:)=qns(:,:)*(1.0-fr_i(:,:)) 
    610610      ENDIF 
    611611! Take into account snow melting except for fully coupled when already in qns_tot 
    612       IF (nsbc == 5) THEN 
     612      IF (ksbc == jp_cpl) THEN 
    613613         qsr(:,:)= qsr_tot(:,:) 
    614614         qns(:,:)= qns_tot(:,:) 
    … …  
    645645 
    646646      CALL cice2nemo(aice,fr_i,'T', 1. ) 
    647       IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN 
     647      IF ( (ksbc == jp_flx).OR.(ksbc == jp_cpl) ) THEN 
    648648         DO jl=1,ncat 
    649649            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 
    … …  
    681681 
    682682 
    683 #if defined key_oasis3 || defined key_oasis4 
    684683   SUBROUTINE cice_sbc_hadgam( kt ) 
    685684      !!--------------------------------------------------------------------- 
    … …  
    723722   END SUBROUTINE cice_sbc_hadgam 
    724723 
    725 #else 
    726    SUBROUTINE cice_sbc_hadgam( kt )    ! Dummy routine 
    727       INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
    728       WRITE(*,*) 'cice_sbc_hadgam: You should not have seen this print! error?' 
    729    END SUBROUTINE cice_sbc_hadgam 
    730 #endif 
    731724 
    732725   SUBROUTINE cice_sbc_final 
    … …  
    10921085CONTAINS 
    10931086 
    1094    SUBROUTINE sbc_ice_cice ( kt, nsbc )     ! Dummy routine 
     1087   SUBROUTINE sbc_ice_cice ( kt, ksbc )     ! Dummy routine 
    10951088      WRITE(*,*) 'sbc_ice_cice: You should not have seen this print! error?', kt 
    10961089   END SUBROUTINE sbc_ice_cice 
    10971090 
    1098    SUBROUTINE cice_sbc_init (nsbc)    ! Dummy routine 
     1091   SUBROUTINE cice_sbc_init (ksbc)    ! Dummy routine 
    10991092      WRITE(*,*) 'cice_sbc_init: You should not have seen this print! error?' 
    11001093   END SUBROUTINE cice_sbc_init 

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

    r4624 r4933  
    1616   USE eosbn2         ! equation of state 
    1717   USE sbc_oce        ! surface boundary condition: ocean fields 
    18    USE sbccpl 
     18#if defined key_lim3 
     19   USE ice    , ONLY :   a_i  
     20#else 
     21   USE sbc_ice, ONLY :   a_i  
     22#endif 
    1923   USE fldread        ! read input field 
    2024   USE iom            ! I/O manager library 
    … …  
    99103                                 ! ( d rho / dt ) / ( d rho / ds )      ( s = 34, t = -1.8 ) 
    100104          
    101          fr_i(:,:) = tfreez( sss_m ) * tmask(:,:,1)      ! sea surface freezing temperature [Celcius] 
     105         fr_i(:,:) = eos_fzp( sss_m ) * tmask(:,:,1)      ! sea surface freezing temperature [Celcius] 
    102106 
    103 ! OM : probleme. a_i pas defini dans les cas lim3 et cice 
    104 #if defined key_coupled && defined key_lim2 
    105          a_i(:,:,1) = fr_i(:,:)          
    106 #endif 
     107         IF( lk_cpl )   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_CICE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r4871 r4933  
    1212   !!            3.4  ! 2011-01  (A Porter)  dynamical allocation 
    1313   !!             -   ! 2012-10  (C. Rousset)  add lim_diahsb 
     14   !!            3.6  ! 2014-07  (M. Vancoppenolle, G. Madec, O. Marti) revise coupled interface 
    1415   !!---------------------------------------------------------------------- 
    1516#if defined key_lim3 
    … …  
    5960   USE prtctl          ! Print control 
    6061   USE lib_fortran     !  
    61    USE cpl_oasis3, ONLY : lk_cpl 
    6262 
    6363#if defined key_bdy  
    … …  
    8080   !!---------------------------------------------------------------------- 
    8181CONTAINS 
    82  
    83    FUNCTION fice_cell_ave ( ptab) 
    84       !!-------------------------------------------------------------------------- 
    85       !! * Compute average over categories, for grid cell (ice covered and free ocean) 
    86       !!-------------------------------------------------------------------------- 
    87       REAL (wp), DIMENSION (jpi,jpj) :: fice_cell_ave 
    88       REAL (wp), DIMENSION (jpi,jpj,jpl), INTENT (in) :: ptab 
    89       INTEGER :: jl ! Dummy loop index 
    90        
    91       fice_cell_ave (:,:) = 0.0_wp 
    92        
    93       DO jl = 1, jpl 
    94          fice_cell_ave (:,:) = fice_cell_ave (:,:) & 
    95             &                  + a_i (:,:,jl) * ptab (:,:,jl) 
    96       END DO 
    97        
    98    END FUNCTION fice_cell_ave 
    99     
    100    FUNCTION fice_ice_ave ( ptab) 
    101       !!-------------------------------------------------------------------------- 
    102       !! * Compute average over categories, for ice covered part of grid cell 
    103       !!-------------------------------------------------------------------------- 
    104       REAL (kind=wp), DIMENSION (jpi,jpj) :: fice_ice_ave 
    105       REAL (kind=wp), DIMENSION (jpi,jpj,jpl), INTENT(in) :: ptab 
    106  
    107       fice_ice_ave (:,:) = 0.0_wp 
    108       WHERE ( at_i (:,:) .GT. 0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:) 
    109  
    110    END FUNCTION fice_ice_ave 
    11182 
    11283   !!====================================================================== 
    … …  
    133104      !!--------------------------------------------------------------------- 
    134105      INTEGER, INTENT(in) ::   kt      ! ocean time step 
    135       INTEGER, INTENT(in) ::   kblk    ! type of bulk (=3 CLIO, =4 CORE) 
     106      INTEGER, INTENT(in) ::   kblk    ! type of bulk (=3 CLIO, =4 CORE, =5 COUPLED) 
    136107      !! 
    137       INTEGER  ::   ji, jj, jl, jk      ! dummy loop index 
     108      INTEGER  ::   jl      ! dummy loop index 
    138109      REAL(wp) ::   zcoef   ! local scalar 
    139       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_ice_os, zalb_ice_cs  ! albedo of the ice under overcast/clear sky 
    140       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_ice      ! mean albedo of ice (for coupled) 
    141  
    142       REAL(wp), POINTER, DIMENSION(:,:) :: zalb_ice_all    ! Mean albedo over all categories 
    143       REAL(wp), POINTER, DIMENSION(:,:) :: ztem_ice_all    ! Mean temperature over all categories 
    144        
    145       REAL(wp), POINTER, DIMENSION(:,:) :: z_qsr_ice_all   ! Mean solar heat flux over all categories 
    146       REAL(wp), POINTER, DIMENSION(:,:) :: z_qns_ice_all   ! Mean non solar heat flux over all categories 
    147       REAL(wp), POINTER, DIMENSION(:,:) :: z_qla_ice_all   ! Mean latent heat flux over all categories 
    148       REAL(wp), POINTER, DIMENSION(:,:) :: z_dqns_ice_all  ! Mean d(qns)/dT over all categories 
    149       REAL(wp), POINTER, DIMENSION(:,:) :: z_dqla_ice_all  ! Mean d(qla)/dT over all categories 
    150       REAL(wp) ::   ztmelts           ! clem 2014: for HC diags 
    151       REAL(wp) ::   epsi20 = 1.e-20   ! 
     110      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_os, zalb_cs  ! ice albedo under overcast/clear sky 
     111      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_ice          ! mean ice albedo (for coupled) 
    152112      !!---------------------------------------------------------------------- 
    153113 
    154       !- O.M. : why do we allocate all these arrays even when MOD( kt-1, nn_fsbc ) /= 0 ????? 
    155  
    156114      IF( nn_timing == 1 )  CALL timing_start('sbc_ice_lim') 
    157  
    158       CALL wrk_alloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs, zalb_ice ) 
    159  
    160       IF( lk_cpl ) THEN 
    161          IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 
    162             &   CALL wrk_alloc( jpi, jpj, ztem_ice_all , zalb_ice_all  , z_qsr_ice_all, z_qns_ice_all,   & 
    163             &                             z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 
    164       ENDIF 
    165115 
    166116      IF( kt == nit000 ) THEN 
    … …  
    185135         u_oce(:,:) = ssu_m(:,:)                     ! mean surface ocean current at ice velocity point 
    186136         v_oce(:,:) = ssv_m(:,:)                     ! (C-grid dynamics :  U- & V-points as the ocean) 
    187  
    188          ! masked sea surface freezing temperature [Kelvin] 
    189          t_bo(:,:) = ( tfreez( sss_m ) +  rt0 ) * tmask(:,:,1) + rt0 * ( 1. - tmask(:,:,1) ) 
    190  
    191          CALL albedo_ice( t_su, ht_i, ht_s, zalb_ice_cs, zalb_ice_os )  ! ... ice albedo 
    192  
     137         ! 
     138         t_bo(:,:) = ( eos_fzp( sss_m ) +  rt0 ) * tmask(:,:,1) + rt0 * ( 1. - tmask(:,:,1) )  ! masked sea surface freezing temperature [Kelvin] 
     139         !                                                                                  ! (set to rt0 over land) 
     140         !                                           ! Ice albedo 
     141         CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice )       
     142 
     143         CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos 
     144 
     145         SELECT CASE( kblk ) 
     146         CASE( jp_core , jp_cpl )   ! CORE and COUPLED bulk formulations 
     147 
     148            ! albedo depends on cloud fraction because of non-linear spectral effects 
     149            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     150            ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo  
     151            ! (zalb_ice) is computed within the bulk routine 
     152             
     153         END SELECT 
     154          
     155         !                                           ! Mask sea ice surface temperature 
    193156         DO jl = 1, jpl 
    194157            t_su(:,:,jl) = t_su(:,:,jl) +  rt0 * ( 1. - tmask(:,:,1) ) 
    195158         END DO 
    196  
    197          IF ( ln_cpl ) zalb_ice (:,:,:) = 0.5 * ( zalb_ice_cs (:,:,:) +  zalb_ice_os (:,:,:) ) 
    198           
    199          IF( lk_cpl ) THEN 
    200             IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 
    201                ! 
    202                ! Compute mean albedo and temperature 
    203                zalb_ice_all (:,:) = fice_ice_ave ( zalb_ice (:,:,:) )  
    204                ztem_ice_all (:,:) = fice_ice_ave ( tn_ice   (:,:,:) )  
    205                ! 
    206             ENDIF 
    207          ENDIF 
    208                                                ! Bulk formulea - provides the following fields: 
     159      
     160         ! Bulk formulae  - provides the following fields: 
    209161         ! utau_ice, vtau_ice : surface ice stress                     (U- & V-points)   [N/m2] 
    210162         ! qsr_ice , qns_ice  : solar & non solar heat flux over ice   (T-point)         [W/m2] 
    … …  
    215167         ! 
    216168         SELECT CASE( kblk ) 
    217          CASE( 3 )                                       ! CLIO bulk formulation 
    218             CALL blk_ice_clio( t_su , zalb_ice_cs, zalb_ice_os,                           & 
     169         CASE( jp_clio )                                       ! CLIO bulk formulation 
     170            CALL blk_ice_clio( t_su , zalb_cs    , zalb_os    , zalb_ice  ,               & 
    219171               &                      utau_ice   , vtau_ice   , qns_ice   , qsr_ice   ,   & 
    220172               &                      qla_ice    , dqns_ice   , dqla_ice  ,               & 
    … …  
    222174               &                      fr1_i0     , fr2_i0     , cp_ice_msh, jpl  ) 
    223175            !          
    224          CASE( 4 )                                       ! CORE bulk formulation 
    225             ! MV 2014 
    226             ! We must account for cloud fraction in the computation of the albedo 
    227             ! The present ref just uses the clear sky value 
    228             ! The overcast sky value is 0.06 higher, and polar skies are mostly overcast 
    229             ! CORE has no cloud fraction, hence we must prescribe it 
    230             ! Mean summer cloud fraction computed from CLIO = 0.81 
    231             zalb_ice(:,:,:) = 0.19 * zalb_ice_cs(:,:,:) + 0.81 * zalb_ice_os(:,:,:) 
    232             ! Following line, we replace zalb_ice_cs by simply zalb_ice 
     176            IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   & 
     177               &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx ) 
     178 
     179         CASE( jp_core )                                       ! CORE bulk formulation 
    233180            CALL blk_ice_core( t_su , u_ice     , v_ice     , zalb_ice   ,               & 
    234181               &                      utau_ice  , vtau_ice  , qns_ice    , qsr_ice   ,   & 
    … …  
    236183               &                      tprecip   , sprecip   ,                            & 
    237184               &                      fr1_i0    , fr2_i0    , cp_ice_msh, jpl  ) 
     185               ! 
     186            IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   & 
     187               &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx ) 
    238188            ! 
    239          CASE ( 5 ) 
    240             zalb_ice (:,:,:) = 0.5 * ( zalb_ice_cs (:,:,:) +  zalb_ice_os (:,:,:) ) 
     189         CASE ( jp_cpl ) 
    241190             
    242191            CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 
    243192 
    244             CALL sbc_cpl_ice_flx( p_frld=ato_i, palbi=zalb_ice, psst=sst_m, pist=tn_ice    ) 
    245  
    246             ! Latent heat flux is forced to 0 in coupled : 
    247             !  it is included in qns (non-solar heat flux) 
    248             qla_ice  (:,:,:) = 0.0e0_wp 
    249             dqla_ice (:,:,:) = 0.0e0_wp 
     193            ! MV -> seb  
     194!           CALL sbc_cpl_ice_flx( p_frld=ato_i, palbi=zalb_ice, psst=sst_m, pist=t_su    ) 
     195 
     196!           IF( nn_limflx == 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   & 
     197!              &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx ) 
     198!           ! Latent heat flux is forced to 0 in coupled : 
     199!           !  it is included in qns (non-solar heat flux) 
     200!           qla_ice  (:,:,:) = 0._wp 
     201!           dqla_ice (:,:,:) = 0._wp 
     202            ! END MV -> seb 
    250203            ! 
    251204         END SELECT 
    252  
    253          ! Average over all categories 
    254          IF( lk_cpl ) THEN 
    255          IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 
    256  
    257             z_qns_ice_all  (:,:) = fice_ice_ave ( qns_ice  (:,:,:) ) 
    258             z_qsr_ice_all  (:,:) = fice_ice_ave ( qsr_ice  (:,:,:) ) 
    259             z_dqns_ice_all (:,:) = fice_ice_ave ( dqns_ice (:,:,:) ) 
    260             z_qla_ice_all  (:,:) = fice_ice_ave ( qla_ice  (:,:,:) ) 
    261             z_dqla_ice_all (:,:) = fice_ice_ave ( dqla_ice (:,:,:) ) 
    262  
    263             DO jl = 1, jpl 
    264                dqns_ice (:,:,jl) = z_dqns_ice_all (:,:) 
    265                dqla_ice (:,:,jl) = z_dqla_ice_all (:,:) 
    266             END DO 
    267             ! 
    268             IF ( ln_iceflx_ave ) THEN 
    269                DO jl = 1, jpl 
    270                   qns_ice  (:,:,jl) = z_qns_ice_all  (:,:) 
    271                   qsr_ice  (:,:,jl) = z_qsr_ice_all  (:,:) 
    272                   qla_ice  (:,:,jl) = z_qla_ice_all  (:,:) 
    273                END DO 
    274             END IF 
    275             ! 
    276             IF ( ln_iceflx_linear ) THEN 
    277                DO jl = 1, jpl 
    278                   qns_ice  (:,:,jl) = z_qns_ice_all(:,:) + z_dqns_ice_all(:,:) * (tn_ice(:,:,jl) - ztem_ice_all(:,:)) 
    279                   qla_ice  (:,:,jl) = z_qla_ice_all(:,:) + z_dqla_ice_all(:,:) * (tn_ice(:,:,jl) - ztem_ice_all(:,:)) 
    280                   qsr_ice  (:,:,jl) = (1.0e0_wp-zalb_ice(:,:,jl)) / (1.0e0_wp-zalb_ice_all(:,:)) * z_qsr_ice_all(:,:) 
    281                END DO 
    282             END IF 
    283          END IF 
    284          ENDIF 
     205          
    285206         !                                           !----------------------! 
    286207         !                                           ! LIM-3  time-stepping ! 
    … …  
    389310                          pfrld(:,:)   = 1._wp - at_i(:,:) 
    390311                          phicif(:,:)  = vt_i(:,:) 
     312 
     313                          ! MV -> seb 
     314                          SELECT CASE( kblk ) 
     315                             CASE ( jp_cpl ) 
     316                             CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su    ) 
     317                             IF( nn_limflx == 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   & 
     318                          &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx ) 
     319                           ! Latent heat flux is forced to 0 in coupled : 
     320                           !  it is included in qns (non-solar heat flux) 
     321                             qla_ice  (:,:,:) = 0._wp 
     322                             dqla_ice (:,:,:) = 0._wp 
     323                          END SELECT 
     324                          ! END MV -> seb 
    391325                          ! 
    392326                          CALL lim_var_bv                 ! bulk brine volume (diag) 
    … …  
    420354         IF( ln_nicep )   CALL lim_ctl( kt )              ! alerts in case of model crash 
    421355         ! 
     356         CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 
     357         ! 
    422358      ENDIF                                    ! End sea-ice time step only 
    423359 
    … …  
    429365      !                                                   ! otherwise the atm.-ocean stresses are used everywhere 
    430366      IF( ln_limdyn )     CALL lim_sbc_tau( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents 
    431        
    432367!!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!! 
    433       CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs, zalb_ice ) 
    434  
    435       IF( lk_cpl ) THEN 
    436          IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 
    437             &    CALL wrk_dealloc( jpi, jpj, ztem_ice_all , zalb_ice_all , z_qsr_ice_all, z_qns_ice_all,   & 
    438             &                                z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 
    439       ENDIF 
     368 
    440369      ! 
    441370      IF( nn_timing == 1 )  CALL timing_stop('sbc_ice_lim') 
    442371      ! 
    443372   END SUBROUTINE sbc_ice_lim 
    444  
    445  
     373    
     374    
     375      SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice,   & 
     376         &                          pdqn_ice, pqla_ice, pdql_ice, k_limflx ) 
     377      !!--------------------------------------------------------------------- 
     378      !!                  ***  ROUTINE sbc_ice_lim  *** 
     379      !!                    
     380      !! ** Purpose :   update the ice surface boundary condition by averaging and / or 
     381      !!                redistributing fluxes on ice categories                    
     382      !! 
     383      !! ** Method  :   average then redistribute  
     384      !! 
     385      !! ** Action  :    
     386      !!--------------------------------------------------------------------- 
     387      INTEGER                   , INTENT(in   ) ::   k_limflx   ! =-1 do nothing; =0 average ;  
     388                                                                ! =1 average and redistribute ; =2 redistribute 
     389      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ptn_ice    ! ice surface temperature  
     390      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb_ice   ! ice albedo 
     391      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pqns_ice   ! non solar flux 
     392      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pqsr_ice   ! net solar flux 
     393      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdqn_ice   ! non solar flux sensitivity 
     394      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pqla_ice   ! latent heat flux 
     395      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdql_ice   ! latent heat flux sensitivity 
     396      ! 
     397      INTEGER  ::   jl      ! dummy loop index 
     398      ! 
     399      REAL(wp), POINTER, DIMENSION(:,:) :: zalb_m    ! Mean albedo over all categories 
     400      REAL(wp), POINTER, DIMENSION(:,:) :: ztem_m    ! Mean temperature over all categories 
     401      ! 
     402      REAL(wp), POINTER, DIMENSION(:,:) :: z_qsr_m   ! Mean solar heat flux over all categories 
     403      REAL(wp), POINTER, DIMENSION(:,:) :: z_qns_m   ! Mean non solar heat flux over all categories 
     404      REAL(wp), POINTER, DIMENSION(:,:) :: z_qla_m   ! Mean latent heat flux over all categories 
     405      REAL(wp), POINTER, DIMENSION(:,:) :: z_dqn_m   ! Mean d(qns)/dT over all categories 
     406      REAL(wp), POINTER, DIMENSION(:,:) :: z_dql_m   ! Mean d(qla)/dT over all categories 
     407      !!---------------------------------------------------------------------- 
     408 
     409      IF( nn_timing == 1 )  CALL timing_start('ice_lim_flx') 
     410      ! 
     411      ! 
     412      SELECT CASE( k_limflx )                              !==  averaged on all ice categories  ==! 
     413      CASE( 0 , 1 ) 
     414         CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_qla_m, z_dqn_m, z_dql_m) 
     415         ! 
     416         z_qns_m(:,:) = fice_ice_ave ( pqns_ice (:,:,:) ) 
     417         z_qsr_m(:,:) = fice_ice_ave ( pqsr_ice (:,:,:) ) 
     418         z_dqn_m(:,:) = fice_ice_ave ( pdqn_ice (:,:,:) ) 
     419         z_qla_m(:,:) = fice_ice_ave ( pqla_ice (:,:,:) ) 
     420         z_dql_m(:,:) = fice_ice_ave ( pdql_ice (:,:,:) ) 
     421         DO jl = 1, jpl 
     422            pdqn_ice(:,:,jl) = z_dqn_m(:,:) 
     423            pdql_ice(:,:,jl) = z_dql_m(:,:) 
     424         END DO 
     425         ! 
     426         DO jl = 1, jpl 
     427            pqns_ice(:,:,jl) = z_qns_m(:,:) 
     428            pqsr_ice(:,:,jl) = z_qsr_m(:,:) 
     429            pqla_ice(:,:,jl) = z_qla_m(:,:) 
     430         END DO 
     431         ! 
     432         CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_qla_m, z_dqn_m, z_dql_m) 
     433      END SELECT 
     434 
     435      SELECT CASE( k_limflx )                              !==  redistribution on all ice categories  ==! 
     436      CASE( 1 , 2 ) 
     437         CALL wrk_alloc( jpi,jpj, zalb_m, ztem_m ) 
     438         ! 
     439         zalb_m(:,:) = fice_ice_ave ( palb_ice (:,:,:) )  
     440         ztem_m(:,:) = fice_ice_ave ( ptn_ice  (:,:,:) )  
     441         DO jl = 1, jpl 
     442            pqns_ice(:,:,jl) = pqns_ice(:,:,jl) + pdqn_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:)) 
     443            pqla_ice(:,:,jl) = pqla_ice(:,:,jl) + pdql_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:)) 
     444            pqsr_ice(:,:,jl) = pqsr_ice(:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) )  
     445         END DO 
     446         ! 
     447         CALL wrk_dealloc( jpi,jpj, zalb_m, ztem_m ) 
     448      END SELECT 
     449      ! 
     450      IF( nn_timing == 1 )  CALL timing_stop('ice_lim_flx') 
     451      ! 
     452   END SUBROUTINE ice_lim_flx 
     453    
     454    
    446455   SUBROUTINE lim_ctl( kt ) 
    447456      !!----------------------------------------------------------------------- 
    … …  
    675684      !!                n : number of the option 
    676685      !!------------------------------------------------------------------- 
    677       INTEGER         , INTENT(in) ::   kt      ! ocean time step 
     686      INTEGER         , INTENT(in) ::   kt            ! ocean time step 
    678687      INTEGER         , INTENT(in) ::   ki, kj, kn    ! ocean gridpoint indices 
    679688      CHARACTER(len=*), INTENT(in) ::   cd1           ! 
    … …  
    853862         END DO 
    854863      END DO 
    855  
     864      ! 
    856865   END SUBROUTINE lim_prt_state 
     866    
     867      
     868   FUNCTION fice_cell_ave ( ptab ) 
     869      !!-------------------------------------------------------------------------- 
     870      !! * Compute average over categories, for grid cell (ice covered and free ocean) 
     871      !!-------------------------------------------------------------------------- 
     872      REAL (wp), DIMENSION (jpi,jpj) :: fice_cell_ave 
     873      REAL (wp), DIMENSION (jpi,jpj,jpl), INTENT (in) :: ptab 
     874      INTEGER :: jl ! Dummy loop index 
     875       
     876      fice_cell_ave (:,:) = 0.0_wp 
     877       
     878      DO jl = 1, jpl 
     879         fice_cell_ave (:,:) = fice_cell_ave (:,:) & 
     880            &                  + a_i (:,:,jl) * ptab (:,:,jl) 
     881      END DO 
     882       
     883   END FUNCTION fice_cell_ave 
     884    
     885    
     886   FUNCTION fice_ice_ave ( ptab ) 
     887      !!-------------------------------------------------------------------------- 
     888      !! * Compute average over categories, for ice covered part of grid cell 
     889      !!-------------------------------------------------------------------------- 
     890      REAL (kind=wp), DIMENSION (jpi,jpj) :: fice_ice_ave 
     891      REAL (kind=wp), DIMENSION (jpi,jpj,jpl), INTENT(in) :: ptab 
     892 
     893      fice_ice_ave (:,:) = 0.0_wp 
     894      WHERE ( at_i (:,:) .GT. 0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:) 
     895 
     896   END FUNCTION fice_ice_ave 
     897 
    857898 
    858899#else 

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

    r4769 r4933  
    9797      !! 
    9898      INTEGER  ::   ji, jj   ! dummy loop indices 
    99       REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_os   ! albedo of the ice under overcast sky 
    100       REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_cs   ! albedo of ice under clear sky 
    101       REAL(wp), DIMENSION(:,:,:), POINTER :: zsist         ! surface ice temperature (K) 
     99      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_os   ! ice albedo under overcast sky 
     100      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_cs   ! ice albedo under clear sky 
     101      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice  ! mean ice albedo 
     102      REAL(wp), DIMENSION(:,:,:), POINTER :: zsist     ! ice surface temperature (K) 
    102103      !!---------------------------------------------------------------------- 
    103104 
    104       CALL wrk_alloc( jpi,jpj,1, zalb_ice_os, zalb_ice_cs, zsist ) 
     105      CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 
    105106 
    106107      IF( kt == nit000 ) THEN 
    … …  
    144145 
    145146         ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land) 
    146          tfu(:,:) = tfreez( sss_m ) +  rt0  
     147         tfu(:,:) = eos_fzp( sss_m ) +  rt0  
    147148 
    148149         zsist (:,:,1) = sist (:,:) + rt0 * ( 1. - tmask(:,:,1) ) 
    149150 
    150          ! ... ice albedo (clear sky and overcast sky) 
     151         ! Ice albedo 
     152 
    151153         CALL albedo_ice( zsist, reshape( hicif, (/jpi,jpj,1/) ), & 
    152154                                 reshape( hsnif, (/jpi,jpj,1/) ), & 
    153                           zalb_ice_cs, zalb_ice_os ) 
     155                          zalb_cs, zalb_os ) 
     156 
     157         SELECT CASE( ksbc ) 
     158         CASE( jp_core , jp_cpl )   ! CORE and COUPLED bulk formulations 
     159 
     160            ! albedo depends on cloud fraction because of non-linear spectral effects 
     161            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     162            ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo  
     163            ! (zalb_ice) is computed within the bulk routine 
     164 
     165         END SELECT 
    154166 
    155167         ! ... Sea-ice surface boundary conditions output from bulk formulae : 
    … …  
    167179         ! 
    168180         SELECT CASE( ksbc ) 
    169          CASE( 3 )           ! CLIO bulk formulation 
    170             CALL blk_ice_clio( zsist, zalb_ice_cs, zalb_ice_os,                         & 
     181         CASE( jp_clio )           ! CLIO bulk formulation 
     182            CALL blk_ice_clio( zsist, zalb_cs    , zalb_os    , zalb_ice   ,            & 
    171183               &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   & 
    172184               &                      qla_ice    , dqns_ice   , dqla_ice   ,            & 
    … …  
    174186               &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  ) 
    175187 
    176          CASE( 4 )           ! CORE bulk formulation 
    177             CALL blk_ice_core( zsist, u_ice      , v_ice      , zalb_ice_cs,            & 
     188         CASE( jp_core )           ! CORE bulk formulation 
     189            CALL blk_ice_core( zsist, u_ice      , v_ice      , zalb_ice   ,            & 
    178190               &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   & 
    179191               &                      qla_ice    , dqns_ice   , dqla_ice   ,            & 
    180192               &                      tprecip    , sprecip    ,                         & 
    181193               &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  ) 
    182             IF( ltrcdm2dc_ice )   CALL blk_ice_meanqsr( zalb_ice_cs, qsr_ice_mean, jpl ) 
    183  
    184          CASE( 5 )           ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 
     194            IF( ltrcdm2dc_ice )   CALL blk_ice_meanqsr( zalb_ice, qsr_ice_mean, jpl ) 
     195 
     196         CASE( jp_cpl )            ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 
    185197            CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 
    186198         END SELECT 
    … …  
    213225#endif 
    214226         END IF 
    215 #if defined key_coupled 
    216227         !                                             ! Ice surface fluxes in coupled mode  
    217          IF( ksbc == 5 )   THEN 
     228         IF( ksbc == jp_cpl )   THEN 
    218229            a_i(:,:,1)=fr_i 
    219230            CALL sbc_cpl_ice_flx( frld,                                              & 
    220231            !                                optional arguments, used only in 'mixed oce-ice' case 
    221             &                                             palbi = zalb_ice_cs, psst = sst_m, pist = zsist ) 
     232            &                                             palbi = zalb_ice, psst = sst_m, pist = zsist ) 
    222233            sprecip(:,:) = - emp_ice(:,:)   ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.) 
    223234         ENDIF 
    224 #endif 
    225235                           CALL lim_thd_2      ( kt )      ! Ice thermodynamics  
    226236                           CALL lim_sbc_flx_2  ( kt )      ! update surface ocean mass, heat & salt fluxes  
    … …  
    252262      IF( ln_limdyn    )   CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents 
    253263      ! 
    254       CALL wrk_dealloc( jpi,jpj,1, zalb_ice_os, zalb_ice_cs, zsist ) 
     264      CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 
    255265      ! 
    256266   END SUBROUTINE sbc_ice_lim_2 

  • branches/2014/dev_CNRS_CICE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r4822 r4933  
    3737   USE sbcice_cice      ! surface boundary condition: CICE    sea-ice model 
    3838   USE sbccpl           ! surface boundary condition: coupled florulation 
    39    USE cpl_oasis3, ONLY:lk_cpl      ! are we in coupled mode? 
    4039   USE sbcssr           ! surface boundary condition: sea surface restoring 
    4140   USE sbcrnf           ! surface boundary condition: runoffs 
    … …  
    8281      INTEGER ::   icpt   ! local integer 
    8382      !! 
    84       NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx,  ln_blk_clio, ln_blk_core, ln_cpl,   & 
     83      NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx,  ln_blk_clio, ln_blk_core,           & 
    8584         &             ln_blk_mfs, ln_apr_dyn, nn_ice,  nn_ice_embd, ln_dm2dc   , ln_rnf,   & 
    86          &             ln_ssr    , nn_fwb    , ln_cdgw , ln_wave , ln_sdw, nn_lsm, cn_iceflx 
     85         &             ln_ssr    , nn_fwb    , ln_cdgw , ln_wave , ln_sdw, nn_lsm, nn_limflx 
    8786      INTEGER  ::   ios 
    8887      !!---------------------------------------------------------------------- 
    … …  
    123122         WRITE(numout,*) '              CORE bulk  formulation                     ln_blk_core = ', ln_blk_core 
    124123         WRITE(numout,*) '              MFS  bulk  formulation                     ln_blk_mfs  = ', ln_blk_mfs 
    125          WRITE(numout,*) '              coupled    formulation (T if key_sbc_cpl)  ln_cpl      = ', ln_cpl 
    126          WRITE(numout,*) '              Flux handling over ice categories          cn_iceflx   = ', TRIM (cn_iceflx) 
     124         WRITE(numout,*) '              coupled    formulation (T if key_oasis3)   lk_cpl      = ', lk_cpl 
     125         WRITE(numout,*) '              Multicategory heat flux formulation (LIM3) nn_limflx   = ', nn_limflx 
    127126         WRITE(numout,*) '           Misc. options of sbc : ' 
    128127         WRITE(numout,*) '              Patm gradient added in ocean & ice Eqs.    ln_apr_dyn  = ', ln_apr_dyn 
    … …  
    137136      ENDIF 
    138137 
    139       !   Flux handling over ice categories 
    140 #if defined key_coupled  
    141       SELECT CASE ( TRIM (cn_iceflx)) 
    142       CASE ('ave') 
    143          ln_iceflx_ave    = .TRUE. 
    144          ln_iceflx_linear = .FALSE. 
    145       CASE ('linear') 
    146          ln_iceflx_ave    = .FALSE. 
    147          ln_iceflx_linear = .TRUE. 
    148       CASE default 
    149          ln_iceflx_ave    = .FALSE. 
    150          ln_iceflx_linear = .FALSE. 
     138      ! LIM3 Multi-category heat flux formulation 
     139      SELECT CASE ( nn_limflx) 
     140      CASE ( -1 ) 
     141         IF(lwp) WRITE(numout,*) '              Use of per-category fluxes (nn_limflx = -1) ' 
     142      CASE ( 0  ) 
     143         IF(lwp) WRITE(numout,*) '              Average per-category fluxes (nn_limflx = 0) '  
     144      CASE ( 1  ) 
     145         IF(lwp) WRITE(numout,*) '              Average then redistribute per-category fluxes (nn_limflx = 1) ' 
     146      CASE ( 2  ) 
     147         IF(lwp) WRITE(numout,*) '              Redistribute a single flux over categories (nn_limflx = 2) ' 
    151148      END SELECT 
    152       IF(lwp) WRITE(numout,*) '              Fluxes averaged over all ice categories         ln_iceflx_ave    = ', ln_iceflx_ave 
    153       IF(lwp) WRITE(numout,*) '              Fluxes distributed linearly over ice categories ln_iceflx_linear = ', ln_iceflx_linear 
    154 #endif 
    155149      ! 
    156150#if defined key_top && ! defined key_offline 
    … …  
    208202      IF( ( nn_ice == 3 .OR. nn_ice == 4 ) .AND. nn_ice_embd == 0 )   & 
    209203         &   CALL ctl_stop( 'LIM3 and CICE sea-ice models require nn_ice_embd = 1 or 2' ) 
    210 #if defined key_coupled 
    211       IF( ln_iceflx_ave .AND. ln_iceflx_linear ) & 
    212          &   CALL ctl_stop( ' ln_iceflx_ave and ln_iceflx_linear options are not compatible' ) 
    213       IF( ( nn_ice ==3 .AND. lk_cpl) .AND. .NOT. ( ln_iceflx_ave .OR. ln_iceflx_linear ) ) & 
    214          &   CALL ctl_stop( ' With lim3 coupled, either ln_iceflx_ave or ln_iceflx_linear must be set to .TRUE.' ) 
    215 #endif       
     204      IF( ( nn_ice /= 3 ) .AND. ( nn_limflx >= 0 ) )   & 
     205         &   WRITE(numout,*) 'The nn_limflx>=0 option has no effect if sea ice model is not LIM3' 
     206      IF( ( nn_ice == 3 ) .AND. ( lk_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) )   & 
     207         &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' ) 
     208      IF( ( nn_ice == 3 ) .AND. ( .NOT. lk_cpl ) .AND. ( nn_limflx == 2 ) )   & 
     209         &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in forced mode cannot be 2' ) 
     210 
    216211      IF( ln_dm2dc )   nday_qsr = -1   ! initialisation flag 
    217212 
    … …  
    238233      !                          ! Choice of the Surface Boudary Condition (set nsbc) 
    239234      icpt = 0 
    240       IF( ln_ana          ) THEN   ;   nsbc =  1   ; icpt = icpt + 1   ;   ENDIF       ! analytical      formulation 
    241       IF( ln_flx          ) THEN   ;   nsbc =  2   ; icpt = icpt + 1   ;   ENDIF       ! flux            formulation 
    242       IF( ln_blk_clio     ) THEN   ;   nsbc =  3   ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk       formulation 
    243       IF( ln_blk_core     ) THEN   ;   nsbc =  4   ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk       formulation 
    244       IF( ln_blk_mfs      ) THEN   ;   nsbc =  6   ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk       formulation 
    245       IF( ln_cpl          ) THEN   ;   nsbc =  5   ; icpt = icpt + 1   ;   ENDIF       ! Coupled         formulation 
    246       IF( cp_cfg == 'gyre') THEN   ;   nsbc =  0                       ;   ENDIF       ! GYRE analytical formulation 
    247       IF( lk_esopa        )            nsbc = -1                                       ! esopa test, ALL formulations 
     235      IF( ln_ana          ) THEN   ;   nsbc = jp_ana    ; icpt = icpt + 1   ;   ENDIF       ! analytical      formulation 
     236      IF( ln_flx          ) THEN   ;   nsbc = jp_flx    ; icpt = icpt + 1   ;   ENDIF       ! flux            formulation 
     237      IF( ln_blk_clio     ) THEN   ;   nsbc = jp_clio   ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk       formulation 
     238      IF( ln_blk_core     ) THEN   ;   nsbc = jp_core   ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk       formulation 
     239      IF( ln_blk_mfs      ) THEN   ;   nsbc = jp_mfs    ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk       formulation 
     240      IF( lk_cpl          ) THEN   ;   nsbc = jp_cpl    ; icpt = icpt + 1   ;   ENDIF       ! Coupled         formulation 
     241      IF( cp_cfg == 'gyre') THEN   ;   nsbc = jp_gyre                       ;   ENDIF       ! GYRE analytical formulation 
     242      IF( lk_esopa        )            nsbc = jp_esopa                                      ! esopa test, ALL formulations 
    248243      ! 
    249244      IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN 
    … …  
    256251      IF(lwp) THEN 
    257252         WRITE(numout,*) 
    258          IF( nsbc == -1 )   WRITE(numout,*) '              ESOPA test All surface boundary conditions' 
    259          IF( nsbc ==  0 )   WRITE(numout,*) '              GYRE analytical formulation' 
    260          IF( nsbc ==  1 )   WRITE(numout,*) '              analytical formulation' 
    261          IF( nsbc ==  2 )   WRITE(numout,*) '              flux formulation' 
    262          IF( nsbc ==  3 )   WRITE(numout,*) '              CLIO bulk formulation' 
    263          IF( nsbc ==  4 )   WRITE(numout,*) '              CORE bulk formulation' 
    264          IF( nsbc ==  5 )   WRITE(numout,*) '              coupled formulation' 
    265          IF( nsbc ==  6 )   WRITE(numout,*) '              MFS Bulk formulation' 
    266       ENDIF 
    267       ! 
    268                           CALL sbc_ssm_init               ! Sea-surface mean fields initialisation 
    269       ! 
    270       IF( ln_ssr      )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation 
    271       ! 
    272       IF( nn_ice == 4 )   CALL cice_sbc_init( nsbc )      ! CICE initialisation 
    273       ! 
     253         IF( nsbc == jp_esopa )   WRITE(numout,*) '              ESOPA test All surface boundary conditions' 
     254         IF( nsbc == jp_gyre  )   WRITE(numout,*) '              GYRE analytical formulation' 
     255         IF( nsbc == jp_ana   )   WRITE(numout,*) '              analytical formulation' 
     256         IF( nsbc == jp_flx   )   WRITE(numout,*) '              flux formulation' 
     257         IF( nsbc == jp_clio  )   WRITE(numout,*) '              CLIO bulk formulation' 
     258         IF( nsbc == jp_core  )   WRITE(numout,*) '              CORE bulk formulation' 
     259         IF( nsbc == jp_cpl   )   WRITE(numout,*) '              coupled formulation' 
     260         IF( nsbc == jp_mfs   )   WRITE(numout,*) '              MFS Bulk formulation' 
     261      ENDIF 
     262      ! 
     263                               CALL sbc_ssm_init               ! Sea-surface mean fields initialisation 
     264      ! 
     265      IF( ln_ssr           )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation 
     266      ! 
     267      IF( nn_ice == 4      )   CALL cice_sbc_init( nsbc )      ! CICE initialisation 
     268      ! 
     269      IF( nsbc   == jp_cpl )   CALL sbc_cpl_init (nn_ice)      ! OASIS initialisation. must be done before first time step 
     270 
    274271   END SUBROUTINE sbc_init 
    275272 
    … …  
    322319      SELECT CASE( nsbc )                                ! Compute ocean surface boundary condition 
    323320      !                                                  ! (i.e. utau,vtau, qns, qsr, emp, sfx) 
    324       CASE(  0 )   ;   CALL sbc_gyre    ( kt )                    ! analytical formulation : GYRE configuration 
    325       CASE(  1 )   ;   CALL sbc_ana     ( kt )                    ! analytical formulation : uniform sbc 
    326       CASE(  2 )   ;   CALL sbc_flx     ( kt )                    ! flux formulation 
    327       CASE(  3 )   ;   CALL sbc_blk_clio( kt )                    ! bulk formulation : CLIO for the ocean 
    328       CASE(  4 )   ;   CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean 
    329       CASE(  5 )   ;   CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! coupled formulation 
    330       CASE(  6 )   ;   CALL sbc_blk_mfs ( kt )                    ! bulk formulation : MFS for the ocean 
    331       CASE( -1 )                                 
    332                        CALL sbc_ana     ( kt )                    ! ESOPA, test ALL the formulations 
    333                        CALL sbc_gyre    ( kt )                    ! 
    334                        CALL sbc_flx     ( kt )                    ! 
    335                        CALL sbc_blk_clio( kt )                    ! 
    336                        CALL sbc_blk_core( kt )                    ! 
    337                        CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! 
     321      CASE( jp_gyre )   ;   CALL sbc_gyre    ( kt )                    ! analytical formulation : GYRE configuration 
     322      CASE( jp_ana  )   ;   CALL sbc_ana     ( kt )                    ! analytical formulation : uniform sbc 
     323      CASE( jp_flx  )   ;   CALL sbc_flx     ( kt )                    ! flux formulation 
     324      CASE( jp_clio )   ;   CALL sbc_blk_clio( kt )                    ! bulk formulation : CLIO for the ocean 
     325      CASE( jp_core )   ;   CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean 
     326      CASE( jp_cpl  )   ;   CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! coupled formulation 
     327      CASE( jp_mfs  )   ;   CALL sbc_blk_mfs ( kt )                    ! bulk formulation : MFS for the ocean 
     328      CASE( jp_esopa )                                 
     329                             CALL sbc_ana     ( kt )                    ! ESOPA, test ALL the formulations 
     330                             CALL sbc_gyre    ( kt )                    ! 
     331                             CALL sbc_flx     ( kt )                    ! 
     332                             CALL sbc_blk_clio( kt )                    ! 
     333                             CALL sbc_blk_core( kt )                    ! 
     334                             CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! 
    338335      END SELECT 
    339336 
    … …  
    344341      CASE(  2 )   ;         CALL sbc_ice_lim_2( kt, nsbc )          ! LIM-2 ice model 
    345342      CASE(  3 )   ;         CALL sbc_ice_lim  ( kt, nsbc )          ! LIM-3 ice model 
    346       !is it useful? 
    347343      CASE(  4 )   ;         CALL sbc_ice_cice ( kt, nsbc )          ! CICE ice model 
    348344      END SELECT                                               
    … …  
    416412         CALL iom_put( "qsr"   ,       qsr  )                   ! solar heat flux 
    417413         IF( nn_ice > 0 )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction  
     414         CALL iom_put( "taum"  , taum       )                   ! wind stress module  
     415         CALL iom_put( "wspd"  , wndm       )                   ! wind speed  module over free ocean or leads in presence of sea-ice 
    418416      ENDIF 
    419417      ! 
    420418      CALL iom_put( "utau", utau )   ! i-wind stress   (stress can be updated at  
    421419      CALL iom_put( "vtau", vtau )   ! j-wind stress    each time step in sea-ice) 
    422       CALL iom_put( "taum", taum )   ! wind stress module  
    423       CALL iom_put( "wspd", wndm )   ! wind speed  module  
    424420      ! 
    425421      IF(ln_ctl) THEN         ! print mean trends (used for debugging) 

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

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

    r4624 r4933  
    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_CICE/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

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

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

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

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

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

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

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

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

    r4624 r4933  
    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_CICE/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r4624 r4933  
    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               ik = mbkt(ji,jj)                              ! bottom T-level index 
     201               zptb(ji,jj) = ptb(ji,jj,ik,jn)       ! bottom before T and S 
    207202            END DO 
    208203         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 
     204         !                
     205         DO jj = 2, jpjm1                                    ! Compute the trend 
    215206            DO ji = 2, jpim1 
    216 #  endif 
    217                ik = mbkt(ji,jj)                            ! bottom T-level index 
     207               ik = mbkt(ji,jj)                              ! bottom T-level index 
    218208               zbtr = r1_e12t(ji,jj)  / fse3t(ji,jj,ik) 
    219209               pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                         & 
    … …  
    264254      DO jn = 1, kjpt                                            ! tracer loop 
    265255         !                                                       ! =========== 
    266 # if defined key_vectopt_loop 
    267          DO jj = 1, 1 
    268             DO ji = 1, jpij-jpi-1   ! vector opt. (forced unrolling) 
    269 # else 
    270256         DO jj = 1, jpjm1 
    271257            DO ji = 1, jpim1            ! CAUTION start from i=1 to update i=2 when cyclic east-west 
    272 # endif 
    273258               IF( utr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero i-direction bbl advection 
    274259                  ! down-slope i/k-indices (deep)      &   up-slope i/k indices (shelf) 
    … …  
    333318      !!                advection terms. 
    334319      !! 
    335       !! ** Method  : 
    336       !!        * diffusive bbl (nn_bbl_ldf=1) : 
     320      !! ** Method  : * diffusive bbl (nn_bbl_ldf=1) : 
    337321      !!        When the product grad( rho) * grad(h) < 0 (where grad is an 
    338322      !!      along bottom slope gradient) an additional lateral 2nd order 
    … …  
    342326      !!      a downslope velocity of 20 cm/s if the condition for slope 
    343327      !!      convection is satified) 
    344       !!        * advective bbl (nn_bbl_adv=1 or 2) : 
     328      !!              * advective bbl (nn_bbl_adv=1 or 2) : 
    345329      !!      nn_bbl_adv = 1   use of the ocean velocity as bbl velocity 
    346330      !!      nn_bbl_adv = 2   follow Campin and Goosse (1999) implentation 
    … …  
    353337      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 
    354338      !!---------------------------------------------------------------------- 
    355       ! 
    356339      INTEGER         , INTENT(in   ) ::   kt       ! ocean time-step index 
    357       INTEGER         , INTENT(in   ) ::   kit000          ! first time step index 
     340      INTEGER         , INTENT(in   ) ::   kit000   ! first time step index 
    358341      CHARACTER(len=3), INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
    359342      !! 
    360343      INTEGER  ::   ji, jj                    ! dummy loop indices 
    361344      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  
     345      INTEGER  ::   iis, iid, ikus, ikud      !   -       - 
     346      INTEGER  ::   ijs, ijd, ikvs, ikvd      !   -       - 
     347      REAL(wp) ::   za, zb, zgdrho            ! local scalars 
     348      REAL(wp) ::   zsign, zsigna, zgbbl      !   -      - 
     349      REAL(wp), DIMENSION(jpi,jpj,jpts)   :: zts, zab         ! 3D workspace 
     350      REAL(wp), DIMENSION(jpi,jpj)        :: zub, zvb, zdep   ! 2D workspace 
     351      !!---------------------------------------------------------------------- 
    401352      ! 
    402353      IF( nn_timing == 1 )  CALL timing_start( 'bbl') 
    403354      ! 
    404       CALL wrk_alloc( jpi, jpj, zub, zvb, ztb, zsb, zdep ) 
    405       ! 
    406  
    407355      IF( kt == kit000 )  THEN 
    408356         IF(lwp)  WRITE(numout,*) 
    … …  
    410358         IF(lwp)  WRITE(numout,*) '~~~~~~~~~~' 
    411359      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 
     360      !                                        !* bottom variables (T, S, alpha, beta, depth, velocity) 
    418361      DO jj = 1, jpj 
    419362         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 
     363            ik = mbkt(ji,jj)                             ! bottom T-level index 
     364            zts (ji,jj,jp_tem) = tsb(ji,jj,ik,jp_tem)    ! bottom before T and S 
     365            zts (ji,jj,jp_sal) = tsb(ji,jj,ik,jp_sal) 
    425366            ! 
    426             zub(ji,jj) = un(ji,jj,mbku(ji,jj))      ! bottom velocity 
    427             zvb(ji,jj) = vn(ji,jj,mbkv(ji,jj)) 
     367            zdep(ji,jj) = fsdept(ji,jj,ik)               ! bottom T-level reference depth 
     368            zub (ji,jj) = un(ji,jj,mbku(ji,jj))          ! bottom velocity 
     369            zvb (ji,jj) = vn(ji,jj,mbkv(ji,jj)) 
    428370         END DO 
    429371      END DO 
    430  
     372      ! 
     373      CALL eos_rab( zts, zdep, zab ) 
     374      ! 
    431375      !                                   !-------------------! 
    432376      IF( nn_bbl_ldf == 1 ) THEN          !   diffusive bbl   ! 
    433377         !                                !-------------------! 
    434378         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) 
     379            DO ji = 1, fs_jpim1   ! vector opt. 
     380               !                                                   ! i-direction 
     381               za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)              ! 2*(alpha,beta) at u-point 
     382               zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal) 
     383               !                                                         ! 2*masked bottom density gradient 
     384               zgdrho = (  za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) )    & 
     385                  &      - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) )  ) * umask(ji,jj,1) 
    443386               ! 
    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. 
     387               zsign  = SIGN(  0.5, -zgdrho * REAL( mgrhu(ji,jj) )  )    ! sign of ( i-gradient * i-slope ) 
     388               ahu_bbl(ji,jj) = ( 0.5 - zsign ) * ahu_bbl_0(ji,jj)       ! masked diffusive flux coeff. 
    446389               ! 
    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) 
     390               !                                                   ! j-direction 
     391               za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)              ! 2*(alpha,beta) at v-point 
     392               zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal) 
     393               !                                                         ! 2*masked bottom density gradient 
     394               zgdrho = (  za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) )    & 
     395                  &      - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) )  ) * vmask(ji,jj,1) 
    454396               ! 
    455                zsign          = SIGN(  0.5, -zgdrho * REAL( mgrhv(ji,jj) )  )     ! sign of ( j-gradient * j-slope ) 
     397               zsign = SIGN(  0.5, -zgdrho * REAL( mgrhv(ji,jj) )  )     ! sign of ( j-gradient * j-slope ) 
    456398               ahv_bbl(ji,jj) = ( 0.5 - zsign ) * ahv_bbl_0(ji,jj) 
    457                ! 
    458399            END DO 
    459400         END DO 
    … …  
    469410            DO jj = 1, jpjm1                                 ! criteria: grad(rho).grad(h)<0  and grad(rho).grad(h)<0 
    470411               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 
     412                  !                                                  ! i-direction 
     413                  za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at u-point 
     414                  zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal) 
     415                  !                                                          ! 2*masked bottom density gradient  
     416                  zgdrho = (  za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) )    & 
     417                            - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) )  ) * umask(ji,jj,1) 
     418                  ! 
     419                  zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhu(ji,jj) )  )   ! sign of i-gradient * i-slope 
     420                  zsigna= SIGN(  0.5, zub(ji,jj) * REAL( mgrhu(ji,jj) )  )   ! sign of u * i-slope 
     421                  ! 
     422                  !                                                          ! bbl velocity 
    483423                  utr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e2u(ji,jj) * e3u_bbl_0(ji,jj) * zub(ji,jj) 
    484424                  ! 
    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 
     425                  !                                                  ! j-direction 
     426                  za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at v-point 
     427                  zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal) 
     428                  !                                                          ! 2*masked bottom density gradient 
     429                  zgdrho = (  za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) )    & 
     430                     &      - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) )  ) * vmask(ji,jj,1) 
     431                  zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhv(ji,jj) )  )   ! sign of j-gradient * j-slope 
     432                  zsigna= SIGN(  0.5, zvb(ji,jj) * REAL( mgrhv(ji,jj) )  )   ! sign of u * i-slope 
     433                  ! 
     434                  !                                                          ! bbl transport 
    496435                  vtr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e1v(ji,jj) * e3v_bbl_0(ji,jj) * zvb(ji,jj) 
    497436               END DO 
    … …  
    502441            DO jj = 1, jpjm1                            ! criteria: rho_up > rho_down 
    503442               DO ji = 1, fs_jpim1   ! vector opt. 
    504                   !                                         ! i-direction 
     443                  !                                                  ! i-direction 
    505444                  ! 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) 
     445                  iid  = ji + MAX( 0, mgrhu(ji,jj) ) 
     446                  iis  = ji + 1 - MAX( 0, mgrhu(ji,jj) ) 
     447                  ! 
     448                  ikud = mbku_d(ji,jj) 
     449                  ikus = mbku(ji,jj) 
     450                  ! 
     451                  za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at u-point 
     452                  zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal) 
     453                  !                                                          !   masked bottom density gradient 
     454                  zgdrho = 0.5 * (  za * ( zts(iid,jj,jp_tem) - zts(iis,jj,jp_tem) )    & 
     455                     &            - zb * ( zts(iid,jj,jp_sal) - zts(iis,jj,jp_sal) )  ) * umask(ji,jj,1) 
     456                  zgdrho = MAX( 0.e0, zgdrho )                               ! only if shelf is denser than deep 
     457                  ! 
     458                  !                                                          ! bbl transport (down-slope direction) 
    519459                  utr_bbl(ji,jj) = e2u(ji,jj) * e3u_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhu(ji,jj) ) 
    520460                  ! 
    521                   !                                         ! j-direction 
     461                  !                                                  ! j-direction 
    522462                  !  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) 
     463                  ijd  = jj + MAX( 0, mgrhv(ji,jj) ) 
     464                  ijs  = jj + 1 - MAX( 0, mgrhv(ji,jj) ) 
     465                  ! 
     466                  ikvd = mbkv_d(ji,jj) 
     467                  ikvs = mbkv(ji,jj) 
     468                  ! 
     469                  za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at v-point 
     470                  zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal) 
     471                  !                                                          !   masked bottom density gradient 
     472                  zgdrho = 0.5 * (  za * ( zts(ji,ijd,jp_tem) - zts(ji,ijs,jp_tem) )    & 
     473                     &            - zb * ( zts(ji,ijd,jp_sal) - zts(ji,ijs,jp_sal) )  ) * vmask(ji,jj,1) 
     474                  zgdrho = MAX( 0.e0, zgdrho )                               ! only if shelf is denser than deep 
     475                  ! 
     476                  !                                                          ! bbl transport (down-slope direction) 
    536477                  vtr_bbl(ji,jj) = e1v(ji,jj) * e3v_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhv(ji,jj) ) 
    537478               END DO 
    … …  
    541482      ENDIF 
    542483      ! 
    543       CALL wrk_dealloc( jpi, jpj, zub, zvb, ztb, zsb, zdep ) 
    544       ! 
    545484      IF( nn_timing == 1 )  CALL timing_stop( 'bbl') 
    546485      ! 
    … …  
    558497      !!---------------------------------------------------------------------- 
    559498      INTEGER ::   ji, jj               ! dummy loop indices 
    560       INTEGER ::   ii0, ii1, ij0, ij1   ! temporary integer 
    561       INTEGER  ::   ios                 ! Local integer output status for namelist read 
     499      INTEGER ::   ii0, ii1, ij0, ij1   ! local integer 
     500      INTEGER ::   ios                  !   -      - 
    562501      REAL(wp), POINTER, DIMENSION(:,:) :: zmbk 
    563502      !! 
    … …  
    598537      IF( nn_bbl_adv == 2 )    WRITE(numout,*) '       * Advective BBL using velocity = F( delta rho)' 
    599538 
    600       IF( nn_eos /= 0 )   CALL ctl_stop ( ' bbl parameterisation requires eos = 0. We stop.' ) 
    601  
    602539      !                             !* vertical index of  "deep" bottom u- and v-points 
    603540      DO jj = 1, jpjm1                    ! (the "shelf" bottom k-indices are mbku and mbkv) 
    … …  
    607544         END DO 
    608545      END DO 
    609       ! convert into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
     546      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
    610547      zmbk(:,:) = REAL( mbku_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'U',1.)   ;   mbku_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
    611548      zmbk(:,:) = REAL( mbkv_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
    612549 
    613                                      !* sign of grad(H) at u- and v-points 
    614       mgrhu(jpi,:) = 0.    ;    mgrhu(:,jpj) = 0.   ;    mgrhv(jpi,:) = 0.    ;    mgrhv(:,jpj) = 0. 
     550                                        !* sign of grad(H) at u- and v-points 
     551      mgrhu(jpi,:) = 0   ;   mgrhu(:,jpj) = 0   ;   mgrhv(jpi,:) = 0   ;   mgrhv(:,jpj) = 0 
    615552      DO jj = 1, jpjm1 
    616553         DO ji = 1, jpim1 
    … …  
    621558 
    622559      DO jj = 1, jpjm1              !* bbl thickness at u- (v-) point 
    623          DO ji = 1, jpim1           ! minimum of top & bottom e3u_0 (e3v_0) 
     560         DO ji = 1, jpim1                 ! minimum of top & bottom e3u_0 (e3v_0) 
    624561            e3u_bbl_0(ji,jj) = MIN( e3u_0(ji,jj,mbkt(ji+1,jj  )), e3u_0(ji,jj,mbkt(ji,jj)) ) 
    625562            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_CICE/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90

    r4624 r4933  
    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_CICE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90

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

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

    r4313 r4933  
    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_CICE/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

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

    r4834 r4933  
    2121   USE sbc_oce         ! surface boundary condition: ocean 
    2222   USE trc_oce         ! share SMS/Ocean variables 
    23    USE trdmod_oce      ! ocean variables trends 
    24    USE trdtra          ! ocean active tracers trends  
     23   USE trd_oce        ! trends: ocean variables 
     24   USE trdtra         ! trends manager: tracers 
    2525   USE in_out_manager  ! I/O manager 
    2626   USE phycst          ! physical constants 
    … …  
    169169               DO ji = 1, jpi 
    170170                  IF ( qsr(ji,jj) /= 0._wp ) THEN 
    171                      oatte(ji,jj) = ( qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) ) 
    172                      iatte(ji,jj) = oatte(ji,jj) 
     171                     fraqsr_1lev(ji,jj) = ( qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) ) 
    173172                  ENDIF 
    174173               END DO 
    … …  
    241240                        zzc2 = zcoef  * EXP( - fse3t(ji,jj,1) * zekg(ji,jj) ) 
    242241                        zzc3 = zcoef  * EXP( - fse3t(ji,jj,1) * zekr(ji,jj) ) 
    243                         oatte(ji,jj) = 1.0 - ( zzc0 + zzc1 + zzc2  + zzc3  ) * tmask(ji,jj,2)  
    244                         iatte(ji,jj) = 1.0 - ( zzc0 + zzc1 + zcoef + zcoef ) * tmask(ji,jj,2) 
     242                        fraqsr_1lev(ji,jj) = 1.0 - ( zzc0 + zzc1 + zzc2  + zzc3  ) * tmask(ji,jj,2)  
    245243                     END DO 
    246244                  END DO 
    … …  
    259257               ! clem: store attenuation coefficient of the first ocean level 
    260258               IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 
    261                   oatte(:,:) = etot3(:,:,1) / r1_rau0_rcp 
    262                   iatte(:,:) = oatte(:,:) 
     259                  fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp 
    263260               ENDIF 
    264261           ENDIF 
    … …  
    287284                        zc0 = zz0 * EXP( -fsdepw(ji,jj,1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,1)*xsi1r ) 
    288285                        zc1 = zz0 * EXP( -fsdepw(ji,jj,2)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,2)*xsi1r ) 
    289                         oatte(ji,jj) = ( zc0*tmask(ji,jj,1) - zc1*tmask(ji,jj,2) ) / r1_rau0_rcp 
    290                         iatte(ji,jj) = oatte(ji,jj) 
     286                        fraqsr_1lev(ji,jj) = ( zc0*tmask(ji,jj,1) - zc1*tmask(ji,jj,2) ) / r1_rau0_rcp 
    291287                     END DO 
    292288                  END DO 
    … …  
    302298               ! clem: store attenuation coefficient of the first ocean level 
    303299               IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 
    304                   oatte(:,:) = etot3(:,:,1) / r1_rau0_rcp 
    305                   iatte(:,:) = oatte(:,:) 
     300                  fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp 
    306301               ENDIF 
    307302               ! 
    … …  
    334329      IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics 
    335330         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    336          CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_qsr, ztrdt ) 
     331         CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt ) 
    337332         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt )  
    338333      ENDIF 
    … …  
    384379      IF( nn_timing == 1 )  CALL timing_start('tra_qsr_init') 
    385380      ! 
    386       ! clem init for oatte and iatte 
     381      ! Default value for fraqsr_1lev 
    387382      IF( .NOT. ln_rstart ) THEN 
    388          oatte(:,:) = 1._wp 
    389          iatte(:,:) = 1._wp 
     383         fraqsr_1lev(:,:) = 1._wp 
    390384      ENDIF 
    391385      ! 

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

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

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

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

    r3632 r4933  
    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_CICE/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90

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

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

    r4624 r4933  
    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_CICE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90

    r4624 r4933  
    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_CICE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90

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

    r4624 r4933  
    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_CICE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90

    r4245 r4933  
    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_CICE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r4624 r4933  
    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 
    … …  
    740732      ! 
    741733      !                               !* Check of some namelist values 
    742       IF( nn_mxl  < 0  .OR.  nn_mxl  > 3 )   CALL ctl_stop( 'bad flag: nn_mxl is  0, 1 or 2 ' ) 
    743       IF( nn_pdl  < 0  .OR.  nn_pdl  > 1 )   CALL ctl_stop( 'bad flag: nn_pdl is  0 or 1    ' ) 
    744       IF( nn_htau < 0  .OR.  nn_htau > 1 )   CALL ctl_stop( 'bad flag: nn_htau is 0, 1 or 2 ' ) 
    745 #if ! key_coupled 
    746       IF( nn_etau == 3 )   CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' ) 
    747 #endif 
     734      IF( nn_mxl  < 0   .OR.  nn_mxl  > 3 )   CALL ctl_stop( 'bad flag: nn_mxl is  0, 1 or 2 ' ) 
     735      IF( nn_pdl  < 0   .OR.  nn_pdl  > 1 )   CALL ctl_stop( 'bad flag: nn_pdl is  0 or 1    ' ) 
     736      IF( nn_htau < 0   .OR.  nn_htau > 1 )   CALL ctl_stop( 'bad flag: nn_htau is 0, 1 or 2 ' ) 
     737      IF( nn_etau == 3 .AND. .NOT. lk_cpl )   CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' ) 
    748738 
    749739      IF( ln_mxl0 ) THEN 

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

    r4723 r4933  
    4242   !!---------------------------------------------------------------------- 
    4343   USE step_oce        ! module used in the ocean time stepping module 
    44    USE sbc_oce         ! surface boundary condition: ocean 
    4544   USE cla             ! cross land advection               (tra_cla routine) 
    4645   USE domcfg          ! domain configuration               (dom_cfg routine) 
    … …  
    5150#endif 
    5251   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) 
     52   USE bdyini          ! open boundary cond. setting      (bdy_init routine) 
     53   USE bdydta          ! open boundary cond. setting  (bdy_dta_init routine) 
     54   USE bdytides        ! open boundary cond. setting  (bdytide_init routine) 
    5655   USE istate          ! initial state setting          (istate_init routine) 
    5756   USE ldfdyn          ! lateral viscosity setting      (ldfdyn_init routine) 
    … …  
    5958   USE zdfini          ! vertical physics setting          (zdf_init routine) 
    6059   USE phycst          ! physical constant                  (par_cst routine) 
    61    USE trdmod          ! momentum/tracers trends       (trd_mod_init routine) 
     60   USE trdini          ! dyn/tra trends initialization     (trd_init routine) 
    6261   USE asminc          ! assimilation increments      
    6362   USE asmbkg          ! writing out state trajectory 
    … …  
    6968   USE icbini          ! handle bergs, initialisation 
    7069   USE icbstp          ! handle bergs, calving, themodynamics and transport 
    71 #if defined key_oasis3 
    7270   USE cpl_oasis3      ! OASIS3 coupling 
    73 #elif defined key_oasis4 
    74    USE cpl_oasis4      ! OASIS4 coupling (not working) 
    75 #endif 
    7671   USE c1d             ! 1D configuration 
    7772   USE step_c1d        ! Time stepping loop for the 1D configuration 
    … …  
    121116      !!---------------------------------------------------------------------- 
    122117      ! 
    123  
    124118#if defined key_agrif 
    125119      CALL Agrif_Init_Grids()      ! AGRIF: set the meshes 
    … …  
    139133# endif 
    140134#endif 
    141  
    142135      ! check that all process are still there... If some process have an error, 
    143136      ! they will never enter in step and other processes will wait until the end of the cpu time! 
    … …  
    166159 
    167160         DO WHILE ( istp <= nitend .AND. nstop == 0 ) 
    168  
    169161#if defined key_agrif 
    170162            CALL Agrif_Step( stp )           ! AGRIF: time stepping 
    … …  
    172164            CALL stp( istp )                 ! standard time stepping 
    173165#endif 
    174  
    175166            istp = istp + 1 
    176167            IF( lk_mpp )   CALL mpp_max( nstop ) 
    … …  
    201192      ! 
    202193      CALL nemo_closefile 
     194      ! 
    203195#if defined key_iomput 
    204196      CALL xios_finalize                ! end mpp communications with xios 
    205 # if defined key_oasis3 || defined key_oasis4 
    206       CALL cpl_prism_finalize           ! end coupling and mpp communications with OASIS 
    207 # endif 
     197      IF( lk_cpl ) CALL cpl_finalize    ! end coupling and mpp communications with OASIS 
    208198#else 
    209 # if defined key_oasis3 || defined key_oasis4 
    210       CALL cpl_prism_finalize           ! end coupling and mpp communications with OASIS 
    211 # else 
    212       IF( lk_mpp )   CALL mppstop       ! end mpp communications 
    213 # endif 
     199      IF( lk_cpl ) THEN  
     200         CALL cpl_finalize              ! end coupling and mpp communications with OASIS 
     201      ELSE 
     202         IF( lk_mpp )   CALL mppstop    ! end mpp communications 
     203      ENDIF 
    214204#endif 
    215205      ! 
    … …  
    227217      INTEGER ::   ios 
    228218      CHARACTER(len=80), DIMENSION(16) ::   cltxt 
    229       !! 
    230       NAMELIST/namctl/ ln_ctl, nn_print, nn_ictls, nn_ictle,   & 
     219      ! 
     220      NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   & 
    231221         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   & 
    232222         &             nn_bench, nn_timing 
    … …  
    281271#if defined key_iomput 
    282272      IF( Agrif_Root() ) THEN 
    283 # if defined key_oasis3 || defined key_oasis4 
    284          CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis 
    285          CALL xios_initialize( "oceanx",local_comm=ilocal_comm ) 
    286 # else 
    287          CALL  xios_initialize( "nemo",return_comm=ilocal_comm ) 
    288 # endif 
     273         IF( lk_cpl ) THEN 
     274            CALL cpl_init( ilocal_comm )                               ! nemo local communicator given by oasis 
     275            CALL xios_initialize( "oceanx",local_comm=ilocal_comm )    ! send nemo communicator to xios 
     276         ELSE 
     277            CALL  xios_initialize( "nemo",return_comm=ilocal_comm )    ! nemo local communicator given by xios 
     278         ENDIF 
    289279      ENDIF 
    290280      narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection 
    291281#else 
    292 # if defined key_oasis3 || defined key_oasis4 
    293       IF( Agrif_Root() ) THEN 
    294          CALL cpl_prism_init( ilocal_comm )                 ! nemo local communicator given by oasis 
    295       ENDIF 
    296       narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt) 
    297 # else 
    298       ilocal_comm = 0 
    299       narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop )                 ! Nodes selection (control print return in cltxt) 
    300 # endif 
     282      IF( lk_cpl ) THEN 
     283         IF( Agrif_Root() ) THEN 
     284            CALL cpl_init( ilocal_comm )                       ! nemo local communicator given by oasis 
     285         ENDIF 
     286         narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt) 
     287      ELSE 
     288         ilocal_comm = 0 
     289         narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt) 
     290      ENDIF 
    301291#endif 
    302292      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 ) 
    … …  
    393383      IF( lk_tide       )   CALL    tide_init( nit000 )    ! Initialisation of the tidal harmonics 
    394384 
    395       IF( lk_bdy        )   CALL      bdy_init  ! Open boundaries initialisation 
    396       IF( lk_bdy        )   CALL  bdy_dta_init  ! Open boundaries initialisation of external data arrays 
     385      IF( lk_bdy        )   CALL     bdy_init   ! Open boundaries initialisation 
     386      IF( lk_bdy        )   CALL bdy_dta_init   ! Open boundaries initialisation of external data arrays 
    397387      IF( lk_bdy .AND. lk_tide )   & 
    398          &                  CALL  bdytide_init  ! Open boundaries initialisation of tidal harmonic forcing 
     388         &                  CALL bdytide_init   ! Open boundaries initialisation of tidal harmonic forcing 
    399389 
    400390                            CALL dyn_nept_init  ! simplified form of Neptune effect 
    … …  
    406396                            CALL     sbc_init   ! Forcings : surface module 
    407397      !                                         ! Vertical physics 
    408  
    409398                            CALL     zdf_init      ! namelist read 
    410  
    411399                            CALL zdf_bfr_init      ! bottom friction 
    412  
    413400      IF( lk_zdfric     )   CALL zdf_ric_init      ! Richardson number dependent Kz 
    414401      IF( lk_zdftke     )   CALL zdf_tke_init      ! TKE closure scheme 
    … …  
    449436                            CALL     trc_init 
    450437#endif 
    451       ! 
    452   
    453                                             ! Diagnostics 
     438      !                                     ! Diagnostics 
    454439      IF( lk_floats     )   CALL     flo_init   ! drifting Floats 
    455440      IF( lk_diaar5     )   CALL dia_ar5_init   ! ar5 diag 
    … …  
    457442      IF( lk_diadct     )   CALL dia_dct_init   ! Sections tranports 
    458443                            CALL dia_hsb_init   ! heat content, salt content and volume budgets 
    459                             CALL trd_mod_init   ! Mixed-layer/Vorticity/Integral constraints trends 
     444                            CALL     trd_init   ! Mixed-layer/Vorticity/Integral constraints trends 
    460445      IF( lk_diaobs     ) THEN                  ! Observation & model comparison 
    461446                            CALL dia_obs_init            ! Initialize observational data 
    462447                            CALL dia_obs( nit000 - 1 )   ! Observation operator for restart 
    463448      ENDIF 
     449 
    464450      !                                     ! Assimilation increments 
    465451      IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments 
    … …  
    659645      !! ** Method  : 
    660646      !!---------------------------------------------------------------------- 
    661       INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have 
     647      INTEGER, INTENT(in) ::   num_pes  ! The number of MPI processes we have 
    662648      ! 
    663649      INTEGER, PARAMETER :: nfactmax = 20 
    … …  
    668654      INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 
    669655      !!---------------------------------------------------------------------- 
    670  
     656      ! 
    671657      ierr = 0 
    672  
     658      ! 
    673659      CALL factorise( ifact, nfactmax, nfact, num_pes, ierr ) 
    674  
     660      ! 
    675661      IF( nfact <= 1 ) THEN 
    676662         WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' 
    … …  
    714700      INTEGER, PARAMETER :: ntest = 14 
    715701      INTEGER :: ilfax(ntest) 
    716  
     702      ! 
    717703      ! lfax contains the set of allowed factors. 
    718704      data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  & 
    … …  
    765751 
    766752#if defined key_mpp_mpi 
     753 
    767754   SUBROUTINE nemo_northcomms 
    768755      !!====================================================================== 
    … …  
    839826   END SUBROUTINE nemo_northcomms 
    840827#endif 
     828 
    841829   !!====================================================================== 
    842830END MODULE nemogcm 

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

    r4840 r4933  
    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] 
    … …  
    5756   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_fmass       !: time evolution of mass of snow+ice               [Kg/m2/s] 
    5857 
    59    !! arrays related to penetration of solar fluxes to calculate the heat budget for sea ice 
    60    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   oatte, iatte       !: attenuation coef of the input solar flux [unitless] 
     58   !! Energy budget of the leads (open water embedded in sea ice) 
     59   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fraqsr_1lev        !: fraction of solar net radiation absorbed in the first ocean level [-] 
    6160 
    6261   !!---------------------------------------------------------------------- 
    … …  
    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         ! 
    … …  
    9595      ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(3) ) 
    9696         ! 
    97       ALLOCATE( iatte(jpi,jpj) , oatte(jpi,jpj) , STAT=ierr(4) ) 
     97      ALLOCATE( fraqsr_1lev(jpi,jpj) , STAT=ierr(4) ) 
    9898         ! 
    9999      oce_alloc = MAXVAL( ierr ) 

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

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

    r4760 r4933  
    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 
    … …  
    203207      IF( lk_floats  )   CALL flo_stp( kstp )         ! drifting Floats 
    204208      IF( lk_diahth  )   CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth) 
    205       IF( lk_diafwb  )  CALL dia_fwb( kstp )         ! Fresh water budget diagnostics 
     209      IF( .NOT. lk_cpl ) CALL dia_fwb( kstp )         ! Fresh water budget diagnostics 
    206210      IF( ln_diaptr  )   CALL dia_ptr( kstp )         ! Poleward TRansports diagnostics 
    207211      IF( lk_diadct  )   CALL dia_dct( kstp )         ! Transports 
    … …  
    219223                         CALL trc_stp( kstp )         ! time-stepping 
    220224#endif 
     225 
    221226 
    222227      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    318323 
    319324      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    320       ! Trends                              (ua, va, tsa used as workspace) 
    321       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    322       IF( nstop == 0 ) THEN 
    323          IF( lk_trddyn     )   CALL trd_dwr( kstp )         ! trends: dynamics 
    324          IF( lk_trdtra     )   CALL trd_twr( kstp )         ! trends: active tracers 
    325          IF( lk_trdmld     )   CALL trd_mld( kstp )         ! trends: Mixed-layer 
    326          IF( lk_trdvor     )   CALL trd_vor( kstp )         ! trends: vorticity budget 
    327       ENDIF 
    328  
    329       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    330325      ! Coupled mode 
    331326      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 

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

    r4328 r4933  
    2525   USE sbcrnf           ! surface boundary condition: runoff variables 
    2626   USE sbccpl           ! surface boundary condition: coupled formulation (call send at end of step) 
    27    USE cpl_oasis3, ONLY : lk_cpl 
     27   USE sbc_oce          ! surface boundary condition: ocean 
    2828   USE sbctide          ! Tide initialisation 
    2929 
    … …  
    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_CICE/NEMOGCM/NEMO/OPA_SRC/vectopt_loop_substitute.h90

    r2528 r4933  
    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_CICE/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90

    r4624 r4933  
    166166      !! note that we need sbc_ssm called first in sbc 
    167167      ! 
    168       IF( ln_cpl ) THEN 
    169          IF( lwp ) WRITE(numout,*) 'Coupled mode not sensible with StandAlone Surface scheme' 
    170          ln_cpl = .FALSE. 
    171       ENDIF 
    172168      IF( ln_apr_dyn ) THEN 
    173169         IF( lwp ) WRITE(numout,*) 'No atmospheric gradient needed with StandAlone Surface scheme' 

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

    r3680 r4933  
    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_CICE/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r3680 r4933  
    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_CICE/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90

    r3680 r4933  
    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_CICE/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90

    r4624 r4933  
    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_CICE/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90

    r3446 r4933  
    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_CICE/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90

    r4624 r4933  
    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_CICE/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90

    r4624 r4933  
    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_CICE/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90

    r4624 r4933  
    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 ( lwm .AND. kt == nittrc000 ) CALL FLUSH    ( numonp )     ! flush output namelist PISCES 

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

    r4624 r4933  
    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_CICE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90

    r4624 r4933  
    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_CICE/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90

    r4624 r4933  
    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_CICE/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90

    r4513 r4933  
    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_CICE/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    r4359 r4933  
    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_CICE/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90

    r3294 r4933  
    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_CICE/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90

    r4611 r4933  
    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_CICE/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90

    r3680 r4933  
    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_CICE/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r3719 r4933  
    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_CICE/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90

    r3680 r4933  
    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_CICE/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90

    r4610 r4933  
    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_CICE/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r4607 r4933  
    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_CICE/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r4624 r4933  
    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_CICE/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r4152 r4933  
    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_CICE/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r4624 r4933  
    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 

  • branches/2014/dev_CNRS_CICE/NEMOGCM/SETTE/param.cfg

    r4373 r4933  
    11#- forcing files storing  
    2 FORCING_DIR=~/FORCING 
     2FORCING_DIR=${WORKDIR}/FORCING 
    33#- input files storing  
    44INPUT_DIR=${CONFIG_DIR}/${NEW_CONF}/EXP00 
    … …  
    66#TMPDIR=${CONFIG_DIR}/${NEW_CONF}/EXP00 
    77#- VALIDATION files storing  
    8 NEMO_VALIDATION_DIR=~/NEMO_VALIDATION 
     8NEMO_VALIDATION_DIR=${WORKDIR}/NEMO_VALIDATION 

  • branches/2014/dev_CNRS_CICE/NEMOGCM/SETTE/sette.sh

    r4797 r4933  
    8888# 
    8989# Compiler among those in NEMOGCM/ARCH 
    90 COMPILER=tobedefined 
     90COMPILER=x3750_ADA 
    9191export BATCH_COMMAND_PAR="llsubmit" 
    9292export BATCH_COMMAND_SEQ=$BATCH_COMMAND_PAR 
    93 export INTERACT_FLAG="yes" 
     93export INTERACT_FLAG="no" 
    9494export MPIRUN_FLAG="yes" 
    9595export USING_XIOS="yes" 
    … …  
    140140# SAS             :11 & 12 
    141141# ORCA2_AGRIF_LIM :13 
    142 for config in 1 2 3 4 5 6 7 8 9 10 11 12 13 
     142##for config in 1 2 3 4 5 6 7 8 9 10 11 12 13 
     143##for config in 1 2 3 4 5 6 7 8 9 10 
     144for config in 9 10 
    143145 
    144146do 

  • branches/2014/dev_CNRS_CICE/NEMOGCM/TOOLS/COMPILE/bld.cfg

    r4865 r4933  
    5353bld::excl_dep        inc::mpe_logf.h 
    5454bld::excl_dep        use::mpi 
    55 bld::excl_dep        use::mod_prism_proto 
    56 bld::excl_dep        use::mod_prism_def_partition_proto 
    57 bld::excl_dep        use::mod_prism_get_comm 
    58 bld::excl_dep        use::mod_prism_get_proto 
    59 bld::excl_dep        use::mod_prism_put_proto 
    60 bld::excl_dep        use::mod_comprism_proto 
     55bld::excl_dep        use::mod_oasis 
    6156bld::excl_dep        use::mkl_dfti 
    6257# Don't generate interface files 

  • branches/2014/dev_CNRS_CICE/NEMOGCM/TOOLS/COMPILE/bld_preproagr.cfg

    r4865 r4933  
    4747bld::excl_dep        inc::mpe_logf.h 
    4848bld::excl_dep        use::mpi 
    49 bld::excl_dep        use::mod_prism_proto 
    50 bld::excl_dep        use::mod_prism_def_partition_proto 
    51 bld::excl_dep        use::mod_prism_get_comm 
    52 bld::excl_dep        use::mod_prism_get_proto 
    53 bld::excl_dep        use::mod_prism_put_proto 
    54 bld::excl_dep        use::mod_comprism_proto 
     49bld::excl_dep        use::mod_oasis 
    5550bld::excl_dep        use::mkl_dfti 
    5651bld::excl_dep       use::nc4interface 

  • branches/2014/dev_CNRS_CICE/NEMOGCM/TOOLS/COMPILE/bldxag.cfg

    r4865 r4933  
    4949bld::excl_dep        inc::mpe_logf.h 
    5050bld::excl_dep        use::mpi 
    51 bld::excl_dep        use::mod_prism_proto 
    52 bld::excl_dep        use::mod_prism_def_partition_proto 
    53 bld::excl_dep        use::mod_prism_get_comm 
    54 bld::excl_dep        use::mod_prism_get_proto 
    55 bld::excl_dep        use::mod_prism_put_proto 
    56 bld::excl_dep        use::mod_comprism_proto 
     51bld::excl_dep        use::mod_oasis 
    5752bld::excl_dep        use::mkl_dfti 
    5853# Don't generate interface files 
Note: See TracChangeset for help on using the changeset viewer.