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

Ignore:
Timestamp:
2014-12-02T10:38:20+01:00 (9 years ago)
Author:
cetlod
Message:

2014/dev_MERGE_2014 : merge in changes from dev_CNRS_CICE

Location:
branches/2014/dev_MERGE_2014/NEMOGCM
Files:
14 deleted
137 edited
14 copied

Legend:

Unmodified
Added
Removed

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

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

    r4230 r4946  
    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_MERGE_2014/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg

    r4370 r4946  
    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_MERGE_2014/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg

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

    r4230 r4946  
    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_MERGE_2014/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_cfg

    r4940 r4946  
    7979                           !     =2 annual global mean of e-p-r set to zero 
    8080                           !     =3 global emp set to zero and spread out over erp area 
     81/ 
    8182!----------------------------------------------------------------------- 
    8283&namsbc_core   !   namsbc_core  CORE bulk formulae 
    … …  
    107108&namtra_qsr    !   penetrative solar radiation 
    108109!----------------------------------------------------------------------- 
     110!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! 
     111!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! 
     112   sn_chl      ='chlorophyll',        -1         , 'CHLA'    ,   .true.     , .true. , 'yearly'  , 'weights_bilin.nc'       , '' 
    109113/ 
    110114!----------------------------------------------------------------------- 

  • branches/2014/dev_MERGE_2014/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/1_namelist_cfg

    r4940 r4946  
    5555/ 
    5656!----------------------------------------------------------------------- 
     57&namsplit      !   time splitting parameters                            ("key_dynspg_ts") 
     58!----------------------------------------------------------------------- 
     59/ 
     60!----------------------------------------------------------------------- 
     61&namcrs        !   Grid coarsening for dynamics output and/or 
     62               !   passive tracer coarsened online simulations 
     63!----------------------------------------------------------------------- 
     64/ 
     65!----------------------------------------------------------------------- 
    5766&namtsd    !   data : Temperature  & Salinity 
    5867!----------------------------------------------------------------------- 
    … …  
    8594   sn_snow     = 'ncar_precip.15JUNE2009_fill' ,        -1         , 'SNOW'    ,   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , '' 
    8695   sn_tdif     = 'taudif_core'                 ,        24         , 'taudif'  ,   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , '' 
    87  
    8896   cn_dir      = './'      !  root directory for the location of the bulk files 
    8997   ln_2m       = .false.   !  air temperature and humidity referenced at 2m (T) instead 10m (F) 
    … …  
    213221!----------------------------------------------------------------------- 
    214222/ 
     223!----------------------------------------------------------------------- 
     224&namobs       !  observation usage                                      ('key_diaobs') 
     225!----------------------------------------------------------------------- 
     226/ 
     227!----------------------------------------------------------------------- 
     228&nam_asminc   !   assimilation increments                               ('key_asminc') 
     229!----------------------------------------------------------------------- 
     230/ 

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

    r4924 r4946  
    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"                        /> 
    … …  
    168173 
    169174         <!-- *_oce variables available with ln_blk_clio or ln_blk_core --> 
     175         <field id="qns_oce"      long_name="Non solar Downward Heat Flux over open ocean"                 unit="W/m2"     /> 
    170176         <field id="qlw_oce"      long_name="Longwave Downward Heat Flux over open ocean"                  unit="W/m2"     /> 
    171177         <field id="qsb_oce"      long_name="Sensible Downward Heat Flux over open ocean"                  unit="W/m2"     /> 
    … …  
    203209         <field id="ice_cover"    long_name="Ice fraction"                                                 unit="1"        /> 
    204210 
     211         <field id="ioceflxb"     long_name="Oceanic flux at the ice base"                                 unit="W/m2"     /> 
    205212         <field id="qsr_ai_cea"   long_name="Air-Ice downward solar heat flux (cell average)"              unit="W/m2"     /> 
    206213         <field id="qns_ai_cea"   long_name="Air-Ice downward non-solar heat flux (cell average)"          unit="W/m2"     /> 
    … …  
    213220         <field id="icethic_cea"  long_name="Ice thickness (cell average)"                                 unit="m"        /> 
    214221         <field id="iceprod_cea"  long_name="Ice production (cell average)"                                unit="m/s"      /> 
     222         <field id="iiceconc"     long_name="Ice concentration"                                            unit=""         /> 
    215223          
    216224         <field id="ice_pres"     long_name="Ice presence"                                                 unit="-"        /> 
    … …  
    227235         <field id="emp_x_sst"    long_name="Concentration/Dilution term on SST"                           unit="kgC/m2/s" /> 
    228236         <field id="emp_x_sss"    long_name="Concentration/Dilution term on SSS"                         unit="kgPSU/m2/s" />         
    229           
    230           
     237        
    231238         <field id="iceconc"      long_name="ice concentration"                                            unit="%"        /> 
    232239         <field id="uice_ipa"     long_name="Ice velocity along i-axis at I-point (ice presence average)"  unit="m/s"      /> 
    … …  
    314321         <field id="hfxdhc"    long_name="Heat content variation in snow and ice"   unit="W/m2" /> 
    315322         <field id="hfxtur"    long_name="turbulent heat flux at the ice base"      unit="W/m2"  /> 
    316  
     323   
     324          
    317325      </field_group> 
    318326 
    … …  
    400408 
    401409      <field_group id="scalar"  domain_ref="1point" > 
    402      <field id="voltot"     long_name="global mean volume"                         unit="m3"   /> 
    403      <field id="sshtot"     long_name="global mean ssh"                            unit="m"    /> 
    404      <field id="sshsteric"  long_name="global mean ssh steric"                     unit="m"    /> 
    405      <field id="sshthster"  long_name="global mean ssh thermosteric"               unit="m"    /> 
    406      <field id="masstot"    long_name="global mean mass"                           unit="kg"   /> 
    407      <field id="temptot"    long_name="global mean temperature"                    unit="degC" /> 
    408      <field id="saltot"     long_name="global mean salinity"                       unit="psu"  /> 
    409      <field id="fram_trans" long_name="Sea Ice Mass Transport Through Fram Strait" unit="kg/s" /> 
     410         <field id="voltot"     long_name="global mean volume"                         unit="m3"   /> 
     411         <field id="sshtot"     long_name="global mean ssh"                            unit="m"    /> 
     412         <field id="sshsteric"  long_name="global mean ssh steric"                     unit="m"    /> 
     413         <field id="sshthster"  long_name="global mean ssh thermosteric"               unit="m"    /> 
     414         <field id="masstot"    long_name="global mean mass"                           unit="kg"   /> 
     415         <field id="temptot"    long_name="global mean temperature"                    unit="degC" /> 
     416         <field id="saltot"     long_name="global mean salinity"                       unit="psu"  /> 
     417         <field id="fram_trans" long_name="Sea Ice Mass Transport Through Fram Strait" unit="kg/s" /> 
     418 
    410419       <!-- available with ln_diahsb --> 
    411     <field id="bgtemper" long_name="global mean temperature variation"            unit="degC"/> 
    412     <field id="bgsaline" long_name="global mean salinity variation"               unit="psu"/> 
    413     <field id="bgheatco" long_name="global mean heat content variation"           unit="10^20J"/> 
    414     <field id="bgsaltco" long_name="global mean salt content variation"           unit="psu*km3" /> 
    415     <field id="bgvolssh" long_name="global mean volume variation (ssh)"           unit="km3"/> 
    416     <field id="bgvole3t" long_name="global mean volume variation (e3t)"           unit="km3"/> 
    417     <field id="bgfrcvol" long_name="global mean volume variation from forcing"    unit="km3"/> 
    418     <field id="bgfrctem" long_name="global mean forcing from heat content variation"   unit="degC"/> 
    419     <field id="bgfrcsal" long_name="global mean forcing salt content variation"        unit="psu"/> 
    420     <field id="bgmistem" long_name="global mean temperature error due to free surface" unit="degC"/> 
    421     <field id="bgmissal" long_name="global mean salinity error due to free surface"    unit="psu"/> 
     420    <field id="bgtemper"     long_name="global mean temperature"                  unit="degC"   /> 
     421    <field id="bgsaline"     long_name="global mean salinity"                     unit="psu"    /> 
     422    <field id="bgheatco"     long_name="global mean heat content"                 unit="10^9J"  /> 
     423    <field id="bgsaltco"     long_name="global mean salt content"                 unit="psu*m3" /> 
     424    <field id="bgvolssh"     long_name="global mean ssh volume"                   unit="km3"     /> 
     425         <field id="bgvole3t"     long_name="global mean volume variation (e3t)"           unit="km3"/> 
     426    <field id="bgvoltot"     long_name="global mean volume"                       unit="km3"     /> 
     427    <field id="bgsshtot"     long_name="global mean ssh"                          unit="m"      /> 
     428    <field id="bgfrcvol"     long_name="global mean volume from forcing"          unit="km3"     /> 
     429    <field id="bgfrctem"     long_name="global mean heat content from forcing"    unit="10^9J"  /> 
     430    <field id="bgfrcsal"     long_name="global mean salt content from forcing"    unit="psu*km3" /> 
     431    <field id="bgmistem"     long_name="global mean temperature error due to free surface" unit="degC" /> 
     432    <field id="bgmissal"     long_name="global mean salinity error due to free surface"    unit="psu"  /> 
    422433      </field_group> 
    423434 
    … …  
    721732    </field_group> 
    722733     
     734    <!--  
     735============================================================================================================ 
     736                     Trend diagnostics : temperature, KE, PE, momentum 
     737============================================================================================================ 
     738    --> 
     739 
     740    <field_group id="trendT" grid_ref="grid_T_3D"> 
     741      <!-- variables available with ln_tra_trd --> 
     742      <field id="ttrd_xad"      long_name="temperature-trend: i-advection"                 unit="degC/s" /> 
     743      <field id="strd_xad"      long_name="salinity   -trend: i-advection"                 unit="psu/s"  /> 
     744      <field id="ttrd_yad"      long_name="temperature-trend: j-advection"                 unit="degC/s" /> 
     745      <field id="strd_yad"      long_name="salinity   -trend: j-advection"                 unit="psu/s"  /> 
     746      <field id="ttrd_zad"      long_name="temperature-trend: k-advection"                 unit="degC/s" /> 
     747      <field id="strd_zad"      long_name="salinity   -trend: k-advection"                 unit="psu/s"  /> 
     748      <field id="ttrd_sad"      long_name="temperature-trend: surface adv. (no-vvl)"       unit="degC/s" grid_ref="grid_T_2D" /> 
     749      <field id="strd_sad"      long_name="salinity   -trend: surface adv. (no-vvl)"       unit="psu/s"  grid_ref="grid_T_2D" /> 
     750      <field id="ttrd_ldf"      long_name="temperature-trend: lateral  diffusion"          unit="degC/s" /> 
     751      <field id="strd_ldf"      long_name="salinity   -trend: lateral  diffusion"          unit="psu/s"  /> 
     752      <field id="ttrd_zdf"      long_name="temperature-trend: vertical diffusion"          unit="degC/s" /> 
     753      <field id="strd_zdf"      long_name="salinity   -trend: vertical diffusion"          unit="psu/s"  /> 
     754      <!-- ln_traldf_iso=T only (iso-neutral diffusion) --> 
     755      <field id="ttrd_zdfp"     long_name="temperature-trend: pure vert. diffusion"        unit="degC/s" /> 
     756      <field id="strd_zdfp"     long_name="salinity   -trend: pure vert. diffusion"        unit="psu/s"  /> 
     757      <!-- --> 
     758      <field id="ttrd_dmp"      long_name="temperature-trend: interior restoring"          unit="degC/s" /> 
     759      <field id="strd_dmp"      long_name="salinity   -trend: interior restoring"          unit="psu/s"  /> 
     760      <field id="ttrd_bbl"      long_name="temperature-trend: bottom boundary layer"       unit="degC/s" /> 
     761      <field id="strd_bbl"      long_name="salinity   -trend: bottom boundary layer"       unit="psu/s"  /> 
     762      <field id="ttrd_npc"      long_name="temperature-trend: non-penetrative conv."       unit="degC/s" /> 
     763      <field id="strd_npc"      long_name="salinity   -trend: non-penetrative conv."       unit="psu/s"  /> 
     764      <field id="ttrd_qns"      long_name="temperature-trend: non-solar flux + runoff"     unit="degC/s" /> 
     765      <field id="strd_cdt"      long_name="salinity   -trend: C/D term       + runoff"     unit="degC/s" /> 
     766      <field id="ttrd_qsr"      long_name="temperature-trend: solar penetr. heating"       unit="degC/s" /> 
     767      <field id="ttrd_bbc"      long_name="temperature-trend: geothermal heating"          unit="degC/s" /> 
     768      <field id="ttrd_atf"      long_name="temperature-trend: asselin time filter"         unit="degC/s" /> 
     769      <field id="strd_atf"      long_name="salinity   -trend: asselin time filter"         unit="psu/s"  /> 
     770      <!-- variables available with ln_KE_trd --> 
     771      <field id="ketrd_hpg"     long_name="ke-trend: hydrostatic pressure gradient"        unit="W/s^3"  /> 
     772      <field id="ketrd_spg"     long_name="ke-trend: surface     pressure gradient"        unit="W/s^3"  /> 
     773      <field id="ketrd_spgexp"  long_name="ke-trend: surface pressure gradient (explicit)" unit="W/s^3"  /> 
     774      <field id="ketrd_spgflt"  long_name="ke-trend: surface pressure gradient (filter)"   unit="W/s^3"  /> 
     775      <field id="ssh_flt"       long_name="filtered contribution to ssh (dynspg_flt)"      unit="m"     grid_ref="grid_T_2D"   /> 
     776      <field id="w0"            long_name="surface vertical velocity"                      unit="m/s"   grid_ref="grid_T_2D"   /> 
     777      <field id="pw0_exp"       long_name="surface pressure flux due to ssh"               unit="W/s^2" grid_ref="grid_T_2D"   /> 
     778      <field id="pw0_flt"       long_name="surface pressure flux due to filtered ssh"      unit="W/s^2" grid_ref="grid_T_2D"   /> 
     779      <field id="ketrd_keg"     long_name="ke-trend: KE gradient         or hor. adv."     unit="W/s^3"  /> 
     780      <field id="ketrd_rvo"     long_name="ke-trend: relative  vorticity or metric term"   unit="W/s^3"  /> 
     781      <field id="ketrd_pvo"     long_name="ke-trend: planetary vorticity"                  unit="W/s^3"  /> 
     782      <field id="ketrd_zad"     long_name="ke-trend: vertical  advection"                  unit="W/s^3"  /> 
     783      <field id="ketrd_udx"     long_name="ke-trend: U.dx[U]"                              unit="W/s^3"  /> 
     784      <field id="ketrd_ldf"     long_name="ke-trend: lateral   diffusion"                  unit="W/s^3"  /> 
     785      <field id="ketrd_zdf"     long_name="ke-trend: vertical  diffusion"                  unit="W/s^3"  /> 
     786      <field id="ketrd_tau"     long_name="ke-trend: wind stress "                         unit="W/s^3" grid_ref="grid_T_2D"   /> 
     787      <field id="ketrd_bfr"     long_name="ke-trend: bottom friction (explicit)"           unit="W/s^3"  />    
     788      <field id="ketrd_bfri"    long_name="ke-trend: bottom friction (implicit)"           unit="W/s^3"  />    
     789      <field id="ketrd_atf"     long_name="ke-trend: asselin time filter trend"            unit="W/s^3"  />   
     790      <field id="ketrd_convP2K" long_name="ke-trend: conversion (potential to kinetic)"    unit="W/s^3"  /> 
     791      <field id="KE"            long_name="kinetic energy: u(n)*u(n+1)/2"                  unit="W/s^2"  />    
     792      <!-- variables available with ln_PE_trd --> 
     793      <field id="petrd_xad"     long_name="pe-trend: i-advection"                          unit="W/m^3"  /> 
     794      <field id="petrd_yad"     long_name="pe-trend: j-advection"                          unit="W/m^3"  /> 
     795      <field id="petrd_zad"     long_name="pe-trend: k-advection"                          unit="W/m^3"  /> 
     796      <field id="petrd_sad"     long_name="pe-trend: surface adv. (no-vvl)"                unit="W/m^3"  grid_ref="grid_T_2D" /> 
     797      <field id="petrd_ldf"     long_name="pe-trend: lateral  diffusion"                   unit="W/m^3"  /> 
     798      <field id="petrd_zdf"     long_name="pe-trend: vertical diffusion"                   unit="W/m^3"  /> 
     799      <field id="petrd_zdfp"    long_name="pe-trend: pure vert. diffusion"                 unit="W/m^3"  /> 
     800      <field id="petrd_dmp"     long_name="pe-trend: interior restoring"                   unit="W/m^3"  /> 
     801      <field id="petrd_bbl"     long_name="pe-trend: bottom boundary layer"                unit="W/m^3"  /> 
     802      <field id="petrd_npc"     long_name="pe-trend: non-penetrative conv."                unit="W/m^3"  /> 
     803      <field id="petrd_nsr"     long_name="pe-trend: surface forcing + runoff"             unit="W/m^3"  /> 
     804      <field id="petrd_qsr"     long_name="pe-trend: solar penetr. heating"                unit="W/m^3"  /> 
     805      <field id="petrd_bbc"     long_name="pe-trend: geothermal heating"                   unit="W/m^3"  /> 
     806      <field id="petrd_atf"     long_name="pe-trend: asselin time filter"                  unit="W/m^3"  /> 
     807      <field id="PEanom"        long_name="potential energy anomaly"                       unit="SI"     />    
     808      <field id="alphaPE"       long_name="- partial deriv. of PEanom wrt T"               unit="/degC"  />    
     809      <field id="betaPE"        long_name="partial deriv. of PEanom wrt S"                 unit="/psu"   />    
     810    </field_group> 
     811 
     812    <field_group id="trendU" grid_ref="grid_U_3D"> 
     813     <!-- variables available with ln_dyn_trd --> 
     814     <field id="utrd_hpg"       long_name="i-trend: hydrostatic pressure gradient"         unit="m/s^2"                      /> 
     815     <field id="utrd_spg"       long_name="i-trend: surface     pressure gradient"         unit="m/s^2"                      /> 
     816     <field id="utrd_spgexp"    long_name="i-trend: surface pressure gradient (explicit)"  unit="m/s^2"                      /> 
     817     <field id="utrd_spgflt"    long_name="i-trend: surface pressure gradient (filtered)"  unit="m/s^2"                      /> 
     818     <field id="utrd_keg"       long_name="i-trend: KE gradient         or hor. adv."      unit="m/s^2"                      /> 
     819     <field id="utrd_rvo"       long_name="i-trend: relative  vorticity or metric term"    unit="m/s^2"                      /> 
     820     <field id="utrd_pvo"       long_name="i-trend: planetary vorticity"                   unit="m/s^2"                      /> 
     821     <field id="utrd_zad"       long_name="i-trend: vertical  advection"                   unit="m/s^2"                      /> 
     822     <field id="utrd_udx"       long_name="i-trend: U.dx[U]"                               unit="m/s^2"                      /> 
     823     <field id="utrd_ldf"       long_name="i-trend: lateral   diffusion"                   unit="m/s^2"                      /> 
     824     <field id="utrd_zdf"       long_name="i-trend: vertical  diffusion"                   unit="m/s^2"                      /> 
     825     <field id="utrd_tau"       long_name="i-trend: wind stress "                          unit="m/s^2" grid_ref="grid_U_2D" /> 
     826     <field id="utrd_bfr"       long_name="i-trend: bottom friction (explicit)"            unit="m/s^2"                      />    
     827     <field id="utrd_bfri"      long_name="i-trend: bottom friction (implicit)"            unit="m/s^2"                      />    
     828     <field id="utrd_tot"       long_name="i-trend: total momentum trend before atf"       unit="m/s^2"                      />    
     829     <field id="utrd_atf"       long_name="i-trend: asselin time filter trend"             unit="m/s^2"                      />    
     830    </field_group> 
     831 
     832    <field_group id="trendV" grid_ref="grid_V_3D"> 
     833     <!-- variables available with ln_dyn_trd --> 
     834     <field id="vtrd_hpg"       long_name="j-trend: hydrostatic pressure gradient"         unit="m/s^2"                      /> 
     835     <field id="vtrd_spg"       long_name="j-trend: surface     pressure gradient"         unit="m/s^2"                      /> 
     836     <field id="vtrd_spgexp"    long_name="j-trend: surface pressure gradient (explicit)"  unit="m/s^2"                      /> 
     837     <field id="vtrd_spgflt"    long_name="j-trend: surface pressure gradient (filtered)"  unit="m/s^2"                      /> 
     838     <field id="vtrd_keg"       long_name="j-trend: KE gradient         or hor. adv."      unit="m/s^2"                      /> 
     839     <field id="vtrd_rvo"       long_name="j-trend: relative  vorticity or metric term"    unit="m/s^2"                      /> 
     840     <field id="vtrd_pvo"       long_name="j-trend: planetary vorticity"                   unit="m/s^2"                      /> 
     841     <field id="vtrd_zad"       long_name="j-trend: vertical  advection"                   unit="m/s^2"                      /> 
     842     <field id="vtrd_vdy"       long_name="i-trend: V.dx[V]"                               unit="m/s^2"                      /> 
     843     <field id="vtrd_ldf"       long_name="j-trend: lateral   diffusion"                   unit="m/s^2"                      /> 
     844     <field id="vtrd_zdf"       long_name="j-trend: vertical  diffusion"                   unit="m/s^2"                      /> 
     845     <field id="vtrd_tau"       long_name="j-trend: wind stress "                          unit="m/s^2" grid_ref="grid_V_2D" /> 
     846     <field id="vtrd_bfr"       long_name="j-trend: bottom friction (explicit)"            unit="m/s^2"                      />    
     847     <field id="vtrd_bfri"      long_name="j-trend: bottom friction (implicit)"            unit="m/s^2"                      />    
     848     <field id="vtrd_tot"       long_name="j-trend: total momentum trend before atf"       unit="m/s^2"                      />    
     849     <field id="vtrd_atf"       long_name="j-trend: asselin time filter trend"            unit="m/s^2"                       />    
     850    </field_group> 
     851 
    723852    </field_definition> 

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

    r4934 r4946  
    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 
    … …  
    232233   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
    233234   ln_blk_mfs  = .false.   !  MFS bulk formulation                      (T => fill namsbc_mfs ) 
    234    ln_cpl      = .false.   !  Coupled formulation                       (T => fill namsbc_cpl ) 
    235235   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr ) 
    236236   nn_ice      = 2         !  =0 no ice boundary condition   , 
    237237                           !  =1 use observed ice-cover      , 
    238                            !  =2 ice-model used                         ("key_lim3" or "key_lim2) 
     238                           !  =2 ice-model used                         ("key_lim3" or "key_lim2") 
    239239   nn_ice_embd = 1         !  =0 levitating ice (no mass exchange, concentration/dilution effect) 
    240240                           !  =1 levitating ice with mass and salt exchange but no presure effect 
    … …  
    256256   nn_lsm  = 0             !  =0 land/sea mask for input fields is not applied (keep empty land/sea mask filename field) , 
    257257                           !  =1:n number of iterations of land/sea mask application for input fields (fill land/sea mask filename field) 
    258    cn_iceflx = 'linear'    !  redistribution of solar input into ice categories during coupling ice/atm. 
     258   nn_limflx = -1          !  LIM3 Multi-category heat flux formulation (use -1 if LIM3 is not used) 
     259                           !  =-1  Use per-category fluxes, bypass redistributor, forced mode only, not yet implemented coupled 
     260                           !  = 0  Average per-category fluxes (forced and coupled mode) 
     261                           !  = 1  Average and redistribute per-category fluxes, forced mode only, not yet implemented coupled 
     262                           !  = 2  Redistribute a single flux over categories (coupled mode only) 
    259263/ 
    260264!----------------------------------------------------------------------- 
    … …  
    312316 
    313317   cn_dir      = './'      !  root directory for the location of the bulk files 
    314    ln_2m       = .false.   !  air temperature and humidity referenced at 2m (T) instead 10m (F) 
    315318   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data 
    316    ln_bulk2z   = .false.   !  Air temperature/humidity and wind vectors are referenced at heights rn_zqt and rn_zu 
    317    rn_zqt      = 3.        !  Air temperature and humidity reference height (m) (ln_bulk2z) 
    318    rn_zu       = 4.        !  Wind vector reference height (m)                  (ln_bulk2z) 
     319   rn_zqt      = 10.        !  Air temperature and humidity reference height (m) 
     320   rn_zu       = 10.        !  Wind vector reference height (m)                  
    319321   rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow) 
    320322   rn_efac     = 1.        !  multiplicative factor for evaporation (0. or 1.) 
    … …  
    343345!                    !                       ! categories !  reference  !    orientation       ! grids  ! 
    344346! send 
    345 sn_snd_temp   =       'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   '' 
    346 sn_snd_alb    =       'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   '' 
    347 sn_snd_thick  =       'none'                 ,    'no'   ,     ''      ,         ''           ,   '' 
    348 sn_snd_crt    =       'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T' 
    349 sn_snd_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''           ,   '' 
     347   sn_snd_temp   =       'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   '' 
     348   sn_snd_alb    =       'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   '' 
     349   sn_snd_thick  =       'none'                 ,    'no'   ,     ''      ,         ''           ,   '' 
     350   sn_snd_crt    =       'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T' 
     351   sn_snd_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''           ,   '' 
    350352! receive 
    351 sn_rcv_w10m   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   '' 
    352 sn_rcv_taumod =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
    353 sn_rcv_tau    =       'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V' 
    354 sn_rcv_dqnsdt =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
    355 sn_rcv_qsr    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   '' 
    356 sn_rcv_qns    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   '' 
    357 sn_rcv_emp    =       'conservative'         ,    'no'    ,     ''      ,         ''          ,   '' 
    358 sn_rcv_rnf    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
    359 sn_rcv_cal    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
    360 sn_rcv_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     353   sn_rcv_w10m   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   '' 
     354   sn_rcv_taumod =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     355   sn_rcv_tau    =       'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V' 
     356   sn_rcv_dqnsdt =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     357   sn_rcv_qsr    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   '' 
     358   sn_rcv_qns    =       'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   '' 
     359   sn_rcv_emp    =       'conservative'         ,    'no'    ,     ''      ,         ''          ,   '' 
     360   sn_rcv_rnf    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     361   sn_rcv_cal    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     362   sn_rcv_co2    =       'coupled'              ,    'no'    ,     ''      ,         ''          ,   '' 
     363! 
     364   nn_cplmodel   =     1     !  Maximum number of models to/from which NEMO is potentialy sending/receiving data 
     365   ln_usecplmask = .false.   !  use a coupling mask file to merge data received from several models 
     366                             !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
    361367/ 
    362368!----------------------------------------------------------------------- 
    … …  
    704710!!   nameos        equation of state 
    705711!!   namtra_adv    advection scheme 
     712!!   namtra_adv_mle   mixed layer eddy param. (Fox-Kemper param.) 
    706713!!   namtra_ldf    lateral diffusion scheme 
    707714!!   namtra_dmp    T & S newtonian damping 
    … …  
    711718&nameos        !   ocean physical parameters 
    712719!----------------------------------------------------------------------- 
    713    nn_eos      =   0       !  type of equation of state and Brunt-Vaisala frequency 
    714                            !     = 0, UNESCO (formulation of Jackett and McDougall (1994) and of McDougall (1987) ) 
    715                            !     = 1, linear: rho(T)   = rau0 * ( 1.028 - ralpha * T ) 
    716                            !     = 2, linear: rho(T,S) = rau0 * ( rbeta * S - ralpha * T ) 
    717    rn_alpha    =   2.0e-4  !  thermal expension coefficient (nn_eos= 1 or 2) 
    718    rn_beta     =   7.7e-4  !  saline  expension coefficient (nn_eos= 2) 
     720   nn_eos      =  -1     !  type of equation of state and Brunt-Vaisala frequency 
     721                                 !  =-1, TEOS-10  
     722                                 !  = 0, EOS-80  
     723                                 !  = 1, S-EOS   (simplified eos) 
     724   ln_useCT    = .true.  ! use of Conservative Temp. ==> surface CT converted in Pot. Temp. in sbcssm 
     725   !                             ! 
     726   !                     ! S-EOS coefficients : 
     727   !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 
     728   rn_a0       =  1.6550e-1      !  thermal expension coefficient (nn_eos= 1) 
     729   rn_b0       =  7.6554e-1      !  saline  expension coefficient (nn_eos= 1) 
     730   rn_lambda1  =  5.9520e-2      !  cabbeling coeff in T^2  (=0 for linear eos) 
     731   rn_lambda2  =  7.4914e-4      !  cabbeling coeff in S^2  (=0 for linear eos) 
     732   rn_mu1      =  1.4970e-4      !  thermobaric coeff. in T (=0 for linear eos) 
     733   rn_mu2      =  1.1090e-5      !  thermobaric coeff. in S (=0 for linear eos) 
     734   rn_nu       =  2.4341e-3      !  cabbeling coeff in T*S  (=0 for linear eos) 
    719735/ 
    720736!----------------------------------------------------------------------- 
    721737&namtra_adv    !   advection scheme for tracer 
    722738!----------------------------------------------------------------------- 
    723    ln_traadv_cen2   =  .false.  !  2nd order centered scheme 
    724    ln_traadv_tvd    =  .true.   !  TVD scheme 
    725    ln_traadv_muscl  =  .false.  !  MUSCL scheme 
    726    ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries 
    727    ln_traadv_ubs    =  .false.  !  UBS scheme 
    728    ln_traadv_qck    =  .false.  !  QUICKEST scheme 
    729    ln_traadv_msc_ups=  .false.  !  use upstream scheme within muscl 
     739   ln_traadv_cen2   =  .false.   !  2nd order centered scheme 
     740   ln_traadv_tvd    =  .true.    !  TVD scheme 
     741   ln_traadv_muscl  =  .false.   !  MUSCL scheme 
     742   ln_traadv_muscl2 =  .false.   !  MUSCL2 scheme + cen2 at boundaries 
     743   ln_traadv_ubs    =  .false.   !  UBS scheme 
     744   ln_traadv_qck    =  .false.   !  QUICKEST scheme 
     745   ln_traadv_msc_ups=  .false.   !  use upstream scheme within muscl 
    730746   ln_traadv_tvd_zts=  .false.  !  TVD scheme with sub-timestepping of vertical tracer advection 
    731747/ 
    … …  
    9851001!!                  ***  Miscellaneous namelists  *** 
    9861002!!====================================================================== 
     1003!!   namsol            elliptic solver / island / free surface 
    9871004!!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi) 
    9881005!!   namctl            Control prints & Benchmark 
    989 !!   namsol            elliptic solver / island / free surface 
     1006!!   namc1d            1D configuration options                         ("key_c1d") 
     1007!!   namc1d_uvd        data: U & V currents                             ("key_c1d") 
     1008!!   namc1d_dyndmp     U & V newtonian damping                          ("key_c1d") 
    9901009!!====================================================================== 
    9911010! 
    … …  
    10461065   ln_dyndmp   =  .false.  !  add a damping term (T) or not (F) 
    10471066/ 
     1067 
    10481068!!====================================================================== 
    10491069!!                  ***  Diagnostics namelists  *** 
    10501070!!====================================================================== 
    10511071!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4") 
    1052 !!   namtrd       dynamics and/or tracer trends                         ("key_trddyn","key_trdtra","key_trdmld") 
     1072!!   namtrd       dynamics and/or tracer trends 
    10531073!!   namflo       float parameters                                      ("key_float") 
    10541074!!   namptr       Poleward Transport Diagnostics 
    … …  
    10681088/ 
    10691089!----------------------------------------------------------------------- 
    1070 &namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra") 
    1071 !              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor") 
    1072 !----------------------------------------------------------------------- 
    1073    nn_trd      = 365       !  time step frequency dynamics and tracers trends 
    1074    nn_ctls     =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk) 
    1075    rn_ucf      =   1.      !  unit conversion factor (=1 -> /seconds ; =86400. -> /day) 
    1076    cn_trdrst_in      = "restart_mld"   ! suffix of ocean restart name (input) 
    1077    cn_trdrst_out     = "restart_mld"   ! suffix of ocean restart name (output) 
    1078    ln_trdmld_restart = .false.         !  restart for ML diagnostics 
    1079    ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S 
    1080 / 
     1090&namtrd        !   diagnostics on dynamics and/or tracer trends 
     1091!              !       and/or mixed-layer trends and/or barotropic vorticity 
     1092!----------------------------------------------------------------------- 
     1093   ln_glo_trd  = .false.   ! (T) global domain averaged diag for T, T^2, KE, and PE 
     1094   ln_dyn_trd  = .false.   ! (T) 3D momentum trend output 
     1095   ln_dyn_mxl  = .FALSE.   ! (T) 2D momentum trends averaged over the mixed layer (not coded yet) 
     1096   ln_vor_trd  = .FALSE.   ! (T) 2D barotropic vorticity trends (not coded yet) 
     1097   ln_KE_trd   = .false.   ! (T) 3D Kinetic   Energy     trends 
     1098   ln_PE_trd   = .false.   ! (T) 3D Potential Energy     trends 
     1099   ln_tra_trd  = .FALSE.   ! (T) 3D tracer trend output 
     1100   ln_tra_mxl  = .false.   ! (T) 2D tracer trends averaged over the mixed layer (not coded yet) 
     1101   nn_trd      = 365       !  print frequency (ln_glo_trd=T) (unit=time step) 
     1102/ 
     1103!!gm   nn_ctls     =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk) 
     1104!!gm   rn_ucf      =   1.      !  unit conversion factor (=1 -> /seconds ; =86400. -> /day) 
     1105!!gm   cn_trdrst_in      = "restart_mld"   ! suffix of ocean restart name (input) 
     1106!!gm   cn_trdrst_out     = "restart_mld"   ! suffix of ocean restart name (output) 
     1107!!gm   ln_trdmld_restart = .false.         !  restart for ML diagnostics 
     1108!!gm   ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S 
     1109!!gm 
    10811110!----------------------------------------------------------------------- 
    10821111&namflo       !   float parameters                                      ("key_float") 

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

    r4932 r4946  
    22ORCA2_LIM_CFC_C14b OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 
    33GYRE_XIOS OPA_SRC 
    4 ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC 
    54ORCA2_SAS_LIM OPA_SRC SAS_SRC LIM_SRC_2 NST_SRC 
    65C1D_PAPA OPA_SRC 
    76ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 
     7GYRE_BFM OPA_SRC TOP_SRC 
    88AMM12 OPA_SRC 
    9 GYRE_BFM OPA_SRC TOP_SRC 
     9ORCA2_LIM3 OPA_SRC LIM_SRC_3 NST_SRC 
    1010ORCA2_LIM_PISCES OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 
     11ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC 
    1112ISOMIP OPA_SRC 
    12 ORCA2_LIM3 OPA_SRC LIM_SRC_3 NST_SRC 
    1313GYRE OPA_SRC 

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

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

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

    r4306 r4946  
    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_MERGE_2014/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90

    r4924 r4946  
    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_MERGE_2014/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90

    r4306 r4946  
    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_MERGE_2014/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90

    r4932 r4946  
    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_MERGE_2014/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90

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

    r4932 r4946  
    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_MERGE_2014/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r4924 r4946  
    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_MERGE_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r4924 r4946  
    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_MERGE_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

    r4924 r4946  
    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_MERGE_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90

    r4924 r4946  
    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_MERGE_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90

    r4924 r4946  
    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_MERGE_2014/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90

    r4924 r4946  
    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_MERGE_2014/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90

    r4812 r4946  
    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 )   & ! Partial steps: before Horizontal DErivative 
    540540        &    CALL zps_hde( kt, jpts, pts, gtsu, gtsv,  &        ! Partial steps: before horizontal gradient 

  • branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OOO_SRC/nemogcm.F90

    r4624 r4946  
    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_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

    r4932 r4946  
    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,*) 
    … …  
    671657      ! used to prevent the applied increments taking the temperature below the local freezing point  
    672658 
    673       DO jk=1, jpkm1 
    674          fzptnz (:,:,jk) = tfreez( tsn(:,:,jk,jp_sal), fsdept(:,:,jk) ) 
    675       ENDDO 
     659      DO jk = 1, jpkm1 
     660         fzptnz(:,:,jk) = eos_fzp( tsn(:,:,jk,jp_sal), fsdept(:,:,jk) ) 
     661      END DO 
    676662 
    677663      IF ( ln_asmiau ) THEN 
    … …  
    688674            IF(lwp) THEN 
    689675               WRITE(numout,*)  
    690                WRITE(numout,*) 'tra_asm_inc : Tracer IAU at time step = ', & 
    691                   &  kt,' with IAU weight = ', wgtiau(it) 
     676               WRITE(numout,*) 'tra_asm_inc : Tracer IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 
    692677               WRITE(numout,*) '~~~~~~~~~~~~' 
    693678            ENDIF 
    … …  
    737722            IF (ln_temnofreeze) THEN 
    738723               ! Do not apply negative increments if the temperature will fall below freezing 
    739                WHERE(t_bkginc(:,:,:) > 0.0_wp .OR. & 
    740                   &   tsn(:,:,:,jp_tem) + t_bkginc(:,:,:) > fzptnz(:,:,:) )  
     724               WHERE( t_bkginc(:,:,:) > 0.0_wp .OR. tsn(:,:,:,jp_tem) + t_bkginc(:,:,:) > fzptnz(:,:,:) )  
    741725                  tsn(:,:,:,jp_tem) = t_bkg(:,:,:) + t_bkginc(:,:,:)    
    742726               END WHERE 
    … …  
    747731               ! Do not apply negative increments if the salinity will fall below a specified 
    748732               ! minimum value salfixmin 
    749                WHERE(s_bkginc(:,:,:) > 0.0_wp .OR. & 
    750                   &   tsn(:,:,:,jp_sal) + s_bkginc(:,:,:) > salfixmin )  
     733               WHERE( s_bkginc(:,:,:) > 0.0_wp .OR. tsn(:,:,:,jp_sal) + s_bkginc(:,:,:) > salfixmin )  
    751734                  tsn(:,:,:,jp_sal) = s_bkg(:,:,:) + s_bkginc(:,:,:)    
    752735               END WHERE 
    … …  
    758741 
    759742            CALL eos( tsb, rhd, rhop, gdept_0(:,:,:) )  ! Before potential and in situ densities 
    760           
     743!!gm  fabien 
     744!            CALL eos( tsb, rhd, rhop )                ! Before potential and in situ densities 
     745!!gm 
     746 
     747 
    761748            IF( ln_zps .AND. .NOT. lk_c1d ) & 
    762749               &  CALL zps_hde( nit000, jpts, tsb, gtsu, gtsv,  &        ! Partial steps: before horizontal gradient 
    … …  
    766753#if defined key_zdfkpp 
    767754            CALL eos( tsn, rhd, fsdept_n(:,:,:) )                      ! Compute rhd 
     755!!gm fabien            CALL eos( tsn, rhd )                      ! Compute rhd 
    768756#endif 
    769757 

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

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

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

    r4147 r4946  
    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_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r4724 r4946  
    9696      ! Add geothermal ice shelf 
    9797      IF( nn_isf .GE. 1 )  THEN 
    98                         z_frc_trd_t = z_frc_trd_t +                      glob_sum( ( risf_tsc(:,:,jp_tem) - rdivisf * fwfisf(:,:) * -1.9 * r1_rau0 ) * surf(:,:) ) 
    99                         z_frc_trd_s = z_frc_trd_s + (1.0_wp - rdivisf) * glob_sum( risf_tsc(:,:,jp_sal) * surf(:,:) ) 
     98          z_frc_trd_t = z_frc_trd_t & 
     99              &   + glob_sum( ( risf_tsc(:,:,jp_tem) - rdivisf * fwfisf(:,:) * (-1.9) * r1_rau0 ) * surf(:,:) ) 
     100          z_frc_trd_s = z_frc_trd_s + (1.0_wp - rdivisf) * glob_sum( risf_tsc(:,:,jp_sal) * surf(:,:) ) 
    100101      ENDIF 
    101102 

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

    r4726 r4946  
    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_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r4924 r4946  
    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) ,     & 
    … …  
    193191         CALL iom_put( "sss2" , z2d(:,:) * z2d(:,:) ) ! square of sea surface salinity 
    194192      END IF 
    195       ! multiply by umask to prevent not numerical value error in the ioserver sometimes 
    196193      IF( lk_vvl .AND. (.NOT. ln_dynadv_vec) ) THEN 
    197194         CALL iom_put( "uoce" , umask(:,:,:) * un(:,:,:) * fse3u_n(:,:,:) )    ! i-transport 
    … …  
    580577         ENDIF 
    581578 
    582 #if ! defined key_coupled  
    583          CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
    584             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    585          CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
    586             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    587          CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping"         , "Kg/m2/s",   &  ! erp * sn 
    588             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    589 #endif 
    590  
    591  
    592  
    593 #if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 )  
    594          CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
    595             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    596          CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
    597             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    598          CALL histdef( nid_T, "sosafldp", "Surface salt flux: Damping"         , "Kg/m2/s",   &  ! erp * sn 
    599             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    600 #endif 
     579         IF( .NOT. lk_cpl ) THEN 
     580            CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
     581               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     582            CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
     583               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     584            CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping"         , "Kg/m2/s",   &  ! erp * sn 
     585               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     586         ENDIF 
     587 
     588         IF( lk_cpl .AND. nn_ice <= 1 ) THEN 
     589            CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
     590               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     591            CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
     592               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     593            CALL histdef( nid_T, "sosafldp", "Surface salt flux: Damping"         , "Kg/m2/s",   &  ! erp * sn 
     594               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     595         ENDIF 
     596          
    601597         clmx ="l_max(only(x))"    ! max index on a period 
    602598         CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX  
    … …  
    613609#endif 
    614610 
    615 #if defined key_coupled  
    616 # if defined key_lim3 
    617          Must be adapted to LIM3 
    618 # endif  
    619 # if defined key_lim2 
    620          CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice 
    621             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    622          CALL histdef( nid_T,"soicealb" , "Ice Albedo"                         , "[0,1]"  ,   &  ! alb_ice 
    623             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    624 # endif  
    625 #endif  
     611         IF( lk_cpl .AND. nn_ice == 2 ) THEN 
     612            CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice 
     613               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     614            CALL histdef( nid_T,"soicealb" , "Ice Albedo"                         , "[0,1]"  ,   &  ! alb_ice 
     615               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     616         ENDIF 
    626617 
    627618         CALL histend( nid_T, snc4chunks=snc4set ) 
    … …  
    773764      ENDIF 
    774765 
    775 #if ! defined key_coupled 
    776 !      CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    777 !      CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    778 !      IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    779 !      CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    780 #endif 
    781 #if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 )  
    782       CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    783       CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
     766      IF( .NOT. lk_cpl ) THEN 
     767         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
     768         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    784769         IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    785       CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    786 #endif 
     770         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
     771      ENDIF 
     772      IF( lk_cpl .AND. nn_ice <= 1 ) THEN 
     773         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
     774         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
     775         IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
     776         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
     777      ENDIF 
    787778!      zw2d(:,:) = FLOAT( nmln(:,:) ) * tmask(:,:,1) 
    788779!      CALL histwrite( nid_T, "sobowlin", it, zw2d          , ndim_hT, ndex_hT )   ! ??? 
    … …  
    795786#endif 
    796787 
    797 #if defined key_coupled  
    798 # if defined key_lim3 
    799       Must be adapted for LIM3 
    800       CALL histwrite( nid_T, "soicetem", it, tn_ice        , ndim_hT, ndex_hT )   ! surf. ice temperature 
    801       CALL histwrite( nid_T, "soicealb", it, alb_ice       , ndim_hT, ndex_hT )   ! ice albedo 
    802 # endif 
    803 # if defined key_lim2 
    804       CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT )   ! surf. ice temperature 
    805       CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT )   ! ice albedo 
    806 # endif 
    807 #endif 
    808       ! Write fields on U grid  
     788      IF( lk_cpl .AND. nn_ice == 2 ) THEN 
     789         CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT )   ! surf. ice temperature 
     790         CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT )   ! ice albedo 
     791      ENDIF 
     792 
    809793      CALL histwrite( nid_U, "vozocrtx", it, un            , ndim_U , ndex_U )    ! i-current 
    810794      IF( ln_traldf_gdia ) THEN 

  • branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r4924 r4946  
    10031003 
    10041004      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE vertical coordinate in namelist nam_vvl' ) 
    1005       IF( .NOT. ln_vvl_zstar .AND. nn_isf .NE. 0)   CALL ctl_stop( 'vvl_ztilde, vvl_layer, vvl_ztilde_as_zstar, vvl_zstar_at_eqtor not tested with ice shelf cavity (only vvl_zstar was tested)' ) 
     1005      IF( .NOT. ln_vvl_zstar .AND. nn_isf .NE. 0) CALL ctl_stop( 'Only vvl_zstar has been tested with ice shelf cavity' ) 
    10061006 
    10071007      IF(lwp) THEN                   ! Print the choice 

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

    r4924 r4946  
    10821082               ! test bathy 
    10831083               IF (risfdep(ji,jj) .GT. 1) THEN 
    1084                zbathydiff =ABS(bathy(ji,jj)   - (gdepw_1d(mbathy (ji,jj)+1) + MIN( e3zps_min, e3t_1d(mbathy (ji,jj)+1)*e3zps_rat ))) 
    1085                zrisfdepdiff=ABS(risfdep(ji,jj) - (gdepw_1d(misfdep(ji,jj)  ) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj)-1)*e3zps_rat ))) 
     1084               zbathydiff =ABS(bathy(ji,jj)   - (gdepw_1d(mbathy (ji,jj)+1) & 
     1085                 &   + MIN( e3zps_min, e3t_1d(mbathy (ji,jj)+1)*e3zps_rat ))) 
     1086               zrisfdepdiff=ABS(risfdep(ji,jj) - (gdepw_1d(misfdep(ji,jj)  ) & 
     1087                 &   - MIN( e3zps_min, e3t_1d(misfdep(ji,jj)-1)*e3zps_rat ))) 
    10861088  
    10871089                  IF (bathy(ji,jj) .GT. risfdep(ji,jj) .AND. mbathy(ji,jj) .LT. misfdep(ji,jj)) THEN 
    … …  
    11041106               ! test bathy 
    11051107               IF( misfdep(ji,jj) == mbathy(ji,jj) .AND. mbathy(ji,jj) .GT. 1) THEN 
    1106                   zbathydiff  =ABS(bathy(ji,jj)  - (gdepw_1d(mbathy (ji,jj)+1) + MIN( e3zps_min,e3t_1d(mbathy (ji,jj)+1)*e3zps_rat ))) 
    1107                   zrisfdepdiff=ABS(risfdep(ji,jj) - (gdepw_1d(misfdep(ji,jj)  ) - MIN( e3zps_min,e3t_1d(misfdep(ji,jj)-1)*e3zps_rat ))) 
     1108                  zbathydiff  =ABS(bathy(ji,jj)  - (gdepw_1d(mbathy (ji,jj)+1)& 
     1109                    & + MIN( e3zps_min,e3t_1d(mbathy (ji,jj)+1)*e3zps_rat ))) 
     1110                  zrisfdepdiff=ABS(risfdep(ji,jj) - (gdepw_1d(misfdep(ji,jj)  )  & 
     1111                    & - MIN( e3zps_min,e3t_1d(misfdep(ji,jj)-1)*e3zps_rat ))) 
    11081112                  IF (zbathydiff .LE. zrisfdepdiff) THEN 
    11091113                     mbathy(ji,jj) = mbathy(ji,jj) + 1 
    … …  
    11211125            DO ji = 1, jpim1 
    11221126               IF( misfdep(ji,jj+1) == mbathy(ji,jj) .AND. mbathy(ji,jj) .GT. 1) THEN 
    1123                   zbathydiff =ABS(bathy(ji,jj    ) - (gdepw_1d(mbathy (ji,jj)+1) + MIN( e3zps_min, e3t_1d(mbathy (ji,jj  )+1)*e3zps_rat ))) 
    1124                   zrisfdepdiff=ABS(risfdep(ji,jj+1) - (gdepw_1d(misfdep(ji,jj+1)) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj+1)-1)*e3zps_rat ))) 
     1127                  zbathydiff =ABS(bathy(ji,jj    ) - (gdepw_1d(mbathy (ji,jj)+1)   & 
     1128                    &   + MIN( e3zps_min, e3t_1d(mbathy (ji,jj  )+1)*e3zps_rat ))) 
     1129                  zrisfdepdiff=ABS(risfdep(ji,jj+1) - (gdepw_1d(misfdep(ji,jj+1))  & 
     1130                    &  - MIN( e3zps_min, e3t_1d(misfdep(ji,jj+1)-1)*e3zps_rat ))) 
    11251131                  IF (zbathydiff .LE. zrisfdepdiff) THEN 
    11261132                     mbathy(ji,jj) = mbathy(ji,jj) + 1 
    1127                      bathy(ji,jj)  = gdepw_1d(mbathy (ji,jj  )) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj   )+1)*e3zps_rat ) 
     1133                     bathy(ji,jj)  = gdepw_1d(mbathy (ji,jj  )) & 
     1134                   &    + MIN( e3zps_min, e3t_1d(mbathy(ji,jj   )+1)*e3zps_rat ) 
    11281135                  ELSE 
    11291136                     misfdep(ji,jj+1)  = misfdep(ji,jj+1) - 1 
    1130                      risfdep (ji,jj+1) = gdepw_1d(misfdep(ji,jj+1)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj+1))*e3zps_rat ) 
     1137                     risfdep (ji,jj+1) = gdepw_1d(misfdep(ji,jj+1)+1) & 
     1138                   &   - MIN( e3zps_min, e3t_1d(misfdep(ji,jj+1))*e3zps_rat ) 
    11311139                  END IF 
    11321140               ENDIF 
    … …  
    11481156            DO ji = 1, jpim1 
    11491157               IF( misfdep(ji,jj) == mbathy(ji,jj+1) .AND. mbathy(ji,jj) .GT. 1) THEN 
    1150                   zbathydiff =ABS(  bathy(ji,jj+1) - (gdepw_1d(mbathy (ji,jj+1)+1) + MIN( e3zps_min, e3t_1d(mbathy (ji,jj+1)+1)*e3zps_rat ))) 
    1151                   zrisfdepdiff=ABS(risfdep(ji,jj  ) - (gdepw_1d(misfdep(ji,jj  )  ) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj  )-1)*e3zps_rat ))) 
     1158                  zbathydiff =ABS(  bathy(ji,jj+1) - (gdepw_1d(mbathy (ji,jj+1)+1) & 
     1159                   &   + MIN( e3zps_min, e3t_1d(mbathy (ji,jj+1)+1)*e3zps_rat ))) 
     1160                  zrisfdepdiff=ABS(risfdep(ji,jj  ) - (gdepw_1d(misfdep(ji,jj  )  )  & 
     1161                   &   - MIN( e3zps_min, e3t_1d(misfdep(ji,jj  )-1)*e3zps_rat ))) 
    11521162                  IF (zbathydiff .LE. zrisfdepdiff) THEN 
    11531163                     mbathy (ji,jj+1) = mbathy(ji,jj+1) + 1 
    … …  
    11771187            DO ji = 1, jpim1 
    11781188               IF( misfdep(ji+1,jj) == mbathy(ji,jj) .AND. mbathy(ji,jj) .GT. 1) THEN 
    1179                   zbathydiff =ABS(  bathy(ji  ,jj) - (gdepw_1d(mbathy (ji,jj)+1) + MIN( e3zps_min, e3t_1d(mbathy (ji  ,jj)+1)*e3zps_rat ))) 
    1180                   zrisfdepdiff=ABS(risfdep(ji+1,jj) - (gdepw_1d(misfdep(ji+1,jj)) - MIN( e3zps_min, e3t_1d(misfdep(ji+1,jj)-1)*e3zps_rat ))) 
     1189                  zbathydiff =ABS(  bathy(ji  ,jj) - (gdepw_1d(mbathy (ji,jj)+1) & 
     1190                    &   + MIN( e3zps_min, e3t_1d(mbathy (ji  ,jj)+1)*e3zps_rat ))) 
     1191                  zrisfdepdiff=ABS(risfdep(ji+1,jj) - (gdepw_1d(misfdep(ji+1,jj)) & 
     1192                    &  - MIN( e3zps_min, e3t_1d(misfdep(ji+1,jj)-1)*e3zps_rat ))) 
    11811193                  IF (zbathydiff .LE. zrisfdepdiff) THEN 
    11821194                     mbathy(ji,jj) = mbathy(ji,jj) + 1 
    … …  
    12051217            DO ji = 1, jpim1 
    12061218               IF( misfdep(ji,jj) == mbathy(ji+1,jj) .AND. mbathy(ji,jj) .GT. 1) THEN 
    1207                   zbathydiff =ABS(  bathy(ji+1,jj) - (gdepw_1d(mbathy (ji+1,jj)+1) + MIN( e3zps_min, e3t_1d(mbathy (ji+1,jj)+1)*e3zps_rat ))) 
    1208                   zrisfdepdiff=ABS(risfdep(ji  ,jj) - (gdepw_1d(misfdep(ji  ,jj)  ) - MIN( e3zps_min, e3t_1d(misfdep(ji  ,jj)-1)*e3zps_rat ))) 
     1219                  zbathydiff =ABS(  bathy(ji+1,jj) - (gdepw_1d(mbathy (ji+1,jj)+1) & 
     1220                      &   + MIN( e3zps_min, e3t_1d(mbathy (ji+1,jj)+1)*e3zps_rat ))) 
     1221                  zrisfdepdiff=ABS(risfdep(ji  ,jj) - (gdepw_1d(misfdep(ji  ,jj)  )  & 
     1222                      &  - MIN( e3zps_min, e3t_1d(misfdep(ji  ,jj)-1)*e3zps_rat ))) 
    12091223                  IF (zbathydiff .LE. zrisfdepdiff) THEN 
    12101224                     mbathy(ji+1,jj)  = mbathy (ji+1,jj) + 1 
    1211                      bathy (ji+1,jj)  = gdepw_1d(mbathy (ji+1,jj)  ) + MIN( e3zps_min, e3t_1d(mbathy (ji+1,jj) +1)*e3zps_rat ) 
     1225                     bathy (ji+1,jj)  = gdepw_1d(mbathy (ji+1,jj)  )  & 
     1226                      &   + MIN( e3zps_min, e3t_1d(mbathy (ji+1,jj) +1)*e3zps_rat ) 
    12121227                  ELSE 
    12131228                     misfdep(ji,jj)   = misfdep(ji  ,jj) - 1 
    1214                      risfdep(ji,jj)   = gdepw_1d(misfdep(ji  ,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji  ,jj)   )*e3zps_rat ) 
     1229                     risfdep(ji,jj)   = gdepw_1d(misfdep(ji  ,jj)+1) & 
     1230                      &   - MIN( e3zps_min, e3t_1d(misfdep(ji  ,jj)   )*e3zps_rat ) 
    12151231                  END IF 
    12161232               ENDIF 
    … …  
    15911607         DO jj = 1, jpjm1  
    15921608            DO ji = 1, fs_jpim1   ! vector opt.  
    1593                e3uw_0(ji,jj,jk) = MIN( gdept_0(ji,jj,jk), gdept_0(ji+1,jj  ,jk) ) - MAX( gdept_0(ji,jj,jk-1), gdept_0(ji+1,jj  ,jk-1) ) 
    1594                e3vw_0(ji,jj,jk) = MIN( gdept_0(ji,jj,jk), gdept_0(ji  ,jj+1,jk) ) - MAX( gdept_0(ji,jj,jk-1), gdept_0(ji  ,jj+1,jk-1) ) 
     1609               e3uw_0(ji,jj,jk) = MIN( gdept_0(ji,jj,jk), gdept_0(ji+1,jj  ,jk) ) & 
     1610                 &   - MAX( gdept_0(ji,jj,jk-1), gdept_0(ji+1,jj  ,jk-1) ) 
     1611               e3vw_0(ji,jj,jk) = MIN( gdept_0(ji,jj,jk), gdept_0(ji  ,jj+1,jk) ) & 
     1612                 &   - MAX( gdept_0(ji,jj,jk-1), gdept_0(ji  ,jj+1,jk-1) ) 
    15951613            END DO  
    15961614         END DO  

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

    r4666 r4946  
    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 
    … …  
    168171      ! 
    169172      DO jk = 1, jpkm1 
    170 #if defined key_vectopt_loop 
    171          DO jj = 1, 1         !Vector opt. => forced unrolling 
    172             DO ji = 1, jpij 
    173 #else  
    174173         DO jj = 1, jpj 
    175174            DO ji = 1, jpi 
    176 #endif                   
    177175               un_b(ji,jj) = un_b(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 
    178176               vn_b(ji,jj) = vn_b(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 
    … …  
    191189      ! 
    192190      ! 
    193       IF( nn_timing == 1 )  CALL timing_stop('istate_init') 
     191      IF( nn_timing == 1 )   CALL timing_stop('istate_init') 
    194192      ! 
    195193   END SUBROUTINE istate_init 
     194 
    196195 
    197196   SUBROUTINE istate_t_s 
    … …  
    225224   END SUBROUTINE istate_t_s 
    226225 
     226 
    227227   SUBROUTINE istate_eel 
    228228      !!---------------------------------------------------------------------- 
    … …  
    239239      USE divcur     ! hor. divergence & rel. vorticity      (div_cur routine) 
    240240      USE iom 
    241   
     241      ! 
    242242      INTEGER  ::   inum              ! temporary logical unit 
    243243      INTEGER  ::   ji, jj, jk        ! dummy loop indices 
    … …  
    250250      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   zssh  ! initial ssh over the global domain 
    251251      !!---------------------------------------------------------------------- 
    252  
     252      ! 
    253253      SELECT CASE ( jp_cfg )  
    254254         !                                              ! ==================== 
    … …  
    381381      INTEGER, PARAMETER ::   ntsinit = 0   ! (0/1) (analytical/input data files) T&S initialization 
    382382      !!---------------------------------------------------------------------- 
    383  
     383      ! 
    384384      SELECT CASE ( ntsinit) 
    385  
     385      ! 
    386386      CASE ( 0 )                  ! analytical T/S profil deduced from LEVITUS 
    387387         IF(lwp) WRITE(numout,*) 
    388388         IF(lwp) WRITE(numout,*) 'istate_gyre : initial analytical T and S profil deduced from LEVITUS ' 
    389389         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    390  
     390         ! 
    391391         DO jk = 1, jpk 
    392392            DO jj = 1, jpj 
    … …  
    413413            END DO 
    414414         END DO 
    415  
     415         ! 
    416416      CASE ( 1 )                  ! T/S data fields read in dta_tem.nc/data_sal.nc files 
    417417         IF(lwp) WRITE(numout,*) 
    … …  
    437437         tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * tmask(:,:,:)  
    438438         tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 
    439  
     439         ! 
    440440      END SELECT 
    441  
     441      ! 
    442442      IF(lwp) THEN 
    443443         WRITE(numout,*) 
    … …  
    446446         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 ) 
    447447      ENDIF 
    448  
     448      ! 
    449449   END SUBROUTINE istate_gyre 
     450 
    450451 
    451452   SUBROUTINE istate_uvg 
    … …  
    463464      USE divcur          ! hor. divergence & rel. vorticity      (div_cur routine) 
    464465      USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    465  
     466      ! 
    466467      INTEGER ::   ji, jj, jk        ! dummy loop indices 
    467468      INTEGER ::   indic             ! ??? 
    … …  
    573574   !!===================================================================== 
    574575END MODULE istate 
    575  

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

    r4924 r4946  
    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_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90

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

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

    r4666 r4946  
    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) 
    … …  
    10199           ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    102100           ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    103            CALL trd_mod( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_trd_bfr, 'DYN', kt ) 
     101           CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt ) 
    104102           CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
    105103        ENDIF 

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

    r4747 r4946  
    3232   USE dom_oce         ! ocean space and time domain 
    3333   USE phycst          ! physical constants 
    34    USE trdmod          ! ocean dynamics trends 
    35    USE trdmod_oce      ! ocean variables trends 
     34   USE trd_oce         ! trends: ocean variables 
     35   USE trddyn          ! trend manager: dynamics 
     36   ! 
    3637   USE in_out_manager  ! I/O manager 
    3738   USE prtctl          ! Print control 
    38    USE lbclnk          ! lateral boundary condition 
     39   USE lbclnk          ! lateral boundary condition  
    3940   USE lib_mpp         ! MPP library 
    4041   USE eosbn2          ! compute density 
    … …  
    7677      !! 
    7778      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    78       !!             - Save the trend (l_trddyn=T) 
     79      !!             - send trends to trd_dyn for futher diagnostics (l_trddyn=T) 
    7980      !!---------------------------------------------------------------------- 
    8081      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    … …  
    101102         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    102103         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    103          CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_hpg, 'DYN', kt ) 
     104         CALL trd_dyn( ztrdu, ztrdv, jpdyn_hpg, kt ) 
    104105         CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
    105106      ENDIF 
    … …  
    177178      IF( ln_hpg_prj )   ioptio = ioptio + 1 
    178179      IF( ioptio /= 1 )   CALL ctl_stop( 'NO or several hydrostatic pressure gradient options used' ) 
    179       IF( (ln_hpg_zco .OR. ln_hpg_zps .OR. ln_hpg_djc .OR. ln_hpg_prj ) .AND. nn_isf .NE. 0 )   CALL ctl_stop( 'Only hpg_sco has been corrected to work with ice shelf cavity. Comparison in a GYRE simulation with bump in the middle show similar result than hpg_zps' ) 
     180      IF( (ln_hpg_zco .OR. ln_hpg_zps .OR. ln_hpg_djc .OR. ln_hpg_prj ) .AND. nn_isf .NE. 0 )   & 
     181          &  CALL ctl_stop( 'Only hpg_sco has been corrected to work with ice shelf cavity.' ) 
    180182      ! 
    181183   END SUBROUTINE dyn_hpg_init 
    … …  
    318320 
    319321      ! partial steps correction at the last level  (use gru & grv computed in zpshde.F90) 
    320 # if defined key_vectopt_loop 
    321          jj = 1 
    322          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    323 # else 
    324322      DO jj = 2, jpjm1 
    325323         DO ji = 2, jpim1 
    326 # endif 
    327324            iku = mbku(ji,jj) 
    328325            ikv = mbkv(ji,jj) 
    … …  
    341338               va  (ji,jj,ikv) = va(ji,jj,ikv) + zhpj(ji,jj,ikv)         ! add the new one to the general momentum trend 
    342339            ENDIF 
    343 # if ! defined key_vectopt_loop 
    344          END DO 
    345 # endif 
     340         END DO 
    346341      END DO 
    347342      ! 
    … …  
    617612   END SUBROUTINE hpg_sco 
    618613 
     614 
    619615   SUBROUTINE hpg_djc( kt ) 
    620616      !!--------------------------------------------------------------------- 
    … …  
    854850      !! 
    855851      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    856       !!             - Save the trend (l_trddyn=T) 
    857       !! 
    858852      !!---------------------------------------------------------------------- 
    859853      INTEGER, PARAMETER  :: polynomial_type = 1    ! 1: cubic spline, 2: linear 
    … …  
    907901 
    908902      ! Transfer the depth of "T(:,:,:)" to vertical coordinate "zdept(:,:,:)" 
    909       DO jj = 1, jpj;   DO ji = 1, jpi 
    910           zdept(ji,jj,1) = 0.5_wp * fse3w(ji,jj,1) - sshn(ji,jj) * znad 
    911       END DO        ;   END DO 
    912  
    913       DO jk = 2, jpk;   DO jj = 1, jpj;   DO ji = 1, jpi 
    914           zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + fse3w(ji,jj,jk) 
    915       END DO        ;   END DO        ;   END DO 
    916  
    917       fsp(:,:,:) = zrhh(:,:,:) 
     903      DO jj = 1, jpj 
     904         DO ji = 1, jpi 
     905            zdept(ji,jj,1) = 0.5_wp * fse3w(ji,jj,1) - sshn(ji,jj) * znad 
     906         END DO 
     907      END DO 
     908 
     909      DO jk = 2, jpk 
     910         DO jj = 1, jpj 
     911            DO ji = 1, jpi 
     912               zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + fse3w(ji,jj,jk) 
     913            END DO 
     914         END DO 
     915      END DO 
     916 
     917      fsp(:,:,:) = zrhh (:,:,:) 
    918918      xsp(:,:,:) = zdept(:,:,:) 
    919919 
    … …  
    11161116   END SUBROUTINE hpg_prj 
    11171117 
     1118 
    11181119   SUBROUTINE cspline(fsp, xsp, asp, bsp, csp, dsp, polynomial_type) 
    11191120      !!---------------------------------------------------------------------- 
    … …  
    11231124      !! 
    11241125      !! ** Method  :   f(x) = asp + bsp*x + csp*x^2 + dsp*x^3 
     1126      !! 
    11251127      !! Reference: CJC Kruger, Constrained Cubic Spline Interpoltation 
    1126       !! 
    11271128      !!---------------------------------------------------------------------- 
    11281129      IMPLICIT NONE 
    … …  
    11321133      INTEGER, INTENT(in) :: polynomial_type                        ! 1: cubic spline 
    11331134                                                                    ! 2: Linear 
    1134  
    1135       ! Local Variables 
     1135      ! 
    11361136      INTEGER  ::   ji, jj, jk                 ! dummy loop indices 
    11371137      INTEGER  ::   jpi, jpj, jpkm1 
    … …  
    12231223      ENDIF 
    12241224 
    1225  
    12261225   END SUBROUTINE cspline 
    12271226 
    … …  
    12331232      !! ** Purpose :   1-d linear interpolation 
    12341233      !! 
    1235       !! ** Method  : 
    1236       !!                interpolation is straight forward 
     1234      !! ** Method  :   interpolation is straight forward 
    12371235      !!                extrapolation is also permitted (no value limit) 
    1238       !! 
    12391236      !!---------------------------------------------------------------------- 
    12401237      IMPLICIT NONE 
    … …  
    12531250   END FUNCTION interp1 
    12541251 
     1252 
    12551253   FUNCTION interp2(x, a, b, c, d)  RESULT(f) 
    12561254      !!---------------------------------------------------------------------- 
    … …  
    13161314   END FUNCTION integ_spline 
    13171315 
    1318  
    13191316   !!====================================================================== 
    13201317END MODULE dynhpg 

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

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

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

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

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

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

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

    r4666 r4946  
    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_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r4724 r4946  
    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_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90

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

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

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

    r4934 r4946  
    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 
    … …  
    5455      !! 
    5556      !! ** Action  : - Update (ua,va) with the vert. momentum adv. trends 
    56       !!              - Save the trends in (ztrdu,ztrdv) ('key_trddyn') 
     57      !!              - Send the trends to trddyn for diagnostics (l_trddyn=T) 
    5758      !!---------------------------------------------------------------------- 
    5859      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx 
    … …  
    119120         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    120121         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    121          CALL trd_mod(ztrdu, ztrdv, jpdyn_trd_zad, 'DYN', kt) 
     122         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt ) 
    122123         CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )  
    123124      ENDIF 
    … …  
    261262         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    262263         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    263          CALL trd_mod(ztrdu, ztrdv, jpdyn_trd_zad, 'DYN', kt) 
     264         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt ) 
    264265         CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )  
    265266      ENDIF 

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

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

    r4812 r4946  
    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) 
    … …  
    142135            ua(:,:,jk) = (ua(:,:,jk) - ua_b(:,:)) * umask(:,:,jk) 
    143136            va(:,:,jk) = (va(:,:,jk) - va_b(:,:)) * vmask(:,:,jk) 
    144          ENDDO 
     137         END DO 
    145138         ! Add bottom/top stress due to barotropic component only: 
    146139         DO jj = 2, jpjm1         
    … …  
    220213               &                                      / ( ze3ua * rau0 )  
    221214#else 
    222             ua(ji,jj,miku(ji,jj)) = ub(ji,jj,miku(ji,jj)) + p2dt *(ua(ji,jj,miku(ji,jj)) +  0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   & 
    223                &                                                     / ( fse3u(ji,jj,miku(ji,jj)) * rau0     ) )  
     215            ua(ji,jj,miku(ji,jj)) = ub(ji,jj,miku(ji,jj)) & 
     216               &                   + p2dt *(ua(ji,jj,miku(ji,jj)) +  0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   & 
     217               &                                  / ( fse3u(ji,jj,miku(ji,jj)) * rau0     ) )  
    224218#endif 
    225219            DO jk = miku(ji,jj)+1, jpkm1 
    … …  
    311305               &                                      / ( ze3va * rau0 )  
    312306#else 
    313             va(ji,jj,mikv(ji,jj)) = vb(ji,jj,mikv(ji,jj)) + p2dt *(va(ji,jj,mikv(ji,jj)) +  0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   & 
     307            va(ji,jj,mikv(ji,jj)) = vb(ji,jj,mikv(ji,jj)) & 
     308               &                   + p2dt *(va(ji,jj,mikv(ji,jj)) +  0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   & 
    314309               &                                                       / ( fse3v(ji,jj,mikv(ji,jj)) * rau0     )  ) 
    315310#endif 
    … …  
    348343      !! restore bottom layer avmu(v)  
    349344      IF( ln_bfrimp ) THEN 
    350 # if defined key_vectopt_loop 
    351         DO jj = 1, 1 
    352            DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    353 # else 
    354345        DO jj = 2, jpjm1 
    355346           DO ji = 2, jpim1 
    356 # endif 
    357347              ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points  
    358348              ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points) 

  • branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r4624 r4946  
    111111   INTEGER ::   numstp          =   -1      !: logical unit for time step 
    112112   INTEGER ::   numtime         =   -1      !: logical unit for timing 
    113    INTEGER ::   numout          =    6      !: logical unit for output print 
     113   INTEGER ::   numout          =    6      !: logical unit for output print; Set to stdout to ensure any early 
     114                                            !  output can be collected; do not change 
    114115   INTEGER ::   numnam_ref      =   -1      !: logical unit for reference namelist 
    115116   INTEGER ::   numnam_cfg      =   -1      !: logical unit for configuration specific namelist 
    116    INTEGER ::   numond          =    7      !: logical unit for Output Namelist Dynamics 
     117   INTEGER ::   numond          =   -1      !: logical unit for Output Namelist Dynamics 
    117118   INTEGER ::   numnam_ice_ref  =   -1      !: logical unit for ice reference namelist 
    118119   INTEGER ::   numnam_ice_cfg  =   -1      !: logical unit for ice reference namelist 
    119    INTEGER ::   numoni          =    8      !: logical unit for Output Namelist Ice 
     120   INTEGER ::   numoni          =   -1      !: logical unit for Output Namelist Ice 
    120121   INTEGER ::   numevo_ice      =   -1      !: logical unit for ice variables (temp. evolution) 
    121122   INTEGER ::   numsol          =   -1      !: logical unit for solver statistics 

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

    r4924 r4946  
    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 
    … …  
    140140#endif 
    141141                  IF( lk_lim3 ) THEN 
    142                      CALL iom_rstput( kt, nitrst, numrow, 'iatte'  , iatte     ) !clem modif 
    143                      CALL iom_rstput( kt, nitrst, numrow, 'oatte'  , oatte     ) !clem modif 
     142                     CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev'  , fraqsr_1lev     ) !clem modif 
    144143                  ENDIF 
    145144      IF( kt == nitrst ) THEN 
    146145         CALL iom_close( numrow )     ! close the restart file (only at last time step) 
    147          IF( .NOT. lk_trdmld )   lrst_oce = .FALSE. 
     146!!gm         IF( .NOT. lk_trdmld )   lrst_oce = .FALSE. 
     147!!gm  not sure what to do here   ===>>>  ask to Sebastian 
     148         lrst_oce = .FALSE. 
    148149      ENDIF 
    149150      ! 
    150151   END SUBROUTINE rst_write 
     152 
    151153 
    152154   SUBROUTINE rst_read_open 
    … …  
    162164      LOGICAL  ::   llok 
    163165      !!---------------------------------------------------------------------- 
    164  
    165       IF( numror .LE. 0 ) THEN 
     166      ! 
     167      IF( numror <= 0 ) THEN 
    166168         IF(lwp) THEN                                             ! Contol prints 
    167169            WRITE(numout,*) 
    … …  
    269271      ! 
    270272      IF( lk_lim3 ) THEN 
    271          CALL iom_get( numror, jpdom_autoglo, 'iatte' , iatte ) ! clem modif 
    272          CALL iom_get( numror, jpdom_autoglo, 'oatte' , oatte ) ! clem modif 
     273         CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev ) 
    273274      ENDIF 
    274275      ! 

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

    r4726 r4946  
    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_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r4812 r4946  
    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 
    … …  
    139140         END DO 
    140141         IF( ln_zps ) THEN                           ! partial steps correction at the bottom ocean level 
    141 # if defined key_vectopt_loop 
    142             DO jj = 1, 1 
    143                DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    144 # else 
    145142            DO jj = 1, jpjm1 
    146143               DO ji = 1, jpim1 
    147 # endif 
    148144! IF should be useless check zpshde (PM) 
    149145               IF ( mbku(ji,jj) > 1 ) zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) 
    … …  
    304300                  zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) )    ! zfk=1 in the ML otherwise zfk=0 
    305301                  zck = ( fsdepw(ji,jj,jk) - fsdepw(ji,jj,mikt(ji,jj) ) ) / MAX( hmlp(ji,jj), 10._wp ) 
    306                   zwz(ji,jj,jk) = (  zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk  ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 
    307                   zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk  ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 
     302                  zwz(ji,jj,jk) = (  zai / ( zbi - zeps ) * ( 1._wp - zfk ) & 
     303                     &            + zck * wslpiml(ji,jj) * zfk  ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 
     304                  zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) & 
     305                     &            + zck * wslpjml(ji,jj) * zfk  ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 
    308306 
    309307!!gm  modif to suppress omlmask....  (as in Griffies operator) 
    … …  
    415413                  uslp(ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk)  
    416414                  vslp(ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk)  
    417                   wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) * 0.5  
    418                   wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) * 0.5  
     415                  wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) & 
     416                    &                              * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) * 0.5  
     417                  wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) & 
     418                    &                              * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) * 0.5  
    419419               END DO  
    420420            END DO  
    … …  
    469469      REAL(wp) ::   zdyrho_raw, ztj_coord, ztj_raw, ztj_lim, ztj_g_raw, ztj_g_lim 
    470470      REAL(wp) ::   zdzrho_raw 
    471       REAL(wp) ::   zbeta0 
    472471      REAL(wp), POINTER, DIMENSION(:,:)     ::   z1_mlbw 
    473       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalbet 
    474472      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zdxrho , zdyrho, zdzrho     ! Horizontal and vertical density gradients 
    475473      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zti_mlb, ztj_mlb            ! for Griffies operator only 
    … …  
    479477      ! 
    480478      CALL wrk_alloc( jpi,jpj, z1_mlbw ) 
    481       CALL wrk_alloc( jpi,jpj,jpk, zalbet ) 
    482479      CALL wrk_alloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  ) 
    483480      CALL wrk_alloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  ) 
    … …  
    486483      !  Some preliminary calculation  ! 
    487484      !--------------------------------! 
    488       ! 
    489       CALL eos_alpbet( tsb, zalbet, zbeta0 )  !==  before local thermal/haline expension ratio at T-points  ==! 
    490485      ! 
    491486      DO jl = 0, 1                            !==  unmasked before density i- j-, k-gradients  ==! 
    … …  
    499494                  zdjt = ( tsb(ji,jj+1,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )    ! j-gradient of T & S at v-point 
    500495                  zdjs = ( tsb(ji,jj+1,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
    501                   zdxrho_raw = ( - zalbet(ji+ip,jj   ,jk) * zdit + zbeta0*zdis ) / e1u(ji,jj) 
    502                   zdyrho_raw = ( - zalbet(ji   ,jj+jp,jk) * zdjt + zbeta0*zdjs ) / e2v(ji,jj) 
    503                   zdxrho(ji+ip,jj   ,jk,1-ip) = SIGN( MAX(   repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign 
     496                  zdxrho_raw = ( - rab_b(ji+ip,jj   ,jk,jp_tem) * zdit + rab_b(ji+ip,jj   ,jk,jp_sal) * zdis ) / e1u(ji,jj) 
     497                  zdyrho_raw = ( - rab_b(ji   ,jj+jp,jk,jp_tem) * zdjt + rab_b(ji   ,jj+jp,jk,jp_sal) * zdjs ) / e2v(ji,jj) 
     498                  zdxrho(ji+ip,jj   ,jk,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign 
    504499                  zdyrho(ji   ,jj+jp,jk,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 
    505500               END DO 
    … …  
    507502         END DO 
    508503         ! 
    509          IF( ln_zps.and.l_grad_zps ) THEN     ! partial steps: correction of i- & j-grad on bottom 
    510 # if defined key_vectopt_loop 
    511             DO jj = 1, 1 
    512                DO ji = 1, jpij-jpi            ! vector opt. (forced unrolling) 
    513 # else 
     504         IF( ln_zps .AND. l_grad_zps ) THEN     ! partial steps: correction of i- & j-grad on bottom 
    514505            DO jj = 1, jpjm1 
    515506               DO ji = 1, jpim1 
    516 # endif 
    517507                  iku  = mbku(ji,jj)          ;   ikv  = mbkv(ji,jj)             ! last ocean level (u- & v-points) 
    518508                  zdit = gtsu(ji,jj,jp_tem)   ;   zdjt = gtsv(ji,jj,jp_tem)      ! i- & j-gradient of Temperature 
    519509                  zdis = gtsu(ji,jj,jp_sal)   ;   zdjs = gtsv(ji,jj,jp_sal)      ! i- & j-gradient of Salinity 
    520                   zdxrho_raw = ( - zalbet(ji+ip,jj   ,iku) * zdit + zbeta0*zdis ) / e1u(ji,jj) 
    521                   zdyrho_raw = ( - zalbet(ji   ,jj+jp,ikv) * zdjt + zbeta0*zdjs ) / e2v(ji,jj) 
     510                  zdxrho_raw = ( - rab_b(ji+ip,jj   ,iku,jp_tem) * zdit + rab_b(ji+ip,jj   ,iku,jp_sal) * zdis ) / e1u(ji,jj) 
     511                  zdyrho_raw = ( - rab_b(ji   ,jj+jp,ikv,jp_tem) * zdjt + rab_b(ji   ,jj+jp,ikv,jp_sal) * zdjs ) / e2v(ji,jj) 
    522512                  zdxrho(ji+ip,jj   ,iku,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign 
    523513                  zdyrho(ji   ,jj+jp,ikv,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 
    … …  
    539529                     zdks = 0._wp 
    540530                  ENDIF 
    541                   zdzrho_raw = ( - zalbet(ji   ,jj   ,jk) * zdkt + zbeta0*zdks ) / fse3w(ji,jj,jk+kp) 
    542                   zdzrho(ji   ,jj   ,jk,  kp) =     - MIN( - repsln,      zdzrho_raw )    ! force zdzrho >= repsln 
     531                  zdzrho_raw = ( - rab_b(ji,jj,jk,jp_tem) * zdkt + rab_b(ji,jj,jk,jp_sal) * zdks ) / fse3w(ji,jj,jk+kp) 
     532                  zdzrho(ji,jj,jk,kp) = - MIN( - repsln, zdzrho_raw )    ! force zdzrho >= repsln 
    543533                 END DO 
    544534            END DO 
    … …  
    684674      ! 
    685675      CALL wrk_dealloc( jpi,jpj, z1_mlbw ) 
    686       CALL wrk_dealloc( jpi,jpj,jpk, zalbet ) 
    687676      CALL wrk_dealloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  ) 
    688677      CALL wrk_dealloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  ) 
    … …  
    735724      !                                            !==   surface mixed layer mask   ! 
    736725      DO jk = 1, jpk                               ! =1 inside the mixed layer, =0 otherwise 
    737 # if defined key_vectopt_loop 
    738          DO jj = 1, 1 
    739             DO ji = 1, jpij                        ! vector opt. (forced unrolling) 
    740 # else 
    741726         DO jj = 1, jpj 
    742727            DO ji = 1, jpi 
    743 # endif 
    744728               ik = nmln(ji,jj) - 1 
    745729               IF( jk <= ik .AND. jk >= mikt(ji,jj) ) THEN   ;   omlmask(ji,jj,jk) = 1._wp 
    … …  
    761745      !----------------------------------------------------------------------- 
    762746      ! 
    763 # if defined key_vectopt_loop 
    764       DO jj = 1, 1 
    765          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    766 # else 
    767747      DO jj = 2, jpjm1 
    768748         DO ji = 2, jpim1 
    769 # endif 
    770749            !                        !==   Slope at u- & v-points just below the Mixed Layer   ==! 
    771750            ! 

  • branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r4924 r4946  
    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, PUBLIC, PARAMETER ::   nmaxfld=40        ! Maximum number of coupling fields 
     64   INTEGER, PUBLIC, PARAMETER ::   nmaxcat=5    ! Maximum number of coupling fields 
     65   INTEGER, PUBLIC, 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_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r4306 r4946  
    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 
    … …  
    2122   USE ice_2 
    2223# endif 
    23 # if defined key_cice  
     24# if defined key_cice 
    2425   USE ice_domain_size, only: ncat  
    2526#endif 
    … …  
    5556# endif 
    5657 
    57 #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 
     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   !: daily 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        !: ice albedo                                       [-] 
    6666 
    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] 
     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         !: Solar surface transmission parameter, thick ice  [-] 
     70   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr2_i0         !: Solar surface transmission parameter, thin ice   [-] 
     71   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice        !: sublimation - precip over sea ice            [kg/m2] 
    7272 
    73 # if defined key_lim3 
    74    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice  !: air temperature 
    75 # endif 
     73   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt            !: category topmelt 
     74   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   botmelt            !: category botmelt 
    7675 
    77 #elif defined key_cice 
     76#if defined key_cice 
    7877   ! 
    7978   ! for consistency with LIM, these are declared with three dimensions 
    8079   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qlw_ice            !: incoming long-wave 
    81    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qla_ice            !: latent flux over ice           [W/m2] 
    82    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice            !: solar heat flux over ice       [W/m2] 
    8380   ! 
    8481   ! other forcing arrays are two dimensional 
    … …  
    8683   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ss_iov             !: y ice-ocean surface stress at NEMO V point 
    8784   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice            !: sublimation-snow budget over ice    [kg/m2] 
    88    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice           !: air temperature 
    8985   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qatm_ice           !: specific humidity 
    9086   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wndi_ice           !: i wind at T point 
    … …  
    9389   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr_iu              !: ice fraction at NEMO U point 
    9490   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr_iv              !: ice fraction at NEMO V point 
    95    ! 
    96    ! finally, arrays corresponding to different ice categories 
    97    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i                !: category ice fraction 
    98    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt            !: category topmelt 
    99    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   botmelt            !: category botmelt 
     91    
     92   ! variables used in the coupled interface 
     93   INTEGER , PUBLIC, PARAMETER ::   jpl = ncat 
     94   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice          ! jpi, jpj 
    10095#endif 
     96    
     97#if defined key_lim2 || defined key_cice 
     98   ! already defined in ice.F90 for LIM3 
     99   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i 
     100   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  ht_i, ht_s 
     101#endif 
     102 
     103#if defined key_lim3 || defined key_cice 
     104   ! not used with LIM2 
     105   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice       !: air temperature [K] 
     106#endif 
     107 
     108   REAL(wp), PUBLIC, SAVE ::   cldf_ice = 0.81    !: cloud fraction over sea ice, summer CLIO value   [-] 
    101109 
    102110   !!---------------------------------------------------------------------- 
    … …  
    111119      !!                     ***  FUNCTION sbc_ice_alloc  *** 
    112120      !!---------------------------------------------------------------------- 
    113       INTEGER :: ierr(2) 
     121      INTEGER :: ierr(5) 
    114122      !!---------------------------------------------------------------------- 
    115123      ierr(:) = 0 
    116124 
    117 #if defined key_lim3 || defined key_lim2 
    118       ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) ,     & 
     125      ALLOCATE( qsr_ice (jpi,jpj,jpl)                         ,     & 
    119126         &      qla_ice (jpi,jpj,jpl) , dqla_ice(jpi,jpj,jpl) ,     & 
    120          &      dqns_ice(jpi,jpj,jpl) , tn_ice  (jpi,jpj,jpl) ,     & 
    121          &      alb_ice (jpi,jpj,jpl) ,                             & 
    122127         &      utau_ice(jpi,jpj)     , vtau_ice(jpi,jpj)     ,     & 
    123          &      fr1_i0  (jpi,jpj)     , fr2_i0  (jpi,jpj)     ,     & 
    124 #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#if defined key_lim3 || defined key_cice 
     129         &      tatm_ice(jpi,jpj)     ,                             & 
    128130#endif 
    129 #elif defined key_cice 
    130       ALLOCATE( qla_ice(jpi,jpj,1)    , qlw_ice(jpi,jpj,1)    , qsr_ice(jpi,jpj,1)    , & 
    131                 wndi_ice(jpi,jpj)     , tatm_ice(jpi,jpj)     , qatm_ice(jpi,jpj)     , & 
     131         &      STAT= ierr(1) ) 
     132#if defined key_cice 
     133      ALLOCATE( qlw_ice(jpi,jpj,1)    , wndi_ice(jpi,jpj)     , qatm_ice(jpi,jpj)     , & 
    132134                wndj_ice(jpi,jpj)     , nfrzmlt(jpi,jpj)      , ss_iou(jpi,jpj)       , & 
    133135                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) ) 
     136                a_i(jpi,jpj,ncat)     , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , & 
     137                STAT= ierr(1) ) 
     138      IF( lk_cpl )   ALLOCATE( u_ice(jpi,jpj)        , fr1_i0(jpi,jpj)       , tn_ice (jpi,jpj,1)    , & 
     139         &                     v_ice(jpi,jpj)        , fr2_i0(jpi,jpj)       , alb_ice(jpi,jpj,1)    , & 
     140         &                     emp_ice(jpi,jpj)      , qns_ice(jpi,jpj,1)    , dqns_ice(jpi,jpj,1)   , & 
     141         &                     STAT= ierr(2) ) 
     142       
     143#else 
     144      ALLOCATE( fr1_i0(jpi,jpj)       , tn_ice (jpi,jpj,1)    , & 
     145         &      fr2_i0(jpi,jpj)       , alb_ice(jpi,jpj,1)    , & 
     146         &      emp_ice(jpi,jpj)      , qns_ice(jpi,jpj,1)    , dqns_ice(jpi,jpj,1)   , & 
     147         &      STAT= ierr(2) ) 
    135148#endif 
    136149         ! 
    137150#if defined key_lim2 
    138       IF( ltrcdm2dc_ice )THEN 
    139          ALLOCATE( qsr_ice_mean (jpi,jpj,jpl), STAT=ierr(2) ) 
    140       ENDIF 
     151      IF( ltrcdm2dc_ice )   ALLOCATE( qsr_ice_mean (jpi,jpj,jpl), STAT=ierr(3) ) 
    141152#endif 
    142153         ! 
     154#if defined key_lim2 
     155      ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(4) ) 
     156#endif 
     157 
     158#if defined key_cice || defined key_lim2 
     159      IF( lk_cpl )   ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) ) 
     160#endif 
     161 
    143162      sbc_ice_alloc = MAXVAL( ierr ) 
    144163      IF( lk_mpp            )   CALL mpp_sum ( sbc_ice_alloc ) 
    … …  
    150169   !!   Default option                      NO LIM 2.0 or 3.0 or CICE sea-ice model 
    151170   !!---------------------------------------------------------------------- 
     171   USE in_out_manager   ! I/O manager 
    152172   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2 ice model 
    153173   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3 ice model 
    154174   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE  ice model 
    155175   CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = '-'      !: no grid ice-velocity 
     176   REAL            , PUBLIC, PARAMETER ::   cldf_ice = 0.81       !: cloud fraction over sea ice, summer CLIO value   [-] 
     177   INTEGER         , PUBLIC, PARAMETER ::   jpl = 1  
     178   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice,fr1_i0,fr2_i0          ! jpi, jpj 
     179   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice, qns_ice, dqns_ice  ! (jpi,jpj,jpl) 
     180   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i 
     181   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice 
     182   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice 
     183   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ht_i, ht_s 
     184   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt, botmelt 
    156185#endif 
    157186 

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

    r4666 r4946  
    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 
    … …  
    4650   !                                             !: =1 levitating ice with mass and salt exchange but no presure effect 
    4751   !                                             !: =2 embedded sea-ice (full salt and mass exchanges and pressure) 
     52   INTEGER , PUBLIC :: nn_limflx        !: LIM3 Multi-category heat flux formulation 
     53   !                                             !: =-1  Use of per-category fluxes 
     54   !                                             !: = 0  Average per-category fluxes 
     55   !                                             !: = 1  Average then redistribute per-category fluxes 
     56   !                                             !: = 2  Redistribute a single flux over categories 
    4857   INTEGER , PUBLIC ::   nn_fwb         !: FreshWater Budget:  
    4958   !                                             !:  = 0 unchecked  
    … …  
    5665   LOGICAL , PUBLIC ::   ln_icebergs    !: Icebergs 
    5766   ! 
    58    CHARACTER (len=8), PUBLIC :: cn_iceflx  !: Flux handling over ice categories 
    59    LOGICAL, PUBLIC :: ln_iceflx_ave     ! Average heat fluxes over all ice categories 
    60    LOGICAL, PUBLIC :: ln_iceflx_linear  ! Redistribute mean heat fluxes over all ice categories, using ice temperature and albedo 
    61    ! 
    62    INTEGER , PUBLIC ::   nn_lsm        !: Number of iteration if seaoverland is applied 
     67   INTEGER , PUBLIC ::   nn_lsm         !: Number of iteration if seaoverland is applied 
     68   !!---------------------------------------------------------------------- 
     69   !!           switch definition (improve readability) 
     70   !!---------------------------------------------------------------------- 
     71   INTEGER , PUBLIC, PARAMETER ::   jp_gyre    = 0        !: GYRE analytical formulation 
     72   INTEGER , PUBLIC, PARAMETER ::   jp_ana     = 1        !: analytical      formulation 
     73   INTEGER , PUBLIC, PARAMETER ::   jp_flx     = 2        !: flux            formulation 
     74   INTEGER , PUBLIC, PARAMETER ::   jp_clio    = 3        !: CLIO bulk       formulation 
     75   INTEGER , PUBLIC, PARAMETER ::   jp_core    = 4        !: CORE bulk       formulation 
     76   INTEGER , PUBLIC, PARAMETER ::   jp_cpl     = 5        !: Coupled         formulation 
     77   INTEGER , PUBLIC, PARAMETER ::   jp_mfs     = 6        !: MFS  bulk       formulation 
     78   INTEGER , PUBLIC, PARAMETER ::   jp_esopa   = -1       !: esopa test, ALL formulations 
     79    
    6380   !!---------------------------------------------------------------------- 
    6481   !!              Ocean Surface Boundary Condition fields 

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

    r4724 r4946  
    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 
    … …  
    403403 
    404404 
    405    SUBROUTINE blk_ice_clio(  pst   , palb_cs, palb_os ,       & 
     405   SUBROUTINE blk_ice_clio(  pst   , palb_cs, palb_os, palb,  & 
    406406      &                      p_taui, p_tauj, p_qns , p_qsr,   & 
    407407      &                      p_qla , p_dqns, p_dqla,          & 
    … …  
    432432      !!---------------------------------------------------------------------- 
    433433      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   pst      ! ice surface temperature                   [Kelvin] 
    434       REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_cs  ! ice albedo (clear    sky) (alb_ice_cs)         [%] 
    435       REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_os  ! ice albedo (overcast sky) (alb_ice_os)         [%] 
     434      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_cs  ! ice albedo (clear    sky) (alb_ice_cs)         [-] 
     435      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_os  ! ice albedo (overcast sky) (alb_ice_os)         [-] 
     436      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   palb     ! ice albedo (actual value)                      [-] 
    436437      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_taui   ! surface ice stress at I-point (i-component) [N/m2] 
    437438      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_tauj   ! surface ice stress at I-point (j-component) [N/m2] 
    … …  
    443444      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_tpr    ! total precipitation          (T-point)   [Kg/m2/s] 
    444445      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_spr    ! solid precipitation          (T-point)   [Kg/m2/s] 
    445       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr1    ! 1sr fraction of qsr penetration in ice         [%] 
    446       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr2    ! 2nd fraction of qsr penetration in ice         [%] 
     446      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr1    ! 1sr fraction of qsr penetration in ice         [-] 
     447      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr2    ! 2nd fraction of qsr penetration in ice         [-] 
    447448      CHARACTER(len=1), INTENT(in   )             ::   cd_grid  ! type of sea-ice grid ("C" or "B" grid) 
    448449      INTEGER, INTENT(in   )                      ::   pdim     ! number of ice categories 
    … …  
    547548      !-----------------------------------------------------------! 
    548549      CALL blk_clio_qsr_ice( palb_cs, palb_os, p_qsr ) 
     550       
     551      DO jl = 1, ijpl 
     552         palb(:,:,jl) = ( palb_cs(:,:,jl) * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) )   & 
     553            &         +   palb_os(:,:,jl) * sf(jp_ccov)%fnow(ji,jj,1) ) 
     554      END DO 
    549555 
    550556      !                                     ! ========================== ! 

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

    r4924 r4946  
    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 
    … …  
    383344      CALL lbc_lnk( vtau(:,:), 'V', -1. ) 
    384345 
     346     
    385347      !  Turbulent fluxes over ocean 
    386348      ! ----------------------------- 
    387       IF( ln_2m .OR. ( ln_bulk2z .AND. rn_zqt /= rn_zu ) ) THEN 
    388          ! Values of temp. and hum. adjusted to height of wind must be used 
    389          zevap(:,:) = rn_efac * MAX( 0.e0, rhoa    *Ce(:,:)*( zqsatw(:,:) - zq_zu(:,:) ) * wndm(:,:) )  ! Evaporation 
    390          zqsb (:,:) =                      rhoa*cpa*Ch(:,:)*( zst   (:,:) - zt_zu(:,:) ) * wndm(:,:)     ! Sensible Heat 
     349      IF( ABS( rn_zu - rn_zqt) < 0.01_wp ) THEN 
     350         !! q_air and t_air are (or "are almost") given at 10m (wind reference height) 
     351         zevap(:,:) = rn_efac*MAX( 0._wp,     rhoa*Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) )*wndm(:,:) ) ! Evaporation 
     352         zqsb (:,:) =                     cpa*rhoa*Ch(:,:)*( zst   (:,:) - sf(jp_tair)%fnow(:,:,1) )*wndm(:,:)   ! Sensible Heat 
    391353      ELSE 
    392 !CDIR COLLAPSE 
    393          zevap(:,:) = rn_efac * MAX( 0.e0, rhoa    *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) ) * wndm(:,:) )   ! Evaporation 
    394 !CDIR COLLAPSE 
    395          zqsb (:,:) =            rhoa*cpa*Ch(:,:)*( zst   (:,:) - sf(jp_tair)%fnow(:,:,1) ) * wndm(:,:)     ! Sensible Heat 
     354         !! q_air and t_air are not given at 10m (wind reference height) 
     355         ! Values of temp. and hum. adjusted to height of wind during bulk algorithm iteration must be used!!! 
     356         zevap(:,:) = rn_efac*MAX( 0._wp,     rhoa*Ce(:,:)*( zqsatw(:,:) - zq_zu(:,:) )*wndm(:,:) )   ! Evaporation 
     357         zqsb (:,:) =                     cpa*rhoa*Ch(:,:)*( zst   (:,:) - zt_zu(:,:) )*wndm(:,:)     ! Sensible Heat 
    396358      ENDIF 
    397 !CDIR COLLAPSE 
    398359      zqla (:,:) = Lv * zevap(:,:)                                                              ! Latent Heat 
    399360 
    … …  
    412373      !     III    Total FLUXES                                                       ! 
    413374      ! ----------------------------------------------------------------------------- ! 
    414       
    415 !CDIR COLLAPSE 
     375      ! 
    416376      emp (:,:) = (  zevap(:,:)                                          &   ! mass flux (evap. - precip.) 
    417377         &         - sf(jp_prec)%fnow(:,:,1) * rn_pfac  ) * tmask(:,:,1) 
    418 !CDIR COLLAPSE 
    419378      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                &   ! Downward Non Solar flux 
    420379         &     - sf(jp_snow)%fnow(:,:,1) * rn_pfac * lfus                         &   ! remove latent melting heat for solid precip 
    421380         &     - zevap(:,:) * pst(:,:) * rcp                                      &   ! remove evap heat content at SST 
    422381         &     + ( sf(jp_prec)%fnow(:,:,1) - sf(jp_snow)%fnow(:,:,1) ) * rn_pfac  &   ! add liquid precip heat content at Tair 
    423          &     * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp                          &    
     382         &     * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp                          & 
    424383         &     + sf(jp_snow)%fnow(:,:,1) * rn_pfac                                &   ! add solid  precip heat content at min(Tair,Tsnow) 
    425384         &     * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) 
    … …  
    445404      ! 
    446405   END SUBROUTINE blk_oce_core 
    447    
    448    SUBROUTINE blk_bio_meanqsr 
    449       !!--------------------------------------------------------------------- 
    450       !!                     ***  ROUTINE blk_bio_meanqsr 
    451       !!                      
    452       !! ** Purpose :   provide daily qsr_mean for PISCES when 
    453       !!                analytic diurnal cycle is applied in physic 
    454       !!                 
    455       !! ** Method  :   add part where there is no ice 
    456       !!  
    457       !!--------------------------------------------------------------------- 
    458       IF( nn_timing == 1 )  CALL timing_start('blk_bio_meanqsr') 
    459  
    460       qsr_mean(:,:) = (1. - albo ) *  sf(jp_qsr)%fnow(:,:,1) 
    461  
    462       IF( nn_timing == 1 )  CALL timing_stop('blk_bio_meanqsr') 
    463  
    464    END SUBROUTINE blk_bio_meanqsr 
    465   
    466   
    467    SUBROUTINE blk_ice_meanqsr(palb,p_qsr_mean,pdim) 
    468       !!--------------------------------------------------------------------- 
    469       !! 
    470       !! ** Purpose :   provide the daily qsr_mean over sea_ice for PISCES when 
    471       !!                analytic diurnal cycle is applied in physic 
    472       !! 
    473       !! ** Method  :   compute qsr 
    474       !!  
    475       !!--------------------------------------------------------------------- 
    476       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb       ! ice albedo (clear sky) (alb_ice_cs)               [%] 
    477       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qsr_mean !     solar heat flux over ice (T-point)         [W/m2] 
    478       INTEGER                   , INTENT(in   ) ::   pdim       ! number of ice categories 
    479       !! 
    480       INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays) 
    481       INTEGER  ::   ji, jj, jl    ! dummy loop indices 
    482       REAL(wp) ::   zztmp         ! temporary variable 
    483       !!--------------------------------------------------------------------- 
    484       IF( nn_timing == 1 )  CALL timing_start('blk_ice_meanqsr') 
    485       ! 
    486       ijpl  = pdim                            ! number of ice categories 
    487       zztmp = 1. / ( 1. - albo ) 
    488       !                                     ! ========================== ! 
    489       DO jl = 1, ijpl                       !  Loop over ice categories  ! 
    490          !                                  ! ========================== ! 
    491          DO jj = 1 , jpj 
    492             DO ji = 1, jpi 
    493                   p_qsr_mean(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr_mean(ji,jj) 
    494             END DO 
    495          END DO 
    496       END DO 
    497       ! 
    498       IF( nn_timing == 1 )  CALL timing_stop('blk_ice_meanqsr') 
    499       ! 
    500    END SUBROUTINE blk_ice_meanqsr   
    501406  
    502407    
    … …  
    521426      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pui      ! ice surface velocity (i- and i- components      [m/s] 
    522427      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pvi      !    at I-point (B-grid) or U & V-point (C-grid) 
    523       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb     ! ice albedo (clear sky) (alb_ice_cs)               [%] 
     428      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb     ! ice albedo (all skies)                            [%] 
    524429      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_taui   ! i- & j-components of surface ice stress        [N/m2] 
    525430      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_tauj   !   at I-point (B-grid) or U & V-point (C-grid) 
    … …  
    541446      REAL(wp) ::   zcoef_wnorm, zcoef_wnorm2, zcoef_dqlw, zcoef_dqla, zcoef_dqsb 
    542447      REAL(wp) ::   zztmp                                        ! temporary variable 
    543       REAL(wp) ::   zcoef_frca                                   ! fractional cloud amount 
    544448      REAL(wp) ::   zwnorm_f, zwndi_f , zwndj_f                  ! relative wind module and components at F-point 
    545449      REAL(wp) ::             zwndi_t , zwndj_t                  ! relative wind components at T-point 
    … …  
    565469      zcoef_dqla   = -Ls * Cice * 11637800. * (-5897.8) 
    566470      zcoef_dqsb   = rhoa * cpa * Cice 
    567       zcoef_frca   = 1.0  - 0.3 
    568       ! MV 2014 the proper cloud fraction (mean summer months from the CLIO climato, NH+SH) is 0.19 
    569       zcoef_frca   = 1.0  - 0.19 
    570471 
    571472!!gm brutal.... 
    … …  
    584485      CASE( 'I' )                  ! B-grid ice dynamics :   I-point (i.e. F-point with sea-ice indexation) 
    585486         !                           and scalar wind at T-point ( = | U10m - U_ice | ) (masked) 
    586 !CDIR NOVERRCHK 
    587487         DO jj = 2, jpjm1 
    588488            DO ji = 2, jpim1   ! B grid : NO vector opt 
    … …  
    609509         ! 
    610510      CASE( 'C' )                  ! C-grid ice dynamics :   U & V-points (same as ocean) 
    611 #if defined key_vectopt_loop 
    612 !CDIR COLLAPSE 
    613 #endif 
    614511         DO jj = 2, jpj 
    615512            DO ji = fs_2, jpi   ! vect. opt. 
    … …  
    619516            END DO 
    620517         END DO 
    621 #if defined key_vectopt_loop 
    622 !CDIR COLLAPSE 
    623 #endif 
    624518         DO jj = 2, jpjm1 
    625519            DO ji = fs_2, fs_jpim1   ! vect. opt. 
    … …  
    640534      DO jl = 1, ijpl                       !  Loop over ice categories  ! 
    641535         !                                  ! ========================== ! 
    642 !CDIR NOVERRCHK 
    643 !CDIR COLLAPSE 
    644536         DO jj = 1 , jpj 
    645 !CDIR NOVERRCHK 
    646537            DO ji = 1, jpi 
    647538               ! ----------------------------! 
    … …  
    668559                  &                         * (  11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) ) 
    669560               ! Latent heat sensitivity for ice (Dqla/Dt) 
    670                ! MV we also have to cap the sensitivity if the flux is zero 
    671                IF ( p_qla(ji,jj,jl) .GT. 0.0 ) THEN 
     561               IF( p_qla(ji,jj,jl) > 0._wp ) THEN 
    672562                  p_dqla(ji,jj,jl) = rn_efac * zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) 
    673563               ELSE 
    674                   p_dqla(ji,jj,jl) = 0.0 
     564                  p_dqla(ji,jj,jl) = 0._wp 
    675565               ENDIF 
    676                               
     566 
    677567               ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 
    678568               z_dqsb(ji,jj,jl) = zcoef_dqsb * z_wnds_t(ji,jj) 
    … …  
    682572               ! ----------------------------! 
    683573               ! Downward Non Solar flux 
    684                p_qns (ji,jj,jl) =     z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - p_qla (ji,jj,jl)       
     574               p_qns (ji,jj,jl) =     z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - p_qla (ji,jj,jl) 
    685575               ! Total non solar heat flux sensitivity for ice 
    686                p_dqns(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + p_dqla(ji,jj,jl) )     
     576               p_dqns(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + p_dqla(ji,jj,jl) ) 
    687577            END DO 
    688578            ! 
    … …  
    695585      ! thin surface layer and penetrates inside the ice cover 
    696586      ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 ) 
    697      
    698 !CDIR COLLAPSE 
    699       p_fr1(:,:) = ( 0.18 * ( 1.0 - zcoef_frca ) + 0.35 * zcoef_frca ) 
    700 !CDIR COLLAPSE 
    701       p_fr2(:,:) = ( 0.82 * ( 1.0 - zcoef_frca ) + 0.65 * zcoef_frca ) 
    702         
    703 !CDIR COLLAPSE 
     587      ! 
     588      p_fr1(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 
     589      p_fr2(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
     590      ! 
    704591      p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac      ! total precipitation [kg/m2/s] 
    705 !CDIR COLLAPSE 
    706592      p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac      ! solid precipitation [kg/m2/s] 
    707       CALL iom_put( 'snowpre', p_spr * 86400. )                  ! Snow precipitation  
    708       CALL iom_put( 'precip', p_tpr * 86400. )                   ! Total precipitation  
     593      CALL iom_put( 'snowpre', p_spr * 86400. )                  ! Snow precipitation 
     594      CALL iom_put( 'precip' , p_tpr * 86400. )                  ! Total precipitation 
    709595      ! 
    710596      IF(ln_ctl) THEN 
    … …  
    719605      ENDIF 
    720606 
    721       CALL wrk_dealloc( jpi,jpj, z_wnds_t ) 
    722       CALL wrk_dealloc( jpi,jpj,pdim, z_qlw, z_qsb, z_dqlw, z_dqsb )  
     607      CALL wrk_dealloc( jpi,jpj,   z_wnds_t ) 
     608      CALL wrk_dealloc( jpi,jpj,   pdim, z_qlw, z_qsb, z_dqlw, z_dqsb ) 
    723609      ! 
    724610      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_core') 
    725611      ! 
    726612   END SUBROUTINE blk_ice_core 
    727    
    728  
    729    SUBROUTINE TURB_CORE_1Z(zu, sst, T_a, q_sat, q_a,   & 
    730       &                        dU , Cd , Ch   , Ce   ) 
     613 
     614 
     615   SUBROUTINE blk_bio_meanqsr 
     616      !!--------------------------------------------------------------------- 
     617      !!                     ***  ROUTINE blk_bio_meanqsr 
     618      !!                      
     619      !! ** Purpose :   provide daily qsr_mean for PISCES when 
     620      !!                analytic diurnal cycle is applied in physic 
     621      !!                 
     622      !! ** Method  :   add part where there is no ice 
     623      !!  
     624      !!--------------------------------------------------------------------- 
     625      IF( nn_timing == 1 )  CALL timing_start('blk_bio_meanqsr') 
     626      ! 
     627      qsr_mean(:,:) = (1. - albo ) *  sf(jp_qsr)%fnow(:,:,1) 
     628      ! 
     629      IF( nn_timing == 1 )  CALL timing_stop('blk_bio_meanqsr') 
     630      ! 
     631   END SUBROUTINE blk_bio_meanqsr 
     632  
     633  
     634   SUBROUTINE blk_ice_meanqsr( palb, p_qsr_mean, pdim ) 
     635      !!--------------------------------------------------------------------- 
     636      !! 
     637      !! ** Purpose :   provide the daily qsr_mean over sea_ice for PISCES when 
     638      !!                analytic diurnal cycle is applied in physic 
     639      !! 
     640      !! ** Method  :   compute qsr 
     641      !!  
     642      !!--------------------------------------------------------------------- 
     643      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb       ! ice albedo (clear sky) (alb_ice_cs)               [%] 
     644      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qsr_mean !     solar heat flux over ice (T-point)         [W/m2] 
     645      INTEGER                   , INTENT(in   ) ::   pdim       ! number of ice categories 
     646      ! 
     647      INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays) 
     648      INTEGER  ::   ji, jj, jl    ! dummy loop indices 
     649      REAL(wp) ::   zztmp         ! temporary variable 
     650      !!--------------------------------------------------------------------- 
     651      IF( nn_timing == 1 )  CALL timing_start('blk_ice_meanqsr') 
     652      ! 
     653      ijpl  = pdim                            ! number of ice categories 
     654      zztmp = 1. / ( 1. - albo ) 
     655      !                                     ! ========================== ! 
     656      DO jl = 1, ijpl                       !  Loop over ice categories  ! 
     657         !                                  ! ========================== ! 
     658         DO jj = 1 , jpj 
     659            DO ji = 1, jpi 
     660                  p_qsr_mean(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr_mean(ji,jj) 
     661            END DO 
     662         END DO 
     663      END DO 
     664      ! 
     665      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_meanqsr') 
     666      ! 
     667   END SUBROUTINE blk_ice_meanqsr   
     668 
     669 
     670   SUBROUTINE turb_core_2z( zt, zu, sst, T_zt, q_sat, q_zt, dU,    & 
     671      &                      Cd, Ch, Ce , T_zu, q_zu ) 
    731672      !!---------------------------------------------------------------------- 
    732673      !!                      ***  ROUTINE  turb_core  *** 
    733674      !! 
    734675      !! ** Purpose :   Computes turbulent transfert coefficients of surface 
    735       !!                fluxes according to Large & Yeager (2004) 
    736       !! 
    737       !! ** 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 
    738       !!      Momentum, Latent and sensible heat exchange coefficients 
    739       !!      Caution: this procedure should only be used in cases when air 
    740       !!      temperature (T_air), air specific humidity (q_air) and wind (dU) 
    741       !!      are provided at the same height 'zzu'! 
    742       !! 
    743       !! References :   Large & Yeager, 2004 : ??? 
    744       !!---------------------------------------------------------------------- 
    745       REAL(wp)                , INTENT(in   ) ::   zu      ! altitude of wind measurement       [m] 
    746       REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   sst     ! sea surface temperature         [Kelvin] 
    747       REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   T_a     ! potential air temperature       [Kelvin] 
    748       REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   q_sat   ! sea surface specific humidity   [kg/kg] 
    749       REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   q_a     ! specific air humidity           [kg/kg] 
    750       REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   dU      ! wind module |U(zu)-U(0)|        [m/s] 
    751       REAL(wp), DIMENSION(:,:), INTENT(  out) ::   Cd      ! transfert coefficient for momentum       (tau) 
    752       REAL(wp), DIMENSION(:,:), INTENT(  out) ::   Ch      ! transfert coefficient for temperature (Q_sens) 
    753       REAL(wp), DIMENSION(:,:), INTENT(  out) ::   Ce      ! transfert coefficient for evaporation  (Q_lat) 
    754       !! 
    755       INTEGER :: j_itt 
    756       INTEGER , PARAMETER ::   nb_itt = 3 
    757       REAL(wp), PARAMETER ::   grav   = 9.8   ! gravity                        
    758       REAL(wp), PARAMETER ::   kappa  = 0.4   ! von Karman s constant 
    759  
    760       REAL(wp), DIMENSION(:,:), POINTER  ::   dU10          ! dU                                   [m/s] 
    761       REAL(wp), DIMENSION(:,:), POINTER  ::   dT            ! air/sea temperature differeence      [K] 
    762       REAL(wp), DIMENSION(:,:), POINTER  ::   dq            ! air/sea humidity difference          [K] 
    763       REAL(wp), DIMENSION(:,:), POINTER  ::   Cd_n10        ! 10m neutral drag coefficient 
    764       REAL(wp), DIMENSION(:,:), POINTER  ::   Ce_n10        ! 10m neutral latent coefficient 
    765       REAL(wp), DIMENSION(:,:), POINTER  ::   Ch_n10        ! 10m neutral sensible coefficient 
    766       REAL(wp), DIMENSION(:,:), POINTER  ::   sqrt_Cd_n10   ! root square of Cd_n10 
    767       REAL(wp), DIMENSION(:,:), POINTER  ::   sqrt_Cd       ! root square of Cd 
    768       REAL(wp), DIMENSION(:,:), POINTER  ::   T_vpot        ! virtual potential temperature        [K] 
    769       REAL(wp), DIMENSION(:,:), POINTER  ::   T_star        ! turbulent scale of tem. fluct. 
    770       REAL(wp), DIMENSION(:,:), POINTER  ::   q_star        ! turbulent humidity of temp. fluct. 
    771       REAL(wp), DIMENSION(:,:), POINTER  ::   U_star        ! turb. scale of velocity fluct. 
    772       REAL(wp), DIMENSION(:,:), POINTER  ::   L             ! Monin-Obukov length                  [m] 
    773       REAL(wp), DIMENSION(:,:), POINTER  ::   zeta          ! stability parameter at height zu 
    774       REAL(wp), DIMENSION(:,:), POINTER  ::   U_n10         ! neutral wind velocity at 10m         [m]    
    775       REAL(wp), DIMENSION(:,:), POINTER  ::   xlogt, xct, zpsi_h, zpsi_m 
    776        
    777       INTEGER , DIMENSION(:,:), POINTER  ::   stab          ! 1st guess stability test integer 
    778       !!---------------------------------------------------------------------- 
    779       ! 
    780       IF( nn_timing == 1 )  CALL timing_start('TURB_CORE_1Z') 
    781       ! 
    782       CALL wrk_alloc( jpi,jpj, stab )   ! integer 
    783       CALL wrk_alloc( jpi,jpj, dU10, dT, dq, Cd_n10, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd, L ) 
    784       CALL wrk_alloc( jpi,jpj, T_vpot, T_star, q_star, U_star, zeta, U_n10, xlogt, xct, zpsi_h, zpsi_m ) 
    785  
    786       !! * Start 
    787       !! Air/sea differences 
    788       dU10 = max(0.5, dU)     ! we don't want to fall under 0.5 m/s 
    789       dT = T_a - sst          ! assuming that T_a is allready the potential temp. at zzu 
    790       dq = q_a - q_sat 
    791       !!     
    792       !! Virtual potential temperature 
    793       T_vpot = T_a*(1. + 0.608*q_a) 
    794       !! 
    795       !! Neutral Drag Coefficient 
    796       stab    = 0.5 + sign(0.5,dT)    ! stable : stab = 1 ; unstable : stab = 0  
    797       IF  ( ln_cdgw ) THEN 
    798         cdn_wave = cdn_wave - rsmall*(tmask(:,:,1)-1) 
    799         Cd_n10(:,:) =   cdn_wave 
    800       ELSE 
    801         Cd_n10  = 1.e-3 * ( 2.7/dU10 + 0.142 + dU10/13.09 )    !   L & Y eq. (6a) 
    802       ENDIF 
    803       sqrt_Cd_n10 = sqrt(Cd_n10) 
    804       Ce_n10  = 1.e-3 * ( 34.6 * sqrt_Cd_n10 )               !   L & Y eq. (6b) 
    805       Ch_n10  = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1.-stab)) !   L & Y eq. (6c), (6d) 
    806       !! 
    807       !! Initializing transfert coefficients with their first guess neutral equivalents : 
    808       Cd = Cd_n10 ;  Ce = Ce_n10 ;  Ch = Ch_n10 ;  sqrt_Cd = sqrt(Cd) 
    809  
    810       !! * Now starting iteration loop 
    811       DO j_itt=1, nb_itt 
    812          !! Turbulent scales : 
    813          U_star  = sqrt_Cd*dU10                !   L & Y eq. (7a) 
    814          T_star  = Ch/sqrt_Cd*dT               !   L & Y eq. (7b) 
    815          q_star  = Ce/sqrt_Cd*dq               !   L & Y eq. (7c) 
    816  
    817          !! Estimate the Monin-Obukov length : 
    818          L  = (U_star**2)/( kappa*grav*(T_star/T_vpot + q_star/(q_a + 1./0.608)) ) 
    819  
    820          !! Stability parameters : 
    821          zeta  = zu/L ;  zeta   = sign( min(abs(zeta),10.0), zeta ) 
    822          zpsi_h  = psi_h(zeta) 
    823          zpsi_m  = psi_m(zeta) 
    824  
    825          IF  ( ln_cdgw ) THEN 
    826            sqrt_Cd=kappa/((kappa/sqrt_Cd_n10) - zpsi_m) ; Cd=sqrt_Cd*sqrt_Cd; 
    827          ELSE 
    828            !! Shifting the wind speed to 10m and neutral stability :  L & Y eq. (9a) 
    829            !   In very rare low-wind conditions, the old way of estimating the 
    830            !   neutral wind speed at 10m leads to a negative value that causes the code 
    831            !   to crash. To prevent this a threshold of 0.25m/s is now imposed. 
    832            U_n10 = MAX( 0.25 , dU10/(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m)) ) 
    833  
    834            !! Updating the neutral 10m transfer coefficients : 
    835            Cd_n10  = 1.e-3 * (2.7/U_n10 + 0.142 + U_n10/13.09)              !  L & Y eq. (6a) 
    836            sqrt_Cd_n10 = sqrt(Cd_n10) 
    837            Ce_n10  = 1.e-3 * (34.6 * sqrt_Cd_n10)                           !  L & Y eq. (6b) 
    838            stab    = 0.5 + sign(0.5,zeta) 
    839            Ch_n10  = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1.-stab))           !  L & Y eq. (6c), (6d) 
    840  
    841            !! Shifting the neutral  10m transfer coefficients to ( zu , zeta ) : 
    842            !! 
    843            xct = 1. + sqrt_Cd_n10/kappa*(log(zu/10) - zpsi_m) 
    844            Cd  = Cd_n10/(xct*xct) ;  sqrt_Cd = sqrt(Cd) 
    845          ENDIF 
    846          !! 
    847          xlogt = log(zu/10.) - zpsi_h 
    848          !! 
    849          xct = 1. + Ch_n10*xlogt/kappa/sqrt_Cd_n10 
    850          Ch  = Ch_n10*sqrt_Cd/sqrt_Cd_n10/xct 
    851          !! 
    852          xct = 1. + Ce_n10*xlogt/kappa/sqrt_Cd_n10 
    853          Ce  = Ce_n10*sqrt_Cd/sqrt_Cd_n10/xct 
    854          !! 
    855       END DO 
    856       !! 
    857       CALL wrk_dealloc( jpi,jpj, stab )   ! integer 
    858       CALL wrk_dealloc( jpi,jpj, dU10, dT, dq, Cd_n10, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd, L ) 
    859       CALL wrk_dealloc( jpi,jpj, T_vpot, T_star, q_star, U_star, zeta, U_n10, xlogt, xct, zpsi_h, zpsi_m ) 
    860       ! 
    861       IF( nn_timing == 1 )  CALL timing_stop('TURB_CORE_1Z') 
    862       ! 
    863     END SUBROUTINE TURB_CORE_1Z 
    864  
    865  
    866     SUBROUTINE TURB_CORE_2Z(zt, zu, sst, T_zt, q_sat, q_zt, dU, Cd, Ch, Ce, T_zu, q_zu) 
    867       !!---------------------------------------------------------------------- 
    868       !!                      ***  ROUTINE  turb_core  *** 
    869       !! 
    870       !! ** Purpose :   Computes turbulent transfert coefficients of surface  
    871       !!                fluxes according to Large & Yeager (2004). 
    872       !! 
    873       !! ** 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 
    874       !!      Momentum, Latent and sensible heat exchange coefficients 
    875       !!      Caution: this procedure should only be used in cases when air 
    876       !!      temperature (T_air) and air specific humidity (q_air) are at a 
    877       !!      different height to wind (dU). 
    878       !! 
    879       !! References :   Large & Yeager, 2004 : ??? 
     676      !!                fluxes according to Large & Yeager (2004) and Large & Yeager (2008) 
     677      !!                If relevant (zt /= zu), adjust temperature and humidity from height zt to zu 
     678      !! 
     679      !! ** Method : Monin Obukhov Similarity Theory  
     680      !!             + Large & Yeager (2004,2008) closure: CD_n10 = f(U_n10) 
     681      !! 
     682      !! ** References :   Large & Yeager, 2004 / Large & Yeager, 2008 
     683      !! 
     684      !! ** Last update: Laurent Brodeau, June 2014: 
     685      !!    - handles both cases zt=zu and zt/=zu 
     686      !!    - optimized: less 2D arrays allocated and less operations 
     687      !!    - better first guess of stability by checking air-sea difference of virtual temperature 
     688      !!       rather than temperature difference only... 
     689      !!    - added function "cd_neutral_10m" that uses the improved parametrization of  
     690      !!      Large & Yeager 2008. Drag-coefficient reduction for Cyclone conditions! 
     691      !!    - using code-wide physical constants defined into "phycst.mod" rather than redifining them 
     692      !!      => 'vkarmn' and 'grav' 
    880693      !!---------------------------------------------------------------------- 
    881694      REAL(wp), INTENT(in   )                     ::   zt       ! height for T_zt and q_zt                   [m] 
    … …  
    885698      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_sat    ! sea surface specific humidity         [kg/kg] 
    886699      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity                 [kg/kg] 
    887       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   dU       ! relative wind module |U(zu)-U(0)|       [m/s] 
     700      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   dU       ! relative wind module at zu            [m/s] 
    888701      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cd       ! transfer coefficient for momentum         (tau) 
    889702      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ch       ! transfer coefficient for sensible heat (Q_sens) 
    … …  
    891704      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   T_zu     ! air temp. shifted at zu                     [K] 
    892705      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. hum.  shifted at zu               [kg/kg] 
    893  
    894       INTEGER :: j_itt 
    895       INTEGER , PARAMETER :: nb_itt = 5              ! number of itterations 
    896       REAL(wp), PARAMETER ::   grav   = 9.8          ! gravity                        
    897       REAL(wp), PARAMETER ::   kappa  = 0.4          ! von Karman's constant 
    898        
    899       REAL(wp), DIMENSION(:,:), POINTER ::   dU10          ! dU                                [m/s] 
    900       REAL(wp), DIMENSION(:,:), POINTER ::   dT            ! air/sea temperature differeence   [K] 
    901       REAL(wp), DIMENSION(:,:), POINTER ::   dq            ! air/sea humidity difference       [K] 
    902       REAL(wp), DIMENSION(:,:), POINTER ::   Cd_n10        ! 10m neutral drag coefficient 
     706      ! 
     707      INTEGER ::   j_itt 
     708      INTEGER , PARAMETER ::   nb_itt = 5       ! number of itterations 
     709      LOGICAL ::   l_zt_equal_zu = .FALSE.      ! if q and t are given at different height than U 
     710      ! 
     711      REAL(wp), DIMENSION(:,:), POINTER ::   U_zu          ! relative wind at zu                            [m/s] 
    903712      REAL(wp), DIMENSION(:,:), POINTER ::   Ce_n10        ! 10m neutral latent coefficient 
    904713      REAL(wp), DIMENSION(:,:), POINTER ::   Ch_n10        ! 10m neutral sensible coefficient 
    905714      REAL(wp), DIMENSION(:,:), POINTER ::   sqrt_Cd_n10   ! root square of Cd_n10 
    906715      REAL(wp), DIMENSION(:,:), POINTER ::   sqrt_Cd       ! root square of Cd 
    907       REAL(wp), DIMENSION(:,:), POINTER ::   T_vpot        ! virtual potential temperature        [K] 
    908       REAL(wp), DIMENSION(:,:), POINTER ::   T_star        ! turbulent scale of tem. fluct. 
    909       REAL(wp), DIMENSION(:,:), POINTER ::   q_star        ! turbulent humidity of temp. fluct. 
    910       REAL(wp), DIMENSION(:,:), POINTER ::   U_star        ! turb. scale of velocity fluct. 
    911       REAL(wp), DIMENSION(:,:), POINTER ::   L             ! Monin-Obukov length                  [m] 
    912716      REAL(wp), DIMENSION(:,:), POINTER ::   zeta_u        ! stability parameter at height zu 
    913717      REAL(wp), DIMENSION(:,:), POINTER ::   zeta_t        ! stability parameter at height zt 
    914       REAL(wp), DIMENSION(:,:), POINTER ::   U_n10         ! neutral wind velocity at 10m        [m] 
    915       REAL(wp), DIMENSION(:,:), POINTER ::   xlogt, xct, zpsi_hu, zpsi_ht, zpsi_m 
    916  
    917       INTEGER , DIMENSION(:,:), POINTER ::   stab          ! 1st stability test integer 
     718      REAL(wp), DIMENSION(:,:), POINTER ::   zpsi_h_u, zpsi_m_u 
     719      REAL(wp), DIMENSION(:,:), POINTER ::   ztmp0, ztmp1, ztmp2 
     720      REAL(wp), DIMENSION(:,:), POINTER ::   stab          ! 1st stability test integer 
    918721      !!---------------------------------------------------------------------- 
    919       ! 
    920       IF( nn_timing == 1 )  CALL timing_start('TURB_CORE_2Z') 
    921       ! 
    922       CALL wrk_alloc( jpi,jpj, dU10, dT, dq, Cd_n10, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd, L ) 
    923       CALL wrk_alloc( jpi,jpj, T_vpot, T_star, q_star, U_star, zeta_u, zeta_t, U_n10 ) 
    924       CALL wrk_alloc( jpi,jpj, xlogt, xct, zpsi_hu, zpsi_ht, zpsi_m ) 
    925       CALL wrk_alloc( jpi,jpj, stab )   ! interger 
    926  
    927       !! Initial air/sea differences 
    928       dU10 = max(0.5, dU)      !  we don't want to fall under 0.5 m/s 
    929       dT = T_zt - sst  
    930       dq = q_zt - q_sat 
    931  
    932       !! Neutral Drag Coefficient : 
    933       stab = 0.5 + sign(0.5,dT)                 ! stab = 1  if dT > 0  -> STABLE 
    934       IF( ln_cdgw ) THEN 
    935         cdn_wave = cdn_wave - rsmall*(tmask(:,:,1)-1) 
    936         Cd_n10(:,:) =   cdn_wave 
     722 
     723      IF( nn_timing == 1 )  CALL timing_start('turb_core_2z') 
     724     
     725      CALL wrk_alloc( jpi,jpj, U_zu, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd ) 
     726      CALL wrk_alloc( jpi,jpj, zeta_u, stab ) 
     727      CALL wrk_alloc( jpi,jpj, zpsi_h_u, zpsi_m_u, ztmp0, ztmp1, ztmp2 ) 
     728 
     729      l_zt_equal_zu = .FALSE. 
     730      IF( ABS(zu - zt) < 0.01 ) l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision 
     731 
     732      IF( .NOT. l_zt_equal_zu )   CALL wrk_alloc( jpi,jpj, zeta_t ) 
     733 
     734      U_zu = MAX( 0.5 , dU )   !  relative wind speed at zu (normally 10m), we don't want to fall under 0.5 m/s 
     735 
     736      !! First guess of stability:  
     737      ztmp0 = T_zt*(1. + 0.608*q_zt) - sst*(1. + 0.608*q_sat) ! air-sea difference of virtual pot. temp. at zt 
     738      stab  = 0.5 + sign(0.5,ztmp0)                           ! stab = 1 if dTv > 0  => STABLE, 0 if unstable 
     739 
     740      !! Neutral coefficients at 10m: 
     741      IF( ln_cdgw ) THEN      ! wave drag case 
     742         cdn_wave(:,:) = cdn_wave(:,:) + rsmall * ( 1._wp - tmask(:,:,1) ) 
     743         ztmp0   (:,:) = cdn_wave(:,:) 
    937744      ELSE 
    938         Cd_n10  = 1.e-3*( 2.7/dU10 + 0.142 + dU10/13.09 )  
     745         ztmp0 = cd_neutral_10m( U_zu ) 
    939746      ENDIF 
    940       sqrt_Cd_n10 = sqrt(Cd_n10) 
     747      sqrt_Cd_n10 = SQRT( ztmp0 ) 
    941748      Ce_n10  = 1.e-3*( 34.6 * sqrt_Cd_n10 ) 
    942749      Ch_n10  = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab)) 
    943  
     750     
    944751      !! Initializing transf. coeff. with their first guess neutral equivalents : 
    945       Cd = Cd_n10 ;  Ce = Ce_n10 ;  Ch = Ch_n10 ;  sqrt_Cd = sqrt(Cd) 
    946  
    947       !! Initializing z_u values with z_t values : 
    948       T_zu = T_zt ;  q_zu = q_zt 
     752      Cd = ztmp0   ;   Ce = Ce_n10   ;   Ch = Ch_n10   ;   sqrt_Cd = sqrt_Cd_n10 
     753 
     754      !! Initializing values at z_u with z_t values: 
     755      T_zu = T_zt   ;   q_zu = q_zt 
    949756 
    950757      !!  * Now starting iteration loop 
    951758      DO j_itt=1, nb_itt 
    952          dT = T_zu - sst ;  dq = q_zu - q_sat ! Updating air/sea differences 
    953          T_vpot = T_zu*(1. + 0.608*q_zu)    ! Updating virtual potential temperature at zu 
    954          U_star = sqrt_Cd*dU10                ! Updating turbulent scales :   (L & Y eq. (7)) 
    955          T_star  = Ch/sqrt_Cd*dT              ! 
    956          q_star  = Ce/sqrt_Cd*dq              ! 
    957          !! 
    958          L = (U_star*U_star) &                ! Estimate the Monin-Obukov length at height zu 
    959               & / (kappa*grav/T_vpot*(T_star*(1.+0.608*q_zu) + 0.608*T_zu*q_star)) 
     759         ! 
     760         ztmp1 = T_zu - sst   ! Updating air/sea differences 
     761         ztmp2 = q_zu - q_sat  
     762 
     763         ! Updating turbulent scales :   (L&Y 2004 eq. (7)) 
     764         ztmp1  = Ch/sqrt_Cd*ztmp1    ! theta* 
     765         ztmp2  = Ce/sqrt_Cd*ztmp2    ! q* 
     766        
     767         ztmp0 = T_zu*(1. + 0.608*q_zu) ! virtual potential temperature at zu 
     768 
     769         ! Estimate the inverse of Monin-Obukov length (1/L) at height zu: 
     770         ztmp0 =  (vkarmn*grav/ztmp0*(ztmp1*(1.+0.608*q_zu) + 0.608*T_zu*ztmp2)) / (Cd*U_zu*U_zu)  
     771         !                                                                     ( Cd*U_zu*U_zu is U*^2 at zu) 
     772 
    960773         !! Stability parameters : 
    961          zeta_u  = zu/L  ;  zeta_u = sign( min(abs(zeta_u),10.0), zeta_u ) 
    962          zeta_t  = zt/L  ;  zeta_t = sign( min(abs(zeta_t),10.0), zeta_t ) 
    963          zpsi_hu = psi_h(zeta_u) 
    964          zpsi_ht = psi_h(zeta_t) 
    965          zpsi_m  = psi_m(zeta_u) 
    966          !! 
    967          !! Shifting the wind speed to 10m and neutral stability : L & Y eq.(9a) 
    968          !   In very rare low-wind conditions, the old way of estimating the 
    969          !   neutral wind speed at 10m leads to a negative value that causes the code 
    970          !   to crash. To prevent this a threshold of 0.25m/s is now imposed. 
    971          U_n10 = MAX( 0.25 , dU10/(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m)) ) 
    972          !! 
    973          !! Shifting temperature and humidity at zu :          (L & Y eq. (9b-9c)) 
    974 !        T_zu = T_zt - T_star/kappa*(log(zt/zu) + psi_h(zeta_u) - psi_h(zeta_t)) 
    975          T_zu = T_zt - T_star/kappa*(log(zt/zu) + zpsi_hu - zpsi_ht) 
    976 !        q_zu = q_zt - q_star/kappa*(log(zt/zu) + psi_h(zeta_u) - psi_h(zeta_t)) 
    977          q_zu = q_zt - q_star/kappa*(log(zt/zu) + zpsi_hu - zpsi_ht) 
    978          !! 
    979          !! q_zu cannot have a negative value : forcing 0 
    980          stab = 0.5 + sign(0.5,q_zu) ;  q_zu = stab*q_zu 
    981          !! 
    982          IF( ln_cdgw ) THEN 
    983             sqrt_Cd=kappa/((kappa/sqrt_Cd_n10) - zpsi_m) ; Cd=sqrt_Cd*sqrt_Cd; 
     774         zeta_u   = zu*ztmp0   ;  zeta_u = sign( min(abs(zeta_u),10.0), zeta_u ) 
     775         zpsi_h_u = psi_h( zeta_u ) 
     776         zpsi_m_u = psi_m( zeta_u ) 
     777        
     778         !! Shifting temperature and humidity at zu (L&Y 2004 eq. (9b-9c)) 
     779         IF ( .NOT. l_zt_equal_zu ) THEN 
     780            zeta_t = zt*ztmp0 ;  zeta_t = sign( min(abs(zeta_t),10.0), zeta_t ) 
     781            stab = LOG(zu/zt) - zpsi_h_u + psi_h(zeta_t)  ! stab just used as temp array!!! 
     782            T_zu = T_zt + ztmp1/vkarmn*stab    ! ztmp1 is still theta* 
     783            q_zu = q_zt + ztmp2/vkarmn*stab    ! ztmp2 is still q* 
     784            q_zu = max(0., q_zu) 
     785         END IF 
     786        
     787         IF( ln_cdgw ) THEN      ! surface wave case 
     788            sqrt_Cd = vkarmn / ( vkarmn / sqrt_Cd_n10 - zpsi_m_u )  
     789            Cd      = sqrt_Cd * sqrt_Cd 
    984790         ELSE 
    985            !! Updating the neutral 10m transfer coefficients : 
    986            Cd_n10  = 1.e-3 * (2.7/U_n10 + 0.142 + U_n10/13.09)    ! L & Y eq. (6a) 
    987            sqrt_Cd_n10 = sqrt(Cd_n10) 
    988            Ce_n10  = 1.e-3 * (34.6 * sqrt_Cd_n10)                 ! L & Y eq. (6b) 
    989            stab    = 0.5 + sign(0.5,zeta_u) 
    990            Ch_n10  = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1.-stab)) ! L & Y eq. (6c-6d) 
    991            !! 
    992            !! 
    993            !! Shifting the neutral 10m transfer coefficients to (zu,zeta_u) : 
    994            xct = 1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m)   ! L & Y eq. (10a) 
    995            Cd = Cd_n10/(xct*xct) ; sqrt_Cd = sqrt(Cd) 
     791           ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)... 
     792           !   In very rare low-wind conditions, the old way of estimating the 
     793           !   neutral wind speed at 10m leads to a negative value that causes the code 
     794           !   to crash. To prevent this a threshold of 0.25m/s is imposed. 
     795           ztmp0 = MAX( 0.25 , U_zu/(1. + sqrt_Cd_n10/vkarmn*(LOG(zu/10.) - zpsi_m_u)) ) !  U_n10 
     796           ztmp0 = cd_neutral_10m(ztmp0)                                                 ! Cd_n10 
     797           sqrt_Cd_n10 = sqrt(ztmp0) 
     798        
     799           Ce_n10  = 1.e-3 * (34.6 * sqrt_Cd_n10)                     ! L&Y 2004 eq. (6b) 
     800           stab    = 0.5 + sign(0.5,zeta_u)                           ! update stability 
     801           Ch_n10  = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab))  ! L&Y 2004 eq. (6c-6d) 
     802 
     803           !! Update of transfer coefficients: 
     804           ztmp1 = 1. + sqrt_Cd_n10/vkarmn*(LOG(zu/10.) - zpsi_m_u)   ! L&Y 2004 eq. (10a) 
     805           Cd      = ztmp0 / ( ztmp1*ztmp1 )    
     806           sqrt_Cd = SQRT( Cd ) 
    996807         ENDIF 
    997          !! 
    998          xlogt = log(zu/10.) - zpsi_hu 
    999          !! 
    1000          xct = 1. + Ch_n10*xlogt/kappa/sqrt_Cd_n10               ! L & Y eq. (10b) 
    1001          Ch  = Ch_n10*sqrt_Cd/sqrt_Cd_n10/xct 
    1002          !! 
    1003          xct = 1. + Ce_n10*xlogt/kappa/sqrt_Cd_n10               ! L & Y eq. (10c) 
    1004          Ce  = Ce_n10*sqrt_Cd/sqrt_Cd_n10/xct 
    1005          !! 
    1006          !! 
     808         ! 
     809         ztmp0 = (LOG(zu/10.) - zpsi_h_u) / vkarmn / sqrt_Cd_n10 
     810         ztmp2 = sqrt_Cd / sqrt_Cd_n10 
     811         ztmp1 = 1. + Ch_n10*ztmp0                
     812         Ch  = Ch_n10*ztmp2 / ztmp1  ! L&Y 2004 eq. (10b) 
     813         ! 
     814         ztmp1 = 1. + Ce_n10*ztmp0                
     815         Ce  = Ce_n10*ztmp2 / ztmp1  ! L&Y 2004 eq. (10c) 
     816         ! 
    1007817      END DO 
    1008       !! 
    1009       CALL wrk_dealloc( jpi,jpj, dU10, dT, dq, Cd_n10, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd, L ) 
    1010       CALL wrk_dealloc( jpi,jpj, T_vpot, T_star, q_star, U_star, zeta_u, zeta_t, U_n10 ) 
    1011       CALL wrk_dealloc( jpi,jpj, xlogt, xct, zpsi_hu, zpsi_ht, zpsi_m ) 
    1012       CALL wrk_dealloc( jpi,jpj, stab )   ! interger 
    1013       ! 
    1014       IF( nn_timing == 1 )  CALL timing_stop('TURB_CORE_2Z') 
    1015       ! 
    1016     END SUBROUTINE TURB_CORE_2Z 
    1017  
    1018  
    1019     FUNCTION psi_m(zta)   !! Psis, L & Y eq. (8c), (8d), (8e) 
     818 
     819      CALL wrk_dealloc( jpi,jpj, U_zu, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd ) 
     820      CALL wrk_dealloc( jpi,jpj, zeta_u, stab ) 
     821      CALL wrk_dealloc( jpi,jpj, zpsi_h_u, zpsi_m_u, ztmp0, ztmp1, ztmp2 ) 
     822 
     823      IF( .NOT. l_zt_equal_zu ) CALL wrk_dealloc( jpi,jpj, zeta_t ) 
     824 
     825      IF( nn_timing == 1 )  CALL timing_stop('turb_core_2z') 
     826      ! 
     827   END SUBROUTINE turb_core_2z 
     828 
     829 
     830   FUNCTION cd_neutral_10m( zw10 ) 
     831      !!---------------------------------------------------------------------- 
     832      !! Estimate of the neutral drag coefficient at 10m as a function  
     833      !! of neutral wind  speed at 10m 
     834      !! 
     835      !! Origin: Large & Yeager 2008 eq.(11a) and eq.(11b) 
     836      !! 
     837      !! Author: L. Brodeau, june 2014 
     838      !!----------------------------------------------------------------------     
     839      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   zw10           ! scalar wind speed at 10m (m/s) 
     840      REAL(wp), DIMENSION(jpi,jpj)             ::   cd_neutral_10m 
     841      ! 
     842      REAL(wp), DIMENSION(:,:), POINTER ::   rgt33 
     843      !!----------------------------------------------------------------------     
     844      ! 
     845      CALL wrk_alloc( jpi,jpj, rgt33 ) 
     846      ! 
     847      !! When wind speed > 33 m/s => Cyclone conditions => special treatment 
     848      rgt33 = 0.5_wp + SIGN( 0.5_wp, (zw10 - 33._wp) )   ! If zw10 < 33. => 0, else => 1   
     849      cd_neutral_10m = 1.e-3 * ( & 
     850         &       (rgt33 + 1._wp)*( 2.7_wp/zw10 + 0.142_wp + zw10/13.09_wp - 3.14807E-10*zw10**6) & ! zw10< 33. 
     851         &      + rgt33         *      2.34   )                                                    ! zw10 >= 33. 
     852      ! 
     853      CALL wrk_dealloc( jpi,jpj, rgt33) 
     854      ! 
     855   END FUNCTION cd_neutral_10m 
     856 
     857 
     858   FUNCTION psi_m(pta)   !! Psis, L&Y 2004 eq. (8c), (8d), (8e) 
    1020859      !------------------------------------------------------------------------------- 
    1021       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: zta 
    1022  
    1023       REAL(wp), PARAMETER :: pi = 3.141592653589793_wp 
     860      ! universal profile stability function for momentum 
     861      !------------------------------------------------------------------------------- 
     862      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pta 
     863      ! 
    1024864      REAL(wp), DIMENSION(jpi,jpj)             :: psi_m 
    1025865      REAL(wp), DIMENSION(:,:), POINTER        :: X2, X, stabit 
    1026866      !------------------------------------------------------------------------------- 
    1027  
     867      ! 
    1028868      CALL wrk_alloc( jpi,jpj, X2, X, stabit ) 
    1029  
    1030       X2 = sqrt(abs(1. - 16.*zta))  ;  X2 = max(X2 , 1.0) ;  X  = sqrt(X2) 
    1031       stabit    = 0.5 + sign(0.5,zta) 
    1032       psi_m = -5.*zta*stabit  &                                                          ! Stable 
    1033          &    + (1. - stabit)*(2*log((1. + X)/2) + log((1. + X2)/2) - 2*atan(X) + pi/2)  ! Unstable  
    1034  
     869      ! 
     870      X2 = SQRT( ABS( 1. - 16.*pta ) )  ;  X2 = MAX( X2 , 1. )   ;   X = SQRT( X2 ) 
     871      stabit = 0.5 + SIGN( 0.5 , pta ) 
     872      psi_m = -5.*pta*stabit  &                                                          ! Stable 
     873         &    + (1. - stabit)*(2.*LOG((1. + X)*0.5) + LOG((1. + X2)*0.5) - 2.*ATAN(X) + rpi*0.5)  ! Unstable 
     874      ! 
    1035875      CALL wrk_dealloc( jpi,jpj, X2, X, stabit ) 
    1036876      ! 
    1037     END FUNCTION psi_m 
    1038  
    1039  
    1040     FUNCTION psi_h( zta )    !! Psis, L & Y eq. (8c), (8d), (8e) 
     877   END FUNCTION psi_m 
     878 
     879 
     880   FUNCTION psi_h( pta )    !! Psis, L&Y 2004 eq. (8c), (8d), (8e) 
    1041881      !------------------------------------------------------------------------------- 
    1042       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   zta 
     882      ! universal profile stability function for temperature and humidity 
     883      !------------------------------------------------------------------------------- 
     884      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pta 
    1043885      ! 
    1044886      REAL(wp), DIMENSION(jpi,jpj)             ::   psi_h 
    1045       REAL(wp), DIMENSION(:,:), POINTER        :: X2, X, stabit 
     887      REAL(wp), DIMENSION(:,:), POINTER        ::   X2, X, stabit 
    1046888      !------------------------------------------------------------------------------- 
    1047  
     889      ! 
    1048890      CALL wrk_alloc( jpi,jpj, X2, X, stabit ) 
    1049  
    1050       X2 = sqrt(abs(1. - 16.*zta))  ;  X2 = max(X2 , 1.) ;  X  = sqrt(X2) 
    1051       stabit    = 0.5 + sign(0.5,zta) 
    1052       psi_h = -5.*zta*stabit  &                                       ! Stable 
    1053          &    + (1. - stabit)*(2.*log( (1. + X2)/2. ))                 ! Unstable 
    1054  
     891      ! 
     892      X2 = SQRT( ABS( 1. - 16.*pta ) )   ;   X2 = MAX( X2 , 1. )   ;   X = SQRT( X2 ) 
     893      stabit = 0.5 + SIGN( 0.5 , pta ) 
     894      psi_h = -5.*pta*stabit   &                                       ! Stable 
     895         &    + (1. - stabit)*(2.*LOG( (1. + X2)*0.5 ))                ! Unstable 
     896      ! 
    1055897      CALL wrk_dealloc( jpi,jpj, X2, X, stabit ) 
    1056898      ! 
    1057     END FUNCTION psi_h 
    1058    
     899   END FUNCTION psi_h 
     900 
    1059901   !!====================================================================== 
    1060902END MODULE sbcblk_core 

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

    r4724 r4946  
    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_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r4924 r4946  
    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) )  ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 
    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 
    … …  
    485454      END DO 
    486455      ! Allocate taum part of frcv which is used even when not received as coupling field 
    487       IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jn)%nct) ) 
     456      IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 
    488457      ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 
    489458      IF( k_ice /= 0 ) THEN 
    490          IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jn)%nct) ) 
    491          IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jn)%nct) ) 
     459         IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 
     460         IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 
    492461      END IF 
    493462 
    … …  
    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_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90

    r4924 r4946  
    9191         area = glob_sum( e1e2t(:,:) )           ! interior global domain surface 
    9292         ! 
    93 #if ! defined key_lim2 &&  ! defined key_lim3 && ! defined key_cice  
     93#if ! defined key_lim2 &&  ! defined key_lim3 && ! defined key_cice 
    9494         snwice_mass_b(:,:) = 0.e0               ! no sea-ice model is being used : no snow+ice mass 
    9595         snwice_mass  (:,:) = 0.e0 

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

    r4627 r4946  
    1717   USE phycst, only : rcp, rau0, r1_rau0, rhosn, rhoic 
    1818   USE in_out_manager  ! I/O manager 
     19   USE iom, only : iom_put              ! I/O manager library !!Joakim edit 
    1920   USE lib_mpp         ! distributed memory computing library 
    2021   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    … …  
    2324   USE daymod          ! calendar 
    2425   USE fldread         ! read input fields 
    25  
    2626   USE sbc_oce         ! Surface boundary condition: ocean fields 
    2727   USE sbc_ice         ! Surface boundary condition: ice   fields 
    … …  
    3838   USE ice_calendar, only: dt 
    3939   USE ice_state, only: aice,aicen,uvel,vvel,vsno,vsnon,vice,vicen 
     40# if defined key_cice4 
    4041   USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow,  & 
    4142                sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_gbm,     & 
    … …  
    4445                uatm,vatm,wind,fsw,flw,Tair,potT,Qa,rhoa,zlvl,   & 
    4546                swvdr,swvdf,swidr,swidf 
     47   USE ice_therm_vertical, only: calc_Tsfc 
     48#else 
     49   USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow,  & 
     50                sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_ai,     & 
     51                fresh_ai,fhocn_ai,fswthru_ai,frzmlt,          & 
     52                flatn_f,fsurfn_f,fcondtopn_f,                    & 
     53                uatm,vatm,wind,fsw,flw,Tair,potT,Qa,rhoa,zlvl,   & 
     54                swvdr,swvdf,swidr,swidf 
     55   USE ice_therm_shared, only: calc_Tsfc 
     56#endif 
    4657   USE ice_forcing, only: frcvdr,frcvdf,frcidr,frcidf 
    4758   USE ice_atmo, only: calc_strair 
    48    USE ice_therm_vertical, only: calc_Tsfc 
    4959 
    5060   USE CICE_InitMod 
    … …  
    95105   END FUNCTION sbc_ice_cice_alloc 
    96106 
    97    SUBROUTINE sbc_ice_cice( kt, nsbc ) 
     107   SUBROUTINE sbc_ice_cice( kt, ksbc ) 
    98108      !!--------------------------------------------------------------------- 
    99109      !!                  ***  ROUTINE sbc_ice_cice  *** 
    … …  
    113123      !!--------------------------------------------------------------------- 
    114124      INTEGER, INTENT(in) ::   kt      ! ocean time step 
    115       INTEGER, INTENT(in) ::   nsbc    ! surface forcing type 
     125      INTEGER, INTENT(in) ::   ksbc    ! surface forcing type 
    116126      !!---------------------------------------------------------------------- 
    117127      ! 
    … …  
    123133 
    124134         ! Make sure any fluxes required for CICE are set 
    125          IF ( nsbc == 2 ) THEN 
     135         IF      ( ksbc == jp_flx ) THEN 
    126136            CALL cice_sbc_force(kt) 
    127          ELSE IF ( nsbc == 5 ) THEN 
     137         ELSE IF ( ksbc == jp_cpl ) THEN 
    128138            CALL sbc_cpl_ice_flx( 1.0-fr_i  ) 
    129139         ENDIF 
    130140 
    131          CALL cice_sbc_in ( kt, nsbc ) 
     141         CALL cice_sbc_in  ( kt, ksbc ) 
    132142         CALL CICE_Run 
    133          CALL cice_sbc_out ( kt, nsbc ) 
    134  
    135          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) 
    136146 
    137147      ENDIF                                          ! End sea-ice time step only 
    … …  
    141151   END SUBROUTINE sbc_ice_cice 
    142152 
    143    SUBROUTINE cice_sbc_init (nsbc) 
     153   SUBROUTINE cice_sbc_init (ksbc) 
    144154      !!--------------------------------------------------------------------- 
    145155      !!                    ***  ROUTINE cice_sbc_init  *** 
    146156      !! ** Purpose: Initialise ice related fields for NEMO and coupling 
    147157      !! 
    148       INTEGER, INTENT( in  ) ::   nsbc                ! surface forcing type 
     158      INTEGER, INTENT( in  ) ::   ksbc                ! surface forcing type 
    149159      REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 
    150160      REAL(wp) ::   zcoefu, zcoefv, zcoeff            ! local scalar 
    151       INTEGER  ::   ji, jj, jl                        ! dummy loop indices 
     161      INTEGER  ::   ji, jj, jl, jk                    ! dummy loop indices 
    152162      !!--------------------------------------------------------------------- 
    153163 
    … …  
    161171      jj_off = INT ( (jpjglo - ny_global) / 2 ) 
    162172 
     173#if defined key_nemocice_decomp 
     174      ! Pass initial SST from NEMO to CICE so ice is initialised correctly if 
     175      ! there is no restart file. 
     176      ! Values from a CICE restart file would overwrite this 
     177      IF ( .NOT. ln_rstart ) THEN     
     178         CALL nemo2cice( tsn(:,:,1,jp_tem) , sst , 'T' , 1.)  
     179      ENDIF   
     180#endif 
     181 
    163182! Initialize CICE 
    164183      CALL CICE_Initialize 
    165184 
    166185! Do some CICE consistency checks 
    167       IF ( (nsbc == 2) .OR. (nsbc == 5) ) THEN 
     186      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_cpl) ) THEN 
    168187         IF ( calc_strair .OR. calc_Tsfc ) THEN 
    169188            CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' ) 
    170189         ENDIF 
    171       ELSEIF (nsbc == 4) THEN 
     190      ELSEIF (ksbc == jp_core) THEN 
    172191         IF ( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN 
    173192            CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=T and calc_Tsfc=T in ice_in' ) 
    … …  
    190209 
    191210      CALL cice2nemo(aice,fr_i, 'T', 1. ) 
    192       IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN 
     211      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_cpl) ) THEN 
    193212         DO jl=1,ncat 
    194213            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 
    … …  
    218237         snwice_mass_b(:,:) = 0.0_wp         ! no mass exchanges 
    219238      ENDIF 
    220       IF( nn_ice_embd == 2 .AND.          &  ! full embedment (case 2) & no restart :  
    221          &   .NOT.ln_rstart ) THEN           ! deplete the initial ssh belew sea-ice area 
    222          sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 
    223          sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 
    224          ! 
     239      IF( .NOT. ln_rstart ) THEN 
     240         IF( nn_ice_embd == 2 ) THEN            ! full embedment (case 2) deplete the initial ssh below sea-ice area 
     241            sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 
     242            sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 
     243#if defined key_vvl             
     244           ! key_vvl necessary? clem: yes for compilation purpose 
     245            DO jk = 1,jpkm1                     ! adjust initial vertical scale factors 
     246               fse3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
     247               fse3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
     248            ENDDO 
     249            fse3t_a(:,:,:) = fse3t_b(:,:,:) 
     250            ! Reconstruction of all vertical scale factors at now and before time 
     251            ! steps 
     252            ! ============================================================================= 
     253            ! Horizontal scale factor interpolations 
     254            ! -------------------------------------- 
     255            CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' ) 
     256            CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' ) 
     257            CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' ) 
     258            CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' ) 
     259            CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n(:,:,:), 'F' ) 
     260            ! Vertical scale factor interpolations 
     261            ! ------------------------------------ 
     262            CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W'  ) 
     263            CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' ) 
     264            CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' ) 
     265            CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' ) 
     266            CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' ) 
     267            ! t- and w- points depth 
     268            ! ---------------------- 
     269            fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1) 
     270            fsdepw_n(:,:,1) = 0.0_wp 
     271            fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:) 
     272            DO jk = 2, jpk 
     273               fsdept_n(:,:,jk) = fsdept_n(:,:,jk-1) + fse3w_n(:,:,jk) 
     274               fsdepw_n(:,:,jk) = fsdepw_n(:,:,jk-1) + fse3t_n(:,:,jk-1) 
     275               fsde3w_n(:,:,jk) = fsdept_n(:,:,jk  ) - sshn   (:,:) 
     276            END DO 
     277#endif 
     278         ENDIF 
    225279      ENDIF 
    226280  
    … …  
    232286 
    233287    
    234    SUBROUTINE cice_sbc_in (kt, nsbc) 
     288   SUBROUTINE cice_sbc_in (kt, ksbc) 
    235289      !!--------------------------------------------------------------------- 
    236290      !!                    ***  ROUTINE cice_sbc_in  *** 
    … …  
    238292      !!--------------------------------------------------------------------- 
    239293      INTEGER, INTENT(in   ) ::   kt   ! ocean time step 
    240       INTEGER, INTENT(in   ) ::   nsbc ! surface forcing type 
     294      INTEGER, INTENT(in   ) ::   ksbc ! surface forcing type 
    241295 
    242296      INTEGER  ::   ji, jj, jl                   ! dummy loop indices       
    … …  
    262316! forced and coupled case  
    263317 
    264       IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN 
     318      IF ( (ksbc == jp_flx).OR.(ksbc == jp_cpl) ) THEN 
    265319 
    266320         ztmpn(:,:,:)=0.0 
    … …  
    287341 
    288342! Surface downward latent heat flux (CI_5) 
    289          IF (nsbc == 2) THEN 
     343         IF (ksbc == jp_flx) THEN 
    290344            DO jl=1,ncat 
    291345               ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl) 
    … …  
    316370! GBM conductive flux through ice (CI_6) 
    317371!  Convert to GBM 
    318             IF (nsbc == 2) THEN 
     372            IF (ksbc == jp_flx) THEN 
    319373               ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl) 
    320374            ELSE 
    … …  
    325379! GBM surface heat flux (CI_7) 
    326380!  Convert to GBM 
    327             IF (nsbc == 2) THEN 
     381            IF (ksbc == jp_flx) THEN 
    328382               ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl)  
    329383            ELSE 
    … …  
    333387         ENDDO 
    334388 
    335       ELSE IF (nsbc == 4) THEN 
     389      ELSE IF (ksbc == jp_core) THEN 
    336390 
    337391! Pass CORE forcing fields to CICE (which will calculate heat fluxes etc itself) 
    … …  
    375429 
    376430! Snowfall 
    377 ! Ensure fsnow is positive (as in CICE routine prepare_forcing)   
     431! Ensure fsnow is positive (as in CICE routine prepare_forcing) 
     432      CALL iom_put('snowpre',MAX( (1.0-fr_i(:,:))*sprecip(:,:) ,0.0)) !!Joakim edit   
    378433      ztmp(:,:)=MAX(fr_i(:,:)*sprecip(:,:),0.0)   
    379434      CALL nemo2cice(ztmp,fsnow,'T', 1. )  
    380435 
    381436! Rainfall 
     437      CALL iom_put('precip', (1.0-fr_i(:,:))*(tprecip(:,:)-sprecip(:,:)) ) !!Joakim edit 
    382438      ztmp(:,:)=fr_i(:,:)*(tprecip(:,:)-sprecip(:,:)) 
    383439      CALL nemo2cice(ztmp,frain,'T', 1. )  
    … …  
    458514 
    459515 
    460    SUBROUTINE cice_sbc_out (kt,nsbc) 
     516   SUBROUTINE cice_sbc_out (kt,ksbc) 
    461517      !!--------------------------------------------------------------------- 
    462518      !!                    ***  ROUTINE cice_sbc_out  *** 
    … …  
    464520      !!--------------------------------------------------------------------- 
    465521      INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
    466       INTEGER, INTENT( in  ) ::   nsbc ! surface forcing type 
     522      INTEGER, INTENT( in  ) ::   ksbc ! surface forcing type 
    467523       
    468524      INTEGER  ::   ji, jj, jl                 ! dummy loop indices 
    … …  
    510566! Freshwater fluxes  
    511567 
    512       IF (nsbc == 2) THEN 
     568      IF (ksbc == jp_flx) THEN 
    513569! Note that emp from the forcing files is evap*(1-aice)-(tprecip-aice*sprecip) 
    514570! What we want here is evap*(1-aice)-tprecip*(1-aice) hence manipulation below 
    … …  
    516572! Better to use evap and tprecip? (but for now don't read in evap in this case) 
    517573         emp(:,:)  = emp(:,:)+fr_i(:,:)*(tprecip(:,:)-sprecip(:,:)) 
    518       ELSE IF (nsbc == 4) THEN 
     574      ELSE IF (ksbc == jp_core) THEN 
    519575         emp(:,:)  = (1.0-fr_i(:,:))*emp(:,:)         
    520       ELSE IF (nsbc ==5) THEN 
     576      ELSE IF (ksbc == jp_cpl) THEN 
    521577! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above)  
    522578! This is currently as required with the coupling fields from the UM atmosphere 
    … …  
    524580      ENDIF 
    525581 
     582#if defined key_cice4 
    526583      CALL cice2nemo(fresh_gbm,ztmp1,'T', 1. ) 
    527584      CALL cice2nemo(fsalt_gbm,ztmp2,'T', 1. ) 
     585#else 
     586      CALL cice2nemo(fresh_ai,ztmp1,'T', 1. ) 
     587      CALL cice2nemo(fsalt_ai,ztmp2,'T', 1. ) 
     588#endif 
    528589 
    529590! Check to avoid unphysical expression when ice is forming (ztmp1 negative) 
    … …  
    535596      sfx(:,:)=ztmp2(:,:)*1000.0 
    536597      emp(:,:)=emp(:,:)-ztmp1(:,:) 
    537   
     598      fmmflx(:,:) = ztmp1(:,:) !!Joakim edit 
     599       
    538600      CALL lbc_lnk( emp , 'T', 1. ) 
    539601      CALL lbc_lnk( sfx , 'T', 1. ) 
    … …  
    543605! Scale qsr and qns according to ice fraction (bulk formulae only) 
    544606 
    545       IF (nsbc == 4) THEN 
     607      IF (ksbc == jp_core) THEN 
    546608         qsr(:,:)=qsr(:,:)*(1.0-fr_i(:,:)) 
    547609         qns(:,:)=qns(:,:)*(1.0-fr_i(:,:)) 
    548610      ENDIF 
    549611! Take into account snow melting except for fully coupled when already in qns_tot 
    550       IF (nsbc == 5) THEN 
     612      IF (ksbc == jp_cpl) THEN 
    551613         qsr(:,:)= qsr_tot(:,:) 
    552614         qns(:,:)= qns_tot(:,:) 
    … …  
    557619! Now add in ice / snow related terms 
    558620! [fswthru will be zero unless running with calc_Tsfc=T in CICE] 
     621#if defined key_cice4 
    559622      CALL cice2nemo(fswthru_gbm,ztmp1,'T', 1. ) 
     623#else 
     624      CALL cice2nemo(fswthru_ai,ztmp1,'T', 1. ) 
     625#endif 
    560626      qsr(:,:)=qsr(:,:)+ztmp1(:,:) 
    561627      CALL lbc_lnk( qsr , 'T', 1. ) 
    … …  
    567633      ENDDO 
    568634 
     635#if defined key_cice4 
    569636      CALL cice2nemo(fhocn_gbm,ztmp1,'T', 1. ) 
     637#else 
     638      CALL cice2nemo(fhocn_ai,ztmp1,'T', 1. ) 
     639#endif 
    570640      qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp1(:,:) 
    571641 
    … …  
    575645 
    576646      CALL cice2nemo(aice,fr_i,'T', 1. ) 
    577       IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN 
     647      IF ( (ksbc == jp_flx).OR.(ksbc == jp_cpl) ) THEN 
    578648         DO jl=1,ncat 
    579649            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 
    … …  
    611681 
    612682 
    613 #if defined key_oasis3 || defined key_oasis4 
    614683   SUBROUTINE cice_sbc_hadgam( kt ) 
    615684      !!--------------------------------------------------------------------- 
    … …  
    653722   END SUBROUTINE cice_sbc_hadgam 
    654723 
    655 #else 
    656    SUBROUTINE cice_sbc_hadgam( kt )    ! Dummy routine 
    657       INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
    658       WRITE(*,*) 'cice_sbc_hadgam: You should not have seen this print! error?' 
    659    END SUBROUTINE cice_sbc_hadgam 
    660 #endif 
    661724 
    662725   SUBROUTINE cice_sbc_final 
    … …  
    713776      IF( kt == nit000 ) THEN                   !  First call kt=nit000  ! 
    714777         !                                      ! ====================== ! 
     778         ! namsbc_cice is not yet in the reference namelist 
     779         ! set file information (default values) 
     780         cn_dir = './'       ! directory in which the model is executed 
     781 
     782         ! (NB: frequency positive => hours, negative => months) 
     783         !            !    file          ! frequency !  variable    ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! landmask 
     784         !            !    name          !  (hours)  !   name       !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! file 
     785         sn_snow = FLD_N( 'snowfall_1m'  ,    -1.    ,  'snowfall'  ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )  
     786         sn_rain = FLD_N( 'rainfall_1m'  ,    -1.    ,  'rainfall'  ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )  
     787         sn_sblm = FLD_N( 'sublim_1m'    ,    -1.    ,  'sublim'    ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    ) 
     788         sn_top1 = FLD_N( 'topmeltn1_1m' ,    -1.    ,  'topmeltn1' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    ) 
     789         sn_top2 = FLD_N( 'topmeltn2_1m' ,    -1.    ,  'topmeltn2' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    ) 
     790         sn_top3 = FLD_N( 'topmeltn3_1m' ,    -1.    ,  'topmeltn3' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    ) 
     791         sn_top4 = FLD_N( 'topmeltn4_1m' ,    -1.    ,  'topmeltn4' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    ) 
     792         sn_top5 = FLD_N( 'topmeltn5_1m' ,    -1.    ,  'topmeltn5' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    ) 
     793         sn_bot1 = FLD_N( 'botmeltn1_1m' ,    -1.    ,  'botmeltn1' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    ) 
     794         sn_bot2 = FLD_N( 'botmeltn2_1m' ,    -1.    ,  'botmeltn2' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    ) 
     795         sn_bot3 = FLD_N( 'botmeltn3_1m' ,    -1.    ,  'botmeltn3' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    ) 
     796         sn_bot4 = FLD_N( 'botmeltn4_1m' ,    -1.    ,  'botmeltn4' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    ) 
     797         sn_bot5 = FLD_N( 'botmeltn5_1m' ,    -1.    ,  'botmeltn5' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    ) 
     798 
    715799         REWIND( numnam_ref )              ! Namelist namsbc_cice in reference namelist :  
    716800         READ  ( numnam_ref, namsbc_cice, IOSTAT = ios, ERR = 901) 
    … …  
    10011085CONTAINS 
    10021086 
    1003    SUBROUTINE sbc_ice_cice ( kt, nsbc )     ! Dummy routine 
     1087   SUBROUTINE sbc_ice_cice ( kt, ksbc )     ! Dummy routine 
    10041088      WRITE(*,*) 'sbc_ice_cice: You should not have seen this print! error?', kt 
    10051089   END SUBROUTINE sbc_ice_cice 
    10061090 
    1007    SUBROUTINE cice_sbc_init (nsbc)    ! Dummy routine 
     1091   SUBROUTINE cice_sbc_init (ksbc)    ! Dummy routine 
    10081092      WRITE(*,*) 'cice_sbc_init: You should not have seen this print! error?' 
    10091093   END SUBROUTINE cice_sbc_init 

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

    r4624 r4946  
    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_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r4924 r4946  
    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(:,:) * umask(:,:,1)                     ! mean surface ocean current at ice velocity point 
    186136         v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1)                    ! (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_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r4924 r4946  
    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 
    … …  
    130131            DO jj = 2, jpj 
    131132               DO ji = 2, jpi   ! NO vector opt. possible 
    132                   u_oce(ji,jj) = 0.5_wp * ( ssu_m(ji-1,jj  ) * umask(ji-1,jj  ,1) + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj) 
    133                   v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji  ,jj-1) * vmask(ji  ,jj-1,1) + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj) 
     133                  u_oce(ji,jj) = 0.5_wp * ( ssu_m(ji-1,jj  ) * umask(ji-1,jj  ,1) & 
     134                     &           + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj) 
     135                  v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji  ,jj-1) * vmask(ji  ,jj-1,1) & 
     136                     &           + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj) 
    134137               END DO 
    135138            END DO 
    … …  
    144147 
    145148         ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land) 
    146          tfu(:,:) = tfreez( sss_m ) +  rt0  
     149         tfu(:,:) = eos_fzp( sss_m ) +  rt0  
    147150 
    148151         zsist (:,:,1) = sist (:,:) + rt0 * ( 1. - tmask(:,:,1) ) 
    149152 
    150          ! ... ice albedo (clear sky and overcast sky) 
     153         ! Ice albedo 
     154 
    151155         CALL albedo_ice( zsist, reshape( hicif, (/jpi,jpj,1/) ), & 
    152156                                 reshape( hsnif, (/jpi,jpj,1/) ), & 
    153                           zalb_ice_cs, zalb_ice_os ) 
     157                          zalb_cs, zalb_os ) 
     158 
     159         SELECT CASE( ksbc ) 
     160         CASE( jp_core , jp_cpl )   ! CORE and COUPLED bulk formulations 
     161 
     162            ! albedo depends on cloud fraction because of non-linear spectral effects 
     163            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     164            ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo  
     165            ! (zalb_ice) is computed within the bulk routine 
     166 
     167         END SELECT 
    154168 
    155169         ! ... Sea-ice surface boundary conditions output from bulk formulae : 
    … …  
    167181         ! 
    168182         SELECT CASE( ksbc ) 
    169          CASE( 3 )           ! CLIO bulk formulation 
    170             CALL blk_ice_clio( zsist, zalb_ice_cs, zalb_ice_os,                         & 
     183         CASE( jp_clio )           ! CLIO bulk formulation 
     184            CALL blk_ice_clio( zsist, zalb_cs    , zalb_os    , zalb_ice   ,            & 
    171185               &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   & 
    172186               &                      qla_ice    , dqns_ice   , dqla_ice   ,            & 
    … …  
    174188               &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  ) 
    175189 
    176          CASE( 4 )           ! CORE bulk formulation 
    177             CALL blk_ice_core( zsist, u_ice      , v_ice      , zalb_ice_cs,            & 
     190         CASE( jp_core )           ! CORE bulk formulation 
     191            CALL blk_ice_core( zsist, u_ice      , v_ice      , zalb_ice   ,            & 
    178192               &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   & 
    179193               &                      qla_ice    , dqns_ice   , dqla_ice   ,            & 
    180194               &                      tprecip    , sprecip    ,                         & 
    181195               &                      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) 
     196            IF( ltrcdm2dc_ice )   CALL blk_ice_meanqsr( zalb_ice, qsr_ice_mean, jpl ) 
     197 
     198         CASE( jp_cpl )            ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 
    185199            CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 
    186200         END SELECT 
    … …  
    213227#endif 
    214228         END IF 
    215 #if defined key_coupled 
    216229         !                                             ! Ice surface fluxes in coupled mode  
    217          IF( ksbc == 5 )   THEN 
     230         IF( ksbc == jp_cpl )   THEN 
    218231            a_i(:,:,1)=fr_i 
    219232            CALL sbc_cpl_ice_flx( frld,                                              & 
    220233            !                                optional arguments, used only in 'mixed oce-ice' case 
    221             &                                             palbi = zalb_ice_cs, psst = sst_m, pist = zsist ) 
     234            &                                             palbi = zalb_ice, psst = sst_m, pist = zsist ) 
    222235            sprecip(:,:) = - emp_ice(:,:)   ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.) 
    223236         ENDIF 
    224 #endif 
    225237                           CALL lim_thd_2      ( kt )      ! Ice thermodynamics  
    226238                           CALL lim_sbc_flx_2  ( kt )      ! update surface ocean mass, heat & salt fluxes  
    … …  
    252264      IF( ln_limdyn    )   CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents 
    253265      ! 
    254       CALL wrk_dealloc( jpi,jpj,1, zalb_ice_os, zalb_ice_cs, zsist ) 
     266      CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 
    255267      ! 
    256268   END SUBROUTINE sbc_ice_lim_2 

  • branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90

    r4938 r4946  
    5454   REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  risfLeff               !:effective length (Leff) BG03 nn_isf==2 
    5555   REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  ttbl, stbl, utbl, vtbl !:top boundary layer variable at T point 
    56    INTEGER(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  misfkt, misfkb         !:Level of ice shelf base 
     56#ifdef key_agrif 
     57   ! AGRIF can not handle these arrays as integers. The reason is a mystery but problems avoided by declaring them as reals 
     58   REAL(wp),    PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  misfkt, misfkb         !:Level of ice shelf base 
    5759                                                                                          !: (first wet level and last level include in the tbl) 
     60#else 
     61   INTEGER,    PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  misfkt, misfkb         !:Level of ice shelf base 
     62#endif 
     63 
    5864 
    5965   REAL(wp), PUBLIC, SAVE ::   rcpi   = 2000.0_wp     ! phycst ? 
    … …  
    303309      sbc_isf_alloc = 0       ! set to zero if no array to be allocated 
    304310      IF( .NOT. ALLOCATED( qisf ) ) THEN 
    305          ALLOCATE(  risf_tsc(jpi,jpj,jpts), risf_tsc_b(jpi,jpj,jpts), qisf(jpi,jpj), fwfisf(jpi,jpj), & 
    306                &    fwfisf_b(jpi,jpj), misfkt(jpi,jpj), rhisf_tbl(jpi,jpj), r1_hisf_tbl(jpi,jpj),     & 
    307                &    rzisf_tbl(jpi,jpj), misfkb(jpi,jpj), ttbl(jpi,jpj), stbl(jpi,jpj), utbl(jpi,jpj), & 
    308                &    vtbl(jpi, jpj), risfLeff(jpi,jpj), rhisf_tbl_0(jpi,jpj), ralpha(jpi,jpj), STAT= sbc_isf_alloc ) 
     311         ALLOCATE(  risf_tsc(jpi,jpj,jpts), risf_tsc_b(jpi,jpj,jpts)              , & 
     312               &    qisf(jpi,jpj)     , fwfisf(jpi,jpj)     , fwfisf_b(jpi,jpj)   , & 
     313               &    rhisf_tbl(jpi,jpj), r1_hisf_tbl(jpi,jpj), rzisf_tbl(jpi,jpj)  , & 
     314               &    ttbl(jpi,jpj)     , stbl(jpi,jpj)       , utbl(jpi,jpj)       , & 
     315               &    vtbl(jpi, jpj)    , risfLeff(jpi,jpj)   , rhisf_tbl_0(jpi,jpj), & 
     316               &    ralpha(jpi,jpj)   , misfkt(jpi,jpj)     , misfkb(jpi,jpj)     , & 
     317               &    STAT= sbc_isf_alloc ) 
    309318         ! 
    310319         IF( lk_mpp                  )   CALL mpp_sum ( sbc_isf_alloc ) 
    … …  
    363372             ! Calculate freezing temperature 
    364373                zpress = grav*rau0*fsdept(ji,jj,ik)*1.e-04  
    365                 zt_frz = tfreez1D(tsb(ji,jj,ik,jp_sal), zpress)  
     374                zt_frz = eos_fzp(tsb(ji,jj,ik,jp_sal), zpress)  
    366375                zt_sum = zt_sum + (tsn(ji,jj,ik,jp_tem)-zt_frz) * fse3t(ji,jj,ik) * tmask(ji,jj,ik)  ! sum temp 
    367376             ENDDO 
    … …  
    445454      zti(:,:)=tinsitu( ttbl, stbl, zpress ) 
    446455! Calculate freezing temperature 
    447       zfrz(:,:)=tfreez( sss_m(:,:), zpress ) 
     456      zfrz(:,:)=eos_fzp( sss_m(:,:), zpress ) 
    448457 
    449458       
    … …  
    526535                     nit = nit + 1 
    527536                     IF (nit .GE. 51) THEN 
    528                         WRITE(numout,*) "sbcisf : too many iteration ... ", zhtflx, zhtflx_b, zgammat, zgammas, nn_gammablk, ji, jj, mikt(ji,jj), narea 
     537                        WRITE(numout,*) "sbcisf : too many iteration ... ", & 
     538                            &  zhtflx, zhtflx_b, zgammat, zgammas, nn_gammablk, ji, jj, mikt(ji,jj), narea 
    529539                        CALL ctl_stop( 'STOP', 'sbc_isf_hol99 : too many iteration ...' ) 
    530540                     END IF 
    … …  
    584594      REAL(wp) :: zgmolet, zgmoles, zgturb   ! contribution of modelecular sublayer and turbulence  
    585595      REAL(wp) :: zcoef                      ! temporary coef 
    586       REAL(wp) :: zrhos, zalbet, zbeta, zthermal, zhalin 
    587       REAL(wp) :: zt, zs, zh 
     596      REAL(wp) :: zdep 
    588597      REAL(wp), PARAMETER :: zxsiN = 0.052   ! dimensionless constant 
    589598      REAL(wp), PARAMETER :: epsln = 1.0e-20 ! a small positive number 
    590599      REAL(wp), PARAMETER :: znu   = 1.95e-6 ! kinamatic viscosity of sea water (m2.s-1) 
    591600      REAL(wp) ::   rcs      = 1.0e-3_wp        ! conversion: mm/s ==> m/s 
     601      REAL(wp), DIMENSION(2) :: zts, zab 
    592602      !!--------------------------------------------------------------------- 
    593603      ! 
    … …  
    656666 
    657667      !! compute bouyancy  
    658                IF( nn_eos < 1) THEN 
    659                   zt     = ttbl(ji,jj) 
    660                   zs     = stbl(ji,jj) - 35.0 
    661                   zh     = fsdepw(ji,jj,ikt) 
    662                   !  potential volumic mass 
    663                   zrhos  = rhop(ji,jj,ikt) 
    664                   zalbet = ( ( ( - 0.255019e-07 * zt + 0.298357e-05 ) * zt   &   ! ratio alpha/beta 
    665                      &                               - 0.203814e-03 ) * zt   & 
    666                      &                               + 0.170907e-01 ) * zt   & 
    667                      &   + 0.665157e-01                                      & 
    668                      &   +     ( - 0.678662e-05 * zs                         & 
    669                      &           - 0.846960e-04 * zt + 0.378110e-02 ) * zs   & 
    670                      &   +   ( ( - 0.302285e-13 * zh                         & 
    671                      &           - 0.251520e-11 * zs                         & 
    672                      &           + 0.512857e-12 * zt * zt           ) * zh   & 
    673                      &           - 0.164759e-06 * zs                         & 
    674                      &        +(   0.791325e-08 * zt - 0.933746e-06 ) * zt   & 
    675                      &                               + 0.380374e-04 ) * zh 
    676  
    677                   zbeta  = ( ( -0.415613e-09 * zt + 0.555579e-07 ) * zt      &   ! beta 
    678                      &                            - 0.301985e-05 ) * zt      & 
    679                      &   + 0.785567e-03                                      & 
    680                      &   + (     0.515032e-08 * zs                           & 
    681                      &         + 0.788212e-08 * zt - 0.356603e-06 ) * zs     & 
    682                      &   +(  (   0.121551e-17 * zh                           & 
    683                      &         - 0.602281e-15 * zs                           & 
    684                      &         - 0.175379e-14 * zt + 0.176621e-12 ) * zh     & 
    685                      &                             + 0.408195e-10   * zs     & 
    686                      &     + ( - 0.213127e-11 * zt + 0.192867e-09 ) * zt     & 
    687                      &                             - 0.121555e-07 ) * zh 
    688  
    689                   zthermal = zbeta * zalbet / ( rcp * zrhos + epsln ) 
    690                   zhalin   = zbeta * stbl(ji,jj) * rcs 
    691                ELSE 
    692                   zrhos    = rhop(ji,jj,ikt) + rau0 * ( 1. - tmask(ji,jj,ikt) ) 
    693                   zthermal = rn_alpha / ( rcp * zrhos + epsln ) 
    694                   zhalin   = rn_beta * stbl(ji,jj) * rcs 
    695                ENDIF 
     668               zts(jp_tem) = ttbl(ji,jj) 
     669               zts(jp_sal) = stbl(ji,jj) 
     670               zdep        = fsdepw(ji,jj,ikt) 
     671               ! 
     672               CALL eos_rab( zts, zdep, zab ) 
     673                  ! 
    696674      !! compute length scale  
    697                zbuofdep = grav * ( zthermal * zqhisf - zhalin * zqwisf )  !!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     675               zbuofdep = grav * ( zab(jp_tem) * zqhisf - zab(jp_sal) * zqwisf )  !!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    698676 
    699677      !! compute Monin Obukov Length 
    … …  
    766744               ! level partially include in ice shelf boundary layer  
    767745               zhk = SUM( fse3t_n(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj) 
    768                IF (cptin == 'T') varout(ji,jj) = varout(ji,jj) + varin(ji,jj,ikb) * (1._wp - zhk) 
    769                IF (cptin == 'U') varout(ji,jj) = varout(ji,jj) + 0.5_wp * (varin(ji,jj,ikb) + varin(ji-1,jj,ikb)) * (1._wp - zhk) 
    770                IF (cptin == 'V') varout(ji,jj) = varout(ji,jj) + 0.5_wp * (varin(ji,jj,ikb) + varin(ji,jj-1,ikb)) * (1._wp - zhk) 
     746               IF (cptin == 'T') & 
     747                   &  varout(ji,jj) = varout(ji,jj) + varin(ji,jj,ikb) * (1._wp - zhk) 
     748               IF (cptin == 'U') & 
     749                   &  varout(ji,jj) = varout(ji,jj) + 0.5_wp * (varin(ji,jj,ikb) + varin(ji-1,jj,ikb)) * (1._wp - zhk) 
     750               IF (cptin == 'V') & 
     751                   &  varout(ji,jj) = varout(ji,jj) + 0.5_wp * (varin(ji,jj,ikb) + varin(ji,jj-1,ikb)) * (1._wp - zhk) 
    771752            END IF 
    772753         END DO 
    … …  
    796777      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phdivn   ! horizontal divergence 
    797778      !! 
    798       INTEGER(wp)  ::   ji, jj, jk   ! dummy loop indices 
    799       INTEGER(wp)  ::   ikt, ikb  
    800       INTEGER(wp)  ::   nk_isf 
     779      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     780      INTEGER  ::   ikt, ikb  
     781      INTEGER  ::   nk_isf 
    801782      REAL(wp)     ::   zhk, z1_hisf_tbl, zhisf_tbl 
    802783      REAL(wp)     ::   zfact     ! local scalar 
    … …  
    834815               ! level fully include in the ice shelf boundary layer 
    835816               DO jk = ikt, ikb - 1 
    836                   phdivn(ji,jj,jk) = phdivn(ji,jj,jk) + ( fwfisf(ji,jj) + fwfisf_b(ji,jj) ) * r1_hisf_tbl(ji,jj) * r1_rau0 * zfact 
     817                  phdivn(ji,jj,jk) = phdivn(ji,jj,jk) + ( fwfisf(ji,jj) + fwfisf_b(ji,jj) ) & 
     818                    &               * r1_hisf_tbl(ji,jj) * r1_rau0 * zfact 
    837819               END DO 
    838820               ! level partially include in ice shelf boundary layer  
    839                phdivn(ji,jj,ikb) = phdivn(ji,jj,ikb) + ( fwfisf(ji,jj) + fwfisf_b(ji,jj) ) * r1_hisf_tbl(ji,jj) * r1_rau0 * zfact * ralpha(ji,jj)  
     821               phdivn(ji,jj,ikb) = phdivn(ji,jj,ikb) + ( fwfisf(ji,jj) & 
     822                  &             + fwfisf_b(ji,jj) ) * r1_hisf_tbl(ji,jj) * r1_rau0 * zfact * ralpha(ji,jj)  
    840823            !==   ice shelf melting mass distributed over several levels   ==! 
    841824         END DO 

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

    r4924 r4946  
    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 
    … …  
    8382      INTEGER ::   icpt   ! local integer 
    8483      !! 
    85       NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx,  ln_blk_clio, ln_blk_core, ln_cpl,   & 
     84      NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx,  ln_blk_clio, ln_blk_core,           & 
    8685         &             ln_blk_mfs, ln_apr_dyn, nn_ice,  nn_ice_embd, ln_dm2dc   , ln_rnf,   & 
    87          &             ln_ssr    , nn_isf    , nn_fwb,  ln_cdgw    , ln_wave    , ln_sdw, nn_lsm, cn_iceflx 
     86         &             ln_ssr    ,  nn_isf , nn_fwb    , ln_cdgw , ln_wave , ln_sdw, nn_lsm, nn_limflx 
    8887      INTEGER  ::   ios 
    8988      !!---------------------------------------------------------------------- 
    … …  
    124123         WRITE(numout,*) '              CORE bulk  formulation                     ln_blk_core = ', ln_blk_core 
    125124         WRITE(numout,*) '              MFS  bulk  formulation                     ln_blk_mfs  = ', ln_blk_mfs 
    126          WRITE(numout,*) '              coupled    formulation (T if key_sbc_cpl)  ln_cpl      = ', ln_cpl 
    127          WRITE(numout,*) '              Flux handling over ice categories          cn_iceflx   = ', TRIM (cn_iceflx) 
     125         WRITE(numout,*) '              coupled    formulation (T if key_oasis3)   lk_cpl      = ', lk_cpl 
     126         WRITE(numout,*) '              Multicategory heat flux formulation (LIM3) nn_limflx   = ', nn_limflx 
    128127         WRITE(numout,*) '           Misc. options of sbc : ' 
    129128         WRITE(numout,*) '              Patm gradient added in ocean & ice Eqs.    ln_apr_dyn  = ', ln_apr_dyn 
    … …  
    139138      ENDIF 
    140139 
    141       !   Flux handling over ice categories 
    142 #if defined key_coupled  
    143       SELECT CASE ( TRIM (cn_iceflx)) 
    144       CASE ('ave') 
    145          ln_iceflx_ave    = .TRUE. 
    146          ln_iceflx_linear = .FALSE. 
    147       CASE ('linear') 
    148          ln_iceflx_ave    = .FALSE. 
    149          ln_iceflx_linear = .TRUE. 
    150       CASE default 
    151          ln_iceflx_ave    = .FALSE. 
    152          ln_iceflx_linear = .FALSE. 
     140      ! LIM3 Multi-category heat flux formulation 
     141      SELECT CASE ( nn_limflx) 
     142      CASE ( -1 ) 
     143         IF(lwp) WRITE(numout,*) '              Use of per-category fluxes (nn_limflx = -1) ' 
     144      CASE ( 0  ) 
     145         IF(lwp) WRITE(numout,*) '              Average per-category fluxes (nn_limflx = 0) '  
     146      CASE ( 1  ) 
     147         IF(lwp) WRITE(numout,*) '              Average then redistribute per-category fluxes (nn_limflx = 1) ' 
     148      CASE ( 2  ) 
     149         IF(lwp) WRITE(numout,*) '              Redistribute a single flux over categories (nn_limflx = 2) ' 
    153150      END SELECT 
    154       IF(lwp) WRITE(numout,*) '              Fluxes averaged over all ice categories         ln_iceflx_ave    = ', ln_iceflx_ave 
    155       IF(lwp) WRITE(numout,*) '              Fluxes distributed linearly over ice categories ln_iceflx_linear = ', ln_iceflx_linear 
    156 #endif 
    157151      ! 
    158152#if defined key_top && ! defined key_offline 
    … …  
    214208      IF( ( nn_ice == 3 .OR. nn_ice == 4 ) .AND. nn_ice_embd == 0 )   & 
    215209         &   CALL ctl_stop( 'LIM3 and CICE sea-ice models require nn_ice_embd = 1 or 2' ) 
    216 #if defined key_coupled 
    217       IF( ln_iceflx_ave .AND. ln_iceflx_linear ) & 
    218          &   CALL ctl_stop( ' ln_iceflx_ave and ln_iceflx_linear options are not compatible' ) 
    219       IF( ( nn_ice ==3 .AND. lk_cpl) .AND. .NOT. ( ln_iceflx_ave .OR. ln_iceflx_linear ) ) & 
    220          &   CALL ctl_stop( ' With lim3 coupled, either ln_iceflx_ave or ln_iceflx_linear must be set to .TRUE.' ) 
    221 #endif       
     210      IF( ( nn_ice /= 3 ) .AND. ( nn_limflx >= 0 ) )   & 
     211         &   WRITE(numout,*) 'The nn_limflx>=0 option has no effect if sea ice model is not LIM3' 
     212      IF( ( nn_ice == 3 ) .AND. ( lk_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) )   & 
     213         &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' ) 
     214      IF( ( nn_ice == 3 ) .AND. ( .NOT. lk_cpl ) .AND. ( nn_limflx == 2 ) )   & 
     215         &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in forced mode cannot be 2' ) 
     216 
    222217      IF( ln_dm2dc )   nday_qsr = -1   ! initialisation flag 
    223218 
    … …  
    244239      !                          ! Choice of the Surface Boudary Condition (set nsbc) 
    245240      icpt = 0 
    246       IF( ln_ana          ) THEN   ;   nsbc =  1   ; icpt = icpt + 1   ;   ENDIF       ! analytical      formulation 
    247       IF( ln_flx          ) THEN   ;   nsbc =  2   ; icpt = icpt + 1   ;   ENDIF       ! flux            formulation 
    248       IF( ln_blk_clio     ) THEN   ;   nsbc =  3   ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk       formulation 
    249       IF( ln_blk_core     ) THEN   ;   nsbc =  4   ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk       formulation 
    250       IF( ln_blk_mfs      ) THEN   ;   nsbc =  6   ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk       formulation 
    251       IF( ln_cpl          ) THEN   ;   nsbc =  5   ; icpt = icpt + 1   ;   ENDIF       ! Coupled         formulation 
    252       IF( cp_cfg == 'gyre') THEN   ;   nsbc =  0                       ;   ENDIF       ! GYRE analytical formulation 
    253       IF( lk_esopa        )            nsbc = -1                                       ! esopa test, ALL formulations 
     241      IF( ln_ana          ) THEN   ;   nsbc = jp_ana    ; icpt = icpt + 1   ;   ENDIF       ! analytical      formulation 
     242      IF( ln_flx          ) THEN   ;   nsbc = jp_flx    ; icpt = icpt + 1   ;   ENDIF       ! flux            formulation 
     243      IF( ln_blk_clio     ) THEN   ;   nsbc = jp_clio   ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk       formulation 
     244      IF( ln_blk_core     ) THEN   ;   nsbc = jp_core   ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk       formulation 
     245      IF( ln_blk_mfs      ) THEN   ;   nsbc = jp_mfs    ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk       formulation 
     246      IF( lk_cpl          ) THEN   ;   nsbc = jp_cpl    ; icpt = icpt + 1   ;   ENDIF       ! Coupled         formulation 
     247      IF( cp_cfg == 'gyre') THEN   ;   nsbc = jp_gyre                       ;   ENDIF       ! GYRE analytical formulation 
     248      IF( lk_esopa        )            nsbc = jp_esopa                                      ! esopa test, ALL formulations 
    254249      ! 
    255250      IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN 
    … …  
    262257      IF(lwp) THEN 
    263258         WRITE(numout,*) 
    264          IF( nsbc == -1 )   WRITE(numout,*) '              ESOPA test All surface boundary conditions' 
    265          IF( nsbc ==  0 )   WRITE(numout,*) '              GYRE analytical formulation' 
    266          IF( nsbc ==  1 )   WRITE(numout,*) '              analytical formulation' 
    267          IF( nsbc ==  2 )   WRITE(numout,*) '              flux formulation' 
    268          IF( nsbc ==  3 )   WRITE(numout,*) '              CLIO bulk formulation' 
    269          IF( nsbc ==  4 )   WRITE(numout,*) '              CORE bulk formulation' 
    270          IF( nsbc ==  5 )   WRITE(numout,*) '              coupled formulation' 
    271          IF( nsbc ==  6 )   WRITE(numout,*) '              MFS Bulk formulation' 
    272       ENDIF 
    273       ! 
    274                           CALL sbc_ssm_init               ! Sea-surface mean fields initialisation 
    275       ! 
    276       IF( ln_ssr      )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation 
    277       ! 
    278       IF( nn_ice == 4 )   CALL cice_sbc_init( nsbc )      ! CICE initialisation 
    279       ! 
     259         IF( nsbc == jp_esopa )   WRITE(numout,*) '              ESOPA test All surface boundary conditions' 
     260         IF( nsbc == jp_gyre  )   WRITE(numout,*) '              GYRE analytical formulation' 
     261         IF( nsbc == jp_ana   )   WRITE(numout,*) '              analytical formulation' 
     262         IF( nsbc == jp_flx   )   WRITE(numout,*) '              flux formulation' 
     263         IF( nsbc == jp_clio  )   WRITE(numout,*) '              CLIO bulk formulation' 
     264         IF( nsbc == jp_core  )   WRITE(numout,*) '              CORE bulk formulation' 
     265         IF( nsbc == jp_cpl   )   WRITE(numout,*) '              coupled formulation' 
     266         IF( nsbc == jp_mfs   )   WRITE(numout,*) '              MFS Bulk formulation' 
     267      ENDIF 
     268      ! 
     269                               CALL sbc_ssm_init               ! Sea-surface mean fields initialisation 
     270      ! 
     271      IF( ln_ssr           )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation 
     272      ! 
     273      IF( nn_ice == 4      )   CALL cice_sbc_init( nsbc )      ! CICE initialisation 
     274      ! 
     275      IF( nsbc   == jp_cpl )   CALL sbc_cpl_init (nn_ice)      ! OASIS initialisation. must be done before first time step 
     276 
    280277   END SUBROUTINE sbc_init 
    281278 
    … …  
    328325      SELECT CASE( nsbc )                                ! Compute ocean surface boundary condition 
    329326      !                                                  ! (i.e. utau,vtau, qns, qsr, emp, sfx) 
    330       CASE(  0 )   ;   CALL sbc_gyre    ( kt )                    ! analytical formulation : GYRE configuration 
    331       CASE(  1 )   ;   CALL sbc_ana     ( kt )                    ! analytical formulation : uniform sbc 
    332       CASE(  2 )   ;   CALL sbc_flx     ( kt )                    ! flux formulation 
    333       CASE(  3 )   ;   CALL sbc_blk_clio( kt )                    ! bulk formulation : CLIO for the ocean 
    334       CASE(  4 )   ;   CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean 
    335       CASE(  5 )   ;   CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! coupled formulation 
    336       CASE(  6 )   ;   CALL sbc_blk_mfs ( kt )                    ! bulk formulation : MFS for the ocean 
    337       CASE( -1 )                                 
    338                        CALL sbc_ana     ( kt )                    ! ESOPA, test ALL the formulations 
    339                        CALL sbc_gyre    ( kt )                    ! 
    340                        CALL sbc_flx     ( kt )                    ! 
    341                        CALL sbc_blk_clio( kt )                    ! 
    342                        CALL sbc_blk_core( kt )                    ! 
    343                        CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! 
     327      CASE( jp_gyre )   ;   CALL sbc_gyre    ( kt )                    ! analytical formulation : GYRE configuration 
     328      CASE( jp_ana  )   ;   CALL sbc_ana     ( kt )                    ! analytical formulation : uniform sbc 
     329      CASE( jp_flx  )   ;   CALL sbc_flx     ( kt )                    ! flux formulation 
     330      CASE( jp_clio )   ;   CALL sbc_blk_clio( kt )                    ! bulk formulation : CLIO for the ocean 
     331      CASE( jp_core )   ;   CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean 
     332      CASE( jp_cpl  )   ;   CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! coupled formulation 
     333      CASE( jp_mfs  )   ;   CALL sbc_blk_mfs ( kt )                    ! bulk formulation : MFS for the ocean 
     334      CASE( jp_esopa )                                 
     335                             CALL sbc_ana     ( kt )                    ! ESOPA, test ALL the formulations 
     336                             CALL sbc_gyre    ( kt )                    ! 
     337                             CALL sbc_flx     ( kt )                    ! 
     338                             CALL sbc_blk_clio( kt )                    ! 
     339                             CALL sbc_blk_core( kt )                    ! 
     340                             CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! 
    344341      END SELECT 
    345342 
    … …  
    350347      CASE(  2 )   ;         CALL sbc_ice_lim_2( kt, nsbc )          ! LIM-2 ice model 
    351348      CASE(  3 )   ;         CALL sbc_ice_lim  ( kt, nsbc )          ! LIM-3 ice model 
    352       !is it useful? 
    353349      CASE(  4 )   ;         CALL sbc_ice_cice ( kt, nsbc )          ! CICE ice model 
    354350      END SELECT                                               
    … …  
    424420         CALL iom_put( "qsr"   ,       qsr  )                   ! solar heat flux 
    425421         IF( nn_ice > 0 )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction  
     422         CALL iom_put( "taum"  , taum       )                   ! wind stress module  
     423         CALL iom_put( "wspd"  , wndm       )                   ! wind speed  module over free ocean or leads in presence of sea-ice 
    426424      ENDIF 
    427425      ! 
    428426      CALL iom_put( "utau", utau )   ! i-wind stress   (stress can be updated at  
    429427      CALL iom_put( "vtau", vtau )   ! j-wind stress    each time step in sea-ice) 
    430       CALL iom_put( "taum", taum )   ! wind stress module  
    431       CALL iom_put( "wspd", wndm )   ! wind speed  module  
    432428      ! 
    433429      IF(ln_ctl) THEN         ! print mean trends (used for debugging) 

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

    r4666 r4946  
    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 
    … …  
    5455      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    5556      ! 
    56       INTEGER  ::   ji,jj               ! loop index 
     57      INTEGER  ::   ji, jj               ! loop index 
    5758      REAL(wp) ::   zcoef, zf_sbc       ! local scalar 
     59      REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts 
     60      REAL(wp), DIMENSION(jpi,jpj)      :: zub, zvb,zdep 
    5861      !!--------------------------------------------------------------------- 
     62       
     63      !                                        !* first wet T-, U-, V- ocean level (ISF) variables (T, S, depth, velocity) 
     64      DO jj = 1, jpj 
     65         DO ji = 1, jpi 
     66            zub(ji,jj)        = ub (ji,jj,miku(ji,jj)) 
     67            zvb(ji,jj)        = vb (ji,jj,mikv(ji,jj)) 
     68            zts(ji,jj,jp_tem) = tsn(ji,jj,mikt(ji,jj),jp_tem) 
     69            zts(ji,jj,jp_sal) = tsn(ji,jj,mikt(ji,jj),jp_sal) 
     70         END DO 
     71      END DO 
     72      ! 
     73      IF( lk_vvl ) THEN 
     74         DO jj = 1, jpj 
     75            DO ji = 1, jpi 
     76               zdep(ji,jj) = fse3t_n(ji,jj,mikt(ji,jj)) 
     77            END DO 
     78         END DO 
     79      ENDIF 
    5980      !                                                   ! ---------------------------------------- ! 
    6081      IF( nn_fsbc == 1 ) THEN                             !   Instantaneous surface fields        ! 
    6182         !                                                ! ---------------------------------------- ! 
    62          DO jj = 1, jpj 
    63             DO ji = 1, jpi 
    64                ssu_m(ji,jj) = ub(ji,jj,miku(ji,jj)) 
    65                ssv_m(ji,jj) = vb(ji,jj,mikv(ji,jj)) 
    66                sst_m(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) 
    67                sss_m(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) 
    68                IF( lk_vvl )   fse3t_m(ji,jj) = fse3t_n(ji,jj,mikt(ji,jj)) 
    69             END DO 
    70          END DO 
     83         ssu_m(:,:) = zub(:,:) 
     84         ssv_m(:,:) = zvb(:,:) 
     85         IF( ln_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
     86         ELSE                    ;   sst_m(:,:) = zts(:,:,jp_tem) 
     87         ENDIF 
     88         sss_m(:,:) = zts(:,:,jp_sal) 
    7189         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    7290         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
    7391         ELSE                    ;   ssh_m(:,:) = sshn(:,:) 
    7492         ENDIF 
     93         ! 
     94         IF( lk_vvl )   fse3t_m(:,:) = zdep(:,:) 
    7595         ! 
    7696      ELSE 
    … …  
    81101            IF(lwp) WRITE(numout,*) '~~~~~~~   mean fields initialised to instantaneous values' 
    82102            zcoef = REAL( nn_fsbc - 1, wp ) 
    83             DO jj = 1, jpj 
    84                DO ji = 1, jpi 
    85                   ssu_m(ji,jj) = zcoef * ub(ji,jj,miku(ji,jj)) 
    86                   ssv_m(ji,jj) = zcoef * vb(ji,jj,mikv(ji,jj)) 
    87                   sst_m(ji,jj) = zcoef * tsn(ji,jj,mikt(ji,jj),jp_tem) 
    88                   sss_m(ji,jj) = zcoef * tsn(ji,jj,mikt(ji,jj),jp_sal) 
    89                   IF( lk_vvl )   fse3t_m(ji,jj) = zcoef * fse3t_n(ji,jj,mikt(ji,jj)) 
    90                END DO 
    91             END DO 
    92             !                          ! removed inverse barometer ssh when Patm forcing is used  
     103            ssu_m(:,:) = zcoef * zub(:,:) 
     104            ssv_m(:,:) = zcoef * zvb(:,:) 
     105            IF( ln_useCT )  THEN    ;   sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
     106            ELSE                    ;   sst_m(:,:) = zcoef * zts(:,:,jp_tem) 
     107            ENDIF 
     108            sss_m(:,:) = zcoef * zts(:,:,jp_sal) 
     109            !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    93110            IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 
    94             ELSE                    ;   ssh_m(:,:) = zcoef *   sshn(:,:) 
     111            ELSE                    ;   ssh_m(:,:) = zcoef * sshn(:,:) 
    95112            ENDIF 
     113            ! 
     114            IF( lk_vvl )   fse3t_m(:,:) = zcoef * zdep(:,:) 
    96115            !                                             ! ---------------------------------------- ! 
    97116         ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN      !   Initialisation: New mean computation   ! 
    … …  
    107126         !                                                !        Cumulate at each time step        ! 
    108127         !                                                ! ---------------------------------------- ! 
    109          DO jj = 1, jpj 
    110             DO ji = 1, jpi 
    111                ssu_m(ji,jj) = ssu_m(ji,jj) + ub(ji,jj,miku(ji,jj)) 
    112                ssv_m(ji,jj) = ssv_m(ji,jj) + vb(ji,jj,mikv(ji,jj)) 
    113                sst_m(ji,jj) = sst_m(ji,jj) + tsn(ji,jj,mikt(ji,jj),jp_tem) 
    114                sss_m(ji,jj) = sss_m(ji,jj) + tsn(ji,jj,mikt(ji,jj),jp_sal) 
    115                IF( lk_vvl )   fse3t_m(ji,jj) = fse3t_m(ji,jj) + fse3t_n(ji,jj,mikt(ji,jj)) 
    116             END DO 
    117          END DO 
    118 !                                   ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    119          IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 *  ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
     128         ssu_m(:,:) = ssu_m(:,:) + zub(:,:) 
     129         ssv_m(:,:) = ssv_m(:,:) + zvb(:,:) 
     130         IF( ln_useCT )  THEN    ;   sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
     131         ELSE                    ;   sst_m(:,:) = sst_m(:,:) + zts(:,:,jp_tem) 
     132         ENDIF 
     133         sss_m(:,:) = sss_m(:,:) + zts(:,:,jp_sal) 
     134         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
     135         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
    120136         ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) 
    121137         ENDIF 
     138         ! 
     139         IF( lk_vvl )   fse3t_m(:,:) = fse3t_m(:,:) + zdep(:,:) 
    122140 
    123141         !                                                ! ---------------------------------------- ! 

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

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

    r4726 r4946  
    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_2d     : freezing temperature for 2d fields 
     36   !!   eos_fzp_0d     : freezing temperature for scalar 
    3137   !!   eos_init       : set eos parameters (namelist) 
    3238   !!---------------------------------------------------------------------- 
    3339   USE dom_oce         ! ocean space and time domain 
    3440   USE phycst          ! physical constants 
    35    USE zdfddm          ! vertical physics: double diffusion 
     41   ! 
    3642   USE in_out_manager  ! I/O manager 
    3743   USE lib_mpp         ! MPP library 
     44   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3845   USE prtctl          ! Print control 
    3946   USE wrk_nemo        ! Memory Allocation 
     47   USE lbclnk         ! ocean lateral boundary conditions 
    4048   USE timing          ! Timing 
    4149 
    … …  
    4755      MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d 
    4856   END INTERFACE 
    49    INTERFACE bn2 
    50       MODULE PROCEDURE eos_bn2 
     57   ! 
     58   INTERFACE eos_rab 
     59      MODULE PROCEDURE rab_3d, rab_2d, rab_0d 
    5160   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 and sbcisf module 
    58    PUBLIC   tfreez1D   ! called by trasbc modules 
    59  
    60    !                                  !!* Namelist (nameos) * 
    61    INTEGER , PUBLIC ::   nn_eos       !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ. 
    62    REAL(wp), PUBLIC ::   rn_alpha     !: thermal expension coeff. (linear equation of state) 
    63    REAL(wp), PUBLIC ::   rn_beta      !: saline  expension coeff. (linear equation of state) 
    64  
    65    REAL(wp), PUBLIC ::   ralpbet              !: alpha / beta ratio 
     61   ! 
     62   INTERFACE eos_fzp  
     63      MODULE PROCEDURE eos_fzp_2d, eos_fzp_0d 
     64   END INTERFACE 
     65   ! 
     66   PUBLIC   eos            ! called by step, istate, tranpc and zpsgrd modules 
     67   PUBLIC   bn2            ! called by step module 
     68   PUBLIC   eos_rab        ! called by ldfslp, zdfddm, trabbl 
     69   PUBLIC   eos_pt_from_ct ! called by sbcssm 
     70   PUBLIC   eos_fzp        ! called by traadv_cen2 and sbcice_... modules 
     71   PUBLIC   eos_pen        ! used for pe diagnostics in trdpen module 
     72   PUBLIC   eos_init       ! called by istate module 
     73 
     74   !                                          !!* Namelist (nameos) * 
     75   INTEGER , PUBLIC ::   nn_eos   = 0         !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ. 
     76   LOGICAL , PUBLIC ::   ln_useCT  = .FALSE.  ! determine if eos_pt_from_ct is used to compute sst_m 
     77 
     78   !                                   !!!  simplified eos coefficients 
     79   ! default value: Vallis 2006 
     80   REAL(wp) ::   rn_a0      = 1.6550e-1_wp     ! thermal expansion coeff.  
     81   REAL(wp) ::   rn_b0      = 7.6554e-1_wp     ! saline  expansion coeff.  
     82   REAL(wp) ::   rn_lambda1 = 5.9520e-2_wp     ! cabbeling coeff. in T^2         
     83   REAL(wp) ::   rn_lambda2 = 5.4914e-4_wp     ! cabbeling coeff. in S^2         
     84   REAL(wp) ::   rn_mu1     = 1.4970e-4_wp     ! thermobaric coeff. in T   
     85   REAL(wp) ::   rn_mu2     = 1.1090e-5_wp     ! thermobaric coeff. in S   
     86   REAL(wp) ::   rn_nu      = 2.4341e-3_wp     ! cabbeling coeff. in theta*salt   
     87    
     88   ! TEOS10/EOS80 parameters 
     89   REAL(wp) ::   r1_S0, r1_T0, r1_Z0, rdeltaS 
     90    
     91   ! EOS parameters 
     92   REAL(wp) ::   EOS000 , EOS100 , EOS200 , EOS300 , EOS400 , EOS500 , EOS600 
     93   REAL(wp) ::   EOS010 , EOS110 , EOS210 , EOS310 , EOS410 , EOS510 
     94   REAL(wp) ::   EOS020 , EOS120 , EOS220 , EOS320 , EOS420 
     95   REAL(wp) ::   EOS030 , EOS130 , EOS230 , EOS330 
     96   REAL(wp) ::   EOS040 , EOS140 , EOS240 
     97   REAL(wp) ::   EOS050 , EOS150 
     98   REAL(wp) ::   EOS060 
     99   REAL(wp) ::   EOS001 , EOS101 , EOS201 , EOS301 , EOS401 
     100   REAL(wp) ::   EOS011 , EOS111 , EOS211 , EOS311 
     101   REAL(wp) ::   EOS021 , EOS121 , EOS221 
     102   REAL(wp) ::   EOS031 , EOS131 
     103   REAL(wp) ::   EOS041 
     104   REAL(wp) ::   EOS002 , EOS102 , EOS202 
     105   REAL(wp) ::   EOS012 , EOS112 
     106   REAL(wp) ::   EOS022 
     107   REAL(wp) ::   EOS003 , EOS103 
     108   REAL(wp) ::   EOS013  
     109    
     110   ! ALPHA parameters 
     111   REAL(wp) ::   ALP000 , ALP100 , ALP200 , ALP300 , ALP400 , ALP500 
     112   REAL(wp) ::   ALP010 , ALP110 , ALP210 , ALP310 , ALP410 
     113   REAL(wp) ::   ALP020 , ALP120 , ALP220 , ALP320 
     114   REAL(wp) ::   ALP030 , ALP130 , ALP230 
     115   REAL(wp) ::   ALP040 , ALP140 
     116   REAL(wp) ::   ALP050 
     117   REAL(wp) ::   ALP001 , ALP101 , ALP201 , ALP301 
     118   REAL(wp) ::   ALP011 , ALP111 , ALP211 
     119   REAL(wp) ::   ALP021 , ALP121 
     120   REAL(wp) ::   ALP031 
     121   REAL(wp) ::   ALP002 , ALP102 
     122   REAL(wp) ::   ALP012 
     123   REAL(wp) ::   ALP003 
     124    
     125   ! BETA parameters 
     126   REAL(wp) ::   BET000 , BET100 , BET200 , BET300 , BET400 , BET500 
     127   REAL(wp) ::   BET010 , BET110 , BET210 , BET310 , BET410 
     128   REAL(wp) ::   BET020 , BET120 , BET220 , BET320 
     129   REAL(wp) ::   BET030 , BET130 , BET230 
     130   REAL(wp) ::   BET040 , BET140 
     131   REAL(wp) ::   BET050 
     132   REAL(wp) ::   BET001 , BET101 , BET201 , BET301 
     133   REAL(wp) ::   BET011 , BET111 , BET211 
     134   REAL(wp) ::   BET021 , BET121 
     135   REAL(wp) ::   BET031 
     136   REAL(wp) ::   BET002 , BET102 
     137   REAL(wp) ::   BET012 
     138   REAL(wp) ::   BET003 
     139 
     140   ! PEN parameters 
     141   REAL(wp) ::   PEN000 , PEN100 , PEN200 , PEN300 , PEN400 
     142   REAL(wp) ::   PEN010 , PEN110 , PEN210 , PEN310 
     143   REAL(wp) ::   PEN020 , PEN120 , PEN220 
     144   REAL(wp) ::   PEN030 , PEN130 
     145   REAL(wp) ::   PEN040 
     146   REAL(wp) ::   PEN001 , PEN101 , PEN201 
     147   REAL(wp) ::   PEN011 , PEN111 
     148   REAL(wp) ::   PEN021 
     149   REAL(wp) ::   PEN002 , PEN102 
     150   REAL(wp) ::   PEN012 
     151    
     152   ! ALPHA_PEN parameters 
     153   REAL(wp) ::   APE000 , APE100 , APE200 , APE300 
     154   REAL(wp) ::   APE010 , APE110 , APE210 
     155   REAL(wp) ::   APE020 , APE120 
     156   REAL(wp) ::   APE030 
     157   REAL(wp) ::   APE001 , APE101 
     158   REAL(wp) ::   APE011 
     159   REAL(wp) ::   APE002 
     160 
     161   ! BETA_PEN parameters 
     162   REAL(wp) ::   BPE000 , BPE100 , BPE200 , BPE300 
     163   REAL(wp) ::   BPE010 , BPE110 , BPE210 
     164   REAL(wp) ::   BPE020 , BPE120 
     165   REAL(wp) ::   BPE030 
     166   REAL(wp) ::   BPE001 , BPE101 
     167   REAL(wp) ::   BPE011 
     168   REAL(wp) ::   BPE002 
    66169 
    67170   !! * Substitutions 
    … …  
    69172#  include "vectopt_loop_substitute.h90" 
    70173   !!---------------------------------------------------------------------- 
    71    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     174   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    72175   !! $Id$ 
    73176   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    83186      !!       defined through the namelist parameter nn_eos. 
    84187      !! 
    85       !! ** Method  :   3 cases: 
    86       !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state. 
    87       !!         the in situ density is computed directly as a function of 
    88       !!         potential temperature relative to the surface (the opa t 
    89       !!         variable), salt and pressure (assuming no pressure variation 
    90       !!         along geopotential surfaces, i.e. the pressure p in decibars 
    91       !!         is approximated by the depth in meters. 
    92       !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0 
    93       !!         with pressure                      p        decibars 
    94       !!              potential temperature         t        deg celsius 
    95       !!              salinity                      s        psu 
    96       !!              reference volumic mass        rau0     kg/m**3 
    97       !!              in situ volumic mass          rho      kg/m**3 
    98       !!              in situ density anomalie      prd      no units 
    99       !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar, 
    100       !!          t = 40 deg celcius, s=40 psu 
    101       !!      nn_eos = 1 : linear equation of state function of temperature only 
    102       !!              prd(t) = 0.0285 - rn_alpha * t 
    103       !!      nn_eos = 2 : linear equation of state function of temperature and 
    104       !!               salinity 
    105       !!              prd(t,s) = rn_beta * s - rn_alpha * tn - 1. 
    106       !!      Note that no boundary condition problem occurs in this routine 
    107       !!      as pts are defined over the whole domain. 
     188      !! ** Method  :   prd(t,s,z) = ( rho(t,s,z) - rau0 ) / rau0 
     189      !!         with   prd    in situ density anomaly      no units 
     190      !!                t      TEOS10: CT or EOS80: PT      Celsius 
     191      !!                s      TEOS10: SA or EOS80: SP      TEOS10: g/kg or EOS80: psu 
     192      !!                z      depth                        meters 
     193      !!                rho    in situ density              kg/m^3 
     194      !!                rau0   reference density            kg/m^3 
     195      !! 
     196      !!     nn_eos = -1 : polynomial TEOS-10 equation of state is used for rho(t,s,z). 
     197      !!         Check value: rho = 1028.21993233072 kg/m^3 for z=3000 dbar, ct=3 Celcius, sa=35.5 g/kg 
     198      !! 
     199      !!     nn_eos =  0 : polynomial EOS-80 equation of state is used for rho(t,s,z). 
     200      !!         Check value: rho = 1028.35011066567 kg/m^3 for z=3000 dbar, pt=3 Celcius, sp=35.5 psu 
     201      !! 
     202      !!     nn_eos =  1 : simplified equation of state 
     203      !!              prd(t,s,z) = ( -a0*(1+lambda/2*(T-T0)+mu*z+nu*(S-S0))*(T-T0) + b0*(S-S0) ) / rau0 
     204      !!              linear case function of T only: rn_alpha<>0, other coefficients = 0 
     205      !!              linear eos function of T and S: rn_alpha and rn_beta<>0, other coefficients=0 
     206      !!              Vallis like equation: use default values of coefficients 
    108207      !! 
    109208      !! ** Action  :   compute prd , the in situ density (no units) 
    110209      !! 
    111       !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 
    112       !!---------------------------------------------------------------------- 
    113       !! 
    114       REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
    115       !                                                      ! 2 : salinity               [psu] 
    116       REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   prd   ! in situ density            [-] 
    117       REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pdep  ! depth                      [m] 
    118       !! 
    119       INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    120       REAL(wp) ::   zt , zs , zh , zsr   ! local scalars 
    121       REAL(wp) ::   zr1, zr2, zr3, zr4   !   -      - 
    122       REAL(wp) ::   zrhop, ze, zbw, zb   !   -      - 
    123       REAL(wp) ::   zd , zc , zaw, za    !   -      - 
    124       REAL(wp) ::   zb1, za1, zkw, zk0   !   -      - 
    125       REAL(wp), POINTER, DIMENSION(:,:,:) :: zws 
    126       !!---------------------------------------------------------------------- 
    127  
    128       ! 
    129       IF( nn_timing == 1 ) CALL timing_start('eos') 
    130       ! 
    131       CALL wrk_alloc( jpi, jpj, jpk, zws ) 
     210      !! References :   Roquet et al, Ocean Modelling, in preparation (2014) 
     211      !!                Vallis, Atmospheric and Oceanic Fluid Dynamics, 2006 
     212      !!                TEOS-10 Manual, 2010 
     213      !!---------------------------------------------------------------------- 
     214      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
     215      !                                                               ! 2 : salinity               [psu] 
     216      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd   ! in situ density            [-] 
     217      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep  ! depth                      [m] 
     218      ! 
     219      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     220      REAL(wp) ::   zt , zh , zs , ztm        ! local scalars 
     221      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      - 
     222      !!---------------------------------------------------------------------- 
     223      ! 
     224      IF( nn_timing == 1 )   CALL timing_start('eos-insitu') 
    132225      ! 
    133226      SELECT CASE( nn_eos ) 
    134227      ! 
    135       CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    136 !CDIR NOVERRCHK 
    137          zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 
     228      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    138229         ! 
    139230         DO jk = 1, jpkm1 
    140231            DO jj = 1, jpj 
    141232               DO ji = 1, jpi 
    142                   zt = pts   (ji,jj,jk,jp_tem) 
    143                   zs = pts   (ji,jj,jk,jp_sal) 
    144                   zh = pdep(ji,jj,jk)        ! depth 
    145                   zsr= zws   (ji,jj,jk)        ! square root salinity 
    146                   ! 
    147                   ! compute volumic mass pure water at atm pressure 
    148                   zr1= ( ( ( ( 6.536332e-9_wp  *zt - 1.120083e-6_wp )*zt + 1.001685e-4_wp )*zt   & 
    149                      &        -9.095290e-3_wp )*zt + 6.793952e-2_wp )*zt +  999.842594_wp 
    150                   ! seawater volumic mass atm pressure 
    151                   zr2= ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp ) *zt+7.6438e-5_wp ) *zt        & 
    152                      &                      -4.0899e-3_wp ) *zt+0.824493_wp 
    153                   zr3= ( -1.6546e-6_wp*zt+1.0227e-4_wp )    *zt-5.72466e-3_wp 
    154                   zr4= 4.8314e-4_wp 
    155                   ! 
    156                   ! potential volumic mass (reference to the surface) 
    157                   zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1 
    158                   ! 
    159                   ! add the compression terms 
    160                   ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp 
    161                   zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp 
    162                   zb = zbw + ze * zs 
    163                   ! 
    164                   zd = -2.042967e-2_wp 
    165                   zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp 
    166                   zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt - 4.721788_wp 
    167                   za = ( zd*zsr + zc ) *zs + zaw 
    168                   ! 
    169                   zb1=   (-0.1909078_wp*zt+7.390729_wp )        *zt-55.87545_wp 
    170                   za1= ( ( 2.326469e-3_wp*zt+1.553190_wp)       *zt-65.00517_wp ) *zt+1044.077_wp 
    171                   zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp ) *zt-30.41638_wp ) *zt + 2098.925_wp ) *zt+190925.6_wp 
    172                   zk0= ( zb1*zsr + za1 )*zs + zkw 
    173                   ! 
    174                   ! masked in situ density anomaly 
    175                   prd(ji,jj,jk) = (  zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  )    & 
    176                      &             - rau0  ) * r1_rau0 * tmask(ji,jj,jk) 
     233                  ! 
     234                  zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
     235                  zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
     236                  zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     237                  ztm = tmask(ji,jj,jk)                                         ! tmask 
     238                  ! 
     239                  zn3 = EOS013*zt   & 
     240                     &   + EOS103*zs+EOS003 
     241                     ! 
     242                  zn2 = (EOS022*zt   & 
     243                     &   + EOS112*zs+EOS012)*zt   & 
     244                     &   + (EOS202*zs+EOS102)*zs+EOS002 
     245                     ! 
     246                  zn1 = (((EOS041*zt   & 
     247                     &   + EOS131*zs+EOS031)*zt   & 
     248                     &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   & 
     249                     &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   & 
     250                     &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
     251                     ! 
     252                  zn0 = (((((EOS060*zt   & 
     253                     &   + EOS150*zs+EOS050)*zt   & 
     254                     &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
     255                     &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
     256                     &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
     257                     &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
     258                     &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
     259                     ! 
     260                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     261                  ! 
     262                  prd(ji,jj,jk) = (  zn * r1_rau0 - 1._wp  ) * ztm  ! density anomaly (masked) 
     263                  ! 
    177264               END DO 
    178265            END DO 
    179266         END DO 
    180267         ! 
    181       CASE( 1 )                !==  Linear formulation function of temperature only  ==! 
     268      CASE( 1 )                !==  simplified EOS  ==! 
     269         ! 
    182270         DO jk = 1, jpkm1 
    183             prd(:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk) 
     271            DO jj = 1, jpj 
     272               DO ji = 1, jpi 
     273                  zt  = pts  (ji,jj,jk,jp_tem) - 10._wp 
     274                  zs  = pts  (ji,jj,jk,jp_sal) - 35._wp 
     275                  zh  = pdep (ji,jj,jk) 
     276                  ztm = tmask(ji,jj,jk) 
     277                  ! 
     278                  zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   & 
     279                     &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   & 
     280                     &  - rn_nu * zt * zs 
     281                     !                                  
     282                  prd(ji,jj,jk) = zn * r1_rau0 * ztm                ! density anomaly (masked) 
     283               END DO 
     284            END DO 
    184285         END DO 
    185286         ! 
    186       CASE( 2 )                !==  Linear formulation function of temperature and salinity  ==! 
    187          DO jk = 1, jpkm1 
    188             prd(:,:,jk) = ( rn_beta  * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk) 
    189          END DO 
    190          ! 
    191287      END SELECT 
    192288      ! 
    193       IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos  : ', ovlap=1, kdim=jpk ) 
    194       ! 
    195       CALL wrk_dealloc( jpi, jpj, jpk, zws ) 
    196       ! 
    197       IF( nn_timing == 1 ) CALL timing_stop('eos') 
     289      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu  : ', ovlap=1, kdim=jpk ) 
     290      ! 
     291      IF( nn_timing == 1 )   CALL timing_stop('eos-insitu') 
    198292      ! 
    199293   END SUBROUTINE eos_insitu 
    … …  
    209303      !!     namelist parameter nn_eos. 
    210304      !! 
    211       !! ** Method  : 
    212       !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state. 
    213       !!         the in situ density is computed directly as a function of 
    214       !!         potential temperature relative to the surface (the opa t 
    215       !!         variable), salt and pressure (assuming no pressure variation 
    216       !!         along geopotential surfaces, i.e. the pressure p in decibars 
    217       !!         is approximated by the depth in meters. 
    218       !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0 
    219       !!              rhop(t,s)  = rho(t,s,0) 
    220       !!         with pressure                      p        decibars 
    221       !!              potential temperature         t        deg celsius 
    222       !!              salinity                      s        psu 
    223       !!              reference volumic mass        rau0     kg/m**3 
    224       !!              in situ volumic mass          rho      kg/m**3 
    225       !!              in situ density anomalie      prd      no units 
    226       !! 
    227       !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar, 
    228       !!          t = 40 deg celcius, s=40 psu 
    229       !! 
    230       !!      nn_eos = 1 : linear equation of state function of temperature only 
    231       !!              prd(t) = ( rho(t) - rau0 ) / rau0 = 0.028 - rn_alpha * t 
    232       !!              rhop(t,s)  = rho(t,s) 
    233       !! 
    234       !!      nn_eos = 2 : linear equation of state function of temperature and 
    235       !!               salinity 
    236       !!              prd(t,s) = ( rho(t,s) - rau0 ) / rau0 
    237       !!                       = rn_beta * s - rn_alpha * tn - 1. 
    238       !!              rhop(t,s)  = rho(t,s) 
    239       !!      Note that no boundary condition problem occurs in this routine 
    240       !!      as (tn,sn) or (ta,sa) are defined over the whole domain. 
    241       !! 
    242305      !! ** Action  : - prd  , the in situ density (no units) 
    243306      !!              - prhop, the potential volumic mass (Kg/m3) 
    244307      !! 
    245       !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 
    246       !!                Brown and Campana, Mon. Weather Rev., 1978 
    247       !!---------------------------------------------------------------------- 
    248       !! 
     308      !!---------------------------------------------------------------------- 
    249309      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celcius] 
    250310      !                                                                ! 2 : salinity               [psu] 
    … …  
    253313      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep   ! depth                      [m] 
    254314      ! 
    255       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    256       REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! local scalars 
    257       REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0               !   -      - 
    258       REAL(wp), POINTER, DIMENSION(:,:,:) :: zws 
    259       !!---------------------------------------------------------------------- 
    260       ! 
    261       IF( nn_timing == 1 ) CALL timing_start('eos-p') 
    262       ! 
    263       CALL wrk_alloc( jpi, jpj, jpk, zws ) 
     315      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     316      REAL(wp) ::   zt , zh , zs , ztm        ! local scalars 
     317      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      - 
     318      !!---------------------------------------------------------------------- 
     319      ! 
     320      IF( nn_timing == 1 )   CALL timing_start('eos-pot') 
    264321      ! 
    265322      SELECT CASE ( nn_eos ) 
    266323      ! 
    267       CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    268 !CDIR NOVERRCHK 
    269          zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 
     324      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    270325         ! 
    271326         DO jk = 1, jpkm1 
    272327            DO jj = 1, jpj 
    273328               DO ji = 1, jpi 
    274                   zt = pts   (ji,jj,jk,jp_tem) 
    275                   zs = pts   (ji,jj,jk,jp_sal) 
    276                   zh = pdep(ji,jj,jk)        ! depth 
    277                   zsr= zws   (ji,jj,jk)        ! square root salinity 
    278                   ! 
    279                   ! compute volumic mass pure water at atm pressure 
    280                   zr1= ( ( ( ( 6.536332e-9_wp*zt-1.120083e-6_wp )*zt+1.001685e-4_wp )*zt   & 
    281                      &                          -9.095290e-3_wp )*zt+6.793952e-2_wp )*zt+999.842594_wp 
    282                   ! seawater volumic mass atm pressure 
    283                   zr2= ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp ) *zt+7.6438e-5_wp ) *zt   & 
    284                      &                                         -4.0899e-3_wp ) *zt+0.824493_wp 
    285                   zr3= ( -1.6546e-6_wp*zt+1.0227e-4_wp )    *zt-5.72466e-3_wp 
    286                   zr4= 4.8314e-4_wp 
    287                   ! 
    288                   ! potential volumic mass (reference to the surface) 
    289                   zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1 
    290                   ! 
    291                   ! save potential volumic mass 
    292                   prhop(ji,jj,jk) = zrhop * tmask(ji,jj,jk) 
    293                   ! 
    294                   ! add the compression terms 
    295                   ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp 
    296                   zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp 
    297                   zb = zbw + ze * zs 
    298                   ! 
    299                   zd = -2.042967e-2_wp 
    300                   zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp 
    301                   zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt - 4.721788_wp 
    302                   za = ( zd*zsr + zc ) *zs + zaw 
    303                   ! 
    304                   zb1=   (  -0.1909078_wp  *zt+7.390729_wp    ) *zt-55.87545_wp 
    305                   za1= ( (   2.326469e-3_wp*zt+1.553190_wp    ) *zt-65.00517_wp ) *zt + 1044.077_wp 
    306                   zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp ) *zt-30.41638_wp ) *zt + 2098.925_wp ) *zt+190925.6_wp 
    307                   zk0= ( zb1*zsr + za1 )*zs + zkw 
    308                   ! 
    309                   ! masked in situ density anomaly 
    310                   prd(ji,jj,jk) = (  zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  )    & 
    311                      &             - rau0  ) * r1_rau0 * tmask(ji,jj,jk) 
     329                  ! 
     330                  zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
     331                  zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
     332                  zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     333                  ztm = tmask(ji,jj,jk)                                         ! tmask 
     334                  ! 
     335                  zn3 = EOS013*zt   & 
     336                     &   + EOS103*zs+EOS003 
     337                     ! 
     338                  zn2 = (EOS022*zt   & 
     339                     &   + EOS112*zs+EOS012)*zt   & 
     340                     &   + (EOS202*zs+EOS102)*zs+EOS002 
     341                     ! 
     342                  zn1 = (((EOS041*zt   & 
     343                     &   + EOS131*zs+EOS031)*zt   & 
     344                     &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   & 
     345                     &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   & 
     346                     &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
     347                     ! 
     348                  zn0 = (((((EOS060*zt   & 
     349                     &   + EOS150*zs+EOS050)*zt   & 
     350                     &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
     351                     &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
     352                     &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
     353                     &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
     354                     &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
     355                     ! 
     356                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     357                  ! 
     358                  prhop(ji,jj,jk) = zn0 * ztm                           ! potential density referenced at the surface 
     359                  ! 
     360                  prd(ji,jj,jk) = (  zn * r1_rau0 - 1._wp  ) * ztm      ! density anomaly (masked) 
    312361               END DO 
    313362            END DO 
    314363         END DO 
    315364         ! 
    316       CASE( 1 )                !==  Linear formulation = F( temperature )  ==! 
     365      CASE( 1 )                !==  simplified EOS  ==! 
     366         ! 
    317367         DO jk = 1, jpkm1 
    318             prd  (:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) )        * tmask(:,:,jk) 
    319             prhop(:,:,jk) = ( 1.e0_wp   +            prd (:,:,jk)       ) * rau0 * tmask(:,:,jk) 
     368            DO jj = 1, jpj 
     369               DO ji = 1, jpi 
     370                  zt  = pts  (ji,jj,jk,jp_tem) - 10._wp 
     371                  zs  = pts  (ji,jj,jk,jp_sal) - 35._wp 
     372                  zh  = pdep (ji,jj,jk) 
     373                  ztm = tmask(ji,jj,jk) 
     374                  !                                                     ! potential density referenced at the surface 
     375                  zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt   & 
     376                     &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs   & 
     377                     &  - rn_nu * zt * zs 
     378                  prhop(ji,jj,jk) = ( rau0 + zn ) * ztm 
     379                  !                                                     ! density anomaly (masked) 
     380                  zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh 
     381                  prd(ji,jj,jk) = zn * r1_rau0 * ztm 
     382                  ! 
     383               END DO 
     384            END DO 
    320385         END DO 
    321386         ! 
    322       CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==! 
    323          DO jk = 1, jpkm1 
    324             prd  (:,:,jk) = ( rn_beta  * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) )        * tmask(:,:,jk) 
    325             prhop(:,:,jk) = ( 1.e0_wp  + prd (:,:,jk) )                                       * rau0 * tmask(:,:,jk) 
    326          END DO 
    327          ! 
    328387      END SELECT 
    329388      ! 
    330       IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-p: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk ) 
    331       ! 
    332       CALL wrk_dealloc( jpi, jpj, jpk, zws ) 
    333       ! 
    334       IF( nn_timing == 1 ) CALL timing_stop('eos-p') 
     389      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk ) 
     390      ! 
     391      IF( nn_timing == 1 )   CALL timing_stop('eos-pot') 
    335392      ! 
    336393   END SUBROUTINE eos_insitu_pot 
    … …  
    345402      !!      defined through the namelist parameter nn_eos. * 2D field case 
    346403      !! 
    347       !! ** Method : 
    348       !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state. 
    349       !!         the in situ density is computed directly as a function of 
    350       !!         potential temperature relative to the surface (the opa t 
    351       !!         variable), salt and pressure (assuming no pressure variation 
    352       !!         along geopotential surfaces, i.e. the pressure p in decibars 
    353       !!         is approximated by the depth in meters. 
    354       !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0 
    355       !!         with pressure                      p        decibars 
    356       !!              potential temperature         t        deg celsius 
    357       !!              salinity                      s        psu 
    358       !!              reference volumic mass        rau0     kg/m**3 
    359       !!              in situ volumic mass          rho      kg/m**3 
    360       !!              in situ density anomalie      prd      no units 
    361       !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar, 
    362       !!          t = 40 deg celcius, s=40 psu 
    363       !!      nn_eos = 1 : linear equation of state function of temperature only 
    364       !!              prd(t) = 0.0285 - rn_alpha * t 
    365       !!      nn_eos = 2 : linear equation of state function of temperature and 
    366       !!               salinity 
    367       !!              prd(t,s) = rn_beta * s - rn_alpha * tn - 1. 
    368       !!      Note that no boundary condition problem occurs in this routine 
    369       !!      as pts are defined over the whole domain. 
    370       !! 
    371       !! ** Action  : - prd , the in situ density (no units) 
    372       !! 
    373       !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 
    374       !!---------------------------------------------------------------------- 
    375       !! 
     404      !! ** Action  : - prd , the in situ density (no units) (unmasked) 
     405      !! 
     406      !!---------------------------------------------------------------------- 
    376407      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
    377408      !                                                           ! 2 : salinity               [psu] 
    378       REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                  [m] 
     409      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                      [m] 
    379410      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(  out) ::   prd   ! in situ density 
    380       !! 
    381       INTEGER  ::   ji, jj                    ! dummy loop indices 
    382       REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! temporary scalars 
    383       REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zmask        !    -         - 
    384       REAL(wp), POINTER, DIMENSION(:,:) :: zws 
    385       !!---------------------------------------------------------------------- 
    386       ! 
    387       IF( nn_timing == 1 ) CALL timing_start('eos2d') 
    388       ! 
    389       CALL wrk_alloc( jpi, jpj, zws ) 
    390       ! 
    391  
     411      ! 
     412      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     413      REAL(wp) ::   zt , zh , zs              ! local scalars 
     414      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      - 
     415      !!---------------------------------------------------------------------- 
     416      ! 
     417      IF( nn_timing == 1 )   CALL timing_start('eos2d') 
     418      ! 
    392419      prd(:,:) = 0._wp 
    393  
     420      ! 
    394421      SELECT CASE( nn_eos ) 
    395422      ! 
    396       CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    397       ! 
    398 !CDIR NOVERRCHK 
    399          DO jj = 1, jpj 
    400 !CDIR NOVERRCHK 
    401             DO ji = 1, jpi   ! vector opt. 
    402                zws(ji,jj) = SQRT( ABS( pts(ji,jj,jp_sal) ) ) 
     423      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
     424         ! 
     425         DO jj = 1, jpjm1 
     426            DO ji = 1, fs_jpim1   ! vector opt. 
     427               ! 
     428               zh  = pdep(ji,jj) * r1_Z0                                  ! depth 
     429               zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature 
     430               zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     431               ! 
     432               zn3 = EOS013*zt   & 
     433                  &   + EOS103*zs+EOS003 
     434                  ! 
     435               zn2 = (EOS022*zt   & 
     436                  &   + EOS112*zs+EOS012)*zt   & 
     437                  &   + (EOS202*zs+EOS102)*zs+EOS002 
     438                  ! 
     439               zn1 = (((EOS041*zt   & 
     440                  &   + EOS131*zs+EOS031)*zt   & 
     441                  &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   & 
     442                  &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   & 
     443                  &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
     444                  ! 
     445               zn0 = (((((EOS060*zt   & 
     446                  &   + EOS150*zs+EOS050)*zt   & 
     447                  &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
     448                  &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
     449                  &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
     450                  &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
     451                  &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
     452                  ! 
     453               zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     454               ! 
     455               prd(ji,jj) = zn * r1_rau0 - 1._wp               ! unmasked in situ density anomaly 
     456               ! 
    403457            END DO 
    404458         END DO 
    405          DO jj = 1, jpj 
    406             DO ji = 1, jpi   ! vector opt. 
    407                zmask = ssmask(ji,jj)          ! land/sea bottom mask = surf. mask 
    408                zt    = pts  (ji,jj,jp_tem)            ! interpolated T 
    409                zs    = pts  (ji,jj,jp_sal)            ! interpolated S 
    410                zsr   = zws  (ji,jj)            ! square root of interpolated S 
    411                zh    = pdep (ji,jj)            ! depth at the partial step level 
    412                ! 
    413                ! compute volumic mass pure water at atm pressure 
    414                zr1 = ( ( ( ( 6.536332e-9_wp*zt-1.120083e-6_wp )*zt+1.001685e-4_wp )*zt   & 
    415                   &                        -9.095290e-3_wp )*zt+6.793952e-2_wp )*zt+999.842594_wp 
    416                ! seawater volumic mass atm pressure 
    417                zr2 = ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp )*zt+7.6438e-5_wp ) *zt   & 
    418                   &                                   -4.0899e-3_wp ) *zt+0.824493_wp 
    419                zr3 = ( -1.6546e-6_wp*zt+1.0227e-4_wp ) *zt-5.72466e-3_wp 
    420                zr4 = 4.8314e-4_wp 
    421                ! 
    422                ! potential volumic mass (reference to the surface) 
    423                zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1 
    424                ! 
    425                ! add the compression terms 
    426                ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp 
    427                zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp 
    428                zb = zbw + ze * zs 
    429                ! 
    430                zd =    -2.042967e-2_wp 
    431                zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp 
    432                zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt -4.721788_wp 
    433                za = ( zd*zsr + zc ) *zs + zaw 
    434                ! 
    435                zb1=     (-0.1909078_wp  *zt+7.390729_wp      ) *zt-55.87545_wp 
    436                za1=   ( ( 2.326469e-3_wp*zt+1.553190_wp      ) *zt-65.00517_wp ) *zt+1044.077_wp 
    437                zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp   ) *zt-30.41638_wp ) *zt   & 
    438                   &                             +2098.925_wp ) *zt+190925.6_wp 
    439                zk0= ( zb1*zsr + za1 )*zs + zkw 
    440                ! 
    441                ! masked in situ density anomaly 
    442                prd(ji,jj) = ( zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  ) - rau0 ) / rau0 * zmask 
     459         ! 
     460         CALL lbc_lnk( prd, 'T', 1. )                    ! Lateral boundary conditions 
     461         ! 
     462      CASE( 1 )                !==  simplified EOS  ==! 
     463         ! 
     464         DO jj = 1, jpjm1 
     465            DO ji = 1, fs_jpim1   ! vector opt. 
     466               ! 
     467               zt    = pts  (ji,jj,jp_tem)  - 10._wp 
     468               zs    = pts  (ji,jj,jp_sal)  - 35._wp 
     469               zh    = pdep (ji,jj)                         ! depth at the partial step level 
     470               ! 
     471               zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   & 
     472                  &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   & 
     473                  &  - rn_nu * zt * zs 
     474                  ! 
     475               prd(ji,jj) = zn * r1_rau0               ! unmasked in situ density anomaly 
     476               ! 
    443477            END DO 
    444478         END DO 
    445479         ! 
    446       CASE( 1 )                !==  Linear formulation = F( temperature )  ==! 
    447          DO jj = 1, jpj 
    448             DO ji = 1, jpi   ! vector opt. 
    449                prd(ji,jj) = ( 0.0285_wp - rn_alpha * pts(ji,jj,jp_tem) ) * ssmask(ji,jj) 
    450             END DO 
    451          END DO 
    452          ! 
    453       CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==! 
    454          DO jj = 1, jpj 
    455             DO ji = 1, jpi   ! vector opt. 
    456                prd(ji,jj) = ( rn_beta * pts(ji,jj,jp_sal) - rn_alpha * pts(ji,jj,jp_tem) ) * ssmask(ji,jj) 
    457             END DO 
    458          END DO 
     480         CALL lbc_lnk( prd, 'T', 1. )                    ! Lateral boundary conditions 
    459481         ! 
    460482      END SELECT 
    461  
     483      ! 
    462484      IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' ) 
    463485      ! 
    464       CALL wrk_dealloc( jpi, jpj, zws ) 
    465       ! 
    466       IF( nn_timing == 1 ) CALL timing_stop('eos2d') 
     486      IF( nn_timing == 1 )   CALL timing_stop('eos2d') 
    467487      ! 
    468488   END SUBROUTINE eos_insitu_2d 
    469489 
    470490 
    471    SUBROUTINE eos_bn2( pts, pn2 ) 
    472       !!---------------------------------------------------------------------- 
    473       !!                  ***  ROUTINE eos_bn2  *** 
    474       !! 
    475       !! ** Purpose :   Compute the local Brunt-Vaisala frequency at the time- 
    476       !!      step of the input arguments 
    477       !! 
    478       !! ** Method : 
    479       !!       * nn_eos = 0  : UNESCO sea water properties 
    480       !!         The brunt-vaisala frequency is computed using the polynomial 
    481       !!      polynomial expression of McDougall (1987): 
    482       !!            N^2 = grav * beta * ( alpha/beta*dk[ t ] - dk[ s ] )/e3w 
    483       !!      If lk_zdfddm=T, the heat/salt buoyancy flux ratio Rrau is 
    484       !!      computed and used in zdfddm module : 
    485       !!              Rrau = alpha/beta * ( dk[ t ] / dk[ s ] ) 
    486       !!       * nn_eos = 1  : linear equation of state (temperature only) 
    487       !!            N^2 = grav * rn_alpha * dk[ t ]/e3w 
    488       !!       * nn_eos = 2  : linear equation of state (temperature & salinity) 
    489       !!            N^2 = grav * (rn_alpha * dk[ t ] - rn_beta * dk[ s ] ) / e3w 
    490       !!      The use of potential density to compute N^2 introduces e r r o r 
    491       !!      in the sign of N^2 at great depths. We recommand the use of 
    492       !!      nn_eos = 0, except for academical studies. 
    493       !!        Macro-tasked on horizontal slab (jk-loop) 
    494       !!      N.B. N^2 is set to zero at the first level (JK=1) in inidtr 
    495       !!      and is never used at this level. 
    496       !! 
    497       !! ** Action  : - pn2 : the brunt-vaisala frequency 
    498       !! 
    499       !! References :   McDougall, J. Phys. Oceanogr., 17, 1950-1964, 1987. 
    500       !!---------------------------------------------------------------------- 
    501       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
    502       !                                                               ! 2 : salinity               [psu] 
    503       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pn2   ! Brunt-Vaisala frequency    [s-1] 
    504       !! 
    505       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    506       REAL(wp) ::   zgde3w, zt, zs, zh, zalbet, zbeta   ! local scalars 
    507 #if defined key_zdfddm 
    508       REAL(wp) ::   zds   ! local scalars 
    509 #endif 
    510       !!---------------------------------------------------------------------- 
    511  
    512       ! 
    513       IF( nn_timing == 1 ) CALL timing_start('bn2') 
    514       ! 
    515       ! pn2 : interior points only (2=< jk =< jpkm1 ) 
    516       ! -------------------------- 
    517       ! 
    518       SELECT CASE( nn_eos ) 
    519       ! 
    520       CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    521          DO jk = 2, jpkm1 
     491   SUBROUTINE rab_3d( pts, pab ) 
     492      !!---------------------------------------------------------------------- 
     493      !!                 ***  ROUTINE rab_3d  *** 
     494      !! 
     495      !! ** Purpose :   Calculates thermal/haline expansion ratio at T-points 
     496      !! 
     497      !! ** Method  :   calculates alpha / beta at T-points 
     498      !! 
     499      !! ** Action  : - pab     : thermal/haline expansion ratio at T-points 
     500      !!---------------------------------------------------------------------- 
     501      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! pot. temperature & salinity 
     502      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pab   ! thermal/haline expansion ratio 
     503      ! 
     504      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     505      REAL(wp) ::   zt , zh , zs , ztm        ! local scalars 
     506      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      - 
     507      !!---------------------------------------------------------------------- 
     508      ! 
     509      IF( nn_timing == 1 )   CALL timing_start('rab_3d') 
     510      ! 
     511      SELECT CASE ( nn_eos ) 
     512      ! 
     513      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
     514         ! 
     515         DO jk = 1, jpkm1 
    522516            DO jj = 1, jpj 
    523517               DO ji = 1, jpi 
    524                   zgde3w = grav / fse3w(ji,jj,jk) 
    525                   zt = 0.5_wp * ( pts(ji,jj,jk,jp_tem) + pts(ji,jj,jk-1,jp_tem) )            ! potential temperature at w-pt 
    526                   zs = 0.5_wp * ( pts(ji,jj,jk,jp_sal) + pts(ji,jj,jk-1,jp_sal) ) - 35.0_wp  ! salinity anomaly (s-35) at w-pt 
    527                   zh = fsdepw(ji,jj,jk)                                                ! depth in meters  at w-point 
    528                   ! 
    529                   zalbet = ( ( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt   &   ! ratio alpha/beta 
    530                      &                                  - 0.203814e-03_wp ) * zt   & 
    531                      &                                  + 0.170907e-01_wp ) * zt   & 
    532                      &   +         0.665157e-01_wp                                 & 
    533                      &   +     ( - 0.678662e-05_wp * zs                            & 
    534                      &           - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs   & 
    535                      &   +   ( ( - 0.302285e-13_wp * zh                            & 
    536                      &           - 0.251520e-11_wp * zs                            & 
    537                      &           + 0.512857e-12_wp * zt * zt              ) * zh   & 
    538                      &           - 0.164759e-06_wp * zs                            & 
    539                      &        +(   0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt   & 
    540                      &                                  + 0.380374e-04_wp ) * zh 
    541                      ! 
    542                   zbeta  = ( ( -0.415613e-09_wp * zt + 0.555579e-07_wp ) * zt      &   ! beta 
    543                      &                               - 0.301985e-05_wp ) * zt      & 
    544                      &   +       0.785567e-03_wp                                   & 
    545                      &   + (     0.515032e-08_wp * zs                              & 
    546                      &         + 0.788212e-08_wp * zt - 0.356603e-06_wp ) * zs     & 
    547                      &   + ( (   0.121551e-17_wp * zh                              & 
    548                      &         - 0.602281e-15_wp * zs                              & 
    549                      &         - 0.175379e-14_wp * zt + 0.176621e-12_wp ) * zh     & 
    550                      &                                + 0.408195e-10_wp   * zs     & 
    551                      &     + ( - 0.213127e-11_wp * zt + 0.192867e-09_wp ) * zt     & 
    552                      &                                - 0.121555e-07_wp ) * zh 
    553                      ! 
    554                   pn2(ji,jj,jk) = zgde3w * zbeta * tmask(ji,jj,jk) * tmask(ji,jj,jk-1)           &   ! N^2 
    555                      &          * ( zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )   & 
    556                      &                     - ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) ) 
    557 #if defined key_zdfddm 
    558                   !                                                         !!bug **** caution a traiter zds=dk[S]= 0 !!!! 
    559                   zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )                    ! Rrau = (alpha / beta) (dk[t] / dk[s]) 
    560                   IF ( ABS( zds) <= 1.e-20_wp ) zds = 1.e-20_wp 
    561                   rrau(ji,jj,jk) = zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) / zds 
    562 #endif 
     518                  ! 
     519                  zh  = fsdept(ji,jj,jk) * r1_Z0                                ! depth 
     520                  zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
     521                  zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     522                  ztm = tmask(ji,jj,jk)                                         ! tmask 
     523                  ! 
     524                  ! alpha 
     525                  zn3 = ALP003 
     526                  ! 
     527                  zn2 = ALP012*zt + ALP102*zs+ALP002 
     528                  ! 
     529                  zn1 = ((ALP031*zt   & 
     530                     &   + ALP121*zs+ALP021)*zt   & 
     531                     &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   & 
     532                     &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 
     533                     ! 
     534                  zn0 = ((((ALP050*zt   & 
     535                     &   + ALP140*zs+ALP040)*zt   & 
     536                     &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   & 
     537                     &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   & 
     538                     &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   & 
     539                     &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 
     540                     ! 
     541                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     542                  ! 
     543                  pab(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm 
     544                  ! 
     545                  ! beta 
     546                  zn3 = BET003 
     547                  ! 
     548                  zn2 = BET012*zt + BET102*zs+BET002 
     549                  ! 
     550                  zn1 = ((BET031*zt   & 
     551                     &   + BET121*zs+BET021)*zt   & 
     552                     &   + (BET211*zs+BET111)*zs+BET011)*zt   & 
     553                     &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 
     554                     ! 
     555                  zn0 = ((((BET050*zt   & 
     556                     &   + BET140*zs+BET040)*zt   & 
     557                     &   + (BET230*zs+BET130)*zs+BET030)*zt   & 
     558                     &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   & 
     559                     &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   & 
     560                     &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 
     561                     ! 
     562                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     563                  ! 
     564                  pab(ji,jj,jk,jp_sal) = zn / zs * r1_rau0 * ztm 
     565                  ! 
    563566               END DO 
    564567            END DO 
    565568         END DO 
    566569         ! 
    567       CASE( 1 )                !==  Linear formulation = F( temperature )  ==! 
    568          DO jk = 2, jpkm1 
    569             pn2(:,:,jk) = grav * rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) )   & 
    570                &          / fse3w(:,:,jk) * tmask(:,:,jk) * tmask(:,:,jk-1) 
    571          END DO 
    572          ! 
    573       CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==! 
    574          DO jk = 2, jpkm1 
    575             pn2(:,:,jk) = grav * (  rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) )      & 
    576                &                  - rn_beta  * ( pts(:,:,jk-1,jp_sal) - pts(:,:,jk,jp_sal) )  )   & 
    577                &               / fse3w(:,:,jk) * tmask(:,:,jk) * tmask(:,:,jk-1) 
    578          END DO 
    579 #if defined key_zdfddm 
    580          DO jk = 2, jpkm1                                 ! Rrau = (alpha / beta) (dk[t] / dk[s]) 
     570      CASE( 1 )                  !==  simplified EOS  ==! 
     571         ! 
     572         DO jk = 1, jpkm1 
    581573            DO jj = 1, jpj 
    582574               DO ji = 1, jpi 
    583                   zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) 
    584                   IF ( ABS( zds ) <= 1.e-20_wp ) zds = 1.e-20_wp 
    585                   rrau(ji,jj,jk) = ralpbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) / zds 
     575                  zt  = pts (ji,jj,jk,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0) 
     576                  zs  = pts (ji,jj,jk,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0) 
     577                  zh  = fsdept(ji,jj,jk)                 ! depth in meters at t-point 
     578                  ztm = tmask(ji,jj,jk)                  ! land/sea bottom mask = surf. mask 
     579                  ! 
     580                  zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 
     581                  pab(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm   ! alpha 
     582                  ! 
     583                  zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 
     584                  pab(ji,jj,jk,jp_sal) = zn * r1_rau0 * ztm   ! beta 
     585                  ! 
    586586               END DO 
    587587            END DO 
    588588         END DO 
    589 #endif 
    590       END SELECT 
    591  
    592       IF(ln_ctl)   CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2  : ', ovlap=1, kdim=jpk ) 
    593 #if defined key_zdfddm 
    594       IF(ln_ctl)   CALL prt_ctl( tab3d_1=rrau, clinfo1=' rrau : ', ovlap=1, kdim=jpk ) 
    595 #endif 
    596       ! 
    597       IF( nn_timing == 1 ) CALL timing_stop('bn2') 
    598       ! 
    599    END SUBROUTINE eos_bn2 
    600  
    601  
    602    SUBROUTINE eos_alpbet( pts, palpbet, beta0 ) 
    603       !!---------------------------------------------------------------------- 
    604       !!                 ***  ROUTINE eos_alpbet  *** 
    605       !! 
    606       !! ** Purpose :   Calculates the in situ thermal/haline expansion ratio at T-points 
    607       !! 
    608       !! ** Method  :   calculates alpha / beta ratio at T-points 
    609       !!       * nn_eos = 0  : UNESCO sea water properties 
    610       !!                       The alpha/beta ratio is returned as 3-D array palpbet using the polynomial 
    611       !!                       polynomial expression of McDougall (1987). 
    612       !!                       Scalar beta0 is returned = 1. 
    613       !!       * nn_eos = 1  : linear equation of state (temperature only) 
    614       !!                       The ratio is undefined, so we return alpha as palpbet 
    615       !!                       Scalar beta0 is returned = 0. 
    616       !!       * nn_eos = 2  : linear equation of state (temperature & salinity) 
    617       !!                       The alpha/beta ratio is returned as ralpbet 
    618       !!                       Scalar beta0 is returned = 1. 
    619       !! 
    620       !! ** Action  : - palpbet : thermal/haline expansion ratio at T-points 
    621       !!            :   beta0   : 1. or 0. 
    622       !!---------------------------------------------------------------------- 
    623       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts       ! pot. temperature & salinity 
    624       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   palpbet   ! thermal/haline expansion ratio 
    625       REAL(wp),                              INTENT(  out) ::   beta0     ! set = 1 except with case 1 eos, rho=rho(T) 
    626       !! 
    627       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    628       REAL(wp) ::   zt, zs, zh   ! local scalars 
    629       !!---------------------------------------------------------------------- 
    630       ! 
    631       IF( nn_timing == 1 ) CALL timing_start('eos_alpbet') 
    632       ! 
    633       SELECT CASE ( nn_eos ) 
    634       ! 
    635       CASE ( 0 )               ! Jackett and McDougall (1994) formulation 
    636          DO jk = 1, jpk 
    637             DO jj = 1, jpj 
    638                DO ji = 1, jpi 
    639                   zt = pts(ji,jj,jk,jp_tem)           ! potential temperature 
    640                   zs = pts(ji,jj,jk,jp_sal) - 35._wp  ! salinity anomaly (s-35) 
    641                   zh = fsdept(ji,jj,jk)               ! depth in meters 
    642                   ! 
    643                   palpbet(ji,jj,jk) =                                              & 
    644                      &     ( ( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt   & 
    645                      &                                  - 0.203814e-03_wp ) * zt   & 
    646                      &                                  + 0.170907e-01_wp ) * zt   & 
    647                      &   + 0.665157e-01_wp                                         & 
    648                      &   +     ( - 0.678662e-05_wp * zs                            & 
    649                      &           - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs   & 
    650                      &   +   ( ( - 0.302285e-13_wp * zh                            & 
    651                      &           - 0.251520e-11_wp * zs                            & 
    652                      &           + 0.512857e-12_wp * zt * zt              ) * zh   & 
    653                      &           - 0.164759e-06_wp * zs                            & 
    654                      &        +(   0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt   & 
    655                      &                                  + 0.380374e-04_wp ) * zh 
    656                END DO 
    657             END DO 
    658          END DO 
    659          beta0 = 1._wp 
    660          ! 
    661       CASE ( 1 )              !==  Linear formulation = F( temperature )  ==! 
    662          palpbet(:,:,:) = rn_alpha 
    663          beta0 = 0._wp 
    664          ! 
    665       CASE ( 2 )              !==  Linear formulation = F( temperature , salinity )  ==! 
    666          palpbet(:,:,:) = ralpbet 
    667          beta0 = 1._wp 
    668589         ! 
    669590      CASE DEFAULT 
    … …  
    674595      END SELECT 
    675596      ! 
    676       IF( nn_timing == 1 ) CALL timing_stop('eos_alpbet') 
    677       ! 
    678    END SUBROUTINE eos_alpbet 
    679  
    680  
    681    FUNCTION tfreez( psal, pdep ) RESULT( ptf ) 
     597      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pab(:,:,:,jp_tem), clinfo1=' rab_3d_t: ', & 
     598         &                       tab3d_2=pab(:,:,:,jp_sal), clinfo2=' rab_3d_s : ', ovlap=1, kdim=jpk ) 
     599      ! 
     600      IF( nn_timing == 1 )   CALL timing_stop('rab_3d') 
     601      ! 
     602   END SUBROUTINE rab_3d 
     603 
     604   SUBROUTINE rab_2d( pts, pdep, pab ) 
     605      !!---------------------------------------------------------------------- 
     606      !!                 ***  ROUTINE rab_2d  *** 
     607      !! 
     608      !! ** Purpose :   Calculates thermal/haline expansion ratio for a 2d field (unmasked) 
     609      !! 
     610      !! ** Action  : - pab     : thermal/haline expansion ratio at T-points 
     611      !!---------------------------------------------------------------------- 
     612      REAL(wp), DIMENSION(jpi,jpj,jpts)    , INTENT(in   ) ::   pts    ! pot. temperature & salinity 
     613      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(in   ) ::   pdep   ! depth                  [m] 
     614      REAL(wp), DIMENSION(jpi,jpj,jpts)    , INTENT(  out) ::   pab    ! thermal/haline expansion ratio 
     615      ! 
     616      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     617      REAL(wp) ::   zt , zh , zs              ! local scalars 
     618      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      - 
     619      !!---------------------------------------------------------------------- 
     620      ! 
     621      IF( nn_timing == 1 ) CALL timing_start('rab_2d') 
     622      ! 
     623      pab(:,:,:) = 0._wp 
     624      ! 
     625      SELECT CASE ( nn_eos ) 
     626      ! 
     627      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
     628         ! 
     629         DO jj = 1, jpjm1 
     630            DO ji = 1, fs_jpim1   ! vector opt. 
     631               ! 
     632               zh  = pdep(ji,jj) * r1_Z0                                  ! depth 
     633               zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature 
     634               zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     635               ! 
     636               ! alpha 
     637               zn3 = ALP003 
     638               ! 
     639               zn2 = ALP012*zt + ALP102*zs+ALP002 
     640               ! 
     641               zn1 = ((ALP031*zt   & 
     642                  &   + ALP121*zs+ALP021)*zt   & 
     643                  &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   & 
     644                  &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 
     645                  ! 
     646               zn0 = ((((ALP050*zt   & 
     647                  &   + ALP140*zs+ALP040)*zt   & 
     648                  &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   & 
     649                  &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   & 
     650                  &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   & 
     651                  &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 
     652                  ! 
     653               zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     654               ! 
     655               pab(ji,jj,jp_tem) = zn * r1_rau0 
     656               ! 
     657               ! beta 
     658               zn3 = BET003 
     659               ! 
     660               zn2 = BET012*zt + BET102*zs+BET002 
     661               ! 
     662               zn1 = ((BET031*zt   & 
     663                  &   + BET121*zs+BET021)*zt   & 
     664                  &   + (BET211*zs+BET111)*zs+BET011)*zt   & 
     665                  &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 
     666                  ! 
     667               zn0 = ((((BET050*zt   & 
     668                  &   + BET140*zs+BET040)*zt   & 
     669                  &   + (BET230*zs+BET130)*zs+BET030)*zt   & 
     670                  &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   & 
     671                  &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   & 
     672                  &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 
     673                  ! 
     674               zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     675               ! 
     676               pab(ji,jj,jp_sal) = zn / zs * r1_rau0 
     677               ! 
     678               ! 
     679            END DO 
     680         END DO 
     681         ! 
     682         CALL lbc_lnk( pab(:,:,jp_tem), 'T', 1. )                    ! Lateral boundary conditions 
     683         CALL lbc_lnk( pab(:,:,jp_sal), 'T', 1. )                     
     684         ! 
     685      CASE( 1 )                  !==  simplified EOS  ==! 
     686         ! 
     687         DO jj = 1, jpjm1 
     688            DO ji = 1, fs_jpim1   ! vector opt. 
     689               ! 
     690               zt    = pts  (ji,jj,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0) 
     691               zs    = pts  (ji,jj,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0) 
     692               zh    = pdep (ji,jj)                   ! depth at the partial step level 
     693               ! 
     694               zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 
     695               pab(ji,jj,jp_tem) = zn * r1_rau0   ! alpha 
     696               ! 
     697               zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 
     698               pab(ji,jj,jp_sal) = zn * r1_rau0   ! beta 
     699               ! 
     700            END DO 
     701         END DO 
     702         ! 
     703         CALL lbc_lnk( pab(:,:,jp_tem), 'T', 1. )                    ! Lateral boundary conditions 
     704         CALL lbc_lnk( pab(:,:,jp_sal), 'T', 1. )                     
     705         ! 
     706      CASE DEFAULT 
     707         IF(lwp) WRITE(numout,cform_err) 
     708         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos 
     709         nstop = nstop + 1 
     710         ! 
     711      END SELECT 
     712      ! 
     713      IF(ln_ctl)   CALL prt_ctl( tab2d_1=pab(:,:,jp_tem), clinfo1=' rab_2d_t: ', & 
     714         &                       tab2d_2=pab(:,:,jp_sal), clinfo2=' rab_2d_s : ' ) 
     715      ! 
     716      IF( nn_timing == 1 )   CALL timing_stop('rab_2d') 
     717      ! 
     718   END SUBROUTINE rab_2d 
     719 
     720 
     721   SUBROUTINE rab_0d( pts, pdep, pab ) 
     722      !!---------------------------------------------------------------------- 
     723      !!                 ***  ROUTINE rab_0d  *** 
     724      !! 
     725      !! ** Purpose :   Calculates thermal/haline expansion ratio for a 2d field (unmasked) 
     726      !! 
     727      !! ** Action  : - pab     : thermal/haline expansion ratio at T-points 
     728      !!---------------------------------------------------------------------- 
     729      REAL(wp), DIMENSION(jpts)    , INTENT(in   ) ::   pts    ! pot. temperature & salinity 
     730      REAL(wp),                      INTENT(in   ) ::   pdep   ! depth                  [m] 
     731      REAL(wp), DIMENSION(jpts)    , INTENT(  out) ::   pab    ! thermal/haline expansion ratio 
     732      ! 
     733      REAL(wp) ::   zt , zh , zs              ! local scalars 
     734      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      - 
     735      !!---------------------------------------------------------------------- 
     736      ! 
     737      IF( nn_timing == 1 ) CALL timing_start('rab_2d') 
     738      ! 
     739      pab(:) = 0._wp 
     740      ! 
     741      SELECT CASE ( nn_eos ) 
     742      ! 
     743      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
     744         ! 
     745         ! 
     746         zh  = pdep * r1_Z0                                  ! depth 
     747         zt  = pts (jp_tem) * r1_T0                           ! temperature 
     748         zs  = SQRT( ABS( pts(jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     749         ! 
     750         ! alpha 
     751         zn3 = ALP003 
     752         ! 
     753         zn2 = ALP012*zt + ALP102*zs+ALP002 
     754         ! 
     755         zn1 = ((ALP031*zt   & 
     756            &   + ALP121*zs+ALP021)*zt   & 
     757            &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   & 
     758            &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 
     759            ! 
     760         zn0 = ((((ALP050*zt   & 
     761            &   + ALP140*zs+ALP040)*zt   & 
     762            &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   & 
     763            &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   & 
     764            &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   & 
     765            &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 
     766            ! 
     767         zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     768         ! 
     769         pab(jp_tem) = zn * r1_rau0 
     770         ! 
     771         ! beta 
     772         zn3 = BET003 
     773         ! 
     774         zn2 = BET012*zt + BET102*zs+BET002 
     775         ! 
     776         zn1 = ((BET031*zt   & 
     777            &   + BET121*zs+BET021)*zt   & 
     778            &   + (BET211*zs+BET111)*zs+BET011)*zt   & 
     779            &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 
     780            ! 
     781         zn0 = ((((BET050*zt   & 
     782            &   + BET140*zs+BET040)*zt   & 
     783            &   + (BET230*zs+BET130)*zs+BET030)*zt   & 
     784            &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   & 
     785            &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   & 
     786            &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 
     787            ! 
     788         zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     789         ! 
     790         pab(jp_sal) = zn / zs * r1_rau0 
     791         ! 
     792         ! 
     793         ! 
     794      CASE( 1 )                  !==  simplified EOS  ==! 
     795         ! 
     796         zt    = pts(jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0) 
     797         zs    = pts(jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0) 
     798         zh    = pdep                    ! depth at the partial step level 
     799         ! 
     800         zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 
     801         pab(jp_tem) = zn * r1_rau0   ! alpha 
     802         ! 
     803         zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 
     804         pab(jp_sal) = zn * r1_rau0   ! beta 
     805         ! 
     806      CASE DEFAULT 
     807         IF(lwp) WRITE(numout,cform_err) 
     808         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos 
     809         nstop = nstop + 1 
     810         ! 
     811      END SELECT 
     812      ! 
     813      IF( nn_timing == 1 )   CALL timing_stop('rab_2d') 
     814      ! 
     815   END SUBROUTINE rab_0d 
     816 
     817 
     818   SUBROUTINE bn2( pts, pab, pn2 ) 
     819      !!---------------------------------------------------------------------- 
     820      !!                  ***  ROUTINE bn2  *** 
     821      !! 
     822      !! ** Purpose :   Compute the local Brunt-Vaisala frequency at the  
     823      !!                time-step of the input arguments 
     824      !! 
     825      !! ** Method  :   pn2 = grav * (alpha dk[T] + beta dk[S] ) / e3w 
     826      !!      where alpha and beta are given in pab, and computed on T-points. 
     827      !!      N.B. N^2 is set one for all to zero at jk=1 in istate module. 
     828      !! 
     829      !! ** Action  :   pn2 : square of the brunt-vaisala frequency at w-point  
     830      !! 
     831      !!---------------------------------------------------------------------- 
     832      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pts   ! pot. temperature and salinity   [Celcius,psu] 
     833      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pab   ! thermal/haline expansion coef.  [Celcius-1,psu-1] 
     834      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::  pn2   ! Brunt-Vaisala frequency squared [1/s^2] 
     835      ! 
     836      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
     837      REAL(wp) ::   zaw, zbw, zrw   ! local scalars 
     838      !!---------------------------------------------------------------------- 
     839      ! 
     840      IF( nn_timing == 1 ) CALL timing_start('bn2') 
     841      ! 
     842      DO jk = 2, jpkm1           ! interior points only (2=< jk =< jpkm1 ) 
     843         DO jj = 1, jpj          ! surface and bottom value set to zero one for all in istate.F90 
     844            DO ji = 1, jpi 
     845               zrw =   ( fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk) )   & 
     846                  &  / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) )  
     847                  ! 
     848               zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw  
     849               zbw = pab(ji,jj,jk,jp_sal) * (1. - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw 
     850               ! 
     851               pn2(ji,jj,jk) = grav * (  zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )     & 
     852                  &                    - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )  )  & 
     853                  &            / fse3w(ji,jj,jk) * tmask(ji,jj,jk) 
     854            END DO 
     855         END DO 
     856      END DO 
     857      ! 
     858      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2  : ', ovlap=1, kdim=jpk ) 
     859      ! 
     860      IF( nn_timing == 1 )   CALL timing_stop('bn2') 
     861      ! 
     862   END SUBROUTINE bn2 
     863 
     864 
     865   FUNCTION eos_pt_from_ct( ctmp, psal ) RESULT( ptmp ) 
     866      !!---------------------------------------------------------------------- 
     867      !!                 ***  ROUTINE eos_pt_from_ct  *** 
     868      !! 
     869      !! ** Purpose :   Compute pot.temp. from cons. temp. [Celcius] 
     870      !! 
     871      !! ** Method  :   rational approximation (5/3th order) of TEOS-10 algorithm 
     872      !!       checkvalue: pt=20.02391895 Celsius for sa=35.7g/kg, ct=20degC 
     873      !! 
     874      !! Reference  :   TEOS-10, UNESCO 
     875      !!                Rational approximation to TEOS10 algorithm (rms error on WOA13 values: 4.0e-5 degC) 
     876      !!---------------------------------------------------------------------- 
     877      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ctmp   ! Cons. Temp [Celcius] 
     878      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity   [psu] 
     879      ! Leave result array automatic rather than making explicitly allocated 
     880      REAL(wp), DIMENSION(jpi,jpj) ::   ptmp   ! potential temperature [Celcius] 
     881      ! 
     882      INTEGER  ::   ji, jj               ! dummy loop indices 
     883      REAL(wp) ::   zt , zs , ztm        ! local scalars 
     884      REAL(wp) ::   zn , zd              ! local scalars 
     885      REAL(wp) ::   zdeltaS , z1_S0 , z1_T0 
     886      !!---------------------------------------------------------------------- 
     887      ! 
     888      IF ( nn_timing == 1 )   CALL timing_start('eos_pt_from_ct') 
     889      ! 
     890      zdeltaS = 5._wp 
     891      z1_S0   = 0.875_wp/35.16504_wp 
     892      z1_T0   = 1._wp/40._wp 
     893      ! 
     894      DO jj = 1, jpj 
     895         DO ji = 1, jpi 
     896            ! 
     897            zt  = ctmp   (ji,jj) * z1_T0 
     898            zs  = SQRT( ABS( psal(ji,jj) + zdeltaS ) * r1_S0 ) 
     899            ztm = tmask(ji,jj,1) 
     900            ! 
     901            zn = ((((-2.1385727895e-01_wp*zt   & 
     902               &   - 2.7674419971e-01_wp*zs+1.0728094330_wp)*zt   & 
     903               &   + (2.6366564313_wp*zs+3.3546960647_wp)*zs-7.8012209473_wp)*zt   & 
     904               &   + ((1.8835586562_wp*zs+7.3949191679_wp)*zs-3.3937395875_wp)*zs-5.6414948432_wp)*zt   & 
     905               &   + (((3.5737370589_wp*zs-1.5512427389e+01_wp)*zs+2.4625741105e+01_wp)*zs   & 
     906               &      +1.9912291000e+01_wp)*zs-3.2191146312e+01_wp)*zt   & 
     907               &   + ((((5.7153204649e-01_wp*zs-3.0943149543_wp)*zs+9.3052495181_wp)*zs   & 
     908               &      -9.4528934807_wp)*zs+3.1066408996_wp)*zs-4.3504021262e-01_wp 
     909               ! 
     910            zd = (2.0035003456_wp*zt   & 
     911               &   -3.4570358592e-01_wp*zs+5.6471810638_wp)*zt   & 
     912               &   + (1.5393993508_wp*zs-6.9394762624_wp)*zs+1.2750522650e+01_wp 
     913               ! 
     914            ptmp(ji,jj) = ( zt / z1_T0 + zn / zd ) * ztm 
     915               ! 
     916         END DO 
     917      END DO 
     918      ! 
     919      IF( nn_timing == 1 )   CALL timing_stop('eos_pt_from_ct') 
     920      ! 
     921   END FUNCTION eos_pt_from_ct 
     922 
     923 
     924   FUNCTION eos_fzp_2d( psal, pdep ) RESULT( ptf ) 
     925      !!---------------------------------------------------------------------- 
     926      !!                 ***  ROUTINE eos_fzp  *** 
     927      !! 
     928      !! ** Purpose :   Compute the freezing point temperature [Celcius] 
     929      !! 
     930      !! ** Method  :   UNESCO freezing point (ptf) in Celcius is given by 
     931      !!       ptf(t,z) = (-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s - 7.53e-4*z 
     932      !!       checkvalue: tf=-2.588567 Celsius for s=40psu, z=500m 
     933      !! 
     934      !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978 
     935      !!---------------------------------------------------------------------- 
     936      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   )           ::   psal   ! salinity   [psu] 
     937      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ), OPTIONAL ::   pdep   ! depth      [m] 
     938      REAL(wp), DIMENSION(jpi,jpj)                          ::   ptf   ! freezing temperature [Celcius] 
     939      ! 
     940      INTEGER  ::   ji, jj   ! dummy loop indices 
     941      REAL(wp) ::   zt, zs   ! local scalars 
     942      !!---------------------------------------------------------------------- 
     943      ! 
     944      SELECT CASE ( nn_eos ) 
     945      ! 
     946      CASE ( -1, 1 )                !==  CT,SA (TEOS-10 formulation) ==! 
     947         ! 
     948         DO jj = 1, jpj 
     949            DO ji = 1, jpi 
     950               zs= SQRT( ABS( psal(ji,jj) ) * r1_S0 )           ! square root salinity 
     951               ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs & 
     952                  &          - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp 
     953            END DO 
     954         END DO 
     955         ptf(:,:) = ptf(:,:) * psal(:,:) 
     956         ! 
     957         IF( PRESENT( pdep ) )   ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 
     958         ! 
     959      CASE ( 0 )                     !==  PT,SP (UNESCO formulation)  ==! 
     960         ! 
     961         ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) )   & 
     962            &                     - 2.154996e-4_wp *       psal(:,:)   ) * psal(:,:) 
     963            ! 
     964         IF( PRESENT( pdep ) )   ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 
     965         ! 
     966      CASE DEFAULT 
     967         IF(lwp) WRITE(numout,cform_err) 
     968         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos 
     969         nstop = nstop + 1 
     970         ! 
     971      END SELECT 
     972      ! 
     973   END FUNCTION eos_fzp_2d 
     974 
     975  FUNCTION eos_fzp_0d( psal, pdep ) RESULT( ptf ) 
     976      !!---------------------------------------------------------------------- 
     977      !!                 ***  ROUTINE eos_fzp  *** 
     978      !! 
     979      !! ** Purpose :   Compute the freezing point temperature [Celcius] 
     980      !! 
     981      !! ** Method  :   UNESCO freezing point (ptf) in Celcius is given by 
     982      !!       ptf(t,z) = (-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s - 7.53e-4*z 
     983      !!       checkvalue: tf=-2.588567 Celsius for s=40psu, z=500m 
     984      !! 
     985      !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978 
     986      !!---------------------------------------------------------------------- 
     987      REAL(wp), INTENT(in)           ::   psal   ! salinity   [psu] 
     988      REAL(wp), INTENT(in), OPTIONAL ::   pdep   ! depth      [m] 
     989      REAL(wp)                       ::   ptf   ! freezing temperature [Celcius] 
     990      ! 
     991      REAL(wp) :: zs   ! local scalars 
     992      !!---------------------------------------------------------------------- 
     993      ! 
     994      SELECT CASE ( nn_eos ) 
     995      ! 
     996      CASE ( -1, 1 )                !==  CT,SA (TEOS-10 formulation) ==! 
     997         ! 
     998         zs  = SQRT( ABS( psal ) * r1_S0 )           ! square root salinity 
     999         ptf = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs & 
     1000                  &          - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp 
     1001         ptf = ptf * psal 
     1002         ! 
     1003         IF( PRESENT( pdep ) )   ptf = ptf - 7.53e-4 * pdep 
     1004         ! 
     1005      CASE ( 0 )                     !==  PT,SP (UNESCO formulation)  ==! 
     1006         ! 
     1007         ptf = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal )   & 
     1008            &                - 2.154996e-4_wp *       psal   ) * psal 
     1009            ! 
     1010         IF( PRESENT( pdep ) )   ptf = ptf - 7.53e-4 * pdep 
     1011         ! 
     1012      CASE DEFAULT 
     1013         IF(lwp) WRITE(numout,cform_err) 
     1014         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos 
     1015         nstop = nstop + 1 
     1016         ! 
     1017      END SELECT 
     1018      ! 
     1019   END FUNCTION eos_fzp_0d 
     1020 
     1021 
     1022   SUBROUTINE eos_pen( pts, pab_pe, ppen ) 
     1023      !!---------------------------------------------------------------------- 
     1024      !!                 ***  ROUTINE eos_pen  *** 
     1025      !! 
     1026      !! ** Purpose :   Calculates nonlinear anomalies of alpha_PE, beta_PE and PE at T-points 
     1027      !! 
     1028      !! ** Method  :   PE is defined analytically as the vertical  
     1029      !!                   primitive of EOS times -g integrated between 0 and z>0. 
     1030      !!                pen is the nonlinear bsq-PE anomaly: pen = ( PE - rau0 gz ) / rau0 gz - rd 
     1031      !!                                                      = 1/z * /int_0^z rd dz - rd  
     1032      !!                                where rd is the density anomaly (see eos_rhd function) 
     1033      !!                ab_pe are partial derivatives of PE anomaly with respect to T and S: 
     1034      !!                    ab_pe(1) = - 1/(rau0 gz) * dPE/dT + drd/dT = - d(pen)/dT 
     1035      !!                    ab_pe(2) =   1/(rau0 gz) * dPE/dS + drd/dS =   d(pen)/dS 
     1036      !! 
     1037      !! ** Action  : - pen         : PE anomaly given at T-points 
     1038      !!            : - pab_pe  : given at T-points 
     1039      !!                    pab_pe(:,:,:,jp_tem) is alpha_pe 
     1040      !!                    pab_pe(:,:,:,jp_sal) is beta_pe 
     1041      !!---------------------------------------------------------------------- 
     1042      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts     ! pot. temperature & salinity 
     1043      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pab_pe  ! alpha_pe and beta_pe 
     1044      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   ppen     ! potential energy anomaly 
     1045      ! 
     1046      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     1047      REAL(wp) ::   zt , zh , zs , ztm        ! local scalars 
     1048      REAL(wp) ::   zn , zn0, zn1, zn2        !   -      - 
     1049      !!---------------------------------------------------------------------- 
     1050      ! 
     1051      IF( nn_timing == 1 )   CALL timing_start('eos_pen') 
     1052      ! 
     1053      SELECT CASE ( nn_eos ) 
     1054      ! 
     1055      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
     1056         ! 
     1057         DO jk = 1, jpkm1 
     1058            DO jj = 1, jpj 
     1059               DO ji = 1, jpi 
     1060                  ! 
     1061                  zh  = fsdept(ji,jj,jk) * r1_Z0                                ! depth 
     1062                  zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
     1063                  zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     1064                  ztm = tmask(ji,jj,jk)                                         ! tmask 
     1065                  ! 
     1066                  ! potential energy non-linear anomaly 
     1067                  zn2 = (PEN012)*zt   & 
     1068                     &   + PEN102*zs+PEN002 
     1069                     ! 
     1070                  zn1 = ((PEN021)*zt   & 
     1071                     &   + PEN111*zs+PEN011)*zt   & 
     1072                     &   + (PEN201*zs+PEN101)*zs+PEN001 
     1073                     ! 
     1074                  zn0 = ((((PEN040)*zt   & 
     1075                     &   + PEN130*zs+PEN030)*zt   & 
     1076                     &   + (PEN220*zs+PEN120)*zs+PEN020)*zt   & 
     1077                     &   + ((PEN310*zs+PEN210)*zs+PEN110)*zs+PEN010)*zt   & 
     1078                     &   + (((PEN400*zs+PEN300)*zs+PEN200)*zs+PEN100)*zs+PEN000 
     1079                     ! 
     1080                  zn  = ( zn2 * zh + zn1 ) * zh + zn0 
     1081                  ! 
     1082                  ppen(ji,jj,jk)  = zn * zh * r1_rau0 * ztm 
     1083                  ! 
     1084                  ! alphaPE non-linear anomaly 
     1085                  zn2 = APE002 
     1086                  ! 
     1087                  zn1 = (APE011)*zt   & 
     1088                     &   + APE101*zs+APE001 
     1089                     ! 
     1090                  zn0 = (((APE030)*zt   & 
     1091                     &   + APE120*zs+APE020)*zt   & 
     1092                     &   + (APE210*zs+APE110)*zs+APE010)*zt   & 
     1093                     &   + ((APE300*zs+APE200)*zs+APE100)*zs+APE000 
     1094                     ! 
     1095                  zn  = ( zn2 * zh + zn1 ) * zh + zn0 
     1096                  !                               
     1097                  pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rau0 * ztm 
     1098                  ! 
     1099                  ! betaPE non-linear anomaly 
     1100                  zn2 = BPE002 
     1101                  ! 
     1102                  zn1 = (BPE011)*zt   & 
     1103                     &   + BPE101*zs+BPE001 
     1104                     ! 
     1105                  zn0 = (((BPE030)*zt   & 
     1106                     &   + BPE120*zs+BPE020)*zt   & 
     1107                     &   + (BPE210*zs+BPE110)*zs+BPE010)*zt   & 
     1108                     &   + ((BPE300*zs+BPE200)*zs+BPE100)*zs+BPE000 
     1109                     ! 
     1110                  zn  = ( zn2 * zh + zn1 ) * zh + zn0 
     1111                  !                               
     1112                  pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rau0 * ztm 
     1113                  ! 
     1114               END DO 
     1115            END DO 
     1116         END DO 
     1117         ! 
     1118      CASE( 1 )                !==  Vallis (2006) simplified EOS  ==! 
     1119         ! 
     1120         DO jk = 1, jpkm1 
     1121            DO jj = 1, jpj 
     1122               DO ji = 1, jpi 
     1123                  zt  = pts(ji,jj,jk,jp_tem) - 10._wp  ! temperature anomaly (t-T0) 
     1124                  zs = pts (ji,jj,jk,jp_sal) - 35._wp  ! abs. salinity anomaly (s-S0) 
     1125                  zh  = fsdept(ji,jj,jk)               ! depth in meters  at t-point 
     1126                  ztm = tmask(ji,jj,jk)                ! tmask 
     1127                  zn  = 0.5_wp * zh * r1_rau0 * ztm 
     1128                  !                                    ! Potential Energy 
     1129                  ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn 
     1130                  !                                    ! alphaPE 
     1131                  pab_pe(ji,jj,jk,jp_tem) = - rn_a0 * rn_mu1 * zn 
     1132                  pab_pe(ji,jj,jk,jp_sal) =   rn_b0 * rn_mu2 * zn 
     1133                  ! 
     1134               END DO 
     1135            END DO 
     1136         END DO 
     1137         ! 
     1138      CASE DEFAULT 
     1139         IF(lwp) WRITE(numout,cform_err) 
     1140         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos 
     1141         nstop = nstop + 1 
     1142         ! 
     1143      END SELECT 
     1144      ! 
     1145      IF( nn_timing == 1 )   CALL timing_stop('eos_pen') 
     1146      ! 
     1147   END SUBROUTINE eos_pen 
     1148 
     1149 
     1150   SUBROUTINE eos_init 
    6821151      !!---------------------------------------------------------------------- 
    6831152      !!                 ***  ROUTINE eos_init  *** 
    6841153      !! 
    685       !! ** Purpose :   Compute the sea surface freezing temperature [Celcius] 
    686       !! 
    687       !! ** Method  :   UNESCO freezing point at the surface (pressure = 0???) 
    688       !!       freezing point [Celcius]=(-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s-7.53e-4*p 
    689       !!       checkvalue: tf= -2.588567 Celsius for s=40.0psu, p=500. decibars 
    690       !! 
    691       !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978 
    692       !!---------------------------------------------------------------------- 
    693       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity             [psu] 
    694       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ), OPTIONAL ::   pdep   ! depth      [decibars] 
    695       ! Leave result array automatic rather than making explicitly allocated 
    696       REAL(wp), DIMENSION(jpi,jpj)                ::   ptf    ! freezing temperature [Celcius] 
    697       !!---------------------------------------------------------------------- 
    698       ! 
    699       ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) )   & 
    700          &                     - 2.154996e-4_wp *       psal(:,:)   ) * psal(:,:) 
    701       IF ( PRESENT( pdep ) ) THEN    
    702          ptf(:,:) = ptf(:,:) - 7.53e-4_wp * pdep(:,:) 
    703       ENDIF 
    704       ! 
    705    END FUNCTION tfreez 
    706  
    707    FUNCTION tfreez1D( psal, pdep ) RESULT( ptf ) 
    708       !!---------------------------------------------------------------------- 
    709       !!                 ***  ROUTINE eos_init  *** 
    710       !! 
    711       !! ** Purpose :   Compute the sea surface freezing temperature [Celcius] 
    712       !! 
    713       !! ** Method  :   UNESCO freezing point at the surface (pressure = 0???) 
    714       !!       freezing point [Celcius]=(-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s-7.53e-4*p 
    715       !!       checkvalue: tf= -2.588567 Celsius for s=40.0psu, p=500. decibars 
    716       !! 
    717       !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978 
    718       !!---------------------------------------------------------------------- 
    719       REAL(wp), INTENT(in   ) ::   psal   ! salinity             [psu] 
    720       REAL(wp), INTENT(in   ), OPTIONAL ::   pdep   ! pressure             [dBar] 
    721       ! Leave result array automatic rather than making explicitly allocated 
    722       REAL(wp)                ::   ptf    ! freezing temperature [Celcius] 
    723       !!---------------------------------------------------------------------- 
    724       ! 
    725       ptf = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal )   & 
    726          &                     - 2.154996e-4_wp *  psal ) * psal 
    727       IF ( PRESENT( pdep ) ) THEN    
    728          ptf = ptf - 7.53e-4_wp * pdep 
    729       ENDIF 
    730       ! 
    731    END FUNCTION tfreez1D 
    732  
    733  
    734  
    735    SUBROUTINE eos_init 
    736       !!---------------------------------------------------------------------- 
    737       !!                 ***  ROUTINE eos_init  *** 
    738       !! 
    7391154      !! ** Purpose :   initializations for the equation of state 
    7401155      !! 
    7411156      !! ** Method  :   Read the namelist nameos and control the parameters 
    7421157      !!---------------------------------------------------------------------- 
    743       NAMELIST/nameos/ nn_eos, rn_alpha, rn_beta 
    744       !!---------------------------------------------------------------------- 
    745       INTEGER  ::   ios 
     1158      INTEGER  ::   ios   ! local integer 
     1159      !! 
     1160      NAMELIST/nameos/ nn_eos, ln_useCT, rn_a0, rn_b0, rn_lambda1, rn_mu1,   & 
     1161         &                                             rn_lambda2, rn_mu2, rn_nu 
     1162      !!---------------------------------------------------------------------- 
    7461163      ! 
    7471164      REWIND( numnam_ref )              ! Namelist nameos in reference namelist : equation of state 
    7481165      READ  ( numnam_ref, nameos, IOSTAT = ios, ERR = 901 ) 
    7491166901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in reference namelist', lwp ) 
    750  
     1167      ! 
    7511168      REWIND( numnam_cfg )              ! Namelist nameos in configuration namelist : equation of state 
    7521169      READ  ( numnam_cfg, nameos, IOSTAT = ios, ERR = 902 ) 
    7531170902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in configuration namelist', lwp ) 
    754       IF(lwm) WRITE( numond, nameos ) 
     1171      WRITE( numond, nameos ) 
     1172      ! 
     1173      rau0        = 1026._wp                 !: volumic mass of reference     [kg/m3] 
     1174      rcp         = 3991.86795711963_wp      !: heat capacity     [J/K] 
    7551175      ! 
    7561176      IF(lwp) THEN                ! Control print 
    … …  
    7601180         WRITE(numout,*) '          Namelist nameos : set eos parameters' 
    7611181         WRITE(numout,*) '             flag for eq. of state and N^2  nn_eos   = ', nn_eos 
    762          WRITE(numout,*) '             thermal exp. coef. (linear)    rn_alpha = ', rn_alpha 
    763          WRITE(numout,*) '             saline  exp. coef. (linear)    rn_beta  = ', rn_beta 
     1182         IF( ln_useCT )   THEN 
     1183            WRITE(numout,*) '             model uses Conservative Temperature' 
     1184            WRITE(numout,*) '             Important: model must be initialized with CT and SA fields' 
     1185         ENDIF 
    7641186      ENDIF 
    7651187      ! 
    7661188      SELECT CASE( nn_eos )         ! check option 
    7671189      ! 
    768       CASE( 0 )                        !==  Jackett and McDougall (1994) formulation  ==! 
     1190      CASE( -1 )                       !==  polynomial TEOS-10  ==! 
    7691191         IF(lwp) WRITE(numout,*) 
    770          IF(lwp) WRITE(numout,*) '          use of Jackett & McDougall (1994) equation of state and' 
    771          IF(lwp) WRITE(numout,*) '                 McDougall (1987) Brunt-Vaisala frequency' 
    772          ! 
    773       CASE( 1 )                        !==  Linear formulation = F( temperature )  ==! 
     1192         IF(lwp) WRITE(numout,*) '          use of TEOS-10 equation of state (cons. temp. and abs. salinity)' 
     1193         ! 
     1194         rdeltaS = 32._wp 
     1195         r1_S0  = 0.875_wp/35.16504_wp 
     1196         r1_T0  = 1._wp/40._wp 
     1197         r1_Z0  = 1.e-4_wp 
     1198         ! 
     1199         EOS000 = 8.0189615746e+02_wp 
     1200         EOS100 = 8.6672408165e+02_wp 
     1201         EOS200 = -1.7864682637e+03_wp 
     1202         EOS300 = 2.0375295546e+03_wp 
     1203         EOS400 = -1.2849161071e+03_wp 
     1204         EOS500 = 4.3227585684e+02_wp 
     1205         EOS600 = -6.0579916612e+01_wp 
     1206         EOS010 = 2.6010145068e+01_wp 
     1207         EOS110 = -6.5281885265e+01_wp 
     1208         EOS210 = 8.1770425108e+01_wp 
     1209         EOS310 = -5.6888046321e+01_wp 
     1210         EOS410 = 1.7681814114e+01_wp 
     1211         EOS510 = -1.9193502195_wp 
     1212         EOS020 = -3.7074170417e+01_wp 
     1213         EOS120 = 6.1548258127e+01_wp 
     1214         EOS220 = -6.0362551501e+01_wp 
     1215         EOS320 = 2.9130021253e+01_wp 
     1216         EOS420 = -5.4723692739_wp 
     1217         EOS030 = 2.1661789529e+01_wp 
     1218         EOS130 = -3.3449108469e+01_wp 
     1219         EOS230 = 1.9717078466e+01_wp 
     1220         EOS330 = -3.1742946532_wp 
     1221         EOS040 = -8.3627885467_wp 
     1222         EOS140 = 1.1311538584e+01_wp 
     1223         EOS240 = -5.3563304045_wp 
     1224         EOS050 = 5.4048723791e-01_wp 
     1225         EOS150 = 4.8169980163e-01_wp 
     1226         EOS060 = -1.9083568888e-01_wp 
     1227         EOS001 = 1.9681925209e+01_wp 
     1228         EOS101 = -4.2549998214e+01_wp 
     1229         EOS201 = 5.0774768218e+01_wp 
     1230         EOS301 = -3.0938076334e+01_wp 
     1231         EOS401 = 6.6051753097_wp 
     1232         EOS011 = -1.3336301113e+01_wp 
     1233         EOS111 = -4.4870114575_wp 
     1234         EOS211 = 5.0042598061_wp 
     1235         EOS311 = -6.5399043664e-01_wp 
     1236         EOS021 = 6.7080479603_wp 
     1237         EOS121 = 3.5063081279_wp 
     1238         EOS221 = -1.8795372996_wp 
     1239         EOS031 = -2.4649669534_wp 
     1240         EOS131 = -5.5077101279e-01_wp 
     1241         EOS041 = 5.5927935970e-01_wp 
     1242         EOS002 = 2.0660924175_wp 
     1243         EOS102 = -4.9527603989_wp 
     1244         EOS202 = 2.5019633244_wp 
     1245         EOS012 = 2.0564311499_wp 
     1246         EOS112 = -2.1311365518e-01_wp 
     1247         EOS022 = -1.2419983026_wp 
     1248         EOS003 = -2.3342758797e-02_wp 
     1249         EOS103 = -1.8507636718e-02_wp 
     1250         EOS013 = 3.7969820455e-01_wp 
     1251         ! 
     1252         ALP000 = -6.5025362670e-01_wp 
     1253         ALP100 = 1.6320471316_wp 
     1254         ALP200 = -2.0442606277_wp 
     1255         ALP300 = 1.4222011580_wp 
     1256         ALP400 = -4.4204535284e-01_wp 
     1257         ALP500 = 4.7983755487e-02_wp 
     1258         ALP010 = 1.8537085209_wp 
     1259         ALP110 = -3.0774129064_wp 
     1260         ALP210 = 3.0181275751_wp 
     1261         ALP310 = -1.4565010626_wp 
     1262         ALP410 = 2.7361846370e-01_wp 
     1263         ALP020 = -1.6246342147_wp 
     1264         ALP120 = 2.5086831352_wp 
     1265         ALP220 = -1.4787808849_wp 
     1266         ALP320 = 2.3807209899e-01_wp 
     1267         ALP030 = 8.3627885467e-01_wp 
     1268         ALP130 = -1.1311538584_wp 
     1269         ALP230 = 5.3563304045e-01_wp 
     1270         ALP040 = -6.7560904739e-02_wp 
     1271         ALP140 = -6.0212475204e-02_wp 
     1272         ALP050 = 2.8625353333e-02_wp 
     1273         ALP001 = 3.3340752782e-01_wp 
     1274         ALP101 = 1.1217528644e-01_wp 
     1275         ALP201 = -1.2510649515e-01_wp 
     1276         ALP301 = 1.6349760916e-02_wp 
     1277         ALP011 = -3.3540239802e-01_wp 
     1278         ALP111 = -1.7531540640e-01_wp 
     1279         ALP211 = 9.3976864981e-02_wp 
     1280         ALP021 = 1.8487252150e-01_wp 
     1281         ALP121 = 4.1307825959e-02_wp 
     1282         ALP031 = -5.5927935970e-02_wp 
     1283         ALP002 = -5.1410778748e-02_wp 
     1284         ALP102 = 5.3278413794e-03_wp 
     1285         ALP012 = 6.2099915132e-02_wp 
     1286         ALP003 = -9.4924551138e-03_wp 
     1287         ! 
     1288         BET000 = 1.0783203594e+01_wp 
     1289         BET100 = -4.4452095908e+01_wp 
     1290         BET200 = 7.6048755820e+01_wp 
     1291         BET300 = -6.3944280668e+01_wp 
     1292         BET400 = 2.6890441098e+01_wp 
     1293         BET500 = -4.5221697773_wp 
     1294         BET010 = -8.1219372432e-01_wp 
     1295         BET110 = 2.0346663041_wp 
     1296         BET210 = -2.1232895170_wp 
     1297         BET310 = 8.7994140485e-01_wp 
     1298         BET410 = -1.1939638360e-01_wp 
     1299         BET020 = 7.6574242289e-01_wp 
     1300         BET120 = -1.5019813020_wp 
     1301         BET220 = 1.0872489522_wp 
     1302         BET320 = -2.7233429080e-01_wp 
     1303         BET030 = -4.1615152308e-01_wp 
     1304         BET130 = 4.9061350869e-01_wp 
     1305         BET230 = -1.1847737788e-01_wp 
     1306         BET040 = 1.4073062708e-01_wp 
     1307         BET140 = -1.3327978879e-01_wp 
     1308         BET050 = 5.9929880134e-03_wp 
     1309         BET001 = -5.2937873009e-01_wp 
     1310         BET101 = 1.2634116779_wp 
     1311         BET201 = -1.1547328025_wp 
     1312         BET301 = 3.2870876279e-01_wp 
     1313         BET011 = -5.5824407214e-02_wp 
     1314         BET111 = 1.2451933313e-01_wp 
     1315         BET211 = -2.4409539932e-02_wp 
     1316         BET021 = 4.3623149752e-02_wp 
     1317         BET121 = -4.6767901790e-02_wp 
     1318         BET031 = -6.8523260060e-03_wp 
     1319         BET002 = -6.1618945251e-02_wp 
     1320         BET102 = 6.2255521644e-02_wp 
     1321         BET012 = -2.6514181169e-03_wp 
     1322         BET003 = -2.3025968587e-04_wp 
     1323         ! 
     1324         PEN000 = -9.8409626043_wp 
     1325         PEN100 = 2.1274999107e+01_wp 
     1326         PEN200 = -2.5387384109e+01_wp 
     1327         PEN300 = 1.5469038167e+01_wp 
     1328         PEN400 = -3.3025876549_wp 
     1329         PEN010 = 6.6681505563_wp 
     1330         PEN110 = 2.2435057288_wp 
     1331         PEN210 = -2.5021299030_wp 
     1332         PEN310 = 3.2699521832e-01_wp 
     1333         PEN020 = -3.3540239802_wp 
     1334         PEN120 = -1.7531540640_wp 
     1335         PEN220 = 9.3976864981e-01_wp 
     1336         PEN030 = 1.2324834767_wp 
     1337         PEN130 = 2.7538550639e-01_wp 
     1338         PEN040 = -2.7963967985e-01_wp 
     1339         PEN001 = -1.3773949450_wp 
     1340         PEN101 = 3.3018402659_wp 
     1341         PEN201 = -1.6679755496_wp 
     1342         PEN011 = -1.3709540999_wp 
     1343         PEN111 = 1.4207577012e-01_wp 
     1344         PEN021 = 8.2799886843e-01_wp 
     1345         PEN002 = 1.7507069098e-02_wp 
     1346         PEN102 = 1.3880727538e-02_wp 
     1347         PEN012 = -2.8477365341e-01_wp 
     1348         ! 
     1349         APE000 = -1.6670376391e-01_wp 
     1350         APE100 = -5.6087643219e-02_wp 
     1351         APE200 = 6.2553247576e-02_wp 
     1352         APE300 = -8.1748804580e-03_wp 
     1353         APE010 = 1.6770119901e-01_wp 
     1354         APE110 = 8.7657703198e-02_wp 
     1355         APE210 = -4.6988432490e-02_wp 
     1356         APE020 = -9.2436260751e-02_wp 
     1357         APE120 = -2.0653912979e-02_wp 
     1358         APE030 = 2.7963967985e-02_wp 
     1359         APE001 = 3.4273852498e-02_wp 
     1360         APE101 = -3.5518942529e-03_wp 
     1361         APE011 = -4.1399943421e-02_wp 
     1362         APE002 = 7.1193413354e-03_wp 
     1363         ! 
     1364         BPE000 = 2.6468936504e-01_wp 
     1365         BPE100 = -6.3170583896e-01_wp 
     1366         BPE200 = 5.7736640125e-01_wp 
     1367         BPE300 = -1.6435438140e-01_wp 
     1368         BPE010 = 2.7912203607e-02_wp 
     1369         BPE110 = -6.2259666565e-02_wp 
     1370         BPE210 = 1.2204769966e-02_wp 
     1371         BPE020 = -2.1811574876e-02_wp 
     1372         BPE120 = 2.3383950895e-02_wp 
     1373         BPE030 = 3.4261630030e-03_wp 
     1374         BPE001 = 4.1079296834e-02_wp 
     1375         BPE101 = -4.1503681096e-02_wp 
     1376         BPE011 = 1.7676120780e-03_wp 
     1377         BPE002 = 1.7269476440e-04_wp 
     1378         ! 
     1379      CASE( 0 )                        !==  polynomial EOS-80 formulation  ==! 
     1380         ! 
    7741381         IF(lwp) WRITE(numout,*) 
    775          IF(lwp) WRITE(numout,*) '          use of linear eos rho(T) = rau0 * ( 1.0285 - rn_alpha * T )' 
    776          IF( lk_zdfddm ) CALL ctl_stop( '          double diffusive mixing parameterization requires',   & 
    777               &                         ' that T and S are used as state variables' ) 
    778          ! 
    779       CASE( 2 )                        !==  Linear formulation = F( temperature , salinity )  ==! 
    780          ralpbet = rn_alpha / rn_beta 
    781          IF(lwp) WRITE(numout,*) 
    782          IF(lwp) WRITE(numout,*) '          use of linear eos rho(T,S) = rau0 * ( rn_beta * S - rn_alpha * T )' 
     1382         IF(lwp) WRITE(numout,*) '          use of EOS-80 equation of state (pot. temp. and pract. salinity)' 
     1383         ! 
     1384         rdeltaS = 20._wp 
     1385         r1_S0  = 1._wp/40._wp 
     1386         r1_T0  = 1._wp/40._wp 
     1387         r1_Z0  = 1.e-4_wp 
     1388         ! 
     1389         EOS000 = 9.5356891948e+02_wp 
     1390         EOS100 = 1.7136499189e+02_wp 
     1391         EOS200 = -3.7501039454e+02_wp 
     1392         EOS300 = 5.1856810420e+02_wp 
     1393         EOS400 = -3.7264470465e+02_wp 
     1394         EOS500 = 1.4302533998e+02_wp 
     1395         EOS600 = -2.2856621162e+01_wp 
     1396         EOS010 = 1.0087518651e+01_wp 
     1397         EOS110 = -1.3647741861e+01_wp 
     1398         EOS210 = 8.8478359933_wp 
     1399         EOS310 = -7.2329388377_wp 
     1400         EOS410 = 1.4774410611_wp 
     1401         EOS510 = 2.0036720553e-01_wp 
     1402         EOS020 = -2.5579830599e+01_wp 
     1403         EOS120 = 2.4043512327e+01_wp 
     1404         EOS220 = -1.6807503990e+01_wp 
     1405         EOS320 = 8.3811577084_wp 
     1406         EOS420 = -1.9771060192_wp 
     1407         EOS030 = 1.6846451198e+01_wp 
     1408         EOS130 = -2.1482926901e+01_wp 
     1409         EOS230 = 1.0108954054e+01_wp 
     1410         EOS330 = -6.2675951440e-01_wp 
     1411         EOS040 = -8.0812310102_wp 
     1412         EOS140 = 1.0102374985e+01_wp 
     1413         EOS240 = -4.8340368631_wp 
     1414         EOS050 = 1.2079167803_wp 
     1415         EOS150 = 1.1515380987e-01_wp 
     1416         EOS060 = -2.4520288837e-01_wp 
     1417         EOS001 = 1.0748601068e+01_wp 
     1418         EOS101 = -1.7817043500e+01_wp 
     1419         EOS201 = 2.2181366768e+01_wp 
     1420         EOS301 = -1.6750916338e+01_wp 
     1421         EOS401 = 4.1202230403_wp 
     1422         EOS011 = -1.5852644587e+01_wp 
     1423         EOS111 = -7.6639383522e-01_wp 
     1424         EOS211 = 4.1144627302_wp 
     1425         EOS311 = -6.6955877448e-01_wp 
     1426         EOS021 = 9.9994861860_wp 
     1427         EOS121 = -1.9467067787e-01_wp 
     1428         EOS221 = -1.2177554330_wp 
     1429         EOS031 = -3.4866102017_wp 
     1430         EOS131 = 2.2229155620e-01_wp 
     1431         EOS041 = 5.9503008642e-01_wp 
     1432         EOS002 = 1.0375676547_wp 
     1433         EOS102 = -3.4249470629_wp 
     1434         EOS202 = 2.0542026429_wp 
     1435         EOS012 = 2.1836324814_wp 
     1436         EOS112 = -3.4453674320e-01_wp 
     1437         EOS022 = -1.2548163097_wp 
     1438         EOS003 = 1.8729078427e-02_wp 
     1439         EOS103 = -5.7238495240e-02_wp 
     1440         EOS013 = 3.8306136687e-01_wp 
     1441         ! 
     1442         ALP000 = -2.5218796628e-01_wp 
     1443         ALP100 = 3.4119354654e-01_wp 
     1444         ALP200 = -2.2119589983e-01_wp 
     1445         ALP300 = 1.8082347094e-01_wp 
     1446         ALP400 = -3.6936026529e-02_wp 
     1447         ALP500 = -5.0091801383e-03_wp 
     1448         ALP010 = 1.2789915300_wp 
     1449         ALP110 = -1.2021756164_wp 
     1450         ALP210 = 8.4037519952e-01_wp 
     1451         ALP310 = -4.1905788542e-01_wp 
     1452         ALP410 = 9.8855300959e-02_wp 
     1453         ALP020 = -1.2634838399_wp 
     1454         ALP120 = 1.6112195176_wp 
     1455         ALP220 = -7.5817155402e-01_wp 
     1456         ALP320 = 4.7006963580e-02_wp 
     1457         ALP030 = 8.0812310102e-01_wp 
     1458         ALP130 = -1.0102374985_wp 
     1459         ALP230 = 4.8340368631e-01_wp 
     1460         ALP040 = -1.5098959754e-01_wp 
     1461         ALP140 = -1.4394226233e-02_wp 
     1462         ALP050 = 3.6780433255e-02_wp 
     1463         ALP001 = 3.9631611467e-01_wp 
     1464         ALP101 = 1.9159845880e-02_wp 
     1465         ALP201 = -1.0286156825e-01_wp 
     1466         ALP301 = 1.6738969362e-02_wp 
     1467         ALP011 = -4.9997430930e-01_wp 
     1468         ALP111 = 9.7335338937e-03_wp 
     1469         ALP211 = 6.0887771651e-02_wp 
     1470         ALP021 = 2.6149576513e-01_wp 
     1471         ALP121 = -1.6671866715e-02_wp 
     1472         ALP031 = -5.9503008642e-02_wp 
     1473         ALP002 = -5.4590812035e-02_wp 
     1474         ALP102 = 8.6134185799e-03_wp 
     1475         ALP012 = 6.2740815484e-02_wp 
     1476         ALP003 = -9.5765341718e-03_wp 
     1477         ! 
     1478         BET000 = 2.1420623987_wp 
     1479         BET100 = -9.3752598635_wp 
     1480         BET200 = 1.9446303907e+01_wp 
     1481         BET300 = -1.8632235232e+01_wp 
     1482         BET400 = 8.9390837485_wp 
     1483         BET500 = -1.7142465871_wp 
     1484         BET010 = -1.7059677327e-01_wp 
     1485         BET110 = 2.2119589983e-01_wp 
     1486         BET210 = -2.7123520642e-01_wp 
     1487         BET310 = 7.3872053057e-02_wp 
     1488         BET410 = 1.2522950346e-02_wp 
     1489         BET020 = 3.0054390409e-01_wp 
     1490         BET120 = -4.2018759976e-01_wp 
     1491         BET220 = 3.1429341406e-01_wp 
     1492         BET320 = -9.8855300959e-02_wp 
     1493         BET030 = -2.6853658626e-01_wp 
     1494         BET130 = 2.5272385134e-01_wp 
     1495         BET230 = -2.3503481790e-02_wp 
     1496         BET040 = 1.2627968731e-01_wp 
     1497         BET140 = -1.2085092158e-01_wp 
     1498         BET050 = 1.4394226233e-03_wp 
     1499         BET001 = -2.2271304375e-01_wp 
     1500         BET101 = 5.5453416919e-01_wp 
     1501         BET201 = -6.2815936268e-01_wp 
     1502         BET301 = 2.0601115202e-01_wp 
     1503         BET011 = -9.5799229402e-03_wp 
     1504         BET111 = 1.0286156825e-01_wp 
     1505         BET211 = -2.5108454043e-02_wp 
     1506         BET021 = -2.4333834734e-03_wp 
     1507         BET121 = -3.0443885826e-02_wp 
     1508         BET031 = 2.7786444526e-03_wp 
     1509         BET002 = -4.2811838287e-02_wp 
     1510         BET102 = 5.1355066072e-02_wp 
     1511         BET012 = -4.3067092900e-03_wp 
     1512         BET003 = -7.1548119050e-04_wp 
     1513         ! 
     1514         PEN000 = -5.3743005340_wp 
     1515         PEN100 = 8.9085217499_wp 
     1516         PEN200 = -1.1090683384e+01_wp 
     1517         PEN300 = 8.3754581690_wp 
     1518         PEN400 = -2.0601115202_wp 
     1519         PEN010 = 7.9263222935_wp 
     1520         PEN110 = 3.8319691761e-01_wp 
     1521         PEN210 = -2.0572313651_wp 
     1522         PEN310 = 3.3477938724e-01_wp 
     1523         PEN020 = -4.9997430930_wp 
     1524         PEN120 = 9.7335338937e-02_wp 
     1525         PEN220 = 6.0887771651e-01_wp 
     1526         PEN030 = 1.7433051009_wp 
     1527         PEN130 = -1.1114577810e-01_wp 
     1528         PEN040 = -2.9751504321e-01_wp 
     1529         PEN001 = -6.9171176978e-01_wp 
     1530         PEN101 = 2.2832980419_wp 
     1531         PEN201 = -1.3694684286_wp 
     1532         PEN011 = -1.4557549876_wp 
     1533         PEN111 = 2.2969116213e-01_wp 
     1534         PEN021 = 8.3654420645e-01_wp 
     1535         PEN002 = -1.4046808820e-02_wp 
     1536         PEN102 = 4.2928871430e-02_wp 
     1537         PEN012 = -2.8729602515e-01_wp 
     1538         ! 
     1539         APE000 = -1.9815805734e-01_wp 
     1540         APE100 = -9.5799229402e-03_wp 
     1541         APE200 = 5.1430784127e-02_wp 
     1542         APE300 = -8.3694846809e-03_wp 
     1543         APE010 = 2.4998715465e-01_wp 
     1544         APE110 = -4.8667669469e-03_wp 
     1545         APE210 = -3.0443885826e-02_wp 
     1546         APE020 = -1.3074788257e-01_wp 
     1547         APE120 = 8.3359333577e-03_wp 
     1548         APE030 = 2.9751504321e-02_wp 
     1549         APE001 = 3.6393874690e-02_wp 
     1550         APE101 = -5.7422790533e-03_wp 
     1551         APE011 = -4.1827210323e-02_wp 
     1552         APE002 = 7.1824006288e-03_wp 
     1553         ! 
     1554         BPE000 = 1.1135652187e-01_wp 
     1555         BPE100 = -2.7726708459e-01_wp 
     1556         BPE200 = 3.1407968134e-01_wp 
     1557         BPE300 = -1.0300557601e-01_wp 
     1558         BPE010 = 4.7899614701e-03_wp 
     1559         BPE110 = -5.1430784127e-02_wp 
     1560         BPE210 = 1.2554227021e-02_wp 
     1561         BPE020 = 1.2166917367e-03_wp 
     1562         BPE120 = 1.5221942913e-02_wp 
     1563         BPE030 = -1.3893222263e-03_wp 
     1564         BPE001 = 2.8541225524e-02_wp 
     1565         BPE101 = -3.4236710714e-02_wp 
     1566         BPE011 = 2.8711395266e-03_wp 
     1567         BPE002 = 5.3661089288e-04_wp 
     1568         ! 
     1569      CASE( 1 )                        !==  Simplified EOS     ==! 
     1570         IF(lwp) THEN 
     1571            WRITE(numout,*) 
     1572            WRITE(numout,*) '          use of simplified eos:    rhd(dT=T-10,dS=S-35,Z) = ' 
     1573            WRITE(numout,*) '             [-a0*(1+lambda1/2*dT+mu1*Z)*dT + b0*(1+lambda2/2*dT+mu2*Z)*dS - nu*dT*dS]/rau0' 
     1574            WRITE(numout,*) 
     1575            WRITE(numout,*) '             thermal exp. coef.    rn_a0      = ', rn_a0 
     1576            WRITE(numout,*) '             saline  cont. coef.   rn_b0      = ', rn_b0 
     1577            WRITE(numout,*) '             cabbeling coef.       rn_lambda1 = ', rn_lambda1 
     1578            WRITE(numout,*) '             cabbeling coef.       rn_lambda2 = ', rn_lambda2 
     1579            WRITE(numout,*) '             thermobar. coef.      rn_mu1     = ', rn_mu1 
     1580            WRITE(numout,*) '             thermobar. coef.      rn_mu2     = ', rn_mu2 
     1581            WRITE(numout,*) '             2nd cabbel. coef.     rn_nu      = ', rn_nu 
     1582            WRITE(numout,*) '               Caution: rn_beta0=0 incompatible with ddm parameterization ' 
     1583         ENDIF 
    7831584         ! 
    7841585      CASE DEFAULT                     !==  ERROR in nn_eos  ==! 
    … …  
    7881589      END SELECT 
    7891590      ! 
     1591      r1_rau0     = 1._wp / rau0 
     1592      r1_rcp      = 1._wp / rcp 
     1593      r1_rau0_rcp = 1._wp / ( rau0 * rcp ) 
     1594      ! 
     1595      IF(lwp) WRITE(numout,*) 
     1596      IF(lwp) WRITE(numout,*) '          volumic mass of reference           rau0  = ', rau0   , ' kg/m^3' 
     1597      IF(lwp) WRITE(numout,*) '          1. / rau0                        r1_rau0  = ', r1_rau0, ' m^3/kg' 
     1598      IF(lwp) WRITE(numout,*) '          ocean specific heat                 rcp   = ', rcp    , ' J/Kelvin' 
     1599      IF(lwp) WRITE(numout,*) '          1. / ( rau0 * rcp )           r1_rau0_rcp = ', r1_rau0_rcp 
     1600      ! 
    7901601   END SUBROUTINE eos_init 
    7911602 

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

    r4666 r4946  
    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 
    … …  
    3838   PRIVATE 
    3939 
    40    PUBLIC   tra_adv_cen2       ! routine called by step.F90 
    41    PUBLIC   ups_orca_set       ! routine used by traadv_cen2_jki.F90 
    42  
    43    LOGICAL  :: l_trd       ! flag to compute trends 
     40   PUBLIC   tra_adv_cen2   ! routine called by traadv.F90 
    4441 
    4542   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: upsmsk !: mixed upstream/centered scheme near some straits  
    … …  
    5653 
    5754   SUBROUTINE tra_adv_cen2( kt, kit000, cdtype, pun, pvn, pwn,     & 
    58       &                                 ptb, ptn, pta, kjpt   )  
     55      &                                         ptb, ptn, pta, kjpt   )  
    5956      !!---------------------------------------------------------------------- 
    6057      !!                  ***  ROUTINE tra_adv_cen2  *** 
    … …  
    8683      !!       * Add this trend now to the general trend of tracer (ta,sa): 
    8784      !!               pta = pta + ztra 
    88       !!       * trend diagnostic ('key_trdtra' defined): the trend is 
     85      !!       * trend diagnostic (l_trdtra=T or l_trctra=T): the trend is 
    8986      !!      saved for diagnostics. The trends saved is expressed as 
    90       !!      Uh.gradh(T), i.e. 
    91       !!                     save trend = ztra + ptn divn 
     87      !!      Uh.gradh(T), i.e.  save trend = ztra + ptn divn 
    9288      !! 
    9389      !!         Part II : vertical advection 
    … …  
    105101      !!         Add this trend now to the general trend of tracer (ta,sa): 
    106102      !!             pta = pta + ztra 
    107       !!         Trend diagnostic ('key_trdtra' defined): the trend is 
     103      !!         Trend diagnostic (l_trdtra=T or l_trctra=T): the trend is 
    108104      !!      saved for diagnostics. The trends saved is expressed as : 
    109105      !!             save trend =  w.gradz(T) = ztra - ptn divn. 
    … …  
    112108      !!              - save trends if needed 
    113109      !!---------------------------------------------------------------------- 
    114       USE oce     , ONLY:   zwx => ua        , zwy  => va          ! (ua,va) used as 3D workspace 
    115       ! 
    116110      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    117111      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    … …  
    122116      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    123117      ! 
    124       INTEGER  ::   ji, jj, jk, jn, ik   ! dummy loop indices 
     118      INTEGER  ::   ji, jj, jk, jn, ikt   ! dummy loop indices 
    125119      INTEGER  ::   ierr                 ! local integer 
    126120      REAL(wp) ::   zbtr, ztra                            ! local scalars 
    … …  
    129123      REAL(wp) ::   zupsut, zcenut, zupst                 !   -      - 
    130124      REAL(wp) ::   zupsvt, zcenvt, zcent, zice           !   -      - 
    131       REAL(wp), POINTER, DIMENSION(:,:  ) :: ztfreez, zpress  
    132       REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz, zind 
     125      REAL(wp), POINTER, DIMENSION(:,:)   :: zfzp, zpres   ! 2D workspace 
     126      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwx, zwy     ! 3D     - 
     127      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz, zind    !  -     - 
    133128      !!---------------------------------------------------------------------- 
    134129      ! 
    135130      IF( nn_timing == 1 )  CALL timing_start('tra_adv_cen2') 
    136131      ! 
    137       CALL wrk_alloc( jpi, jpj, ztfreez, zpress ) 
    138       CALL wrk_alloc( jpi, jpj, jpk, zwz, zind ) 
     132      CALL wrk_alloc( jpi, jpj, zpres, zfzp ) 
     133      CALL wrk_alloc( jpi, jpj, jpk, zwx, zwy, zwz, zind ) 
    139134      ! 
    140135 
    … …  
    145140         IF(lwp) WRITE(numout,*) 
    146141         ! 
    147          IF ( .NOT. ALLOCATED( upsmsk ) )  THEN 
     142         IF( .NOT. ALLOCATED( upsmsk ) )  THEN 
    148143             ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 
    149144             IF( ierr /= 0 )   CALL ctl_stop('STOP', 'tra_adv_cen2: unable to allocate array') 
    … …  
    163158      ENDIF 
    164159      ! 
    165       l_trd = .FALSE. 
    166       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE. 
    167       ! 
    168160      ! Upstream / centered scheme indicator 
    169161      ! ------------------------------------ 
    … …  
    173165      DO jj = 1, jpj  
    174166         DO ji = 1, jpi  
    175             ik=mikt(ji,jj)  
    176             IF (ik > 1 ) THEN  
    177                zpress(ji,jj) = grav*rau0*fsdept(ji,jj,ik)*1.e-04   
     167            ikt = mikt(ji,jj)  
     168            IF (ikt > 1 ) THEN  
     169               zpres(ji,jj) = grav * rau0 * fsdept(ji,jj,ikt) * 1.e-04   
    178170            ELSE  
    179                zpress(ji,jj) = 0.0  
     171               zpres(ji,jj) = 0.0  
    180172            ENDIF   
    181173         END DO  
    182174      END DO  
    183       ztfreez(:,:) = tfreez( tsn(:,:,1, jp_sal), zpress(:,:) ) 
    184        
     175      zfzp(:,:) = eos_fzp( tsn(:,:,1,jp_sal), zpres(:,:) ) 
    185176      DO jk = 1, jpk 
    186177         DO jj = 1, jpj 
    187178            DO ji = 1, jpi 
    188179               !                                        ! below ice covered area (if tn < "freezing"+0.1 ) 
    189                IF( tsn(ji,jj,jk,jp_tem) <= ztfreez(ji,jj) + 0.1 ) THEN   ;   zice = 1.e0 
    190                ELSE                                                      ;   zice = 0.e0 
     180               IF( tsn(ji,jj,jk,jp_tem) <= zfzp(ji,jj) + 0.1 ) THEN   ;   zice = 1._wp 
     181               ELSE                                                   ;   zice = 0._wp 
    191182               ENDIF 
    192183               zind(ji,jj,jk) = MAX (   & 
    … …  
    240231            DO jj = 1, jpj   ! vector opt. 
    241232               DO ji = 1, jpi   ! vector opt. 
    242                   ik=mikt(ji,jj)                 
    243                   zwz(ji,jj,ik ) = pwn(ji,jj,ik) * ptn(ji,jj,ik,jn)   ! linear free surface  
    244                   zwz(ji,jj,1:ik-1) = 0.e0 
     233                  ikt = mikt(ji,jj)                 
     234                  zwz(ji,jj,ikt ) = pwn(ji,jj,ikt) * ptn(ji,jj,ikt,jn)   ! linear free surface  
     235                  zwz(ji,jj,1:ikt-1) = 0.e0 
    245236               END DO 
    246237            END DO 
    … …  
    280271         END DO 
    281272 
    282          !                                 ! trend diagnostics (contribution of upstream fluxes) 
    283          IF( l_trd ) THEN 
    284             CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptn(:,:,:,jn) ) 
    285             CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptn(:,:,:,jn) ) 
    286             CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zwz, pwn, ptn(:,:,:,jn) ) 
     273         !                                 ! trend diagnostics 
     274         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR.    & 
     275            &( cdtype == 'TRC' .AND. l_trdtrc ) )   THEN 
     276            CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) ) 
     277            CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 
     278            CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) ) 
    287279         END IF 
    288280         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    289281         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN   
    290            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) 
    291            IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) 
     282           IF( jn == jp_tem )   htr_adv(:) = ptr_vj( zwy(:,:,:) ) 
     283           IF( jn == jp_sal )   str_adv(:) = ptr_vj( zwy(:,:,:) ) 
    292284         ENDIF 
    293285         ! 
    294       ENDDO 
     286      END DO 
    295287 
    296288      ! ---------------------------  required in restart file to ensure restartability) 
    … …  
    301293      ENDIF 
    302294      ! 
    303       CALL wrk_dealloc( jpi, jpj, ztfreez, zpress ) 
    304       CALL wrk_dealloc( jpi, jpj, jpk, zwz, zind ) 
     295      CALL wrk_dealloc( jpi, jpj, zpres, zfzp ) 
     296      CALL wrk_dealloc( jpi, jpj, jpk, zwx, zwy, zwz, zind ) 
    305297      ! 
    306298      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_cen2') 
    … …  
    323315      INTEGER  ::   ii0, ii1, ij0, ij1      ! temporary integers 
    324316      !!---------------------------------------------------------------------- 
    325        
    326317      ! 
    327318      IF( nn_timing == 1 )  CALL timing_start('ups_orca_set') 

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

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

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

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

    r4934 r4946  
    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 
    … …  
    9596         IF(lwp) WRITE(numout,*) 'tra_adv_tvd : TVD advection scheme on ', cdtype 
    9697         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     98         ! 
     99         l_trd = .FALSE. 
     100         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 
    97101      ENDIF 
    98       ! 
    99       l_trd = .FALSE. 
    100       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 
    101102      ! 
    102103      IF( l_trd )  THEN 
    … …  
    244245            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed 
    245246             
    246             CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, ztrdx, pun, ptn(:,:,:,jn) )    
    247             CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, ztrdy, pvn, ptn(:,:,:,jn) )   
    248             CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, ztrdz, pwn, ptn(:,:,:,jn) )  
     247            CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) )    
     248            CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) )   
     249            CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) )  
    249250         END IF 
    250251         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    … …  
    518519            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed 
    519520             
    520             CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, ztrdx, pun, ptn(:,:,:,jn) )    
    521             CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, ztrdy, pvn, ptn(:,:,:,jn) )   
    522             CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, ztrdz, pwn, ptn(:,:,:,jn) )  
     521            CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) )    
     522            CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) )   
     523            CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) )  
    523524         END IF 
    524525         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    … …  
    552553      !!       in-space based differencing for fluid 
    553554      !!---------------------------------------------------------------------- 
    554       ! 
    555       !!---------------------------------------------------------------------- 
    556555      REAL(wp), DIMENSION(jpk)         , INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step 
    557556      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft      ! before & after field 
    558557      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions 
    559558      ! 
    560       INTEGER ::   ji, jj, jk   ! dummy loop indices 
    561       INTEGER ::   ikm1         ! local integer 
     559      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     560      INTEGER  ::   ikm1         ! local integer 
    562561      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt   ! local scalars 
    563562      REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      - 
    … …  
    569568      CALL wrk_alloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo ) 
    570569      ! 
    571  
    572570      zbig  = 1.e+40_wp 
    573571      zrtrn = 1.e-15_wp 
    574572      zbetup(:,:,:) = 0._wp   ;   zbetdo(:,:,:) = 0._wp 
    575573 
    576  
    577574      ! Search local extrema 
    578575      ! -------------------- 
    579576      ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land 
    580       zbup = MAX( pbef * tmask - zbig * ( 1.e0 - tmask ),   & 
    581          &        paft * tmask - zbig * ( 1.e0 - tmask )  ) 
    582       zbdo = MIN( pbef * tmask + zbig * ( 1.e0 - tmask ),   & 
    583          &        paft * tmask + zbig * ( 1.e0 - tmask )  ) 
     577      zbup = MAX( pbef * tmask - zbig * ( 1._wp - tmask ),   & 
     578         &        paft * tmask - zbig * ( 1._wp - tmask )  ) 
     579      zbdo = MIN( pbef * tmask + zbig * ( 1._wp - tmask ),   & 
     580         &        paft * tmask + zbig * ( 1._wp - tmask )  ) 
    584581 
    585582      DO jj = 2, jpjm1 
    … …  
    625622         DO jj = 2, jpjm1 
    626623            DO ji = fs_2, fs_jpim1   ! vector opt. 
    627                zau = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) ) 
    628                zbu = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) ) 
     624               zau = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) ) 
     625               zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) ) 
    629626               zcu =       ( 0.5  + SIGN( 0.5 , paa(ji,jj,jk) ) ) 
    630                paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1.e0 - zcu) * zbu ) 
    631  
    632                zav = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) ) 
    633                zbv = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) ) 
     627               paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1._wp - zcu) * zbu ) 
     628 
     629               zav = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) ) 
     630               zbv = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) ) 
    634631               zcv =       ( 0.5  + SIGN( 0.5 , pbb(ji,jj,jk) ) ) 
    635                pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1.e0 - zcv) * zbv ) 
     632               pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1._wp - zcv) * zbv ) 
    636633 
    637634      ! monotonic flux in the k direction, i.e. pcc 
    … …  
    640637               zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) ) 
    641638               zc =       ( 0.5  + SIGN( 0.5 , pcc(ji,jj,jk+1) ) ) 
    642                pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1.e0 - zc) * zb ) 
     639               pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb ) 
    643640            END DO 
    644641         END DO 

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

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

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

    r4726 r4946  
    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) * ssmask(ji,jj)      ! bottom before T and S 
    423             zsb (ji,jj) = tsb(ji,jj,ik,jp_sal) * ssmask(ji,jj) 
    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_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90

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

    r4666 r4946  
    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) 
    … …  
    118119         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    119120         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 
    120          CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_ldf, ztrdt ) 
    121          CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_ldf, ztrds ) 
     121         CALL trd_tra( kt, 'TRA', jp_tem, jptra_ldf, ztrdt ) 
     122         CALL trd_tra( kt, 'TRA', jp_sal, jptra_ldf, ztrds ) 
    122123         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )  
    123124      ENDIF 
    … …  
    180181            IF ( ln_traldf_iso   )   nldf = 1      ! isoneutral (   rotation) 
    181182         ENDIF 
    182          IF ( ln_zps ) THEN             ! z-coordinate 
     183         IF ( ln_zps ) THEN             ! zps-coordinate 
    183184            IF ( ln_traldf_level )   ierr = 1      ! iso-level not allowed 
    184185            IF ( ln_traldf_hor   )   nldf = 0      ! horizontal (no rotation) 
    185186            IF ( ln_traldf_iso   )   nldf = 1      ! isoneutral (   rotation) 
    186187         ENDIF 
    187          IF ( ln_sco ) THEN             ! z-coordinate 
     188         IF ( ln_sco ) THEN             ! s-coordinate 
    188189            IF ( ln_traldf_level )   nldf = 0      ! iso-level  (no rotation) 
    189190            IF ( ln_traldf_hor   )   nldf = 1      ! horizontal (   rotation) 
    … …  
    198199            IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
    199200         ENDIF 
    200          IF ( ln_zps ) THEN             ! z-coordinate 
     201         IF ( ln_zps ) THEN             ! zps-coordinate 
    201202            IF ( ln_traldf_level )   ierr = 1      ! iso-level not allowed  
    202203            IF ( ln_traldf_hor   )   nldf = 2      ! horizontal (no rotation) 
    203204            IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
    204205         ENDIF 
    205          IF ( ln_sco ) THEN             ! z-coordinate 
     206         IF ( ln_sco ) THEN             ! s-coordinate 
    206207            IF ( ln_traldf_level )   nldf = 2      ! iso-level  (no rotation) 
    207208            IF ( ln_traldf_hor   )   nldf = 3      ! horizontal (   rotation) 

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

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

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

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

    r4924 r4946  
    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 
    … …  
    303299               ! clem: store attenuation coefficient of the first ocean level 
    304300               IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 
    305                   oatte(:,:) = etot3(:,:,1) / r1_rau0_rcp 
    306                   iatte(:,:) = oatte(:,:) 
     301                  fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp 
    307302               ENDIF 
    308303               ! 
    … …  
    335330      IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics 
    336331         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    337          CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_qsr, ztrdt ) 
     332         CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt ) 
    338333         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt )  
    339334      ENDIF 
    … …  
    385380      IF( nn_timing == 1 )  CALL timing_start('tra_qsr_init') 
    386381      ! 
    387       ! clem init for oatte and iatte 
     382      ! Default value for fraqsr_1lev 
    388383      IF( .NOT. ln_rstart ) THEN 
    389          oatte(:,:) = 1._wp 
    390          iatte(:,:) = 1._wp 
     384         fraqsr_1lev(:,:) = 1._wp 
    391385      ENDIF 
    392386      ! 

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

    r4726 r4946  
    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 
    … …  
    4144#  include "vectopt_loop_substitute.h90" 
    4245   !!---------------------------------------------------------------------- 
    43    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     46   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    4447   !! $Id$ 
    4548   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    9396      !!         where emp, the surface freshwater budget (evaporation minus 
    9497      !!         precipitation minus runoff) given in kg/m2/s is divided 
    95       !!         by rau0 = 1020 kg/m3 (density of sea water) to obtain m/s.     
     98      !!         by rau0 (density of sea water) to obtain m/s.     
    9699      !!         Note: even though Fwe does not appear explicitly for  
    97100      !!         temperature in this routine, the heat carried by the water 
    … …  
    109112      !! ** Action  : - Update the 1st level of (ta,sa) with the trend associated 
    110113      !!                with the tracer surface boundary condition  
    111       !!              - save the trend it in ttrd ('key_trdtra') 
     114      !!              - send trends to trdtra module (l_trdtra=T) 
    112115      !!---------------------------------------------------------------------- 
    113116      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    … …  
    130133      ENDIF 
    131134 
    132       IF( l_trdtra )   THEN                    !* Save ta and sa trends 
     135      IF( l_trdtra ) THEN                    !* Save ta and sa trends 
    133136         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )  
    134137         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    … …  
    143146 
    144147      !---------------------------------------- 
    145       !        EMP, EMPS and QNS effects 
     148      !        EMP, SFX and QNS effects 
    146149      !---------------------------------------- 
    147150      !                                          Set before sbc tracer content fields 
    … …  
    152155              & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN 
    153156            IF(lwp) WRITE(numout,*) '          nit000-1 surface tracer content forcing fields red in the restart file' 
    154             zfact = 0.5e0 
     157            zfact = 0.5_wp 
    155158            CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) )   ! before heat content sbc trend 
    156159            CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) )   ! before salt content sbc trend 
    157160         ELSE                                         ! No restart or restart not found: Euler forward time stepping 
    158             zfact = 1.e0 
    159             sbc_tsc_b(:,:,:) = 0.e0 
     161            zfact = 1._wp 
     162            sbc_tsc_b(:,:,:) = 0._wp 
    160163         ENDIF 
    161164      ELSE                                         ! Swap of forcing fields 
    162165         !                                         ! ---------------------- 
    163          zfact = 0.5e0 
     166         zfact = 0.5_wp 
    164167         sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:) 
    165168      ENDIF 
    … …  
    217220      !---------------------------------------- 
    218221      ! 
    219       IF (nn_isf .GT. 0) THEN 
     222      IF( nn_isf > 0 ) THEN 
    220223         zfact = 0.5e0 
    221224         DO jj = 2, jpj 
    … …  
    231234               ! compute tfreez for the temperature correction (we add water at freezing temperature) 
    232235!                  zpress = grav*rau0*fsdept(ji,jj,jk)*1.e-04 
    233                   zt_frz = -1.9 !tfreez1D( tsn(ji,jj,jk,jp_sal), zpress ) 
     236                  zt_frz = -1.9 !eos_fzp( tsn(ji,jj,jk,jp_sal), zpress ) 
    234237               ! compute trend 
    235238                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)                                          & 
    … …  
    244247               ! compute tfreez for the temperature correction (we add water at freezing temperature) 
    245248!               zpress = grav*rau0*fsdept(ji,jj,ikb)*1.e-04 
    246                zt_frz = -1.9 !tfreez1D( tsn(ji,jj,ikb,jp_sal), zpress ) 
     249               zt_frz = -1.9 !eos_fzp( tsn(ji,jj,ikb,jp_sal), zpress ) 
    247250               ! compute trend 
    248251               tsa(ji,jj,ikb,jp_tem) = tsa(ji,jj,ikb,jp_tem)                                           & 
    … …  
    286289      ENDIF 
    287290  
    288       IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics 
     291      IF( l_trdtra )   THEN                      ! send trends for further diagnostics 
    289292         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    290293         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 
    291          CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_nsr, ztrdt ) 
    292          CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_nsr, ztrds ) 
     294         CALL trd_tra( kt, 'TRA', jp_tem, jptra_nsr, ztrdt ) 
     295         CALL trd_tra( kt, 'TRA', jp_sal, jptra_nsr, ztrds ) 
    293296         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )  
    294297      ENDIF 

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

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

    r4812 r4946  
    7575      !!          Idem for di(s) and dj(s)           
    7676      !! 
    77       !!      For rho, we call eos_insitu_2d which will compute rd~(t~,s~) at  
    78       !!      the good depth zh from interpolated T and S for the different 
    79       !!      formulation of the equation of state (eos). 
     77      !!      For rho, we call eos which will compute rd~(t~,s~) at the right 
     78      !!      depth zh from interpolated T and S for the different formulations 
     79      !!      of the equation of state (eos). 
    8080      !!      Gradient formulation for rho : 
    81       !!          di(rho) = rd~ - rd(i,j,k) or rd(i+1,j,k) - rd~ 
     81      !!          di(rho) = rd~ - rd(i,j,k)   or  rd(i+1,j,k) - rd~ 
    8282      !! 
    8383      !! ** Action  : compute for top and bottom interfaces 
    … …  
    8888      !!              - pge3ru, pge3rv, sge3ru, sge3rv: horizontal gradient of rho weighted by local e3w at u- & v-points  
    8989      !!---------------------------------------------------------------------- 
    90       ! 
    9190      INTEGER                              , INTENT(in   )           ::  kt          ! ocean time-step index 
    9291      INTEGER                              , INTENT(in   )           ::  kjpt        ! number of tracers 
    … …  
    107106      INTEGER  ::   iku, ikv, ikum1, ikvm1,ikup1, ikvp1   ! partial step level (ocean bottom level) at u- and v-points 
    108107      REAL(wp) ::  ze3wu, ze3wv, zmaxu, zmaxv, zdzwu, zdzwv, zdzwuip1, zdzwvjp1  ! temporary scalars 
    109       REAL(wp), POINTER, DIMENSION(:,:  ) ::  zri, zrj, zhi, zhj 
    110       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zti, ztj    ! interpolated value of tracer 
     108      REAL(wp), DIMENSION(jpi,jpj)      ::  zri, zrj, zhi, zhj   ! NB: 3rd dim=1 to use eos 
     109      REAL(wp), DIMENSION(jpi,jpj,kjpt) ::  zti, ztj             !  
    111110      !!---------------------------------------------------------------------- 
    112111      ! 
    113112      IF( nn_timing == 1 )  CALL timing_start( 'zps_hde') 
    114113      ! 
    115       CALL wrk_alloc( jpi, jpj,       zri, zrj, zhi, zhj )  
    116       CALL wrk_alloc( jpi, jpj, kjpt, zti, ztj           )  
    117       ! 
    118114      pgtu(:,:,:)=0.0_wp ; pgtv(:,:,:)=0.0_wp ; 
    119115      ! 
    120116      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==! 
    121117         ! 
    122 # if defined key_vectopt_loop 
    123          jj = 1 
    124          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled) 
    125 # else 
    126          DO jj = 1, jpjm1 
    127             DO ji = 1, jpim1 
    128 # endif 
     118         DO jj = 1, jpjm1 
     119            DO ji = 1, jpim1 
    129120               iku = mbku(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points 
    130121               ikv = mbkv(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1 
    … …  
    138129               ! i- direction 
    139130               IF (iku .GT. 1) THEN 
    140                IF( ze3wu >= 0._wp ) THEN      ! case 1 
    141                   zmaxu =  ze3wu / fse3w(ji+1,jj,iku) 
    142                   ! interpolated values of tracers 
    143                   zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 
    144                   ! gradient of  tracers 
    145                   pgtu(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 
    146                ELSE                           ! case 2 
    147                   zmaxu = -ze3wu / fse3w(ji,jj,iku) 
    148                   ! interpolated values of tracers 
    149                   zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 
    150                   ! gradient of tracers 
    151                   pgtu(ji,jj,jn) = umask(ji,jj,iku) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 
    152                ENDIF 
     131                  IF( ze3wu >= 0._wp ) THEN      ! case 1 
     132                     zmaxu =  ze3wu / fse3w(ji+1,jj,iku) 
     133                     ! interpolated values of tracers 
     134                     zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 
     135                     ! gradient of  tracers 
     136                     pgtu(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 
     137                  ELSE                           ! case 2 
     138                     zmaxu = -ze3wu / fse3w(ji,jj,iku) 
     139                     ! interpolated values of tracers 
     140                     zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 
     141                     ! gradient of tracers 
     142                     pgtu(ji,jj,jn) = umask(ji,jj,iku) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 
     143                  ENDIF 
    153144               ENDIF 
    154145               ! 
    155146               ! j- direction 
    156147               IF (ikv .GT. 1) THEN 
    157                IF( ze3wv >= 0._wp ) THEN      ! case 1 
    158                   zmaxv =  ze3wv / fse3w(ji,jj+1,ikv) 
    159                   ! interpolated values of tracers 
    160                   ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 
    161                   ! gradient of tracers 
    162                   pgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 
    163                ELSE                           ! case 2 
    164                   zmaxv =  -ze3wv / fse3w(ji,jj,ikv) 
    165                   ! interpolated values of tracers 
    166                   ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 
    167                   ! gradient of tracers 
    168                   pgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 
    169                ENDIF 
    170                ENDIF 
    171 # if ! defined key_vectopt_loop 
    172             END DO 
    173 # endif 
     148                  IF( ze3wv >= 0._wp ) THEN      ! case 1 
     149                     zmaxv =  ze3wv / fse3w(ji,jj+1,ikv) 
     150                     ! interpolated values of tracers 
     151                     ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 
     152                     ! gradient of tracers 
     153                     pgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 
     154                  ELSE                           ! case 2 
     155                     zmaxv =  -ze3wv / fse3w(ji,jj,ikv) 
     156                     ! interpolated values of tracers 
     157                     ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 
     158                     ! gradient of tracers 
     159                     pgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 
     160                  ENDIF 
     161              ENDIF 
     162            END DO 
    174163         END DO 
    175164         CALL lbc_lnk( pgtu(:,:,jn), 'U', -1. )   ;   CALL lbc_lnk( pgtv(:,:,jn), 'V', -1. )   ! Lateral boundary cond. 
    … …  
    180169      IF( PRESENT( prd ) ) THEN         ! depth of the partial step level 
    181170         pgru(:,:)=0.0_wp ; pgrv(:,:)=0.0_wp  
    182 # if defined key_vectopt_loop 
    183          jj = 1 
    184          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled) 
    185 # else 
    186          DO jj = 1, jpjm1 
    187             DO ji = 1, jpim1 
    188 # endif 
     171         DO jj = 1, jpjm1 
     172            DO ji = 1, jpim1 
    189173               iku = mbku(ji,jj) 
    190174               ikv = mbkv(ji,jj) 
    … …  
    198182               ELSE                        ;   zhj(ji,jj) = fsdept(ji,jj  ,ikv) + ze3wv    ! -     -      case 2 
    199183               ENDIF 
    200 # if ! defined key_vectopt_loop 
    201             END DO 
    202 # endif 
     184            END DO 
    203185         END DO 
    204186          
    … …  
    209191 
    210192         ! Gradient of density at the last level  
    211 # if defined key_vectopt_loop 
    212          jj = 1 
    213          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled) 
    214 # else 
    215          DO jj = 1, jpjm1 
    216             DO ji = 1, jpim1 
    217 # endif 
     193         DO jj = 1, jpjm1 
     194            DO ji = 1, jpim1 
    218195               iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points 
    219196               ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 )    ! last and before last ocean level at u- & v-points 
    … …  
    250227                                   -(fse3w(ji,jj  ,ikv) + ze3wv) * ( zrj(ji,jj      ) + prd(ji,jj  ,ikvm1) + 2._wp) )  ! j: 2 
    251228               ENDIF 
    252 # if ! defined key_vectopt_loop 
    253             END DO 
    254 # endif 
     229            END DO 
    255230         END DO 
    256231         CALL lbc_lnk( pgru   , 'U', -1. )   ;   CALL lbc_lnk( pgrv   , 'V', -1. )   ! Lateral boundary conditions 
    … …  
    262237         ! (ISH)  compute grui and gruvi 
    263238      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!            ! 
    264 # if defined key_vectopt_loop 
    265          jj = 1 
    266          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled) 
    267 # else 
    268          DO jj = 1, jpjm1 
    269             DO ji = 1, jpim1 
    270 # endif 
     239         DO jj = 1, jpjm1 
     240            DO ji = 1, jpim1 
    271241               iku = miku(ji,jj)   ;  ikup1 = miku(ji,jj) + 1 
    272242               ikv = mikv(ji,jj)   ;  ikvp1 = mikv(ji,jj) + 1 
    … …  
    307277                  sgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 
    308278               ENDIF 
    309 # if ! defined key_vectopt_loop 
    310             END DO 
    311 # endif 
     279            END DO!! 
    312280         END DO!! 
    313281         CALL lbc_lnk( sgtu(:,:,jn), 'U', -1. )   ;   CALL lbc_lnk( sgtv(:,:,jn), 'V', -1. )   ! Lateral boundary cond. 
    … …  
    317285      ! horizontal derivative of density anomalies (rd) 
    318286      IF( PRESENT( prd ) ) THEN         ! depth of the partial step level 
    319 # if defined key_vectopt_loop 
    320          jj = 1 
    321          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled) 
    322 # else 
    323          DO jj = 1, jpjm1 
    324             DO ji = 1, jpim1 
    325 # endif 
     287         DO jj = 1, jpjm1 
     288            DO ji = 1, jpim1 
    326289               iku = miku(ji,jj) 
    327290               ikv = mikv(ji,jj) 
    … …  
    335298               ELSE                        ;   zhj(ji,jj) = fsdept(ji,jj  ,ikv) - ze3wv    ! -     -      case 2 
    336299               ENDIF 
    337 # if ! defined key_vectopt_loop 
    338             END DO 
    339 # endif 
     300            END DO 
    340301         END DO 
    341302 
    … …  
    346307 
    347308         ! Gradient of density at the last level  
    348 # if defined key_vectopt_loop 
    349          jj = 1 
    350          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled) 
    351 # else 
    352          DO jj = 1, jpjm1 
    353             DO ji = 1, jpim1 
    354 # endif 
     309         DO jj = 1, jpjm1 
     310            DO ji = 1, jpim1 
    355311               iku = miku(ji,jj) ; ikup1 = miku(ji,jj) + 1 
    356312               ikv = mikv(ji,jj) ; ikvp1 = mikv(ji,jj) + 1 
    … …  
    388344                                   -(fse3w(ji,jj  ,ikv+1) + ze3wv) * ( zrj(ji,jj      ) + prd(ji,jj  ,ikv+1) + 2._wp) )  ! j: 2 
    389345               ENDIF 
    390 # if ! defined key_vectopt_loop 
    391             END DO 
    392 # endif 
     346            END DO 
    393347         END DO 
    394348         CALL lbc_lnk( sgru   , 'U', -1. )   ;   CALL lbc_lnk( sgrv   , 'V', -1. )   ! Lateral boundary conditions 
    … …  
    399353      END IF   
    400354      ! 
    401       CALL wrk_dealloc( jpi, jpj,       zri, zrj, zhi, zhj)  
    402       CALL wrk_dealloc( jpi, jpj, kjpt, zti, ztj           )  
    403       ! 
    404355      IF( nn_timing == 1 )  CALL timing_stop( 'zps_hde') 
    405356      ! 

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

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

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

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

    r4924 r4946  
    113113         IF ( ln_loglayer.AND.lk_vvl ) THEN ! "log layer" bottom friction coefficient 
    114114 
    115 #  if defined key_vectopt_loop 
    116             DO jj = 1, 1 
    117 !CDIR NOVERRCHK 
    118                DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    119 #  else 
    120 !CDIR NOVERRCHK 
    121115            DO jj = 1, jpj 
    122 !CDIR NOVERRCHK 
    123116               DO ji = 1, jpi 
    124 #  endif 
    125117                  ikbt = mbkt(ji,jj) 
    126 ! JC: possible WAD implementation should modify line below if layers vanish 
     118!! JC: possible WAD implementation should modify line below if layers vanish 
    127119                  ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp 
    128120                  zbfrt(ji,jj) = MAX(bfrcoef2d(ji,jj), ztmp) 
    … …  
    143135         ENDIF 
    144136 
    145 # if defined key_vectopt_loop 
    146          DO jj = 1, 1 
    147 !CDIR NOVERRCHK 
    148             DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    149 # else 
    150 !CDIR NOVERRCHK 
    151137         DO jj = 2, jpjm1 
    152 !CDIR NOVERRCHK 
    153138            DO ji = 2, jpim1 
    154 # endif 
    155139               ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points 
    156140               ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points) 
    … …  
    206190            END DO 
    207191         END DO 
    208  
    209192         ! 
    210193         CALL lbc_lnk( bfrua, 'U', 1. )   ;   CALL lbc_lnk( bfrva, 'V', 1. )      ! Lateral boundary condition 
    … …  
    342325         ! 
    343326         IF ( ln_loglayer.AND.(.NOT.lk_vvl) ) THEN ! set "log layer" bottom friction once for all 
    344 #  if defined key_vectopt_loop 
    345             DO jj = 1, 1 
    346 !CDIR NOVERRCHK 
    347                DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    348 #  else 
    349 !CDIR NOVERRCHK 
    350327            DO jj = 1, jpj 
    351 !CDIR NOVERRCHK 
    352328               DO ji = 1, jpi 
    353 #  endif 
    354329                  ikbt = mbkt(ji,jj) 
    355330                  ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp 
    … …  
    388363      zmaxtfr = -1.e10_wp    ! initialise tracker for maximum of bottom friction coefficient 
    389364      ! 
    390 #  if defined key_vectopt_loop 
    391       DO jj = 1, 1 
    392 !CDIR NOVERRCHK 
    393          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    394 #  else 
    395 !CDIR NOVERRCHK 
    396365      DO jj = 2, jpjm1 
    397 !CDIR NOVERRCHK 
    398366         DO ji = 2, jpim1 
    399 #  endif 
    400367             ikbu = mbku(ji,jj)       ! deepest ocean level at u- and v-points 
    401368             ikbv = mbkv(ji,jj) 

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

    r4812 r4946  
    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      !                                                ! =============== 
    109       !                                                ! Horizontal slab 
     111      DO jk = 2, jpkm1                                 ! Horizontal slab 
    110112         !                                             ! =============== 
    111       DO jj = 1, jpj                                     ! indicators: 
    112          DO ji = 1, jpi 
    113             DO jk = mikt(ji,jj)+1, jpkm1                                 ! Horizontal slab 
    114113         ! Define the mask  
    115114         ! --------------- 
    116                rrau(ji,jj,jk) = MAX( 1.e-20, rrau(ji,jj,jk) )         ! only retains positive value of rrau 
    117  
     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  )  & 
     121                   &    * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 
     122               zbw = (  rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal) * zrw  )  & 
     123                   &    * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 
     124               ! 
     125               zdt = zaw * ( tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) 
     126               zds = zbw * ( tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) )  
     127               IF( ABS( zds) <= 1.e-20_wp )   zds = 1.e-20_wp 
     128               zrau(ji,jj) = MAX(  1.e-20, zdt / zds  )    ! only retains positive value of zrau 
     129            END DO 
     130         END DO 
     131 
     132         DO jj = 1, jpj                                     ! indicators: 
     133            DO ji = 1, jpi 
    118134               ! stability indicator: msks=1 if rn2>0; 0 elsewhere 
    119135               IF( rn2(ji,jj,jk) + 1.e-12  <= 0. ) THEN   ;   zmsks(ji,jj) = 0._wp 
    120136               ELSE                                       ;   zmsks(ji,jj) = 1._wp 
    121137               ENDIF 
    122                ! salt fingering indicator: msksf=1 if rrau>1; 0 elsewhere             
    123                IF( rrau(ji,jj,jk) <= 1.          ) THEN   ;   zmskf(ji,jj) = 0._wp 
     138               ! salt fingering indicator: msksf=1 if R>1; 0 elsewhere             
     139               IF( zrau(ji,jj) <= 1.             ) THEN   ;   zmskf(ji,jj) = 0._wp 
    124140               ELSE                                       ;   zmskf(ji,jj) = 1._wp 
    125141               ENDIF 
    126142               ! diffusive layering indicators:  
    127                !     ! mskdl1=1 if 0<rrau<1; 0 elsewhere 
    128                IF( rrau(ji,jj,jk) >= 1.          ) THEN   ;   zmskd1(ji,jj) = 0._wp 
     143               !     ! mskdl1=1 if 0< R <1; 0 elsewhere 
     144               IF( zrau(ji,jj) >= 1.             ) THEN   ;   zmskd1(ji,jj) = 0._wp 
    129145               ELSE                                       ;   zmskd1(ji,jj) = 1._wp 
    130146               ENDIF 
    131                !     ! mskdl2=1 if 0<rrau<0.5; 0 elsewhere 
    132                IF( rrau(ji,jj,jk) >= 0.5         ) THEN   ;   zmskd2(ji,jj) = 0._wp 
     147               !     ! mskdl2=1 if 0< R <0.5; 0 elsewhere 
     148               IF( zrau(ji,jj) >= 0.5            ) THEN   ;   zmskd2(ji,jj) = 0._wp 
    133149               ELSE                                       ;   zmskd2(ji,jj) = 1._wp 
    134150               ENDIF 
    135                !   mskdl3=1 if 0.5<rrau<1; 0 elsewhere 
    136                IF( rrau(ji,jj,jk) <= 0.5 .OR. rrau(ji,jj,jk) >= 1. ) THEN   ;   zmskd3(ji,jj) = 0._wp 
    137                ELSE                                                         ;   zmskd3(ji,jj) = 1._wp 
    138                ENDIF 
     151               !   mskdl3=1 if 0.5< R <1; 0 elsewhere 
     152               IF( zrau(ji,jj) <= 0.5 .OR. zrau(ji,jj) >= 1. ) THEN   ;   zmskd3(ji,jj) = 0._wp 
     153               ELSE                                                   ;   zmskd3(ji,jj) = 1._wp 
     154               ENDIF 
     155            END DO 
     156         END DO 
    139157         ! mask zmsk in order to have avt and avs masked 
    140                zmsks(ji,jj) = zmsks(ji,jj) * tmask(ji,jj,jk) 
     158         zmsks(:,:) = zmsks(:,:) * tmask(:,:,jk) 
    141159 
    142160 
    … …  
    144162         ! ------------------ 
    145163         ! Constant eddy coefficient: reset to the background value 
    146                zinr = 1./rrau(ji,jj,jk) 
     164!CDIR NOVERRCHK 
     165         DO jj = 1, jpj 
     166!CDIR NOVERRCHK 
     167            DO ji = 1, jpi 
     168               zinr = 1._wp / zrau(ji,jj) 
    147169               ! salt fingering 
    148                zrr = rrau(ji,jj,jk)/rn_hsbfr 
     170               zrr = zrau(ji,jj) / rn_hsbfr 
    149171               zrr = zrr * zrr 
    150172               zavfs = rn_avts / ( 1 + zrr*zrr*zrr ) * zmsks(ji,jj) * zmskf(ji,jj) 
    … …  
    152174               ! diffusive layering 
    153175               zavdt = 1.3635e-6 * EXP(  4.6 * EXP( -0.54*(zinr-1.) )  ) * zmsks(ji,jj) * zmskd1(ji,jj) 
    154                zavds = zavdt * zmsks(ji,jj) * (  (1.85 * rrau(ji,jj,jk) - 0.85 ) * zmskd3(ji,jj)   & 
    155                   &                            +  0.15 * rrau(ji,jj,jk)          * zmskd2(ji,jj)  ) 
     176               zavds = zavdt * zmsks(ji,jj) * (  ( 1.85 * zrau(ji,jj) - 0.85 ) * zmskd3(ji,jj)   & 
     177                  &                             +  0.15 * zrau(ji,jj)          * zmskd2(ji,jj)  ) 
    156178               ! add to the eddy viscosity coef. previously computed 
    157179               avs (ji,jj,jk) = avt(ji,jj,jk) + zavfs + zavds 
    … …  
    160182            END DO 
    161183         END DO 
    162       END DO 
     184 
     185 
    163186         ! Increase avmu, avmv if necessary 
    164187         ! -------------------------------- 
    165188!!gm to be changed following the definition of avm. 
    166       DO jj = 1, jpjm1 
    167          DO ji = 1, fs_jpim1   ! vector opt. 
    168             DO jk = miku(ji,jj)+1, jpkm1                                 ! Horizontal slab 
     189         DO jj = 1, jpjm1 
     190            DO ji = 1, fs_jpim1   ! vector opt. 
    169191               avmu(ji,jj,jk) = MAX( avmu(ji,jj,jk),    & 
    170192                  &                  avt(ji,jj,jk), avt(ji+1,jj,jk),   & 
    171193                  &                  avs(ji,jj,jk), avs(ji+1,jj,jk) )  * umask(ji,jj,jk) 
    172             END DO 
    173             DO jk = mikv(ji,jj)+1, jpkm1 
    174194               avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk),    & 
    175195                  &                  avt(ji,jj,jk), avt(ji,jj+1,jk),   & 
    … …  
    209229      !!              called by zdf_ddm at the first timestep (nit000) 
    210230      !!---------------------------------------------------------------------- 
     231      INTEGER ::   ios   ! local integer 
     232      !! 
    211233      NAMELIST/namzdf_ddm/ rn_avts, rn_hsbfr 
    212       INTEGER  ::   ios                 ! Local integer output status for namelist read 
    213234      !!---------------------------------------------------------------------- 
    214235      ! 

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

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

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

    r4812 r4946  
    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, ikt, imkt   ! 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               ikt = mbkt(ji,jj) 
     107               hmlp(ji,jj) = hmlp(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * fse3w(ji,jj,jk) 
     108               IF( hmlp(ji,jj) < zN2_c )   nmln(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level 
     109            END DO 
     110         END DO 
     111      END DO 
     112      ! 
     113      ! w-level of the turbocline 
     114      imld(:,:) = mbkt(:,:) + 1        ! Initialization to the number of w ocean point 
     115      DO jk = jpkm1, nlb10, -1         ! from the bottom to nlb10  
    99116         DO jj = 1, jpj 
    100117            DO ji = 1, jpi 
    101                IF( rhop(ji,jj,jk) > rhop(ji,jj,MAX(mikt(ji,jj),nla10)) + rho_c )   nmln(ji,jj) = MAX(jk,mikt(ji,jj))      ! Mixed layer 
    102                IF( avt (ji,jj,jk) < avt_c                     )   imld(ji,jj) = MAX(mikt(ji,jj),jk)      ! Turbocline  
     118               imkt = mikt(ji,jj) 
     119               IF( avt (ji,jj,jk) < avt_c )   imld(ji,jj) = MAX( imkt, jk )      ! Turbocline  
    103120            END DO 
    104121         END DO 
    … …  
    109126            iiki = imld(ji,jj) 
    110127            iikn = nmln(ji,jj) 
    111             hmld (ji,jj) = ( fsdepw(ji,jj,iiki  ) - fsdepw(ji,jj,mikt(ji,jj) )            ) * ssmask(ji,jj)    ! Turbocline depth  
    112             hmlp (ji,jj) = ( fsdepw(ji,jj,iikn  ) - fsdepw(ji,jj,MAX(mikt(ji,jj),nla10) ) ) * ssmask(ji,jj)    ! Mixed layer depth 
    113             hmlpt(ji,jj) = ( fsdept(ji,jj,iikn-1) - fsdepw(ji,jj,mikt(ji,jj) )            ) * ssmask(ji,jj)    ! depth of the last T-point inside the mixed layer 
     128            imkt = mikt(ji,jj) 
     129            hmld (ji,jj) = ( fsdepw(ji,jj,iiki  ) - fsdepw(ji,jj,imkt )            )   * ssmask(ji,jj)    ! Turbocline depth  
     130            hmlp (ji,jj) = ( fsdepw(ji,jj,iikn  ) - fsdepw(ji,jj,MAX( imkt,nla10 ) ) ) * ssmask(ji,jj)    ! Mixed layer depth 
     131            hmlpt(ji,jj) = ( fsdept(ji,jj,iikn-1) - fsdepw(ji,jj,imkt )            )   * ssmask(ji,jj)    ! depth of the last T-point inside the mixed layer 
    114132         END DO 
    115133      END DO 

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

    r4666 r4946  
    295295         END DO 
    296296         !                               ! finite LC depth 
    297 # if defined key_vectopt_loop 
    298          DO jj = 1, 1 
    299             DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    300 # else 
    301297         DO jj = 1, jpj  
    302298            DO ji = 1, jpi 
    303 # endif 
    304299               zhlc(ji,jj) = fsdepw(ji,jj,imlc(ji,jj)) 
    305300            END DO 
    306301         END DO 
    307302         zcof = 0.016 / SQRT( zrhoa * zcdrag ) 
    308 !CDIR NOVERRCHK 
    309303         DO jk = 2, jpkm1         !* TKE Langmuir circulation source term added to en 
    310 !CDIR NOVERRCHK 
    311304            DO jj = 2, jpjm1 
    312 !CDIR NOVERRCHK 
    313305               DO ji = fs_2, fs_jpim1   ! vector opt. 
    314306                  zus  = zcof * SQRT( taum(ji,jj) )           ! Stokes drift 
    … …  
    399391               DO ji = fs_2, fs_jpim1   ! vector opt. 
    400392                  en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   & 
    401                      &                                               * ( 1._wp - fr_i(ji,jj) )  * tmask(ji,jj,jk) * tmask(ji,jj,1) 
     393                     &                                 * ( 1._wp - fr_i(ji,jj) )  * tmask(ji,jj,jk) * tmask(ji,jj,1) 
    402394               END DO 
    403395            END DO 
    … …  
    408400               jk = nmln(ji,jj) 
    409401               en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   & 
    410                   &                                               * ( 1._wp - fr_i(ji,jj) )  * tmask(ji,jj,jk) * tmask(ji,jj,1) 
     402                  &                                 * ( 1._wp - fr_i(ji,jj) )  * tmask(ji,jj,jk) * tmask(ji,jj,1) 
    411403            END DO 
    412404         END DO 
    … …  
    424416                  zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add )  ! apply some modifications... 
    425417                  en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   & 
    426                      &                                        * ( 1._wp - fr_i(ji,jj) ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) * tmask(ji,jj,1) 
     418                     &                        * ( 1._wp - fr_i(ji,jj) ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) * tmask(ji,jj,1) 
    427419               END DO 
    428420            END DO 
    … …  
    734726      ! 
    735727      !                               !* Check of some namelist values 
    736       IF( nn_mxl  < 0  .OR.  nn_mxl  > 3 )   CALL ctl_stop( 'bad flag: nn_mxl is  0, 1 or 2 ' ) 
    737       IF( nn_pdl  < 0  .OR.  nn_pdl  > 1 )   CALL ctl_stop( 'bad flag: nn_pdl is  0 or 1    ' ) 
    738       IF( nn_htau < 0  .OR.  nn_htau > 1 )   CALL ctl_stop( 'bad flag: nn_htau is 0, 1 or 2 ' ) 
    739 #if ! key_coupled 
    740       IF( nn_etau == 3 )   CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' ) 
    741 #endif 
     728      IF( nn_mxl  < 0   .OR.  nn_mxl  > 3 )   CALL ctl_stop( 'bad flag: nn_mxl is  0, 1 or 2 ' ) 
     729      IF( nn_pdl  < 0   .OR.  nn_pdl  > 1 )   CALL ctl_stop( 'bad flag: nn_pdl is  0 or 1    ' ) 
     730      IF( nn_htau < 0   .OR.  nn_htau > 1 )   CALL ctl_stop( 'bad flag: nn_htau is 0, 1 or 2 ' ) 
     731      IF( nn_etau == 3 .AND. .NOT. lk_cpl )   CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' ) 
    742732 
    743733      IF( ln_mxl0 ) THEN 

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

    r4924 r4946  
    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_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/oce.F90

    r4924 r4946  
    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] 
    … …  
    7069   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_fmass       !: time evolution of mass of snow+ice               [Kg/m2/s] 
    7170 
    72    !! arrays related to penetration of solar fluxes to calculate the heat budget for sea ice 
    73    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   oatte, iatte       !: attenuation coef of the input solar flux [unitless] 
     71   !! Energy budget of the leads (open water embedded in sea ice) 
     72   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fraqsr_1lev        !: fraction of solar net radiation absorbed in the first ocean level [-] 
    7473 
    7574   !!---------------------------------------------------------------------- 
    … …  
    9493         &      hdivb(jpi,jpj,jpk)      , hdivn(jpi,jpj,jpk)      ,                             & 
    9594         &      tsb  (jpi,jpj,jpk,jpts) , tsn  (jpi,jpj,jpk,jpts) , tsa(jpi,jpj,jpk,jpts) ,     & 
     95         &      rab_b(jpi,jpj,jpk,jpts) , rab_n(jpi,jpj,jpk,jpts) ,                             & 
    9696         &      rn2b (jpi,jpj,jpk)      , rn2  (jpi,jpj,jpk)                              , STAT=ierr(1) ) 
    9797         ! 
    … …  
    117117      ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(3) ) 
    118118         ! 
    119       ALLOCATE( iatte(jpi,jpj) , oatte(jpi,jpj) , STAT=ierr(4) ) 
     119      ALLOCATE( fraqsr_1lev(jpi,jpj) , STAT=ierr(4) ) 
    120120         ! 
    121121      oce_alloc = MAXVAL( ierr ) 

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

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

    r4924 r4946  
    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 
    … …  
    4041   !! * Substitutions 
    4142#  include "domzgr_substitute.h90" 
    42 #  include "zdfddm_substitute.h90" 
    43    !!---------------------------------------------------------------------- 
    44    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     43!!gm   #  include "zdfddm_substitute.h90" 
     44   !!---------------------------------------------------------------------- 
     45   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    4546   !! $Id$ 
    4647   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    107108      ! Ocean physics update                (ua, va, tsa used as workspace) 
    108109      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    109                          CALL bn2( tsb, rn2b )        ! before Brunt-Vaisala frequency 
    110                          CALL bn2( tsn, rn2  )        ! now    Brunt-Vaisala frequency 
     110      !  THERMODYNAMICS 
     111                         CALL eos_rab( tsb, rab_b )       ! before local thermal/haline expension ratio at T-points 
     112                         CALL eos_rab( tsn, rab_n )       ! now    local thermal/haline expension ratio at T-points 
     113                         CALL bn2    ( tsb, rab_b, rn2b ) ! before Brunt-Vaisala frequency 
     114                         CALL bn2    ( tsn, rab_n, rn2  ) ! now    Brunt-Vaisala frequency 
    111115      ! 
    112116      !  VERTICAL PHYSICS 
    … …  
    206210      IF( lk_floats  )   CALL flo_stp( kstp )         ! drifting Floats 
    207211      IF( lk_diahth  )   CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth) 
    208       IF( lk_diafwb  )  CALL dia_fwb( kstp )         ! Fresh water budget diagnostics 
     212      IF( .NOT. lk_cpl ) CALL dia_fwb( kstp )         ! Fresh water budget diagnostics 
    209213      IF( ln_diaptr  )   CALL dia_ptr( kstp )         ! Poleward TRansports diagnostics 
    210214      IF( lk_diadct  )   CALL dia_dct( kstp )         ! Transports 
    … …  
    222226                         CALL trc_stp( kstp )         ! time-stepping 
    223227#endif 
     228 
    224229 
    225230      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    322327 
    323328      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    324       ! Trends                              (ua, va, tsa used as workspace) 
    325       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    326       IF( nstop == 0 ) THEN 
    327          IF( lk_trddyn     )   CALL trd_dwr( kstp )         ! trends: dynamics 
    328          IF( lk_trdtra     )   CALL trd_twr( kstp )         ! trends: active tracers 
    329          IF( lk_trdmld     )   CALL trd_mld( kstp )         ! trends: Mixed-layer 
    330          IF( lk_trdvor     )   CALL trd_vor( kstp )         ! trends: vorticity budget 
    331       ENDIF 
    332  
    333       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    334329      ! Coupled mode 
    335330      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 

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

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

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

    r4624 r4946  
    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_MERGE_2014/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90

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

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

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

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

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

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

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

    r4624 r4946  
    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_MERGE_2014/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90

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

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

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

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

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

    r4812 r4946  
    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_MERGE_2014/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90

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

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

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

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

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

    r4812 r4946  
    191191      USE trcnxt        , ONLY:   trc_nxt_alloc 
    192192      USE trczdf        , ONLY:   trc_zdf_alloc 
    193       USE trdmod_trc_oce, ONLY:   trd_mod_trc_oce_alloc 
    194 #if defined key_trdmld_trc  
    195       USE trdmld_trc    , ONLY:   trd_mld_trc_alloc 
     193      USE trdtrc_oce    , ONLY:   trd_trc_oce_alloc 
     194#if defined key_trdmxl_trc  
     195      USE trdmxl_trc    , ONLY:   trd_mxl_trc_alloc 
    196196#endif 
    197197      ! 
    … …  
    203203      ierr = ierr + trc_nxt_alloc() 
    204204      ierr = ierr + trc_zdf_alloc() 
    205       ierr = ierr + trd_mod_trc_oce_alloc() 
    206 #if defined key_trdmld_trc  
    207       ierr = ierr + trd_mld_trc_alloc() 
     205      ierr = ierr + trd_trc_oce_alloc() 
     206#if defined key_trdmxl_trc  
     207      ierr = ierr + trd_mxl_trc_alloc() 
    208208#endif 
    209209      ! 

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

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

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

    r4624 r4946  
    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_MERGE_2014/NEMOGCM/SETTE/param.cfg

    r4936 r4946  
    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_MERGE_2014/NEMOGCM/SETTE/sette.sh

    r4932 r4946  
    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" 

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

    r4924 r4946  
    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_MERGE_2014/NEMOGCM/TOOLS/COMPILE/bld_preproagr.cfg

    r4924 r4946  
    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_MERGE_2014/NEMOGCM/TOOLS/COMPILE/bldxag.cfg

    r4924 r4946  
    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.