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

Changeset 6455


Ignore:
Timestamp:
2016-04-08T10:57:55+02:00 (8 years ago)
Author:
aumont
Message:

upgrade to last revision of 3_6_stable

Location:
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM
Files:
8 deleted
105 edited
22 copied

Legend:

Unmodified
Added
Removed
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/ARCH/CMCC/arch-ifort_athena_xios.fcm

    r6232 r6455  
    3434 
    3535# required modules 
    36 # module load  INTEL/intel_xe_2013 NETCDF/netcdf-4.3_parallel_shared NETCDF/parallel-netcdf-1.3.1 HDF5/hdf5-1.8.11_parallel_shared 
     36# module load  INTEL/intel_xe_2013 NETCDF/netcdf-4.3_parallel NETCDF/parallel-netcdf-1.3.1 HDF5/hdf5-1.8.11_parallel 
    3737 
    3838# Environment variables set by user. Others should automatically define when loading modules. 
    3939#export XIOS=/users/home/models/nemo/xios 
    40 #export HDF5=/users/home/opt/hdf5/hdf5-1.8.11_parallel_shared 
    41 #export NETCDF=/users/home/opt/netcdf/netcdf-4.3_parallel_shared 
     40#export HDF5=/users/home/opt/hdf5/hdf5-1.8.11_parallel 
     41#export NETCDF=/users/home/opt/netcdf/netcdf-4.3_parallel 
    4242 
    4343%NCDF_INC            -I${NETCDF}/include  
     
    4949%CPP                 cpp 
    5050%FC                  mpiifort 
    51 %FCFLAGS             -r8 -O3 -xHost -fp-model source -traceback ${CFLAGS}  
     51%FCFLAGS             -r8 -O3 -xHost -fp-model source -traceback 
    5252%FFLAGS              %FCFLAGS 
    5353%LD                  mpiifort 
    5454%FPPFLAGS            -P -C -traditional 
    55 %LDFLAGS             -lstdc++ -lz -lgpfs -lcurl  ${LDFLAGS} 
     55%LDFLAGS             -lstdc++ -lz -lgpfs -lcurl 
    5656%AR                  ar  
    5757%ARFLAGS             -r 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg

    r5501 r6455  
    200200/ 
    201201!----------------------------------------------------------------------- 
    202 &namobc        !   open boundaries parameters                           ("key_obc") 
    203 !----------------------------------------------------------------------- 
    204 / 
    205 !----------------------------------------------------------------------- 
    206202&namagrif      !  AGRIF zoom                                            ("key_agrif") 
    207203!----------------------------------------------------------------------- 
     
    369365/ 
    370366!----------------------------------------------------------------------- 
     367&namzdf_tmx_new !  new tidal mixing parameterization                    ("key_zdftmx_new") 
     368!----------------------------------------------------------------------- 
     369/ 
     370!----------------------------------------------------------------------- 
    371371&namsol        !   elliptic solver / island / free surface 
    372372!----------------------------------------------------------------------- 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg

    r5925 r6455  
    179179/ 
    180180!----------------------------------------------------------------------- 
    181 &namobc        !   open boundaries parameters                           ("key_obc") 
    182 !----------------------------------------------------------------------- 
    183 / 
    184 !----------------------------------------------------------------------- 
    185181&namagrif      !  AGRIF zoom                                            ("key_agrif") 
    186182!----------------------------------------------------------------------- 
     
    307303/ 
    308304!----------------------------------------------------------------------- 
     305&namzdf_tmx_new !  new tidal mixing parameterization                    ("key_zdftmx_new") 
     306!----------------------------------------------------------------------- 
     307/ 
     308!----------------------------------------------------------------------- 
    309309&namsol        !   elliptic solver / island / free surface 
    310310!----------------------------------------------------------------------- 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg

    r5407 r6455  
    160160/ 
    161161!----------------------------------------------------------------------- 
    162 &namobc        !   open boundaries parameters                           ("key_obc") 
    163 !----------------------------------------------------------------------- 
    164 / 
    165 !----------------------------------------------------------------------- 
    166162&namagrif      !  AGRIF zoom                                            ("key_agrif") 
    167163!----------------------------------------------------------------------- 
     
    304300/ 
    305301!----------------------------------------------------------------------- 
     302&namzdf_tmx_new !  new tidal mixing parameterization                    ("key_zdftmx_new") 
     303!----------------------------------------------------------------------- 
     304/ 
     305!----------------------------------------------------------------------- 
    306306&namsol        !   elliptic solver / island / free surface 
    307307!----------------------------------------------------------------------- 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg

    r5407 r6455  
    165165/ 
    166166!----------------------------------------------------------------------- 
    167 &namobc        !   open boundaries parameters                           ("key_obc") 
    168 !----------------------------------------------------------------------- 
    169 / 
    170 !----------------------------------------------------------------------- 
    171167&namagrif      !  AGRIF zoom                                            ("key_agrif") 
    172168!----------------------------------------------------------------------- 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/namelist_cfg

    r5407 r6455  
    154154/ 
    155155!----------------------------------------------------------------------- 
    156 &namobc        !   open boundaries parameters                           ("key_obc") 
    157 !----------------------------------------------------------------------- 
    158 / 
    159 !----------------------------------------------------------------------- 
    160156&namagrif      !  AGRIF zoom                                            ("key_agrif") 
    161157!----------------------------------------------------------------------- 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_cfg

    r4990 r6455  
    165165/ 
    166166!----------------------------------------------------------------------- 
     167&namzdf_tmx_new !  new tidal mixing parameterization                    ("key_zdftmx_new") 
     168!----------------------------------------------------------------------- 
     169/ 
     170!----------------------------------------------------------------------- 
    167171&namsol        !   elliptic solver / island / free surface 
    168172!----------------------------------------------------------------------- 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef.xml

    r5517 r6455  
    6161   <file id="file2" name_suffix="_SBC" description="surface fluxes variables" > <!-- time step automaticaly defined based on nn_fsbc --> 
    6262     <field field_ref="empmr"        name="wfo"      /> 
     63          <field field_ref="emp_oce"      name="emp_oce"  long_name="Evap minus Precip over ocean"              /> 
     64          <field field_ref="emp_ice"      name="emp_ice"  long_name="Evap minus Precip over ice"                /> 
    6365     <field field_ref="qsr_oce"      name="qsr_oce"  /> 
    6466     <field field_ref="qns_oce"      name="qns_oce"  /> 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/namelist_cfg

    r4995 r6455  
    168168/ 
    169169!----------------------------------------------------------------------- 
     170&namzdf_tmx_new !  new tidal mixing parameterization                    ("key_zdftmx_new") 
     171!----------------------------------------------------------------------- 
     172/ 
     173!----------------------------------------------------------------------- 
    170174&namsol        !   elliptic solver / island / free surface 
    171175!----------------------------------------------------------------------- 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/1_namelist_cfg

    r5407 r6455  
    55!!                                    namsbc_cpl, namtra_qsr, namsbc_rnf,  
    66!!                                    namsbc_apr, namsbc_ssr, namsbc_alb) 
    7 !!              4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide) 
     7!!              4 - lateral boundary (namlbc, namcla, namagrif, nambdy, nambdy_tide) 
    88!!              5 - bottom  boundary (nambfr, nambbc, nambbl) 
    99!!              6 - Tracer           (nameos, namtra_adv, namtra_ldf, namtra_dmp) 
     
    303303!!   namlbc        lateral momentum boundary condition 
    304304!!   namcla        cross land advection 
    305 !!   namobc        open boundaries parameters                           ("key_obc") 
    306305!!   namagrif      agrif nested grid ( read by child model only )       ("key_agrif")  
    307306!!   nambdy        Unstructured open boundaries                         ("key_bdy") 
     
    319318!----------------------------------------------------------------------- 
    320319   nn_cla      =    0      !  advection between 2 ocean pts separates by land 
    321 / 
    322 !----------------------------------------------------------------------- 
    323 &namobc        !   open boundaries parameters                           ("key_obc") 
    324 !----------------------------------------------------------------------- 
    325    ln_obc_clim = .false.   !  climatological obc data files (T) or not (F) 
    326    ln_vol_cst  = .true.    !  impose the total volume conservation (T) or not (F) 
    327    ln_obc_fla  = .false.   !  Flather open boundary condition  
    328    nn_obcdta   =    1      !  = 0 the obc data are equal to the initial state 
    329                            !  = 1 the obc data are read in 'obc.dta' files 
    330    cn_obcdta   = 'annual'  !  set to annual if obc datafile hold 1 year of data 
    331                            !  set to monthly if obc datafile hold 1 month of data 
    332    rn_dpein    =    1.     !  damping time scale for inflow at east  open boundary 
    333    rn_dpwin    =    1.     !     -           -         -       west    -      - 
    334    rn_dpnin    =    1.     !     -           -         -       north   -      - 
    335    rn_dpsin    =    1.     !     -           -         -       south   -      - 
    336    rn_dpeob    = 3000.     !  time relaxation (days) for the east  open boundary 
    337    rn_dpwob    =   15.     !     -           -         -     west    -      - 
    338    rn_dpnob    = 3000.     !     -           -         -     north   -      - 
    339    rn_dpsob    =   15.     !     -           -         -     south   -      - 
    340    rn_volemp   =    1.     !  = 0 the total volume change with the surface flux (E-P-R) 
    341                            !  = 1 the total volume remains constant 
    342320/ 
    343321!----------------------------------------------------------------------- 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_cfg

    r5407 r6455  
    136136/ 
    137137!----------------------------------------------------------------------- 
    138 &namobc        !   open boundaries parameters                           ("key_obc") 
    139 !----------------------------------------------------------------------- 
    140 / 
    141 !----------------------------------------------------------------------- 
    142138&namagrif      !  AGRIF zoom                                            ("key_agrif") 
    143139!----------------------------------------------------------------------- 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_cfg

    r4370 r6455  
    165165/ 
    166166!----------------------------------------------------------------------- 
     167&namzdf_tmx_new !  new tidal mixing parameterization                    ("key_zdftmx_new") 
     168!----------------------------------------------------------------------- 
     169/ 
     170!----------------------------------------------------------------------- 
    167171&namsol        !   elliptic solver / island / free surface 
    168172!----------------------------------------------------------------------- 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/CONFIG/SHARED/field_def.xml

    r5517 r6455  
    2323      <field_group id="grid_T" grid_ref="grid_T_2D" > 
    2424         <field id="e3t"          long_name="T-cell thickness"   standard_name="cell_thickness"   unit="m"   grid_ref="grid_T_3D"/> 
     25         <field id="e3t_0"        long_name="Initial T-cell thickness"   standard_name="ref_cell_thickness"   unit="m"   grid_ref="grid_T_3D"/> 
    2526 
    2627         <field id="toce"         long_name="temperature"         standard_name="sea_water_potential_temperature"   unit="degC"     grid_ref="grid_T_3D"/> 
     
    5960         <field id="alpha"        long_name="thermal expansion"                                                         unit="degC-1" grid_ref="grid_T_3D" /> 
    6061         <field id="beta"         long_name="haline contraction"                                                        unit="1e3"    grid_ref="grid_T_3D" /> 
    61          <field id="bn2"          long_name="squared Brunt-Vaisala frequency"                                           unit="s-1"    grid_ref="grid_T_3D" /> 
    6262         <field id="rhop"         long_name="potential density (sigma0)"        standard_name="sea_water_sigma_theta"   unit="kg/m3"  grid_ref="grid_T_3D" /> 
    6363 
     
    174174      <field_group id="SBC" grid_ref="grid_T_2D" > <!-- time step automaticaly defined based on nn_fsbc --> 
    175175         <field id="empmr"        long_name="Net Upward Water Flux"                standard_name="water_flux_out_of_sea_ice_and_sea_water"                              unit="kg/m2/s"   /> 
     176         <field id="empbmr"       long_name="Net Upward Water Flux at pre. tstep"  standard_name="water_flux_out_of_sea_ice_and_sea_water"                              unit="kg/m2/s"   /> 
     177         <field id="emp_oce"      long_name="Evap minus Precip over ocean"         standard_name="evap_minus_precip_over_sea_water"                                     unit="kg/m2/s"   /> 
     178         <field id="emp_ice"      long_name="Evap minus Precip over ice"           standard_name="evap_minus_precip_over_sea_ice"                                       unit="kg/m2/s"   /> 
    176179         <field id="saltflx"      long_name="Downward salt flux"                                                                                                        unit="1e-3/m2/s" /> 
    177180         <field id="fmmflx"       long_name="Water flux due to freezing/melting"                                                                                        unit="kg/m2/s"   /> 
     
    274277         <field id="micesalt"     long_name="Mean ice salinity"                                                                                                               unit="1e-3"         /> 
    275278         <field id="miceage"      long_name="Mean ice age"                                                                                                                    unit="years"        /> 
     279         <field id="alb_ice"      long_name="Mean albedo over sea ice"                                                                                                        unit=""             /> 
     280         <field id="albedo"       long_name="Mean albedo over sea ice and ocean"                                                                                              unit=""             /> 
    276281 
    277282         <field id="iceage_cat"   long_name="Ice age for categories"                                       unit="days"   axis_ref="ncatice" /> 
     
    311316         <field id="sfxsni"       long_name="salt flux from snow-ice formation"                            unit="1e-3*kg/m2/day" /> 
    312317         <field id="sfxopw"       long_name="salt flux from open water ice formation"                      unit="1e-3*kg/m2/day" /> 
     318         <field id="sfxsub"       long_name="salt flux from sublimation"                                   unit="1e-3*kg/m2/day" /> 
    313319         <field id="sfx"          long_name="salt flux total"                                              unit="1e-3*kg/m2/day" /> 
    314320 
     
    324330         <field id="vfxsub"       long_name="snw sublimation"                                              unit="m/day"   /> 
    325331         <field id="vfxspr"       long_name="snw precipitation on ice"                                     unit="m/day"   /> 
     332         <field id="vfxthin"      long_name="daily thermo ice prod. for thin ice(<20cm) + open water"      unit="m/day"   /> 
    326333 
    327334         <field id="afxtot"       long_name="area tendency (total)"                                        unit="day-1"   /> 
     
    365372      <field_group id="grid_U"   grid_ref="grid_U_2D"> 
    366373         <field id="e3u"          long_name="U-cell thickness"                                       standard_name="cell_thickness"              unit="m"          grid_ref="grid_U_3D" /> 
     374         <field id="e3u_0"        long_name="Initial U-cell thickness"                               standard_name="ref_cell_thickness"          unit="m"          grid_ref="grid_U_3D"/> 
    367375         <field id="utau"         long_name="Wind Stress along i-axis"                               standard_name="surface_downward_x_stress"   unit="N/m2"                            /> 
    368376         <field id="uoce"         long_name="ocean current along i-axis"                             standard_name="sea_water_x_velocity"        unit="m/s"        grid_ref="grid_U_3D" /> 
     
    400408      <field_group id="grid_V"   grid_ref="grid_V_2D"> 
    401409         <field id="e3v"          long_name="V-cell thickness"                                       standard_name="cell_thickness"              unit="m"          grid_ref="grid_V_3D" /> 
     410         <field id="e3v_0"        long_name="Initial V-cell thickness"                               standard_name="ref_cell_thickness"          unit="m"          grid_ref="grid_V_3D"/> 
    402411         <field id="vtau"         long_name="Wind Stress along j-axis"                               standard_name="surface_downward_y_stress"   unit="N/m2"                            /> 
    403412         <field id="voce"         long_name="ocean current along j-axis"                             standard_name="sea_water_y_velocity"        unit="m/s"        grid_ref="grid_V_3D" /> 
     
    441450        <field id="woce_eiv"     long_name="EIV ocean vertical velocity"   standard_name="bolus_upward_sea_water_velocity"   unit="m/s" /> 
    442451 
    443         <!-- woce_eiv: available with key_trabbl_adv --> 
    444452        <field id="avt"          long_name="vertical eddy diffusivity"   standard_name="ocean_vertical_heat_diffusivity"       unit="m2/s" /> 
     453        <field id="logavt"       long_name="logarithm of vertical eddy diffusivity"   standard_name="ocean_vertical_heat_diffusivity"       unit="m2/s" /> 
    445454        <field id="avm"          long_name="vertical eddy viscosity"     standard_name="ocean_vertical_momentum_diffusivity"   unit="m2/s" /> 
    446455 
    447456        <!-- avs: available with key_zdfddm --> 
    448457        <field id="avs"          long_name="salt vertical eddy diffusivity"   standard_name="ocean_vertical_salt_diffusivity"   unit="m2/s" /> 
     458        <field id="logavs"       long_name="logarithm of salt vertical eddy diffusivity"   standard_name="ocean_vertical_heat_diffusivity"       unit="m2/s" /> 
    449459 
    450460        <!-- avt_evd and avm_evd: available with ln_zdfevd --> 
     
    454464        <!-- avt_tide: available with key_zdftmx --> 
    455465        <field id="av_tide"      long_name="tidal vertical diffusivity"   standard_name="ocean_vertical_tracer_diffusivity_due_to_tides"   unit="m2/s" /> 
     466 
     467       <!-- variables available with key_zdftmx_new --> 
     468        <field id="av_ratio"     long_name="S over T diffusivity ratio"            standard_name="salinity_over_temperature_diffusivity_ratio"                     unit="1"    /> 
     469        <field id="av_wave"      long_name="wave-induced vertical diffusivity"     standard_name="ocean_vertical_tracer_diffusivity_due_to_internal_waves"         unit="m2/s" /> 
     470        <field id="bn2"          long_name="squared Brunt-Vaisala frequency"       standard_name="squared_brunt_vaisala_frequency"                                 unit="s-1"  /> 
     471        <field id="bflx_tmx"     long_name="wave-induced buoyancy flux"            standard_name="buoyancy_flux_due_to_internal_waves"                             unit="W/kg" /> 
     472        <field id="pcmap_tmx"    long_name="power consumed by wave-driven mixing"  standard_name="vertically_integrated_power_consumption_by_wave_driven_mixing"   unit="W/m2"      grid_ref="grid_W_2D" /> 
     473        <field id="emix_tmx"     long_name="power density available for mixing"    standard_name="power_available_for_mixing_from_breaking_internal_waves"         unit="W/kg" /> 
    456474 
    457475        <!-- variables available with key_diaar5 -->    
     
    527545         <field id="ibgsfxbom"    long_name="global mean salt flux (thermo)"                         unit="1e-3*m/day" /> 
    528546         <field id="ibgsfxsum"    long_name="global mean salt flux (thermo)"                         unit="1e-3*m/day" /> 
     547         <field id="ibgsfxsub"    long_name="global mean salt flux (thermo)"                         unit="1e-3*m/day" /> 
    529548 
    530549         <field id="ibghfxdhc"    long_name="Heat content variation in snow and ice"                 unit="W"          /> 
     
    849868       <field id="Totlig"      long_name="Total ligand concentation"               unit="nmol/m3"    grid_ref="grid_T_3D" /> 
    850869       <field id="Biron"       long_name="Bioavailable iron"                       unit="nmol/m3"    grid_ref="grid_T_3D" /> 
    851        <field id="Sdenit"      long_name="Nitrate reduction in the sediments"      unit="mol/m2/s"                        /> 
     870       <field id="Sdenit"      long_name="Nitrate reduction in the sediments"      unit="molN/m2/s"                       /> 
     871       <field id="SedCal"      long_name="Calcite burial in the sediments"         unit="molC/m2/s"                       /> 
     872       <field id="SedSi"       long_name="Silicon burial in the sediments"         unit="molSi/m2/s"                      /> 
     873       <field id="SedC"        long_name="Organic C burial in the sediments"       unit="molC/m2/s"                       /> 
    852874       <field id="Ironice"     long_name="Iron input/uptake due to sea ice"        unit="mol/m2/s"                        /> 
    853875       <field id="HYDR"        long_name="Iron input from hydrothemal vents"       unit="mol/m2/s"   grid_ref="grid_T_3D" /> 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref

    r5429 r6455  
    2121   cn_icerst_outdir = "."          !  directory in which to write output ice restarts 
    2222   ln_limdyn     = .true.          !  ice dynamics (T) or thermodynamics only (F) 
    23    rn_amax       = 0.999           !  maximum tolerated ice concentration  
     23   rn_amax_n     = 0.999           !  maximum tolerated ice concentration NH 
     24   rn_amax_s     = 0.999           !  maximum tolerated ice concentration SH 
    2425   ln_limdiahsb  = .false.         !  check the heat and salt budgets (T) or not (F) 
    2526   ln_limdiaout  = .true.          !  output the heat and salt budgets (T) or not (F) 
     
    8586   rn_hnewice  = 0.1               !  thickness for new ice formation in open water (m) 
    8687   ln_frazil   = .false.           !  use frazil ice collection thickness as a function of wind (T) or not (F) 
    87    rn_maxfrazb = 0.0               !  maximum fraction of frazil ice collecting at the ice base 
     88   rn_maxfrazb = 1.0               !  maximum fraction of frazil ice collecting at the ice base 
    8889   rn_vfrazb   = 0.417             !  thresold drift speed for frazil ice collecting at the ice bottom (m/s) 
    8990   rn_Cfrazb   = 5.0               !  squeezing coefficient for frazil ice collecting at the ice bottom 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/CONFIG/SHARED/namelist_ref

    r5578 r6455  
    55!!                                    namsbc_cpl, namtra_qsr, namsbc_rnf, 
    66!!                                    namsbc_apr, namsbc_ssr, namsbc_alb) 
    7 !!              4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide) 
     7!!              4 - lateral boundary (namlbc, namcla, namagrif, nambdy, nambdy_tide) 
    88!!              5 - bottom  boundary (nambfr, nambbc, nambbl) 
    99!!              6 - Tracer           (nameos, namtra_adv, namtra_ldf, namtra_dmp) 
    1010!!              7 - dynamics         (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf) 
    11 !!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_kpp, namzdf_ddm, namzdf_tmx) 
     11!!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_kpp, namzdf_ddm, namzdf_tmx, namzdf_tmx_new) 
    1212!!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namhsb, namsto) 
    1313!!             10 - miscellaneous    (namsol, nammpp, namctl) 
     
    408408   ln_qsr_2bd  = .false.   !  2 bands              light penetration 
    409409   ln_qsr_bio  = .false.   !  bio-model light penetration 
    410    nn_chldta   =      1    !  RGB : Chl data (=1) or cst value (=0) 
     410   nn_chldta   =      1    !  RGB : 2D Chl data (=1), 3D Chl data (=2) or cst value (=0) 
    411411   rn_abs      =   0.58    !  RGB & 2 bands: fraction of light (rn_si1) 
    412412   rn_si0      =   0.35    !  RGB & 2 bands: shortess depth of extinction 
     
    500500&namsbc_alb    !   albedo parameters 
    501501!----------------------------------------------------------------------- 
    502    rn_cloud    =    0.06   !  cloud correction to snow and ice albedo 
    503    rn_albice   =    0.53   !  albedo of melting ice in the arctic and antarctic 
    504    rn_alphd    =    0.80   !  coefficients for linear interpolation used to 
    505    rn_alphc    =    0.65   !  compute albedo between two extremes values 
    506    rn_alphdi   =    0.72   !  (Pyane, 1972) 
     502   nn_ice_alb  =    0   !  parameterization of ice/snow albedo 
     503                        !     0: Shine & Henderson-Sellers (JGR 1985) 
     504                        !     1: "home made" based on Brandt et al. (J. Climate 2005) 
     505                        !                         and Grenfell & Perovich (JGR 2004) 
     506   rn_albice   =  0.53  !  albedo of bare puddled ice (values from 0.49 to 0.58) 
     507                        !     0.53 (default) => if nn_ice_alb=0 
     508                        !     0.50 (default) => if nn_ice_alb=1 
    507509/ 
    508510!----------------------------------------------------------------------- 
     
    546548!!   namlbc        lateral momentum boundary condition 
    547549!!   namcla        cross land advection 
    548 !!   namobc        open boundaries parameters                           ("key_obc") 
    549550!!   namagrif      agrif nested grid ( read by child model only )       ("key_agrif") 
    550551!!   nambdy        Unstructured open boundaries                         ("key_bdy") 
     
    563564!----------------------------------------------------------------------- 
    564565   nn_cla      =    0      !  advection between 2 ocean pts separates by land 
    565 / 
    566 !----------------------------------------------------------------------- 
    567 &namobc        !   open boundaries parameters                           ("key_obc") 
    568 !----------------------------------------------------------------------- 
    569    ln_obc_clim = .false.   !  climatological obc data files (T) or not (F) 
    570    ln_vol_cst  = .true.    !  impose the total volume conservation (T) or not (F) 
    571    ln_obc_fla  = .false.   !  Flather open boundary condition 
    572    nn_obcdta   =    1      !  = 0 the obc data are equal to the initial state 
    573                            !  = 1 the obc data are read in 'obc.dta' files 
    574    cn_obcdta   = 'annual'  !  set to annual if obc datafile hold 1 year of data 
    575                            !  set to monthly if obc datafile hold 1 month of data 
    576    rn_dpein    =    1.     !  damping time scale for inflow at east  open boundary 
    577    rn_dpwin    =    1.     !     -           -         -       west    -      - 
    578    rn_dpnin    =    1.     !     -           -         -       north   -      - 
    579    rn_dpsin    =    1.     !     -           -         -       south   -      - 
    580    rn_dpeob    = 3000.     !  time relaxation (days) for the east  open boundary 
    581    rn_dpwob    =   15.     !     -           -         -     west    -      - 
    582    rn_dpnob    = 3000.     !     -           -         -     north   -      - 
    583    rn_dpsob    =   15.     !     -           -         -     south   -      - 
    584    rn_volemp   =    1.     !  = 0 the total volume change with the surface flux (E-P-R) 
    585                            !  = 1 the total volume remains constant 
    586566/ 
    587567!----------------------------------------------------------------------- 
     
    898878!!             Tracers & Dynamics vertical physics namelists 
    899879!!====================================================================== 
    900 !!    namzdf        vertical physics 
    901 !!    namzdf_ric    richardson number dependent vertical mixing         ("key_zdfric") 
    902 !!    namzdf_tke    TKE dependent vertical mixing                       ("key_zdftke") 
    903 !!    namzdf_kpp    KPP dependent vertical mixing                       ("key_zdfkpp") 
    904 !!    namzdf_ddm    double diffusive mixing parameterization            ("key_zdfddm") 
    905 !!    namzdf_tmx    tidal mixing parameterization                       ("key_zdftmx") 
     880!!    namzdf            vertical physics 
     881!!    namzdf_ric        richardson number dependent vertical mixing     ("key_zdfric") 
     882!!    namzdf_tke        TKE dependent vertical mixing                   ("key_zdftke") 
     883!!    namzdf_kpp        KPP dependent vertical mixing                   ("key_zdfkpp") 
     884!!    namzdf_ddm        double diffusive mixing parameterization        ("key_zdfddm") 
     885!!    namzdf_tmx        tidal mixing parameterization                   ("key_zdftmx") 
     886!!    namzdf_tmx_new    new tidal mixing parameterization               ("key_zdftmx_new") 
    906887!!====================================================================== 
    907888! 
     
    1010991   rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency 
    1011992/ 
    1012  
     993!----------------------------------------------------------------------- 
     994&namzdf_tmx_new    !   new tidal mixing parameterization                ("key_zdftmx_new") 
     995!----------------------------------------------------------------------- 
     996   nn_zpyc     = 1         !  pycnocline-intensified dissipation scales as N (=1) or N^2 (=2) 
     997   ln_mevar    = .true.    !  variable (T) or constant (F) mixing efficiency 
     998   ln_tsdiff   = .true.    !  account for differential T/S mixing (T) or not (F) 
     999/ 
    10131000!!====================================================================== 
    10141001!!                  ***  Miscellaneous namelists  *** 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/CONFIG/SHARED/namelist_top_ref

    r5416 r6455  
    6262   rn_ahtrc_0       =  2000.    !  horizontal eddy diffusivity for tracers [m2/s] 
    6363   rn_ahtrb_0       =     0.    !     background eddy diffusivity for ldf_iso [m2/s] 
     64   rn_fact_lap      =     1.    !     enhanced zonal eddy diffusivity 
    6465/ 
    6566!----------------------------------------------------------------------- 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/CONFIG/cfg.txt

    r6204 r6455  
    66GYRE_BFM OPA_SRC TOP_SRC 
    77AMM12 OPA_SRC 
     8ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC 
    89ORCA2_LIM_PISCES OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 
     10ORCA2_LIM3 OPA_SRC LIM_SRC_3 NST_SRC 
    911GYRE OPA_SRC 
    10 ORCA2_LIM3 OPA_SRC LIM_SRC_3 NST_SRC 
    1112ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 
    12 ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/LIM_SRC_3/ice.F90

    r5341 r6455  
    253253   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhld        !: heat flux from the lead used for bottom melting 
    254254 
    255    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw    !: snow-ocean mass exchange over 1 time step [kg/m2] 
    256    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_spr    !: snow precipitation on ice over 1 time step [kg/m2] 
    257    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sub    !: snow sublimation over 1 time step [kg/m2] 
    258  
    259    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice    !: ice-ocean mass exchange over 1 time step [kg/m2] 
    260    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sni    !: snow ice growth component of wfx_ice [kg/m2] 
    261    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_opw    !: lateral ice growth component of wfx_ice [kg/m2] 
    262    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bog    !: bottom ice growth component of wfx_ice [kg/m2] 
    263    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_dyn    !: dynamical ice growth component of wfx_ice [kg/m2] 
    264    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bom    !: bottom melt component of wfx_ice [kg/m2] 
    265    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sum    !: surface melt component of wfx_ice [kg/m2] 
    266    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_res    !: residual component of wfx_ice [kg/m2] 
    267  
    268    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_tot     !: ice concentration tendency (total) [s-1] 
     255   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw    !: snow-ocean mass exchange   [kg.m-2.s-1] 
     256   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_spr    !: snow precipitation on ice  [kg.m-2.s-1] 
     257   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sub    !: snow/ice sublimation       [kg.m-2.s-1] 
     258 
     259   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice    !: ice-ocean mass exchange                   [kg.m-2.s-1] 
     260   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sni    !: snow ice growth component of wfx_ice      [kg.m-2.s-1] 
     261   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_opw    !: lateral ice growth component of wfx_ice   [kg.m-2.s-1] 
     262   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bog    !: bottom ice growth component of wfx_ice    [kg.m-2.s-1] 
     263   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_dyn    !: dynamical ice growth component of wfx_ice [kg.m-2.s-1] 
     264   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bom    !: bottom melt component of wfx_ice          [kg.m-2.s-1] 
     265   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sum    !: surface melt component of wfx_ice         [kg.m-2.s-1] 
     266   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_res    !: residual component of wfx_ice             [kg.m-2.s-1] 
     267 
     268   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_tot     !: ice concentration tendency (total)          [s-1] 
    269269   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_thd     !: ice concentration tendency (thermodynamics) [s-1] 
    270    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_dyn     !: ice concentration tendency (dynamics) [s-1] 
     270   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_dyn     !: ice concentration tendency (dynamics)       [s-1] 
    271271 
    272272   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bog     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     
    279279   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_res     !: residual salt flux due to correction of ice thickness [PSU/m2/s] 
    280280 
    281    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bog     !: total heat flux causing bottom ice growth  
    282    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bom     !: total heat flux causing bottom ice melt  
    283    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sum     !: total heat flux causing surface ice melt  
    284    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_opw     !: total heat flux causing open water ice formation 
    285    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dif     !: total heat flux causing Temp change in the ice  
    286    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_snw     !: heat flux for snow melt  
    287    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err     !: heat flux error after heat diffusion  
    288    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_dif !: heat flux remaining due to change in non-solar flux 
    289    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_rem !: heat flux error after heat remapping  
    290    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_in      !: heat flux available for thermo transformations  
    291    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_out     !: heat flux remaining at the end of thermo transformations  
    292  
     281   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sub     !: salt flux due to ice sublimation 
     282 
     283   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bog     !: total heat flux causing bottom ice growth        [W.m-2] 
     284   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bom     !: total heat flux causing bottom ice melt          [W.m-2] 
     285   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sum     !: total heat flux causing surface ice melt         [W.m-2] 
     286   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_opw     !: total heat flux causing open water ice formation [W.m-2] 
     287   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dif     !: total heat flux causing Temp change in the ice   [W.m-2] 
     288   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_snw     !: heat flux for snow melt                          [W.m-2] 
     289   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err     !: heat flux error after heat diffusion             [W.m-2] 
     290   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_dif !: heat flux remaining due to change in non-solar flux [W.m-2] 
     291   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_rem !: heat flux error after heat remapping             [W.m-2] 
     292   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_in      !: heat flux available for thermo transformations   [W.m-2] 
     293   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_out     !: heat flux remaining at the end of thermo transformations  [W.m-2] 
     294   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_err_sub !: mass flux error after sublimation [kg.m-2.s-1] 
     295    
    293296   ! heat flux associated with ice-atmosphere mass exchange 
    294    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sub     !: heat flux for sublimation  
    295    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_spr     !: heat flux of the snow precipitation  
     297   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sub     !: heat flux for sublimation  [W.m-2] 
     298   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_spr     !: heat flux of the snow precipitation  [W.m-2] 
    296299 
    297300   ! heat flux associated with ice-ocean mass exchange 
    298    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_thd     !: ice-ocean heat flux from thermo processes (limthd_dh)  
    299    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dyn     !: ice-ocean heat flux from mecanical processes (limitd_me)  
    300    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_res     !: residual heat flux due to correction of ice thickness 
     301   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_thd     !: ice-ocean heat flux from thermo processes (limthd_dh)  [W.m-2] 
     302   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dyn     !: ice-ocean heat flux from mecanical processes (limitd_me)  [W.m-2] 
     303   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_res     !: residual heat flux due to correction of ice thickness [W.m-2] 
    301304 
    302305   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ftr_ice   !: transmitted solar radiation under ice 
     306   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rn_amax_2d  !: maximum ice concentration 2d array 
    303307 
    304308   !!-------------------------------------------------------------------------- 
     
    372376   INTEGER          , PUBLIC ::   nlay_i          !: number of ice  layers  
    373377   INTEGER          , PUBLIC ::   nlay_s          !: number of snow layers  
    374    CHARACTER(len=32), PUBLIC ::   cn_icerst_in    !: suffix of ice restart name (input) 
     378   CHARACTER(len=80), PUBLIC ::   cn_icerst_in    !: suffix of ice restart name (input) 
    375379   CHARACTER(len=256), PUBLIC ::   cn_icerst_indir !: ice restart input directory 
    376    CHARACTER(len=32), PUBLIC ::   cn_icerst_out   !: suffix of ice restart name (output) 
     380   CHARACTER(len=80), PUBLIC ::   cn_icerst_out   !: suffix of ice restart name (output) 
    377381   CHARACTER(len=256), PUBLIC ::   cn_icerst_outdir!: ice restart output directory 
    378382   LOGICAL          , PUBLIC ::   ln_limdyn       !: flag for ice dynamics (T) or not (F) 
    379383   LOGICAL          , PUBLIC ::   ln_icectl       !: flag for sea-ice points output (T) or not (F) 
    380    REAL(wp)         , PUBLIC ::   rn_amax         !: maximum ice concentration 
     384   REAL(wp)         , PUBLIC ::   rn_amax_n       !: maximum ice concentration Northern hemisphere 
     385   REAL(wp)         , PUBLIC ::   rn_amax_s       !: maximum ice concentration Southern hemisphere 
    381386   INTEGER          , PUBLIC ::   iiceprt         !: debug i-point 
    382387   INTEGER          , PUBLIC ::   jiceprt         !: debug j-point 
     
    438443         &      afx_tot(jpi,jpj) , afx_thd(jpi,jpj),  afx_dyn(jpi,jpj) ,                        & 
    439444         &      fhtur  (jpi,jpj) , ftr_ice(jpi,jpj,jpl), qlead  (jpi,jpj) ,                     & 
    440          &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) ,                        & 
     445         &      rn_amax_2d(jpi,jpj),                                                            & 
     446         &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj) ,                       & 
    441447         &      sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,    & 
    442448         &      hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) ,     &  
    443          &      hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) ,                                   & 
     449         &      hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) , wfx_err_sub(jpi,jpj) ,       & 
    444450         &      hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) ,                           & 
    445451         &      hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , hfx_opw(jpi,jpj) ,    & 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90

    r5183 r6455  
    2424   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2525   USE sbc_oce , ONLY : sfx  ! Surface boundary condition: ocean fields 
    26  
     26   USE sbc_ice , ONLY : qevap_ice 
     27    
    2728   IMPLICIT NONE 
    2829   PRIVATE 
     
    184185         ! salt flux 
    185186         zfs_b  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
    186             &                  sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  & 
     187            &                  sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:)                   & 
    187188            &                ) *  e12t(:,:) * tmask(:,:,1) * zconv ) 
    188189 
     
    209210         ! salt flux 
    210211         zfs  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
    211             &                sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  &  
     212            &                sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:)                   &  
    212213            &              ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zfs_b 
    213214 
     
    256257            ENDIF 
    257258            IF (     zvmin   < -epsi10 ) WRITE(numout,*) 'violation v_i<0  [m]          (',cd_routine,') = ',zvmin 
    258             IF (     zamax   > rn_amax+epsi10 .AND. cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' ) THEN 
     259            IF (     zamax   > MAX( rn_amax_n, rn_amax_s ) + epsi10 .AND. & 
     260               &                         cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' ) THEN 
    259261                                         WRITE(numout,*) 'violation a_i>amax            (',cd_routine,') = ',zamax 
    260262            ENDIF 
     
    286288#if ! defined key_bdy 
    287289      ! heat flux 
    288       zhfx  = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es - hfx_sub ) * e12t * tmask(:,:,1) * zconv )  
     290      zhfx  = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es - SUM( qevap_ice * a_i_b, dim=3 ) )  & 
     291         &              * e12t * tmask(:,:,1) * zconv )  
    289292      ! salt flux 
    290293      zsfx  = glob_sum( ( sfx + diag_smvi ) * e12t * tmask(:,:,1) * zconv ) * rday 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90

    r5215 r6455  
    5656      real(wp)   ::   zbg_ivo, zbg_svo, zbg_are, zbg_sal ,zbg_tem ,zbg_ihc ,zbg_shc 
    5757      real(wp)   ::   zbg_sfx, zbg_sfx_bri, zbg_sfx_bog, zbg_sfx_bom, zbg_sfx_sum, zbg_sfx_sni,   & 
    58       &               zbg_sfx_opw, zbg_sfx_res, zbg_sfx_dyn  
     58      &               zbg_sfx_opw, zbg_sfx_res, zbg_sfx_dyn, zbg_sfx_sub  
    5959      real(wp)   ::   zbg_vfx, zbg_vfx_bog, zbg_vfx_opw, zbg_vfx_sni, zbg_vfx_dyn 
    6060      real(wp)   ::   zbg_vfx_bom, zbg_vfx_sum, zbg_vfx_res, zbg_vfx_spr, zbg_vfx_snw, zbg_vfx_sub   
     
    111111      zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    112112      zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) ) 
     113      zbg_sfx_sub = ztmp * glob_sum( sfx_sub(:,:) * e12t(:,:) * tmask(:,:,1) ) 
    113114 
    114115      ! Heat budget 
     
    189190      CALL iom_put( 'ibgsfxbom' , zbg_sfx_bom                              )   ! salt flux bottom melt       - 
    190191      CALL iom_put( 'ibgsfxsum' , zbg_sfx_sum                              )   ! salt flux surface melt      - 
     192      CALL iom_put( 'ibgsfxsub' , zbg_sfx_sub                              )   ! salt flux sublimation      - 
    191193 
    192194      CALL iom_put( 'ibghfxdhc' , zbg_hfx_dhc                              )   ! Heat content variation in snow and ice [W] 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r5202 r6455  
    4545   REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   asum     ! sum of total ice and open water area 
    4646   REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   aksum    ! ratio of area removed to area ridged 
    47    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   athorn   ! participation function; fraction of ridging/ 
    48    !                                                     ! closing associated w/ category n 
     47   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   athorn   ! participation function; fraction of ridging/closing associated w/ category n 
    4948   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   hrmin    ! minimum ridge thickness 
    5049   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   hrmax    ! maximum ridge thickness 
    5150   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   hraft    ! thickness of rafted ice 
    52    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   krdg     ! mean ridge thickness/thickness of ridging ice  
     51   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   krdg     ! thickness of ridging ice / mean ridge thickness 
    5352   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   aridge   ! participating ice ridging 
    5453   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   araft    ! participating ice rafting 
    5554 
    5655   REAL(wp), PARAMETER ::   krdgmin = 1.1_wp    ! min ridge thickness multiplier 
    57    REAL(wp), PARAMETER ::   kraft   = 2.0_wp    ! rafting multipliyer 
    58    REAL(wp), PARAMETER ::   kamax   = 1.0_wp    ! max of ice area authorized (clem: scheme is not stable if kamax <= 0.99) 
     56   REAL(wp), PARAMETER ::   kraft   = 0.5_wp    ! rafting multipliyer 
    5957 
    6058   REAL(wp) ::   Cp                             !  
    6159   ! 
    62    !----------------------------------------------------------------------- 
    63    ! Ridging diagnostic arrays for history files 
    64    !----------------------------------------------------------------------- 
    65    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dardg1dt   ! rate of fractional area loss by ridging ice (1/s) 
    66    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dardg2dt   ! rate of fractional area gain by new ridges (1/s) 
    67    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dvirdgdt   ! rate of ice volume ridged (m/s) 
    68    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   opening    ! rate of opening due to divergence/shear (1/s) 
    6960   ! 
    7061   !!---------------------------------------------------------------------- 
     
    8374         &      asum (jpi,jpj)     , athorn(jpi,jpj,0:jpl)                    ,     & 
    8475         &      aksum(jpi,jpj)                                                ,     & 
    85          ! 
    8676         &      hrmin(jpi,jpj,jpl) , hraft(jpi,jpj,jpl) , aridge(jpi,jpj,jpl) ,     & 
    87          &      hrmax(jpi,jpj,jpl) , krdg (jpi,jpj,jpl) , araft (jpi,jpj,jpl) ,     & 
    88          ! 
    89          !* Ridging diagnostic arrays for history files 
    90          &      dardg1dt(jpi,jpj)  , dardg2dt(jpi,jpj)                        ,     &  
    91          &      dvirdgdt(jpi,jpj)  , opening(jpi,jpj)                         , STAT=lim_itd_me_alloc ) 
     77         &      hrmax(jpi,jpj,jpl) , krdg (jpi,jpj,jpl) , araft (jpi,jpj,jpl) , STAT=lim_itd_me_alloc ) 
    9278         ! 
    9379      IF( lim_itd_me_alloc /= 0 )   CALL ctl_warn( 'lim_itd_me_alloc: failed to allocate arrays' ) 
     
    132118      REAL(wp), POINTER, DIMENSION(:,:)   ::   opning          ! rate of opening due to divergence/shear 
    133119      REAL(wp), POINTER, DIMENSION(:,:)   ::   closing_gross   ! rate at which area removed, not counting area of new ridges 
    134       REAL(wp), POINTER, DIMENSION(:,:)   ::   msnow_mlt       ! mass of snow added to ocean (kg m-2) 
    135       REAL(wp), POINTER, DIMENSION(:,:)   ::   esnow_mlt       ! energy needed to melt snow in ocean (J m-2) 
    136       REAL(wp), POINTER, DIMENSION(:,:)   ::   vt_i_init, vt_i_final  !  ice volume summed over categories 
    137120      ! 
    138121      INTEGER, PARAMETER ::   nitermax = 20     
     
    142125      IF( nn_timing == 1 )  CALL timing_start('limitd_me') 
    143126 
    144       CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 
     127      CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross ) 
    145128 
    146129      IF(ln_ctl) THEN 
     
    154137      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    155138 
    156       CALL lim_var_zapsmall 
    157       CALL lim_var_glo2eqv            ! equivalent variables, requested for rafting 
    158  
    159139      !-----------------------------------------------------------------------------! 
    160140      ! 1) Thickness categories boundaries, ice / o.w. concentrations, init_ons 
     
    164144      CALL lim_itd_me_ridgeprep                                    ! prepare ridging 
    165145      ! 
    166       IF( con_i)   CALL lim_column_sum( jpl, v_i, vt_i_init )      ! conservation check 
    167146 
    168147      DO jj = 1, jpj                                     ! Initialize arrays. 
    169148         DO ji = 1, jpi 
    170             msnow_mlt(ji,jj) = 0._wp 
    171             esnow_mlt(ji,jj) = 0._wp 
    172             dardg1dt (ji,jj) = 0._wp 
    173             dardg2dt (ji,jj) = 0._wp 
    174             dvirdgdt (ji,jj) = 0._wp 
    175             opening  (ji,jj) = 0._wp 
    176149 
    177150            !-----------------------------------------------------------------------------! 
     
    204177            ! If divu_adv < 0, make sure the closing rate is large enough 
    205178            ! to give asum = 1.0 after ridging. 
    206  
    207             divu_adv(ji,jj) = ( kamax - asum(ji,jj) ) * r1_rdtice  ! asum found in ridgeprep 
     179             
     180            divu_adv(ji,jj) = ( 1._wp - asum(ji,jj) ) * r1_rdtice  ! asum found in ridgeprep 
    208181 
    209182            IF( divu_adv(ji,jj) < 0._wp )   closing_net(ji,jj) = MAX( closing_net(ji,jj), -divu_adv(ji,jj) ) 
     
    224197      DO WHILE ( iterate_ridging > 0 .AND. niter < nitermax ) 
    225198 
     199         ! 3.2 closing_gross 
     200         !-----------------------------------------------------------------------------! 
     201         ! Based on the ITD of ridging and ridged ice, convert the net 
     202         !  closing rate to a gross closing rate.   
     203         ! NOTE: 0 < aksum <= 1 
     204         closing_gross(:,:) = closing_net(:,:) / aksum(:,:) 
     205 
     206         ! correction to closing rate and opening if closing rate is excessive 
     207         !--------------------------------------------------------------------- 
     208         ! Reduce the closing rate if more than 100% of the open water  
     209         ! would be removed.  Reduce the opening rate proportionately. 
    226210         DO jj = 1, jpj 
    227211            DO ji = 1, jpi 
    228  
    229                ! 3.2 closing_gross 
    230                !-----------------------------------------------------------------------------! 
    231                ! Based on the ITD of ridging and ridged ice, convert the net 
    232                !  closing rate to a gross closing rate.   
    233                ! NOTE: 0 < aksum <= 1 
    234                closing_gross(ji,jj) = closing_net(ji,jj) / aksum(ji,jj) 
    235  
    236                ! correction to closing rate and opening if closing rate is excessive 
    237                !--------------------------------------------------------------------- 
    238                ! Reduce the closing rate if more than 100% of the open water  
    239                ! would be removed.  Reduce the opening rate proportionately. 
    240                za   = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice 
    241                IF( za > epsi20 ) THEN 
    242                   zfac = MIN( 1._wp, ato_i(ji,jj) / za ) 
    243                   closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 
    244                   opning       (ji,jj) = opning       (ji,jj) * zfac 
     212               za   = ( opning(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) ) * rdt_ice 
     213               IF( za < 0._wp .AND. za > - ato_i(ji,jj) ) THEN  ! would lead to negative ato_i 
     214                  zfac = - ato_i(ji,jj) / za 
     215                  opning(ji,jj) = athorn(ji,jj,0) * closing_gross(ji,jj) - ato_i(ji,jj) * r1_rdtice  
     216               ELSEIF( za > 0._wp .AND. za > ( asum(ji,jj) - ato_i(ji,jj) ) ) THEN  ! would lead to ato_i > asum 
     217                  zfac = ( asum(ji,jj) - ato_i(ji,jj) ) / za 
     218                  opning(ji,jj) = athorn(ji,jj,0) * closing_gross(ji,jj) + ( asum(ji,jj) - ato_i(ji,jj) ) * r1_rdtice  
    245219               ENDIF 
    246  
    247220            END DO 
    248221         END DO 
     
    256229               DO ji = 1, jpi 
    257230                  za = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice 
    258                   IF( za  >  epsi20 ) THEN 
    259                      zfac = MIN( 1._wp, a_i(ji,jj,jl) / za ) 
     231                  IF( za  >  a_i(ji,jj,jl) ) THEN 
     232                     zfac = a_i(ji,jj,jl) / za 
    260233                     closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 
    261                      opning       (ji,jj) = opning       (ji,jj) * zfac 
    262234                  ENDIF 
    263235               END DO 
     
    268240         !-----------------------------------------------------------------------------! 
    269241 
    270          CALL lim_itd_me_ridgeshift( opning, closing_gross, msnow_mlt, esnow_mlt ) 
    271  
     242         CALL lim_itd_me_ridgeshift( opning, closing_gross ) 
     243 
     244          
    272245         ! 3.4 Compute total area of ice plus open water after ridging. 
    273246         !-----------------------------------------------------------------------------! 
    274247         ! This is in general not equal to one because of divergence during transport 
    275          asum(:,:) = ato_i(:,:) 
    276          DO jl = 1, jpl 
    277             asum(:,:) = asum(:,:) + a_i(:,:,jl) 
    278          END DO 
     248         asum(:,:) = ato_i(:,:) + SUM( a_i, dim=3 ) 
    279249 
    280250         ! 3.5 Do we keep on iterating ??? 
     
    284254 
    285255         iterate_ridging = 0 
    286  
    287256         DO jj = 1, jpj 
    288257            DO ji = 1, jpi 
    289                IF (ABS(asum(ji,jj) - kamax ) < epsi10) THEN 
     258               IF( ABS( asum(ji,jj) - 1._wp ) < epsi10 ) THEN 
    290259                  closing_net(ji,jj) = 0._wp 
    291260                  opning     (ji,jj) = 0._wp 
    292261               ELSE 
    293262                  iterate_ridging    = 1 
    294                   divu_adv   (ji,jj) = ( kamax - asum(ji,jj) ) * r1_rdtice 
     263                  divu_adv   (ji,jj) = ( 1._wp - asum(ji,jj) ) * r1_rdtice 
    295264                  closing_net(ji,jj) = MAX( 0._wp, -divu_adv(ji,jj) ) 
    296265                  opning     (ji,jj) = MAX( 0._wp,  divu_adv(ji,jj) ) 
     
    309278 
    310279         IF( iterate_ridging == 1 ) THEN 
     280            CALL lim_itd_me_ridgeprep 
    311281            IF( niter  >  nitermax ) THEN 
    312282               WRITE(numout,*) ' ALERTE : non-converging ridging scheme ' 
    313283               WRITE(numout,*) ' niter, iterate_ridging ', niter, iterate_ridging 
    314284            ENDIF 
    315             CALL lim_itd_me_ridgeprep 
    316285         ENDIF 
    317286 
    318287      END DO !! on the do while over iter 
    319  
    320       !-----------------------------------------------------------------------------! 
    321       ! 4) Ridging diagnostics 
    322       !-----------------------------------------------------------------------------! 
    323       ! Convert ridging rate diagnostics to correct units. 
    324       ! Update fresh water and heat fluxes due to snow melt. 
    325       DO jj = 1, jpj 
    326          DO ji = 1, jpi 
    327  
    328             dardg1dt(ji,jj) = dardg1dt(ji,jj) * r1_rdtice 
    329             dardg2dt(ji,jj) = dardg2dt(ji,jj) * r1_rdtice 
    330             dvirdgdt(ji,jj) = dvirdgdt(ji,jj) * r1_rdtice 
    331             opening (ji,jj) = opening (ji,jj) * r1_rdtice 
    332  
    333             !-----------------------------------------------------------------------------! 
    334             ! 5) Heat, salt and freshwater fluxes 
    335             !-----------------------------------------------------------------------------! 
    336             wfx_snw(ji,jj) = wfx_snw(ji,jj) + msnow_mlt(ji,jj) * r1_rdtice     ! fresh water source for ocean 
    337             hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + esnow_mlt(ji,jj) * r1_rdtice     ! heat sink for ocean (<0, W.m-2) 
    338  
    339          END DO 
    340       END DO 
    341  
    342       ! Check if there is a ridging error 
    343       IF( lwp ) THEN 
    344          DO jj = 1, jpj 
    345             DO ji = 1, jpi 
    346                IF( ABS( asum(ji,jj) - kamax)  >  epsi10 ) THEN   ! there is a bug 
    347                   WRITE(numout,*) ' ' 
    348                   WRITE(numout,*) ' ALERTE : Ridging error: total area = ', asum(ji,jj) 
    349                   WRITE(numout,*) ' limitd_me ' 
    350                   WRITE(numout,*) ' POINT : ', ji, jj 
    351                   WRITE(numout,*) ' jpl, a_i, athorn ' 
    352                   WRITE(numout,*) 0, ato_i(ji,jj), athorn(ji,jj,0) 
    353                   DO jl = 1, jpl 
    354                      WRITE(numout,*) jl, a_i(ji,jj,jl), athorn(ji,jj,jl) 
    355                   END DO 
    356                ENDIF 
    357             END DO 
    358          END DO 
    359       END IF 
    360  
    361       ! Conservation check 
    362       IF ( con_i ) THEN 
    363          CALL lim_column_sum (jpl,   v_i, vt_i_final) 
    364          fieldid = ' v_i : limitd_me ' 
    365          CALL lim_cons_check (vt_i_init, vt_i_final, 1.0e-6, fieldid)  
    366       ENDIF 
    367288 
    368289      CALL lim_var_agg( 1 )  
     
    410331      ENDIF  ! ln_limdyn=.true. 
    411332      ! 
    412       CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 
     333      CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross ) 
    413334      ! 
    414335      IF( nn_timing == 1 )  CALL timing_stop('limitd_me') 
    415336   END SUBROUTINE lim_itd_me 
    416337 
     338   SUBROUTINE lim_itd_me_ridgeprep 
     339      !!---------------------------------------------------------------------! 
     340      !!                ***  ROUTINE lim_itd_me_ridgeprep *** 
     341      !! 
     342      !! ** Purpose :   preparation for ridging and strength calculations 
     343      !! 
     344      !! ** Method  :   Compute the thickness distribution of the ice and open water  
     345      !!              participating in ridging and of the resulting ridges. 
     346      !!---------------------------------------------------------------------! 
     347      INTEGER ::   ji,jj, jl    ! dummy loop indices 
     348      REAL(wp) ::   Gstari, astari, hrmean, zdummy   ! local scalar 
     349      REAL(wp), POINTER, DIMENSION(:,:,:) ::   Gsum      ! Gsum(n) = sum of areas in categories 0 to n 
     350      !------------------------------------------------------------------------------! 
     351 
     352      CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 
     353 
     354      Gstari     = 1.0/rn_gstar     
     355      astari     = 1.0/rn_astar     
     356      aksum(:,:)    = 0.0 
     357      athorn(:,:,:) = 0.0 
     358      aridge(:,:,:) = 0.0 
     359      araft (:,:,:) = 0.0 
     360 
     361      ! Zero out categories with very small areas 
     362      CALL lim_var_zapsmall 
     363 
     364      ! Ice thickness needed for rafting 
     365      DO jl = 1, jpl 
     366         DO jj = 1, jpj 
     367            DO ji = 1, jpi 
     368               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 
     369               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
     370            END DO 
     371         END DO 
     372      END DO 
     373 
     374      !------------------------------------------------------------------------------! 
     375      ! 1) Participation function  
     376      !------------------------------------------------------------------------------! 
     377 
     378      ! Compute total area of ice plus open water. 
     379      ! This is in general not equal to one because of divergence during transport 
     380      asum(:,:) = ato_i(:,:) + SUM( a_i, dim=3 ) 
     381 
     382      ! Compute cumulative thickness distribution function 
     383      ! Compute the cumulative thickness distribution function Gsum, 
     384      ! where Gsum(n) is the fractional area in categories 0 to n. 
     385      ! initial value (in h = 0) equals open water area 
     386      Gsum(:,:,-1) = 0._wp 
     387      Gsum(:,:,0 ) = ato_i(:,:) 
     388      ! for each value of h, you have to add ice concentration then 
     389      DO jl = 1, jpl 
     390         Gsum(:,:,jl) = Gsum(:,:,jl-1) + a_i(:,:,jl) 
     391      END DO 
     392 
     393      ! Normalize the cumulative distribution to 1 
     394      DO jl = 0, jpl 
     395         Gsum(:,:,jl) = Gsum(:,:,jl) / asum(:,:) 
     396      END DO 
     397 
     398      ! 1.3 Compute participation function a(h) = b(h).g(h) (athorn) 
     399      !-------------------------------------------------------------------------------------------------- 
     400      ! Compute the participation function athorn; this is analogous to 
     401      ! a(h) = b(h)g(h) as defined in Thorndike et al. (1975). 
     402      ! area lost from category n due to ridging/closing 
     403      ! athorn(n)   = total area lost due to ridging/closing 
     404      ! assume b(h) = (2/Gstar) * (1 - G(h)/Gstar).  
     405      ! 
     406      ! The expressions for athorn are found by integrating b(h)g(h) between 
     407      ! the category boundaries. 
     408      ! athorn is always >= 0 and SUM(athorn(0:jpl))=1 
     409      !----------------------------------------------------------------- 
     410 
     411      IF( nn_partfun == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975) 
     412         DO jl = 0, jpl     
     413            DO jj = 1, jpj  
     414               DO ji = 1, jpi 
     415                  IF    ( Gsum(ji,jj,jl)   < rn_gstar ) THEN 
     416                     athorn(ji,jj,jl) = Gstari * ( Gsum(ji,jj,jl) - Gsum(ji,jj,jl-1) ) * & 
     417                        &                        ( 2._wp - ( Gsum(ji,jj,jl-1) + Gsum(ji,jj,jl) ) * Gstari ) 
     418                  ELSEIF( Gsum(ji,jj,jl-1) < rn_gstar ) THEN 
     419                     athorn(ji,jj,jl) = Gstari * ( rn_gstar       - Gsum(ji,jj,jl-1) ) *  & 
     420                        &                        ( 2._wp - ( Gsum(ji,jj,jl-1) + rn_gstar       ) * Gstari ) 
     421                  ELSE 
     422                     athorn(ji,jj,jl) = 0._wp 
     423                  ENDIF 
     424               END DO 
     425            END DO 
     426         END DO 
     427 
     428      ELSE                             !--- Exponential, more stable formulation (Lipscomb et al, 2007) 
     429         !                         
     430         zdummy = 1._wp / ( 1._wp - EXP(-astari) )        ! precompute exponential terms using Gsum as a work array 
     431         DO jl = -1, jpl 
     432            Gsum(:,:,jl) = EXP( -Gsum(:,:,jl) * astari ) * zdummy 
     433         END DO 
     434         DO jl = 0, jpl 
     435             athorn(:,:,jl) = Gsum(:,:,jl-1) - Gsum(:,:,jl) 
     436         END DO 
     437         ! 
     438      ENDIF 
     439 
     440      IF( ln_rafting ) THEN      ! Ridging and rafting ice participation functions 
     441         ! 
     442         DO jl = 1, jpl 
     443            DO jj = 1, jpj  
     444               DO ji = 1, jpi 
     445                  zdummy           = TANH ( rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) 
     446                  aridge(ji,jj,jl) = ( 1._wp + zdummy ) * 0.5_wp * athorn(ji,jj,jl) 
     447                  araft (ji,jj,jl) = ( 1._wp - zdummy ) * 0.5_wp * athorn(ji,jj,jl) 
     448               END DO 
     449            END DO 
     450         END DO 
     451 
     452      ELSE 
     453         ! 
     454         DO jl = 1, jpl 
     455            aridge(:,:,jl) = athorn(:,:,jl) 
     456         END DO 
     457         ! 
     458      ENDIF 
     459 
     460      !----------------------------------------------------------------- 
     461      ! 2) Transfer function 
     462      !----------------------------------------------------------------- 
     463      ! Compute max and min ridged ice thickness for each ridging category. 
     464      ! Assume ridged ice is uniformly distributed between hrmin and hrmax. 
     465      !  
     466      ! This parameterization is a modified version of Hibler (1980). 
     467      ! The mean ridging thickness, hrmean, is proportional to hi^(0.5) 
     468      !  and for very thick ridging ice must be >= krdgmin*hi 
     469      ! 
     470      ! The minimum ridging thickness, hrmin, is equal to 2*hi  
     471      !  (i.e., rafting) and for very thick ridging ice is 
     472      !  constrained by hrmin <= (hrmean + hi)/2. 
     473      !  
     474      ! The maximum ridging thickness, hrmax, is determined by 
     475      !  hrmean and hrmin. 
     476      ! 
     477      ! These modifications have the effect of reducing the ice strength 
     478      ! (relative to the Hibler formulation) when very thick ice is 
     479      ! ridging. 
     480      ! 
     481      ! aksum = net area removed/ total area removed 
     482      ! where total area removed = area of ice that ridges 
     483      !         net area removed = total area removed - area of new ridges 
     484      !----------------------------------------------------------------- 
     485 
     486      aksum(:,:) = athorn(:,:,0) 
     487      ! Transfer function 
     488      DO jl = 1, jpl !all categories have a specific transfer function 
     489         DO jj = 1, jpj 
     490            DO ji = 1, jpi 
     491                
     492               IF( athorn(ji,jj,jl) > 0._wp ) THEN 
     493                  hrmean          = MAX( SQRT( rn_hstar * ht_i(ji,jj,jl) ), ht_i(ji,jj,jl) * krdgmin ) 
     494                  hrmin(ji,jj,jl) = MIN( 2._wp * ht_i(ji,jj,jl), 0.5_wp * ( hrmean + ht_i(ji,jj,jl) ) ) 
     495                  hrmax(ji,jj,jl) = 2._wp * hrmean - hrmin(ji,jj,jl) 
     496                  hraft(ji,jj,jl) = ht_i(ji,jj,jl) / kraft 
     497                  krdg(ji,jj,jl)  = ht_i(ji,jj,jl) / MAX( hrmean, epsi20 ) 
     498 
     499                  ! Normalization factor : aksum, ensures mass conservation 
     500                  aksum(ji,jj) = aksum(ji,jj) + aridge(ji,jj,jl) * ( 1._wp - krdg(ji,jj,jl) )    & 
     501                     &                        + araft (ji,jj,jl) * ( 1._wp - kraft          ) 
     502 
     503               ELSE 
     504                  hrmin(ji,jj,jl)  = 0._wp  
     505                  hrmax(ji,jj,jl)  = 0._wp  
     506                  hraft(ji,jj,jl)  = 0._wp  
     507                  krdg (ji,jj,jl)  = 1._wp 
     508               ENDIF 
     509 
     510            END DO 
     511         END DO 
     512      END DO 
     513      ! 
     514      CALL wrk_dealloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 
     515      ! 
     516   END SUBROUTINE lim_itd_me_ridgeprep 
     517 
     518 
     519   SUBROUTINE lim_itd_me_ridgeshift( opning, closing_gross ) 
     520      !!---------------------------------------------------------------------- 
     521      !!                ***  ROUTINE lim_itd_me_icestrength *** 
     522      !! 
     523      !! ** Purpose :   shift ridging ice among thickness categories of ice thickness 
     524      !! 
     525      !! ** Method  :   Remove area, volume, and energy from each ridging category 
     526      !!              and add to thicker ice categories. 
     527      !!---------------------------------------------------------------------- 
     528      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   opning         ! rate of opening due to divergence/shear 
     529      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   closing_gross  ! rate at which area removed, excluding area of new ridges 
     530      ! 
     531      CHARACTER (len=80) ::   fieldid   ! field identifier 
     532      ! 
     533      INTEGER ::   ji, jj, jl, jl1, jl2, jk   ! dummy loop indices 
     534      INTEGER ::   ij                ! horizontal index, combines i and j loops 
     535      INTEGER ::   icells            ! number of cells with a_i > puny 
     536      REAL(wp) ::   hL, hR, farea    ! left and right limits of integration 
     537 
     538      INTEGER , POINTER, DIMENSION(:) ::   indxi, indxj   ! compressed indices 
     539      REAL(wp), POINTER, DIMENSION(:) ::   zswitch, fvol   ! new ridge volume going to n2 
     540 
     541      REAL(wp), POINTER, DIMENSION(:) ::   afrac            ! fraction of category area ridged  
     542      REAL(wp), POINTER, DIMENSION(:) ::   ardg1 , ardg2    ! area of ice ridged & new ridges 
     543      REAL(wp), POINTER, DIMENSION(:) ::   vsrdg , esrdg    ! snow volume & energy of ridging ice 
     544      REAL(wp), POINTER, DIMENSION(:) ::   dhr   , dhr2     ! hrmax - hrmin  &  hrmax^2 - hrmin^2 
     545 
     546      REAL(wp), POINTER, DIMENSION(:) ::   vrdg1   ! volume of ice ridged 
     547      REAL(wp), POINTER, DIMENSION(:) ::   vrdg2   ! volume of new ridges 
     548      REAL(wp), POINTER, DIMENSION(:) ::   vsw     ! volume of seawater trapped into ridges 
     549      REAL(wp), POINTER, DIMENSION(:) ::   srdg1   ! sal*volume of ice ridged 
     550      REAL(wp), POINTER, DIMENSION(:) ::   srdg2   ! sal*volume of new ridges 
     551      REAL(wp), POINTER, DIMENSION(:) ::   smsw    ! sal*volume of water trapped into ridges 
     552      REAL(wp), POINTER, DIMENSION(:) ::   oirdg1, oirdg2   ! ice age of ice ridged 
     553 
     554      REAL(wp), POINTER, DIMENSION(:) ::   afrft            ! fraction of category area rafted 
     555      REAL(wp), POINTER, DIMENSION(:) ::   arft1 , arft2    ! area of ice rafted and new rafted zone 
     556      REAL(wp), POINTER, DIMENSION(:) ::   virft , vsrft    ! ice & snow volume of rafting ice 
     557      REAL(wp), POINTER, DIMENSION(:) ::   esrft , smrft    ! snow energy & salinity of rafting ice 
     558      REAL(wp), POINTER, DIMENSION(:) ::   oirft1, oirft2   ! ice age of ice rafted 
     559 
     560      REAL(wp), POINTER, DIMENSION(:,:) ::   eirft      ! ice energy of rafting ice 
     561      REAL(wp), POINTER, DIMENSION(:,:) ::   erdg1      ! enth*volume of ice ridged 
     562      REAL(wp), POINTER, DIMENSION(:,:) ::   erdg2      ! enth*volume of new ridges 
     563      REAL(wp), POINTER, DIMENSION(:,:) ::   ersw       ! enth of water trapped into ridges 
     564      !!---------------------------------------------------------------------- 
     565 
     566      CALL wrk_alloc( jpij,        indxi, indxj ) 
     567      CALL wrk_alloc( jpij,        zswitch, fvol ) 
     568      CALL wrk_alloc( jpij,        afrac, ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 ) 
     569      CALL wrk_alloc( jpij,        vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw, oirdg1, oirdg2 ) 
     570      CALL wrk_alloc( jpij,        afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 
     571      CALL wrk_alloc( jpij,nlay_i, eirft, erdg1, erdg2, ersw ) 
     572 
     573      !------------------------------------------------------------------------------- 
     574      ! 1) Compute change in open water area due to closing and opening. 
     575      !------------------------------------------------------------------------------- 
     576      DO jj = 1, jpj 
     577         DO ji = 1, jpi 
     578            ato_i(ji,jj) = MAX( 0._wp, ato_i(ji,jj) +  & 
     579               &                     ( opning(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) ) * rdt_ice ) 
     580         END DO 
     581      END DO 
     582 
     583      !----------------------------------------------------------------- 
     584      ! 3) Pump everything from ice which is being ridged / rafted 
     585      !----------------------------------------------------------------- 
     586      ! Compute the area, volume, and energy of ice ridging in each 
     587      ! category, along with the area of the resulting ridge. 
     588 
     589      DO jl1 = 1, jpl !jl1 describes the ridging category 
     590 
     591         !------------------------------------------------ 
     592         ! 3.1) Identify grid cells with nonzero ridging 
     593         !------------------------------------------------ 
     594         icells = 0 
     595         DO jj = 1, jpj 
     596            DO ji = 1, jpi 
     597               IF( athorn(ji,jj,jl1) > 0._wp .AND. closing_gross(ji,jj) > 0._wp ) THEN 
     598                  icells = icells + 1 
     599                  indxi(icells) = ji 
     600                  indxj(icells) = jj 
     601               ENDIF 
     602            END DO 
     603         END DO 
     604 
     605         DO ij = 1, icells 
     606            ji = indxi(ij) ; jj = indxj(ij) 
     607 
     608            !-------------------------------------------------------------------- 
     609            ! 3.2) Compute area of ridging ice (ardg1) and of new ridge (ardg2) 
     610            !-------------------------------------------------------------------- 
     611            ardg1(ij) = aridge(ji,jj,jl1) * closing_gross(ji,jj) * rdt_ice 
     612            arft1(ij) = araft (ji,jj,jl1) * closing_gross(ji,jj) * rdt_ice 
     613 
     614            !--------------------------------------------------------------- 
     615            ! 3.3) Compute ridging /rafting fractions, make sure afrac <=1  
     616            !--------------------------------------------------------------- 
     617            afrac(ij) = ardg1(ij) / a_i(ji,jj,jl1) !ridging 
     618            afrft(ij) = arft1(ij) / a_i(ji,jj,jl1) !rafting 
     619            ardg2(ij) = ardg1(ij) * krdg(ji,jj,jl1) 
     620            arft2(ij) = arft1(ij) * kraft 
     621 
     622            !-------------------------------------------------------------------------- 
     623            ! 3.4) Subtract area, volume, and energy from ridging  
     624            !     / rafting category n1. 
     625            !-------------------------------------------------------------------------- 
     626            vrdg1(ij) = v_i(ji,jj,jl1) * afrac(ij) 
     627            vrdg2(ij) = vrdg1(ij) * ( 1. + rn_por_rdg ) 
     628            vsw  (ij) = vrdg1(ij) * rn_por_rdg 
     629 
     630            vsrdg (ij) = v_s  (ji,jj,  jl1) * afrac(ij) 
     631            esrdg (ij) = e_s  (ji,jj,1,jl1) * afrac(ij) 
     632            srdg1 (ij) = smv_i(ji,jj,  jl1) * afrac(ij) 
     633            oirdg1(ij) = oa_i (ji,jj,  jl1) * afrac(ij) 
     634            oirdg2(ij) = oa_i (ji,jj,  jl1) * afrac(ij) * krdg(ji,jj,jl1)  
     635 
     636            ! rafting volumes, heat contents ... 
     637            virft (ij) = v_i  (ji,jj,  jl1) * afrft(ij) 
     638            vsrft (ij) = v_s  (ji,jj,  jl1) * afrft(ij) 
     639            esrft (ij) = e_s  (ji,jj,1,jl1) * afrft(ij) 
     640            smrft (ij) = smv_i(ji,jj,  jl1) * afrft(ij)  
     641            oirft1(ij) = oa_i (ji,jj,  jl1) * afrft(ij)  
     642            oirft2(ij) = oa_i (ji,jj,  jl1) * afrft(ij) * kraft  
     643 
     644            !----------------------------------------------------------------- 
     645            ! 3.5) Compute properties of new ridges 
     646            !----------------------------------------------------------------- 
     647            smsw(ij)  = vsw(ij) * sss_m(ji,jj)                   ! salt content of seawater frozen in voids 
     648            srdg2(ij) = srdg1(ij) + smsw(ij)                     ! salt content of new ridge 
     649             
     650            sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ij) * rhoic * r1_rdtice 
     651            wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ij) * rhoic * r1_rdtice   ! increase in ice volume due to seawater frozen in voids 
     652             
     653            !------------------------------------------             
     654            ! 3.7 Put the snow somewhere in the ocean 
     655            !------------------------------------------             
     656            !  Place part of the snow lost by ridging into the ocean.  
     657            !  Note that esrdg > 0; the ocean must cool to melt snow. 
     658            !  If the ocean temp = Tf already, new ice must grow. 
     659            !  During the next time step, thermo_rates will determine whether 
     660            !  the ocean cools or new ice grows. 
     661            wfx_snw(ji,jj) = wfx_snw(ji,jj) + ( rhosn * vsrdg(ij) * ( 1._wp - rn_fsnowrdg )   &  
     662               &                              + rhosn * vsrft(ij) * ( 1._wp - rn_fsnowrft ) ) * r1_rdtice  ! fresh water source for ocean 
     663 
     664            hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ( - esrdg(ij) * ( 1._wp - rn_fsnowrdg )         &  
     665               &                                - esrft(ij) * ( 1._wp - rn_fsnowrft ) ) * r1_rdtice        ! heat sink for ocean (<0, W.m-2) 
     666 
     667            !----------------------------------------------------------------- 
     668            ! 3.8 Compute quantities used to apportion ice among categories 
     669            ! in the n2 loop below 
     670            !----------------------------------------------------------------- 
     671            dhr (ij) = 1._wp / ( hrmax(ji,jj,jl1)                    - hrmin(ji,jj,jl1)                    ) 
     672            dhr2(ij) = 1._wp / ( hrmax(ji,jj,jl1) * hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1) * hrmin(ji,jj,jl1) ) 
     673 
     674 
     675            ! update jl1 (removing ridged/rafted area) 
     676            a_i  (ji,jj,  jl1) = a_i  (ji,jj,  jl1) - ardg1 (ij) - arft1 (ij) 
     677            v_i  (ji,jj,  jl1) = v_i  (ji,jj,  jl1) - vrdg1 (ij) - virft (ij) 
     678            v_s  (ji,jj,  jl1) = v_s  (ji,jj,  jl1) - vsrdg (ij) - vsrft (ij) 
     679            e_s  (ji,jj,1,jl1) = e_s  (ji,jj,1,jl1) - esrdg (ij) - esrft (ij) 
     680            smv_i(ji,jj,  jl1) = smv_i(ji,jj,  jl1) - srdg1 (ij) - smrft (ij) 
     681            oa_i (ji,jj,  jl1) = oa_i (ji,jj,  jl1) - oirdg1(ij) - oirft1(ij) 
     682 
     683         END DO 
     684 
     685         !-------------------------------------------------------------------- 
     686         ! 3.9 Compute ridging ice enthalpy, remove it from ridging ice and 
     687         !      compute ridged ice enthalpy  
     688         !-------------------------------------------------------------------- 
     689         DO jk = 1, nlay_i 
     690            DO ij = 1, icells 
     691               ji = indxi(ij) ; jj = indxj(ij) 
     692               ! heat content of ridged ice 
     693               erdg1(ij,jk) = e_i(ji,jj,jk,jl1) * afrac(ij)  
     694               eirft(ij,jk) = e_i(ji,jj,jk,jl1) * afrft(ij)                
     695                
     696               ! enthalpy of the trapped seawater (J/m2, >0) 
     697               ! clem: if sst>0, then ersw <0 (is that possible?) 
     698               ersw(ij,jk)  = - rhoic * vsw(ij) * rcp * sst_m(ji,jj) * r1_nlay_i 
     699 
     700               ! heat flux to the ocean 
     701               hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ersw(ij,jk) * r1_rdtice  ! > 0 [W.m-2] ocean->ice flux  
     702 
     703               ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean 
     704               erdg2(ij,jk) = erdg1(ij,jk) + ersw(ij,jk) 
     705 
     706               ! update jl1 
     707               e_i  (ji,jj,jk,jl1) = e_i(ji,jj,jk,jl1) - erdg1(ij,jk) - eirft(ij,jk) 
     708 
     709            END DO 
     710         END DO 
     711 
     712         !------------------------------------------------------------------------------- 
     713         ! 4) Add area, volume, and energy of new ridge to each category jl2 
     714         !------------------------------------------------------------------------------- 
     715         DO jl2  = 1, jpl  
     716            ! over categories to which ridged/rafted ice is transferred 
     717            DO ij = 1, icells 
     718               ji = indxi(ij) ; jj = indxj(ij) 
     719 
     720               ! Compute the fraction of ridged ice area and volume going to thickness category jl2. 
     721               IF( hrmin(ji,jj,jl1) <= hi_max(jl2) .AND. hrmax(ji,jj,jl1) > hi_max(jl2-1) ) THEN 
     722                  hL = MAX( hrmin(ji,jj,jl1), hi_max(jl2-1) ) 
     723                  hR = MIN( hrmax(ji,jj,jl1), hi_max(jl2)   ) 
     724                  farea    = ( hR      - hL      ) * dhr(ij)  
     725                  fvol(ij) = ( hR * hR - hL * hL ) * dhr2(ij) 
     726               ELSE 
     727                  farea    = 0._wp  
     728                  fvol(ij) = 0._wp                   
     729               ENDIF 
     730 
     731               ! Compute the fraction of rafted ice area and volume going to thickness category jl2 
     732               IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. hraft(ji,jj,jl1) >  hi_max(jl2-1) ) THEN 
     733                  zswitch(ij) = 1._wp 
     734               ELSE 
     735                  zswitch(ij) = 0._wp                   
     736               ENDIF 
     737 
     738               a_i  (ji,jj  ,jl2) = a_i  (ji,jj  ,jl2) + ( ardg2 (ij) * farea    + arft2 (ij) * zswitch(ij) ) 
     739               oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + ( oirdg2(ij) * farea    + oirft2(ij) * zswitch(ij) ) 
     740               v_i  (ji,jj  ,jl2) = v_i  (ji,jj  ,jl2) + ( vrdg2 (ij) * fvol(ij) + virft (ij) * zswitch(ij) ) 
     741               smv_i(ji,jj  ,jl2) = smv_i(ji,jj  ,jl2) + ( srdg2 (ij) * fvol(ij) + smrft (ij) * zswitch(ij) ) 
     742               v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + ( vsrdg (ij) * rn_fsnowrdg * fvol(ij)  +  & 
     743                  &                                        vsrft (ij) * rn_fsnowrft * zswitch(ij) ) 
     744               e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + ( esrdg (ij) * rn_fsnowrdg * fvol(ij)  +  & 
     745                  &                                        esrft (ij) * rn_fsnowrft * zswitch(ij) ) 
     746 
     747            END DO 
     748 
     749            ! Transfer ice energy to category jl2 by ridging 
     750            DO jk = 1, nlay_i 
     751               DO ij = 1, icells 
     752                  ji = indxi(ij) ; jj = indxj(ij) 
     753                  e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + erdg2(ij,jk) * fvol(ij) + eirft(ij,jk) * zswitch(ij)                   
     754               END DO 
     755            END DO 
     756            ! 
     757         END DO ! jl2 
     758          
     759      END DO ! jl1 (deforming categories) 
     760 
     761      ! 
     762      CALL wrk_dealloc( jpij,        indxi, indxj ) 
     763      CALL wrk_dealloc( jpij,        zswitch, fvol ) 
     764      CALL wrk_dealloc( jpij,        afrac, ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 ) 
     765      CALL wrk_dealloc( jpij,        vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw, oirdg1, oirdg2 ) 
     766      CALL wrk_dealloc( jpij,        afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 
     767      CALL wrk_dealloc( jpij,nlay_i, eirft, erdg1, erdg2, ersw ) 
     768      ! 
     769   END SUBROUTINE lim_itd_me_ridgeshift 
    417770 
    418771   SUBROUTINE lim_itd_me_icestrength( kstrngth ) 
     
    434787      INTEGER             ::   ksmooth     ! smoothing the resistance to deformation 
    435788      INTEGER             ::   numts_rm    ! number of time steps for the P smoothing 
    436       REAL(wp)            ::   zhi, zp, z1_3  ! local scalars 
     789      REAL(wp)            ::   zp, z1_3    ! local scalars 
    437790      REAL(wp), POINTER, DIMENSION(:,:) ::   zworka   ! temporary array used here 
    438791      !!---------------------------------------------------------------------- 
     
    459812               DO ji = 1, jpi 
    460813                  ! 
    461                   IF( a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0._wp ) THEN 
    462                      zhi = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
     814                  IF( athorn(ji,jj,jl) > 0._wp ) THEN 
    463815                     !---------------------------- 
    464816                     ! PE loss from deforming ice 
    465817                     !---------------------------- 
    466                      strength(ji,jj) = strength(ji,jj) - athorn(ji,jj,jl) * zhi * zhi 
     818                     strength(ji,jj) = strength(ji,jj) - athorn(ji,jj,jl) * ht_i(ji,jj,jl) * ht_i(ji,jj,jl) 
    467819 
    468820                     !-------------------------- 
    469821                     ! PE gain from rafting ice 
    470822                     !-------------------------- 
    471                      strength(ji,jj) = strength(ji,jj) + 2._wp * araft(ji,jj,jl) * zhi * zhi 
     823                     strength(ji,jj) = strength(ji,jj) + 2._wp * araft(ji,jj,jl) * ht_i(ji,jj,jl) * ht_i(ji,jj,jl) 
    472824 
    473825                     !---------------------------- 
    474826                     ! PE gain from ridging ice 
    475827                     !---------------------------- 
    476                      strength(ji,jj) = strength(ji,jj) + aridge(ji,jj,jl) / krdg(ji,jj,jl)     & 
    477                         * z1_3 * ( hrmax(ji,jj,jl)**2 + hrmin(ji,jj,jl)**2 +  hrmax(ji,jj,jl) * hrmin(ji,jj,jl) )   
     828                     strength(ji,jj) = strength(ji,jj) + aridge(ji,jj,jl) * krdg(ji,jj,jl) * z1_3 *  & 
     829                        &                              ( hrmax(ji,jj,jl) * hrmax(ji,jj,jl) +         & 
     830                        &                                hrmin(ji,jj,jl) * hrmin(ji,jj,jl) +         & 
     831                        &                                hrmax(ji,jj,jl) * hrmin(ji,jj,jl) )   
    478832                        !!(a**3-b**3)/(a-b) = a*a+ab+b*b                       
    479833                  ENDIF 
     
    497851         ! 
    498852      ENDIF                     ! kstrngth 
    499  
    500853      ! 
    501854      !------------------------------------------------------------------------------! 
     
    503856      !------------------------------------------------------------------------------! 
    504857      ! CAN BE REMOVED 
    505       ! 
    506858      IF( ln_icestr_bvf ) THEN 
    507  
    508859         DO jj = 1, jpj 
    509860            DO ji = 1, jpi 
     
    511862            END DO 
    512863         END DO 
    513  
    514864      ENDIF 
    515  
    516865      ! 
    517866      !------------------------------------------------------------------------------! 
     
    558907      IF ( ksmooth == 2 ) THEN 
    559908 
    560  
    561909         CALL lbc_lnk( strength, 'T', 1. ) 
    562910 
     
    565913               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp) THEN  
    566914                  numts_rm = 1 ! number of time steps for the running mean 
    567                   IF ( strp1(ji,jj) > 0.0 ) numts_rm = numts_rm + 1 
    568                   IF ( strp2(ji,jj) > 0.0 ) numts_rm = numts_rm + 1 
     915                  IF ( strp1(ji,jj) > 0._wp ) numts_rm = numts_rm + 1 
     916                  IF ( strp2(ji,jj) > 0._wp ) numts_rm = numts_rm + 1 
    569917                  zp = ( strength(ji,jj) + strp1(ji,jj) + strp2(ji,jj) ) / numts_rm 
    570918                  strp2(ji,jj) = strp1(ji,jj) 
     
    583931      ! 
    584932   END SUBROUTINE lim_itd_me_icestrength 
    585  
    586  
    587    SUBROUTINE lim_itd_me_ridgeprep 
    588       !!---------------------------------------------------------------------! 
    589       !!                ***  ROUTINE lim_itd_me_ridgeprep *** 
    590       !! 
    591       !! ** Purpose :   preparation for ridging and strength calculations 
    592       !! 
    593       !! ** Method  :   Compute the thickness distribution of the ice and open water  
    594       !!              participating in ridging and of the resulting ridges. 
    595       !!---------------------------------------------------------------------! 
    596       INTEGER ::   ji,jj, jl    ! dummy loop indices 
    597       REAL(wp) ::   Gstari, astari, zhi, hrmean, zdummy   ! local scalar 
    598       REAL(wp), POINTER, DIMENSION(:,:)   ::   zworka    ! temporary array used here 
    599       REAL(wp), POINTER, DIMENSION(:,:,:) ::   Gsum      ! Gsum(n) = sum of areas in categories 0 to n 
    600       !------------------------------------------------------------------------------! 
    601  
    602       CALL wrk_alloc( jpi,jpj, zworka ) 
    603       CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 
    604  
    605       Gstari     = 1.0/rn_gstar     
    606       astari     = 1.0/rn_astar     
    607       aksum(:,:)    = 0.0 
    608       athorn(:,:,:) = 0.0 
    609       aridge(:,:,:) = 0.0 
    610       araft (:,:,:) = 0.0 
    611       hrmin(:,:,:)  = 0.0  
    612       hrmax(:,:,:)  = 0.0  
    613       hraft(:,:,:)  = 0.0  
    614       krdg (:,:,:)  = 1.0 
    615  
    616       !     ! Zero out categories with very small areas 
    617       CALL lim_var_zapsmall 
    618  
    619       !------------------------------------------------------------------------------! 
    620       ! 1) Participation function  
    621       !------------------------------------------------------------------------------! 
    622  
    623       ! Compute total area of ice plus open water. 
    624       ! This is in general not equal to one because of divergence during transport 
    625       asum(:,:) = ato_i(:,:) 
    626       DO jl = 1, jpl 
    627          asum(:,:) = asum(:,:) + a_i(:,:,jl) 
    628       END DO 
    629  
    630       ! Compute cumulative thickness distribution function 
    631       ! Compute the cumulative thickness distribution function Gsum, 
    632       ! where Gsum(n) is the fractional area in categories 0 to n. 
    633       ! initial value (in h = 0) equals open water area 
    634  
    635       Gsum(:,:,-1) = 0._wp 
    636       Gsum(:,:,0 ) = ato_i(:,:) 
    637  
    638       ! for each value of h, you have to add ice concentration then 
    639       DO jl = 1, jpl 
    640          Gsum(:,:,jl) = Gsum(:,:,jl-1) + a_i(:,:,jl) 
    641       END DO 
    642  
    643       ! Normalize the cumulative distribution to 1 
    644       zworka(:,:) = 1._wp / Gsum(:,:,jpl) 
    645       DO jl = 0, jpl 
    646          Gsum(:,:,jl) = Gsum(:,:,jl) * zworka(:,:) 
    647       END DO 
    648  
    649       ! 1.3 Compute participation function a(h) = b(h).g(h) (athorn) 
    650       !-------------------------------------------------------------------------------------------------- 
    651       ! Compute the participation function athorn; this is analogous to 
    652       ! a(h) = b(h)g(h) as defined in Thorndike et al. (1975). 
    653       ! area lost from category n due to ridging/closing 
    654       ! athorn(n)   = total area lost due to ridging/closing 
    655       ! assume b(h) = (2/Gstar) * (1 - G(h)/Gstar).  
    656       ! 
    657       ! The expressions for athorn are found by integrating b(h)g(h) between 
    658       ! the category boundaries. 
    659       !----------------------------------------------------------------- 
    660  
    661       IF( nn_partfun == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975) 
    662          DO jl = 0, jpl     
    663             DO jj = 1, jpj  
    664                DO ji = 1, jpi 
    665                   IF( Gsum(ji,jj,jl) < rn_gstar) THEN 
    666                      athorn(ji,jj,jl) = Gstari * ( Gsum(ji,jj,jl) - Gsum(ji,jj,jl-1) ) * & 
    667                         &                        ( 2.0 - (Gsum(ji,jj,jl-1) + Gsum(ji,jj,jl) ) * Gstari ) 
    668                   ELSEIF (Gsum(ji,jj,jl-1) < rn_gstar) THEN 
    669                      athorn(ji,jj,jl) = Gstari * ( rn_gstar - Gsum(ji,jj,jl-1) ) *  & 
    670                         &                        ( 2.0 - ( Gsum(ji,jj,jl-1) + rn_gstar ) * Gstari ) 
    671                   ELSE 
    672                      athorn(ji,jj,jl) = 0.0 
    673                   ENDIF 
    674                END DO 
    675             END DO 
    676          END DO 
    677  
    678       ELSE                             !--- Exponential, more stable formulation (Lipscomb et al, 2007) 
    679          !                         
    680          zdummy = 1._wp / ( 1._wp - EXP(-astari) )        ! precompute exponential terms using Gsum as a work array 
    681          DO jl = -1, jpl 
    682             Gsum(:,:,jl) = EXP( -Gsum(:,:,jl) * astari ) * zdummy 
    683          END DO 
    684          DO jl = 0, jpl 
    685              athorn(:,:,jl) = Gsum(:,:,jl-1) - Gsum(:,:,jl) 
    686          END DO 
    687          ! 
    688       ENDIF 
    689  
    690       IF( ln_rafting ) THEN      ! Ridging and rafting ice participation functions 
    691          ! 
    692          DO jl = 1, jpl 
    693             DO jj = 1, jpj  
    694                DO ji = 1, jpi 
    695                   IF ( athorn(ji,jj,jl) > 0._wp ) THEN 
    696 !!gm  TANH( -X ) = - TANH( X )  so can be computed only 1 time.... 
    697                      aridge(ji,jj,jl) = ( TANH (  rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl) 
    698                      araft (ji,jj,jl) = ( TANH ( -rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl) 
    699                      IF ( araft(ji,jj,jl) < epsi06 )   araft(ji,jj,jl)  = 0._wp 
    700                      aridge(ji,jj,jl) = MAX( athorn(ji,jj,jl) - araft(ji,jj,jl), 0.0 ) 
    701                   ENDIF 
    702                END DO 
    703             END DO 
    704          END DO 
    705  
    706       ELSE 
    707          ! 
    708          DO jl = 1, jpl 
    709             aridge(:,:,jl) = athorn(:,:,jl) 
    710          END DO 
    711          ! 
    712       ENDIF 
    713  
    714       IF( ln_rafting ) THEN 
    715  
    716          IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) > epsi10 .AND. lwp ) THEN 
    717             DO jl = 1, jpl 
    718                DO jj = 1, jpj 
    719                   DO ji = 1, jpi 
    720                      IF ( aridge(ji,jj,jl) + araft(ji,jj,jl) - athorn(ji,jj,jl) > epsi10 ) THEN 
    721                         WRITE(numout,*) ' ALERTE 96 : wrong participation function ... ' 
    722                         WRITE(numout,*) ' ji, jj, jl : ', ji, jj, jl 
    723                         WRITE(numout,*) ' lat, lon   : ', gphit(ji,jj), glamt(ji,jj) 
    724                         WRITE(numout,*) ' aridge     : ', aridge(ji,jj,1:jpl) 
    725                         WRITE(numout,*) ' araft      : ', araft(ji,jj,1:jpl) 
    726                         WRITE(numout,*) ' athorn     : ', athorn(ji,jj,1:jpl) 
    727                      ENDIF 
    728                   END DO 
    729                END DO 
    730             END DO 
    731          ENDIF 
    732  
    733       ENDIF 
    734  
    735       !----------------------------------------------------------------- 
    736       ! 2) Transfer function 
    737       !----------------------------------------------------------------- 
    738       ! Compute max and min ridged ice thickness for each ridging category. 
    739       ! Assume ridged ice is uniformly distributed between hrmin and hrmax. 
    740       !  
    741       ! This parameterization is a modified version of Hibler (1980). 
    742       ! The mean ridging thickness, hrmean, is proportional to hi^(0.5) 
    743       !  and for very thick ridging ice must be >= krdgmin*hi 
    744       ! 
    745       ! The minimum ridging thickness, hrmin, is equal to 2*hi  
    746       !  (i.e., rafting) and for very thick ridging ice is 
    747       !  constrained by hrmin <= (hrmean + hi)/2. 
    748       !  
    749       ! The maximum ridging thickness, hrmax, is determined by 
    750       !  hrmean and hrmin. 
    751       ! 
    752       ! These modifications have the effect of reducing the ice strength 
    753       ! (relative to the Hibler formulation) when very thick ice is 
    754       ! ridging. 
    755       ! 
    756       ! aksum = net area removed/ total area removed 
    757       ! where total area removed = area of ice that ridges 
    758       !         net area removed = total area removed - area of new ridges 
    759       !----------------------------------------------------------------- 
    760  
    761       ! Transfer function 
    762       DO jl = 1, jpl !all categories have a specific transfer function 
    763          DO jj = 1, jpj 
    764             DO ji = 1, jpi 
    765  
    766                IF (a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0.0 ) THEN 
    767                   zhi = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
    768                   hrmean          = MAX(SQRT(rn_hstar*zhi), zhi*krdgmin) 
    769                   hrmin(ji,jj,jl) = MIN(2.0*zhi, 0.5*(hrmean + zhi)) 
    770                   hrmax(ji,jj,jl) = 2.0*hrmean - hrmin(ji,jj,jl) 
    771                   hraft(ji,jj,jl) = kraft*zhi 
    772                   krdg(ji,jj,jl)  = hrmean / zhi 
    773                ELSE 
    774                   hraft(ji,jj,jl) = 0.0 
    775                   hrmin(ji,jj,jl) = 0.0  
    776                   hrmax(ji,jj,jl) = 0.0  
    777                   krdg (ji,jj,jl) = 1.0 
    778                ENDIF 
    779  
    780             END DO 
    781          END DO 
    782       END DO 
    783  
    784       ! Normalization factor : aksum, ensures mass conservation 
    785       aksum(:,:) = athorn(:,:,0) 
    786       DO jl = 1, jpl  
    787          aksum(:,:)    = aksum(:,:) + aridge(:,:,jl) * ( 1._wp - 1._wp / krdg(:,:,jl) )    & 
    788             &                       + araft (:,:,jl) * ( 1._wp - 1._wp / kraft        ) 
    789       END DO 
    790       ! 
    791       CALL wrk_dealloc( jpi,jpj, zworka ) 
    792       CALL wrk_dealloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 
    793       ! 
    794    END SUBROUTINE lim_itd_me_ridgeprep 
    795  
    796  
    797    SUBROUTINE lim_itd_me_ridgeshift( opning, closing_gross, msnow_mlt, esnow_mlt ) 
    798       !!---------------------------------------------------------------------- 
    799       !!                ***  ROUTINE lim_itd_me_icestrength *** 
    800       !! 
    801       !! ** Purpose :   shift ridging ice among thickness categories of ice thickness 
    802       !! 
    803       !! ** Method  :   Remove area, volume, and energy from each ridging category 
    804       !!              and add to thicker ice categories. 
    805       !!---------------------------------------------------------------------- 
    806       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   opning         ! rate of opening due to divergence/shear 
    807       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   closing_gross  ! rate at which area removed, excluding area of new ridges 
    808       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   msnow_mlt      ! mass of snow added to ocean (kg m-2) 
    809       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   esnow_mlt      ! energy needed to melt snow in ocean (J m-2) 
    810       ! 
    811       CHARACTER (len=80) ::   fieldid   ! field identifier 
    812       LOGICAL, PARAMETER ::   l_conservation_check = .true.  ! if true, check conservation (useful for debugging) 
    813       ! 
    814       INTEGER ::   ji, jj, jl, jl1, jl2, jk   ! dummy loop indices 
    815       INTEGER ::   ij                ! horizontal index, combines i and j loops 
    816       INTEGER ::   icells            ! number of cells with aicen > puny 
    817       REAL(wp) ::   hL, hR, farea, ztmelts    ! left and right limits of integration 
    818  
    819       INTEGER , POINTER, DIMENSION(:) ::   indxi, indxj   ! compressed indices 
    820  
    821       REAL(wp), POINTER, DIMENSION(:,:) ::   vice_init, vice_final   ! ice volume summed over categories 
    822       REAL(wp), POINTER, DIMENSION(:,:) ::   eice_init, eice_final   ! ice energy summed over layers 
    823  
    824       REAL(wp), POINTER, DIMENSION(:,:,:) ::   aicen_init, vicen_init   ! ice  area    & volume before ridging 
    825       REAL(wp), POINTER, DIMENSION(:,:,:) ::   vsnwn_init, esnwn_init   ! snow volume  & energy before ridging 
    826       REAL(wp), POINTER, DIMENSION(:,:,:) ::   smv_i_init, oa_i_init    ! ice salinity & age    before ridging 
    827  
    828       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   eicen_init        ! ice energy before ridging 
    829  
    830       REAL(wp), POINTER, DIMENSION(:,:) ::   afrac , fvol     ! fraction of category area ridged & new ridge volume going to n2 
    831       REAL(wp), POINTER, DIMENSION(:,:) ::   ardg1 , ardg2    ! area of ice ridged & new ridges 
    832       REAL(wp), POINTER, DIMENSION(:,:) ::   vsrdg , esrdg    ! snow volume & energy of ridging ice 
    833       REAL(wp), POINTER, DIMENSION(:,:) ::   dhr   , dhr2     ! hrmax - hrmin  &  hrmax^2 - hrmin^2 
    834  
    835       REAL(wp), POINTER, DIMENSION(:,:) ::   vrdg1   ! volume of ice ridged 
    836       REAL(wp), POINTER, DIMENSION(:,:) ::   vrdg2   ! volume of new ridges 
    837       REAL(wp), POINTER, DIMENSION(:,:) ::   vsw     ! volume of seawater trapped into ridges 
    838       REAL(wp), POINTER, DIMENSION(:,:) ::   srdg1   ! sal*volume of ice ridged 
    839       REAL(wp), POINTER, DIMENSION(:,:) ::   srdg2   ! sal*volume of new ridges 
    840       REAL(wp), POINTER, DIMENSION(:,:) ::   smsw    ! sal*volume of water trapped into ridges 
    841       REAL(wp), POINTER, DIMENSION(:,:) ::   oirdg1, oirdg2   ! ice age of ice ridged 
    842  
    843       REAL(wp), POINTER, DIMENSION(:,:) ::   afrft            ! fraction of category area rafted 
    844       REAL(wp), POINTER, DIMENSION(:,:) ::   arft1 , arft2    ! area of ice rafted and new rafted zone 
    845       REAL(wp), POINTER, DIMENSION(:,:) ::   virft , vsrft    ! ice & snow volume of rafting ice 
    846       REAL(wp), POINTER, DIMENSION(:,:) ::   esrft , smrft    ! snow energy & salinity of rafting ice 
    847       REAL(wp), POINTER, DIMENSION(:,:) ::   oirft1, oirft2   ! ice age of ice rafted 
    848  
    849       REAL(wp), POINTER, DIMENSION(:,:,:) ::   eirft      ! ice energy of rafting ice 
    850       REAL(wp), POINTER, DIMENSION(:,:,:) ::   erdg1      ! enth*volume of ice ridged 
    851       REAL(wp), POINTER, DIMENSION(:,:,:) ::   erdg2      ! enth*volume of new ridges 
    852       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ersw       ! enth of water trapped into ridges 
    853       !!---------------------------------------------------------------------- 
    854  
    855       CALL wrk_alloc( (jpi+1)*(jpj+1),       indxi, indxj ) 
    856       CALL wrk_alloc( jpi, jpj,              vice_init, vice_final, eice_init, eice_final ) 
    857       CALL wrk_alloc( jpi, jpj,              afrac, fvol , ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 ) 
    858       CALL wrk_alloc( jpi, jpj,              vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw, oirdg1, oirdg2 ) 
    859       CALL wrk_alloc( jpi, jpj,              afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 
    860       CALL wrk_alloc( jpi, jpj, jpl,         aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 
    861       CALL wrk_alloc( jpi, jpj, nlay_i,      eirft, erdg1, erdg2, ersw ) 
    862       CALL wrk_alloc( jpi, jpj, nlay_i, jpl, eicen_init ) 
    863  
    864       ! Conservation check 
    865       eice_init(:,:) = 0._wp 
    866  
    867       IF( con_i ) THEN 
    868          CALL lim_column_sum        (jpl,    v_i,       vice_init ) 
    869          CALL lim_column_sum_energy (jpl, nlay_i,  e_i, eice_init ) 
    870          DO ji = mi0(iiceprt), mi1(iiceprt) 
    871             DO jj = mj0(jiceprt), mj1(jiceprt) 
    872                WRITE(numout,*) ' vice_init  : ', vice_init(ji,jj) 
    873                WRITE(numout,*) ' eice_init  : ', eice_init(ji,jj) 
    874             END DO 
    875          END DO 
    876       ENDIF 
    877  
    878       !------------------------------------------------------------------------------- 
    879       ! 1) Compute change in open water area due to closing and opening. 
    880       !------------------------------------------------------------------------------- 
    881       DO jj = 1, jpj 
    882          DO ji = 1, jpi 
    883             ato_i(ji,jj) = ato_i(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice        & 
    884                &                        + opning(ji,jj)                          * rdt_ice 
    885             IF    ( ato_i(ji,jj) < -epsi10 ) THEN    ! there is a bug 
    886                IF(lwp)   WRITE(numout,*) 'Ridging error: ato_i < 0 -- ato_i : ',ato_i(ji,jj) 
    887             ELSEIF( ato_i(ji,jj) < 0._wp   ) THEN    ! roundoff error 
    888                ato_i(ji,jj) = 0._wp 
    889             ENDIF 
    890          END DO 
    891       END DO 
    892  
    893       !----------------------------------------------------------------- 
    894       ! 2) Save initial state variables 
    895       !----------------------------------------------------------------- 
    896       aicen_init(:,:,:)   = a_i  (:,:,:) 
    897       vicen_init(:,:,:)   = v_i  (:,:,:) 
    898       vsnwn_init(:,:,:)   = v_s  (:,:,:) 
    899       smv_i_init(:,:,:)   = smv_i(:,:,:) 
    900       esnwn_init(:,:,:)   = e_s  (:,:,1,:) 
    901       eicen_init(:,:,:,:) = e_i  (:,:,:,:) 
    902       oa_i_init (:,:,:)   = oa_i (:,:,:) 
    903  
    904       ! 
    905       !----------------------------------------------------------------- 
    906       ! 3) Pump everything from ice which is being ridged / rafted 
    907       !----------------------------------------------------------------- 
    908       ! Compute the area, volume, and energy of ice ridging in each 
    909       ! category, along with the area of the resulting ridge. 
    910  
    911       DO jl1 = 1, jpl !jl1 describes the ridging category 
    912  
    913          !------------------------------------------------ 
    914          ! 3.1) Identify grid cells with nonzero ridging 
    915          !------------------------------------------------ 
    916  
    917          icells = 0 
    918          DO jj = 1, jpj 
    919             DO ji = 1, jpi 
    920                IF( aicen_init(ji,jj,jl1) > epsi10 .AND. athorn(ji,jj,jl1) > 0._wp  & 
    921                   &   .AND. closing_gross(ji,jj) > 0._wp ) THEN 
    922                   icells = icells + 1 
    923                   indxi(icells) = ji 
    924                   indxj(icells) = jj 
    925                ENDIF 
    926             END DO 
    927          END DO 
    928  
    929          DO ij = 1, icells 
    930             ji = indxi(ij) 
    931             jj = indxj(ij) 
    932  
    933             !-------------------------------------------------------------------- 
    934             ! 3.2) Compute area of ridging ice (ardg1) and of new ridge (ardg2) 
    935             !-------------------------------------------------------------------- 
    936  
    937             ardg1(ji,jj) = aridge(ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice 
    938             arft1(ji,jj) = araft (ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice 
    939             ardg2(ji,jj) = ardg1(ji,jj) / krdg(ji,jj,jl1) 
    940             arft2(ji,jj) = arft1(ji,jj) / kraft 
    941  
    942             !--------------------------------------------------------------- 
    943             ! 3.3) Compute ridging /rafting fractions, make sure afrac <=1  
    944             !--------------------------------------------------------------- 
    945  
    946             afrac(ji,jj) = ardg1(ji,jj) / aicen_init(ji,jj,jl1) !ridging 
    947             afrft(ji,jj) = arft1(ji,jj) / aicen_init(ji,jj,jl1) !rafting 
    948  
    949             IF( afrac(ji,jj) > kamax + epsi10 ) THEN  ! there is a bug 
    950                IF(lwp)   WRITE(numout,*) ' ardg > a_i -- ardg, aicen_init : ', ardg1(ji,jj), aicen_init(ji,jj,jl1) 
    951             ELSEIF( afrac(ji,jj) > kamax ) THEN       ! roundoff error 
    952                afrac(ji,jj) = kamax 
    953             ENDIF 
    954  
    955             IF( afrft(ji,jj) > kamax + epsi10 ) THEN ! there is a bug 
    956                IF(lwp)   WRITE(numout,*) ' arft > a_i -- arft, aicen_init : ', arft1(ji,jj), aicen_init(ji,jj,jl1)  
    957             ELSEIF( afrft(ji,jj) > kamax) THEN       ! roundoff error 
    958                afrft(ji,jj) = kamax 
    959             ENDIF 
    960  
    961             !-------------------------------------------------------------------------- 
    962             ! 3.4) Subtract area, volume, and energy from ridging  
    963             !     / rafting category n1. 
    964             !-------------------------------------------------------------------------- 
    965             vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj) 
    966             vrdg2(ji,jj) = vrdg1(ji,jj) * ( 1. + rn_por_rdg ) 
    967             vsw  (ji,jj) = vrdg1(ji,jj) * rn_por_rdg 
    968  
    969             vsrdg (ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj) 
    970             esrdg (ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj) 
    971             srdg1 (ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 
    972             oirdg1(ji,jj) = oa_i_init (ji,jj,jl1) * afrac(ji,jj) 
    973             oirdg2(ji,jj) = oa_i_init (ji,jj,jl1) * afrac(ji,jj) / krdg(ji,jj,jl1)  
    974  
    975             ! rafting volumes, heat contents ... 
    976             virft (ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj) 
    977             vsrft (ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj) 
    978             esrft (ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj) 
    979             smrft (ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj)  
    980             oirft1(ji,jj) = oa_i_init (ji,jj,jl1) * afrft(ji,jj)  
    981             oirft2(ji,jj) = oa_i_init (ji,jj,jl1) * afrft(ji,jj) / kraft  
    982  
    983             ! substract everything 
    984             a_i(ji,jj,jl1)   = a_i(ji,jj,jl1)   - ardg1 (ji,jj) - arft1 (ji,jj) 
    985             v_i(ji,jj,jl1)   = v_i(ji,jj,jl1)   - vrdg1 (ji,jj) - virft (ji,jj) 
    986             v_s(ji,jj,jl1)   = v_s(ji,jj,jl1)   - vsrdg (ji,jj) - vsrft (ji,jj) 
    987             e_s(ji,jj,1,jl1) = e_s(ji,jj,1,jl1) - esrdg (ji,jj) - esrft (ji,jj) 
    988             smv_i(ji,jj,jl1) = smv_i(ji,jj,jl1) - srdg1 (ji,jj) - smrft (ji,jj) 
    989             oa_i(ji,jj,jl1)  = oa_i(ji,jj,jl1)  - oirdg1(ji,jj) - oirft1(ji,jj) 
    990  
    991             !----------------------------------------------------------------- 
    992             ! 3.5) Compute properties of new ridges 
    993             !----------------------------------------------------------------- 
    994             !--------- 
    995             ! Salinity 
    996             !--------- 
    997             smsw(ji,jj)  = vsw(ji,jj) * sss_m(ji,jj)                      ! salt content of seawater frozen in voids !! MV HC2014 
    998             srdg2(ji,jj) = srdg1(ji,jj) + smsw(ji,jj)                     ! salt content of new ridge 
    999  
    1000             !srdg2(ji,jj) = MIN( rn_simax * vrdg2(ji,jj) , zsrdg2 )         ! impose a maximum salinity 
    1001              
    1002             sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ji,jj) * rhoic * r1_rdtice 
    1003             wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ji,jj) * rhoic * r1_rdtice   ! increase in ice volume du to seawater frozen in voids              
    1004  
    1005             !------------------------------------             
    1006             ! 3.6 Increment ridging diagnostics 
    1007             !------------------------------------             
    1008  
    1009             !        jl1 looping 1-jpl 
    1010             !           ij looping 1-icells 
    1011  
    1012             dardg1dt   (ji,jj) = dardg1dt(ji,jj) + ardg1(ji,jj) + arft1(ji,jj) 
    1013             dardg2dt   (ji,jj) = dardg2dt(ji,jj) + ardg2(ji,jj) + arft2(ji,jj) 
    1014             opening    (ji,jj) = opening (ji,jj) + opning(ji,jj) * rdt_ice 
    1015  
    1016             IF( con_i )   vice_init(ji,jj) = vice_init(ji,jj) + vrdg2(ji,jj) - vrdg1(ji,jj) 
    1017  
    1018             !------------------------------------------             
    1019             ! 3.7 Put the snow somewhere in the ocean 
    1020             !------------------------------------------             
    1021             !  Place part of the snow lost by ridging into the ocean.  
    1022             !  Note that esnow_mlt < 0; the ocean must cool to melt snow. 
    1023             !  If the ocean temp = Tf already, new ice must grow. 
    1024             !  During the next time step, thermo_rates will determine whether 
    1025             !  the ocean cools or new ice grows. 
    1026             !        jl1 looping 1-jpl 
    1027             !           ij looping 1-icells 
    1028  
    1029             msnow_mlt(ji,jj) = msnow_mlt(ji,jj) + rhosn*vsrdg(ji,jj)*(1.0-rn_fsnowrdg)   &   ! rafting included 
    1030                &                                + rhosn*vsrft(ji,jj)*(1.0-rn_fsnowrft) 
    1031  
    1032             ! in J/m2 (same as e_s) 
    1033             esnow_mlt(ji,jj) = esnow_mlt(ji,jj) - esrdg(ji,jj)*(1.0-rn_fsnowrdg)         &   !rafting included 
    1034                &                                - esrft(ji,jj)*(1.0-rn_fsnowrft)           
    1035  
    1036             !----------------------------------------------------------------- 
    1037             ! 3.8 Compute quantities used to apportion ice among categories 
    1038             ! in the n2 loop below 
    1039             !----------------------------------------------------------------- 
    1040  
    1041             !        jl1 looping 1-jpl 
    1042             !           ij looping 1-icells 
    1043  
    1044             dhr (ji,jj) = hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1) 
    1045             dhr2(ji,jj) = hrmax(ji,jj,jl1) * hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1) * hrmin(ji,jj,jl1) 
    1046  
    1047          END DO 
    1048  
    1049          !-------------------------------------------------------------------- 
    1050          ! 3.9 Compute ridging ice enthalpy, remove it from ridging ice and 
    1051          !      compute ridged ice enthalpy  
    1052          !-------------------------------------------------------------------- 
    1053          DO jk = 1, nlay_i 
    1054             DO ij = 1, icells 
    1055                ji = indxi(ij) 
    1056                jj = indxj(ij) 
    1057                ! heat content of ridged ice 
    1058                erdg1(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrac(ji,jj)  
    1059                eirft(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrft(ji,jj) 
    1060                e_i  (ji,jj,jk,jl1)  = e_i(ji,jj,jk,jl1) - erdg1(ji,jj,jk) - eirft(ji,jj,jk) 
    1061                 
    1062                 
    1063                ! enthalpy of the trapped seawater (J/m2, >0) 
    1064                ! clem: if sst>0, then ersw <0 (is that possible?) 
    1065                ersw(ji,jj,jk)   = - rhoic * vsw(ji,jj) * rcp * sst_m(ji,jj) * r1_nlay_i 
    1066  
    1067                ! heat flux to the ocean 
    1068                hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ersw(ji,jj,jk) * r1_rdtice  ! > 0 [W.m-2] ocean->ice flux  
    1069  
    1070                ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean 
    1071                erdg2(ji,jj,jk)  = erdg1(ji,jj,jk) + ersw(ji,jj,jk) 
    1072  
    1073             END DO 
    1074          END DO 
    1075  
    1076  
    1077          IF( con_i ) THEN 
    1078             DO jk = 1, nlay_i 
    1079                DO ij = 1, icells 
    1080                   ji = indxi(ij) 
    1081                   jj = indxj(ij) 
    1082                   eice_init(ji,jj) = eice_init(ji,jj) + erdg2(ji,jj,jk) - erdg1(ji,jj,jk) 
    1083                END DO 
    1084             END DO 
    1085          ENDIF 
    1086  
    1087          !------------------------------------------------------------------------------- 
    1088          ! 4) Add area, volume, and energy of new ridge to each category jl2 
    1089          !------------------------------------------------------------------------------- 
    1090          !        jl1 looping 1-jpl 
    1091          DO jl2  = 1, jpl  
    1092             ! over categories to which ridged ice is transferred 
    1093             DO ij = 1, icells 
    1094                ji = indxi(ij) 
    1095                jj = indxj(ij) 
    1096  
    1097                ! Compute the fraction of ridged ice area and volume going to  
    1098                ! thickness category jl2. 
    1099                ! Transfer area, volume, and energy accordingly. 
    1100  
    1101                IF( hrmin(ji,jj,jl1) >= hi_max(jl2) .OR. hrmax(ji,jj,jl1) <= hi_max(jl2-1) ) THEN 
    1102                   hL = 0._wp 
    1103                   hR = 0._wp 
    1104                ELSE 
    1105                   hL = MAX( hrmin(ji,jj,jl1), hi_max(jl2-1) ) 
    1106                   hR = MIN( hrmax(ji,jj,jl1), hi_max(jl2)   ) 
    1107                ENDIF 
    1108  
    1109                ! fraction of ridged ice area and volume going to n2 
    1110                farea = ( hR - hL ) / dhr(ji,jj)  
    1111                fvol(ji,jj) = ( hR*hR - hL*hL ) / dhr2(ji,jj) 
    1112  
    1113                a_i  (ji,jj  ,jl2) = a_i  (ji,jj  ,jl2) + ardg2 (ji,jj) * farea 
    1114                v_i  (ji,jj  ,jl2) = v_i  (ji,jj  ,jl2) + vrdg2 (ji,jj) * fvol(ji,jj) 
    1115                v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + vsrdg (ji,jj) * fvol(ji,jj) * rn_fsnowrdg 
    1116                e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + esrdg (ji,jj) * fvol(ji,jj) * rn_fsnowrdg 
    1117                smv_i(ji,jj  ,jl2) = smv_i(ji,jj  ,jl2) + srdg2 (ji,jj) * fvol(ji,jj) 
    1118                oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirdg2(ji,jj) * farea 
    1119  
    1120             END DO 
    1121  
    1122             ! Transfer ice energy to category jl2 by ridging 
    1123             DO jk = 1, nlay_i 
    1124                DO ij = 1, icells 
    1125                   ji = indxi(ij) 
    1126                   jj = indxj(ij) 
    1127                   e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + fvol(ji,jj) * erdg2(ji,jj,jk) 
    1128                END DO 
    1129             END DO 
    1130             ! 
    1131          END DO                 ! jl2 (new ridges)             
    1132  
    1133          DO jl2 = 1, jpl  
    1134  
    1135             DO ij = 1, icells 
    1136                ji = indxi(ij) 
    1137                jj = indxj(ij) 
    1138                ! Compute the fraction of rafted ice area and volume going to  
    1139                ! thickness category jl2, transfer area, volume, and energy accordingly. 
    1140                ! 
    1141                IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. hraft(ji,jj,jl1) >  hi_max(jl2-1) ) THEN 
    1142                   a_i  (ji,jj  ,jl2) = a_i  (ji,jj  ,jl2) + arft2 (ji,jj) 
    1143                   v_i  (ji,jj  ,jl2) = v_i  (ji,jj  ,jl2) + virft (ji,jj) 
    1144                   v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + vsrft (ji,jj) * rn_fsnowrft 
    1145                   e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + esrft (ji,jj) * rn_fsnowrft 
    1146                   smv_i(ji,jj  ,jl2) = smv_i(ji,jj  ,jl2) + smrft (ji,jj)     
    1147                   oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirft2(ji,jj) 
    1148                ENDIF 
    1149                ! 
    1150             END DO 
    1151  
    1152             ! Transfer rafted ice energy to category jl2  
    1153             DO jk = 1, nlay_i 
    1154                DO ij = 1, icells 
    1155                   ji = indxi(ij) 
    1156                   jj = indxj(ij) 
    1157                   IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. hraft(ji,jj,jl1) > hi_max(jl2-1)  ) THEN 
    1158                      e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + eirft(ji,jj,jk) 
    1159                   ENDIF 
    1160                END DO 
    1161             END DO 
    1162  
    1163          END DO 
    1164  
    1165       END DO ! jl1 (deforming categories) 
    1166  
    1167       ! Conservation check 
    1168       IF ( con_i ) THEN 
    1169          CALL lim_column_sum (jpl,   v_i, vice_final) 
    1170          fieldid = ' v_i : limitd_me ' 
    1171          CALL lim_cons_check (vice_init, vice_final, 1.0e-6, fieldid)  
    1172  
    1173          CALL lim_column_sum_energy (jpl, nlay_i,  e_i, eice_final ) 
    1174          fieldid = ' e_i : limitd_me ' 
    1175          CALL lim_cons_check (eice_init, eice_final, 1.0e-2, fieldid)  
    1176  
    1177          DO ji = mi0(iiceprt), mi1(iiceprt) 
    1178             DO jj = mj0(jiceprt), mj1(jiceprt) 
    1179                WRITE(numout,*) ' vice_init  : ', vice_init (ji,jj) 
    1180                WRITE(numout,*) ' vice_final : ', vice_final(ji,jj) 
    1181                WRITE(numout,*) ' eice_init  : ', eice_init (ji,jj) 
    1182                WRITE(numout,*) ' eice_final : ', eice_final(ji,jj) 
    1183             END DO 
    1184          END DO 
    1185       ENDIF 
    1186       ! 
    1187       CALL wrk_dealloc( (jpi+1)*(jpj+1),        indxi, indxj ) 
    1188       CALL wrk_dealloc( jpi, jpj,               vice_init, vice_final, eice_init, eice_final ) 
    1189       CALL wrk_dealloc( jpi, jpj,               afrac, fvol , ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 ) 
    1190       CALL wrk_dealloc( jpi, jpj,               vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw, oirdg1, oirdg2 ) 
    1191       CALL wrk_dealloc( jpi, jpj,               afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 
    1192       CALL wrk_dealloc( jpi, jpj, jpl,          aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 
    1193       CALL wrk_dealloc( jpi, jpj, nlay_i,       eirft, erdg1, erdg2, ersw ) 
    1194       CALL wrk_dealloc( jpi, jpj, nlay_i, jpl,  eicen_init ) 
    1195       ! 
    1196    END SUBROUTINE lim_itd_me_ridgeshift 
    1197933 
    1198934   SUBROUTINE lim_itd_me_init 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r5407 r6455  
    9494      !!              - fr_i    : ice fraction 
    9595      !!              - tn_ice  : sea-ice surface temperature 
    96       !!              - alb_ice : sea-ice albedo (only useful in coupled mode) 
     96      !!              - alb_ice : sea-ice albedo (recomputed only for coupled mode) 
    9797      !! 
    9898      !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. 
     
    106106      REAL(wp) ::   zqsr                                           ! New solar flux received by the ocean 
    107107      ! 
    108       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb_cs, zalb_os     ! 2D/3D workspace 
     108      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb_cs, zalb_os     ! 3D workspace 
     109      REAL(wp), POINTER, DIMENSION(:,:)   ::   zalb                 ! 2D workspace 
    109110      !!--------------------------------------------------------------------- 
    110111 
    111112      ! make calls for heat fluxes before it is modified 
     113      ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 
    112114      IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) )                                   !     solar flux at ocean surface 
    113115      IF( iom_use('qns_oce') )   CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) )                   ! non-solar flux at ocean surface 
     
    118120      IF( iom_use('qt_ice' ) )   CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) )   & 
    119121         &                                                      * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) 
    120       IF( iom_use('qemp_oce' ) )   CALL iom_put( "qemp_oce"  , qemp_oce(:,:) )   
    121       IF( iom_use('qemp_ice' ) )   CALL iom_put( "qemp_ice"  , qemp_ice(:,:) )   
    122  
    123       ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 
     122      IF( iom_use('qemp_oce') )  CALL iom_put( "qemp_oce" , qemp_oce(:,:) )   
     123      IF( iom_use('qemp_ice') )  CALL iom_put( "qemp_ice" , qemp_ice(:,:) )   
     124      IF( iom_use('emp_oce' ) )  CALL iom_put( "emp_oce"  , emp_oce(:,:) )   ! emp over ocean (taking into account the snow blown away from the ice) 
     125      IF( iom_use('emp_ice' ) )  CALL iom_put( "emp_ice"  , emp_ice(:,:) )   ! emp over ice   (taking into account the snow blown away from the ice) 
     126 
     127      ! albedo output 
     128      CALL wrk_alloc( jpi,jpj, zalb )     
     129 
     130      zalb(:,:) = 0._wp 
     131      WHERE     ( SUM( a_i_b, dim=3 ) <= epsi06 )  ;  zalb(:,:) = 0.066_wp 
     132      ELSEWHERE                                    ;  zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / SUM( a_i_b, dim=3 ) 
     133      END WHERE 
     134      IF( iom_use('alb_ice' ) )  CALL iom_put( "alb_ice"  , zalb(:,:) )           ! ice albedo output 
     135 
     136      zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + 0.066_wp * ( 1._wp - SUM( a_i_b, dim=3 ) )       
     137      IF( iom_use('albedo'  ) )  CALL iom_put( "albedo"  , zalb(:,:) )           ! ice albedo output 
     138 
     139      CALL wrk_dealloc( jpi,jpj, zalb )     
     140      ! 
     141       
    124142      DO jj = 1, jpj 
    125143         DO ji = 1, jpi 
     
    140158            hfx_out(ji,jj) = hfx_out(ji,jj) + zqmass + zqsr 
    141159 
    142             ! Add the residual from heat diffusion equation (W.m-2) 
    143             !------------------------------------------------------- 
    144             hfx_out(ji,jj) = hfx_out(ji,jj) + hfx_err_dif(ji,jj) 
     160            ! Add the residual from heat diffusion equation and sublimation (W.m-2) 
     161            !---------------------------------------------------------------------- 
     162            hfx_out(ji,jj) = hfx_out(ji,jj) + hfx_err_dif(ji,jj) +   & 
     163               &           ( hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) ) 
    145164 
    146165            ! New qsr and qns used to compute the oceanic heat flux at the next time step 
    147             !--------------------------------------------------- 
     166            !---------------------------------------------------------------------------- 
    148167            qsr(ji,jj) = zqsr                                       
    149168            qns(ji,jj) = hfx_out(ji,jj) - zqsr               
     
    165184 
    166185            ! mass flux at the ocean/ice interface 
    167             fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) ) * r1_rdtice  ! F/M mass flux save at least for biogeochemical model 
    168             emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
    169              
     186            fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_err_sub(ji,jj) )              ! F/M mass flux save at least for biogeochemical model 
     187            emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
    170188         END DO 
    171189      END DO 
     
    175193      !------------------------------------------! 
    176194      sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:)   & 
    177          &     + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) 
     195         &     + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) + sfx_sub(:,:) 
    178196 
    179197      !-------------------------------------------------------------! 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r5407 r6455  
    461461 
    462462      DO ji = kideb, kiut 
    463          zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) ) 
     463         zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) + dh_i_sub(ji) ) 
    464464         IF( zdh_mel < 0._wp .AND. a_i_1d(ji) > 0._wp )  THEN 
    465465            zvi          = a_i_1d(ji) * ht_i_1d(ji) 
     
    470470            zda_mel     = rswitch * a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi20 ) ) 
    471471            a_i_1d(ji)  = MAX( epsi20, a_i_1d(ji) + zda_mel )  
    472              ! adjust thickness 
     472            ! adjust thickness 
    473473            ht_i_1d(ji) = zvi / a_i_1d(ji)             
    474474            ht_s_1d(ji) = zvs / a_i_1d(ji)             
     
    514514          
    515515         CALL tab_2d_1d( nbpb, qprec_ice_1d(1:nbpb), qprec_ice(:,:) , jpi, jpj, npb(1:nbpb) ) 
     516         CALL tab_2d_1d( nbpb, qevap_ice_1d(1:nbpb), qevap_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    516517         CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    517518         CALL tab_2d_1d( nbpb, fr1_i0_1d  (1:nbpb), fr1_i0          , jpi, jpj, npb(1:nbpb) ) 
     
    543544         CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri         , jpi, jpj, npb(1:nbpb) ) 
    544545         CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res         , jpi, jpj, npb(1:nbpb) ) 
    545           
     546         CALL tab_2d_1d( nbpb, sfx_sub_1d (1:nbpb), sfx_sub         , jpi, jpj,npb(1:nbpb) ) 
     547  
    546548         CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd         , jpi, jpj, npb(1:nbpb) ) 
    547549         CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr         , jpi, jpj, npb(1:nbpb) ) 
     
    593595         CALL tab_1d_2d( nbpb, sfx_res       , npb, sfx_res_1d(1:nbpb)   , jpi, jpj ) 
    594596         CALL tab_1d_2d( nbpb, sfx_bri       , npb, sfx_bri_1d(1:nbpb)   , jpi, jpj ) 
    595           
     597         CALL tab_1d_2d( nbpb, sfx_sub       , npb, sfx_sub_1d(1:nbpb)   , jpi, jpj )         
     598  
    596599         CALL tab_1d_2d( nbpb, hfx_thd       , npb, hfx_thd_1d(1:nbpb)   , jpi, jpj ) 
    597600         CALL tab_1d_2d( nbpb, hfx_spr       , npb, hfx_spr_1d(1:nbpb)   , jpi, jpj ) 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

    r5487 r6455  
    7474 
    7575      REAL(wp) ::   ztmelts             ! local scalar 
    76       REAL(wp) ::   zfdum        
     76      REAL(wp) ::   zdum        
    7777      REAL(wp) ::   zfracs       ! fractionation coefficient for bottom salt entrapment 
    7878      REAL(wp) ::   zs_snic      ! snow-ice salinity 
     
    9595      REAL(wp), POINTER, DIMENSION(:) ::   zq_rema     ! remaining heat at the end of the routine    (J.m-2) 
    9696      REAL(wp), POINTER, DIMENSION(:) ::   zf_tt       ! Heat budget to determine melting or freezing(W.m-2) 
     97      REAL(wp), POINTER, DIMENSION(:) ::   zevap_rema  ! remaining mass flux from sublimation        (kg.m-2) 
    9798 
    9899      REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_mel   ! snow melt  
     
    105106 
    106107      REAL(wp), POINTER, DIMENSION(:) ::   zqh_i       ! total ice heat content  (J.m-2) 
    107       REAL(wp), POINTER, DIMENSION(:) ::   zqh_s       ! total snow heat content (J.m-2) 
    108       REAL(wp), POINTER, DIMENSION(:) ::   zq_s        ! total snow enthalpy     (J.m-3) 
    109108      REAL(wp), POINTER, DIMENSION(:) ::   zsnw        ! distribution of snow after wind blowing 
    110109 
     
    122121      END SELECT 
    123122 
    124       CALL wrk_alloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw ) 
    125       CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 
     123      CALL wrk_alloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw, zevap_rema ) 
     124      CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i ) 
    126125      CALL wrk_alloc( jpij, nlay_i, zdeltah, zh_i ) 
    127126      CALL wrk_alloc( jpij, nlay_i, icount ) 
    128127        
    129       dh_i_surf  (:) = 0._wp ; dh_i_bott  (:) = 0._wp ; dh_snowice(:) = 0._wp 
     128      dh_i_surf  (:) = 0._wp ; dh_i_bott  (:) = 0._wp ; dh_snowice(:) = 0._wp ; dh_i_sub(:) = 0._wp 
    130129      dsm_i_se_1d(:) = 0._wp ; dsm_i_si_1d(:) = 0._wp    
    131130 
    132131      zqprec   (:) = 0._wp ; zq_su    (:) = 0._wp ; zq_bo    (:) = 0._wp ; zf_tt(:) = 0._wp 
    133       zq_rema  (:) = 0._wp ; zsnw     (:) = 0._wp 
     132      zq_rema  (:) = 0._wp ; zsnw     (:) = 0._wp ; zevap_rema(:) = 0._wp ; 
    134133      zdh_s_mel(:) = 0._wp ; zdh_s_pre(:) = 0._wp ; zdh_s_sub(:) = 0._wp ; zqh_i(:) = 0._wp 
    135       zqh_s    (:) = 0._wp ; zq_s     (:) = 0._wp      
    136134 
    137135      zdeltah(:,:) = 0._wp ; zh_i(:,:) = 0._wp        
     
    159157      ! 
    160158      DO ji = kideb, kiut 
    161          zfdum      = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji)  
     159         zdum       = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji)  
    162160         zf_tt(ji)  = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji)  
    163161 
    164          zq_su (ji) = MAX( 0._wp, zfdum     * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - rt0 ) ) 
     162         zq_su (ji) = MAX( 0._wp, zdum      * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - rt0 ) ) 
    165163         zq_bo (ji) = MAX( 0._wp, zf_tt(ji) * rdt_ice ) 
    166164      END DO 
     
    187185      !  2) Computing layer thicknesses and enthalpies.            ! 
    188186      !------------------------------------------------------------! 
    189       ! 
    190       DO jk = 1, nlay_s 
    191          DO ji = kideb, kiut 
    192             zqh_s(ji) =  zqh_s(ji) + q_s_1d(ji,jk) * ht_s_1d(ji) * r1_nlay_s 
    193          END DO 
    194       END DO 
    195187      ! 
    196188      DO jk = 1, nlay_i 
     
    275267      END DO 
    276268 
    277       !---------------------- 
    278       ! 3.2 Snow sublimation  
    279       !---------------------- 
     269      !------------------------------ 
     270      ! 3.2 Sublimation (part1: snow)  
     271      !------------------------------ 
    280272      ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates 
    281273      ! clem comment: not counted in mass/heat exchange in limsbc since this is an exchange with atm. (not ocean) 
    282       ! clem comment: ice should also sublimate 
    283274      zdeltah(:,:) = 0._wp 
    284       ! coupled mode: sublimation is set to 0 (evap_ice = 0) until further notice 
    285       ! forced  mode: snow thickness change due to sublimation 
    286       DO ji = kideb, kiut 
    287          zdh_s_sub(ji)  =  MAX( - ht_s_1d(ji) , - evap_ice_1d(ji) * r1_rhosn * rdt_ice ) 
    288          ! Heat flux by sublimation [W.m-2], < 0 
    289          !      sublimate first snow that had fallen, then pre-existing snow 
     275      DO ji = kideb, kiut 
     276         zdh_s_sub(ji)  = MAX( - ht_s_1d(ji) , - evap_ice_1d(ji) * r1_rhosn * rdt_ice ) 
     277         ! remaining evap in kg.m-2 (used for ice melting later on) 
     278         zevap_rema(ji)  = evap_ice_1d(ji) * rdt_ice + zdh_s_sub(ji) * rhosn 
     279         ! Heat flux by sublimation [W.m-2], < 0 (sublimate first snow that had fallen, then pre-existing snow) 
    290280         zdeltah(ji,1)  = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) ) 
    291281         hfx_sub_1d(ji) = hfx_sub_1d(ji) + ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * q_s_1d(ji,1)  & 
     
    309299      !------------------------------------------- 
    310300      ! new temp and enthalpy of the snow (remaining snow precip + remaining pre-existing snow) 
    311       zq_s(:) = 0._wp  
    312301      DO jk = 1, nlay_s 
    313302         DO ji = kideb,kiut 
    314             rswitch       = MAX(  0._wp , SIGN( 1._wp, ht_s_1d(ji) - epsi20 )  ) 
    315             q_s_1d(ji,jk) = rswitch / MAX( ht_s_1d(ji), epsi20 ) *                          & 
    316               &            ( (   zdh_s_pre(ji)             ) * zqprec(ji) +  & 
    317               &              (   ht_s_1d(ji) - zdh_s_pre(ji) ) * rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus ) ) 
    318             zq_s(ji)     =  zq_s(ji) + q_s_1d(ji,jk) 
     303            rswitch       = MAX( 0._wp , SIGN( 1._wp, ht_s_1d(ji) - epsi20 ) ) 
     304            q_s_1d(ji,jk) = rswitch / MAX( ht_s_1d(ji), epsi20 ) *           & 
     305              &            ( ( zdh_s_pre(ji)               ) * zqprec(ji) +  & 
     306              &              ( ht_s_1d(ji) - zdh_s_pre(ji) ) * rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus ) ) 
    319307         END DO 
    320308      END DO 
     
    370358               zQm            = zfmdt * zEw                           ! Energy of the melt water sent to the ocean [J/m2, <0] 
    371359                
    372                ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok) 
     360               ! Contribution to salt flux >0 (clem: using sm_i_1d and not s_i_1d(jk) is ok) 
    373361               sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice 
    374362                
     
    383371                
    384372            END IF 
     373            ! ---------------------- 
     374            ! Sublimation part2: ice 
     375            ! ---------------------- 
     376            zdum      = MAX( - ( zh_i(ji,jk) + zdeltah(ji,jk) ) , - zevap_rema(ji) * r1_rhoic ) 
     377            zdeltah(ji,jk) = zdeltah(ji,jk) + zdum 
     378            dh_i_sub(ji)  = dh_i_sub(ji) + zdum 
     379            ! Salt flux > 0 (clem2016: flux is sent to the ocean for simplicity but salt should remain in the ice except if all ice is melted. 
     380            !                          It must be corrected at some point) 
     381            sfx_sub_1d(ji) = sfx_sub_1d(ji) - rhoic * a_i_1d(ji) * zdum * sm_i_1d(ji) * r1_rdtice 
     382            ! Heat flux [W.m-2], < 0 
     383            hfx_sub_1d(ji) = hfx_sub_1d(ji) + zdum * q_i_1d(ji,jk) * a_i_1d(ji) * r1_rdtice 
     384            ! Mass flux > 0 
     385            wfx_sub_1d(ji) =  wfx_sub_1d(ji) - rhoic * a_i_1d(ji) * zdum * r1_rdtice 
     386            ! update remaining mass flux 
     387            zevap_rema(ji)  = zevap_rema(ji) + zdum * rhoic 
     388             
    385389            ! record which layers have disappeared (for bottom melting)  
    386390            !    => icount=0 : no layer has vanished 
     
    389393            icount(ji,jk) = NINT( rswitch ) 
    390394            zh_i(ji,jk)   = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) ) 
    391  
     395                         
    392396            ! update heat content (J.m-2) and layer thickness 
    393397            qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_1d(ji,jk) 
     
    397401      ! update ice thickness 
    398402      DO ji = kideb, kiut 
    399          ht_i_1d(ji) =  MAX( 0._wp , ht_i_1d(ji) + dh_i_surf(ji) ) 
     403         ht_i_1d(ji) =  MAX( 0._wp , ht_i_1d(ji) + dh_i_surf(ji) + dh_i_sub(ji) ) 
     404      END DO 
     405 
     406      ! remaining "potential" evap is sent to ocean 
     407      DO ji = kideb, kiut 
     408         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
     409         wfx_err_sub(ii,ij) = wfx_err_sub(ii,ij) - zevap_rema(ji) * a_i_1d(ji) * r1_rdtice  ! <=0 (net evap for the ocean in kg.m-2.s-1) 
    400410      END DO 
    401411 
     
    686696      WHERE( ht_i_1d == 0._wp ) a_i_1d = 0._wp 
    687697       
    688       CALL wrk_dealloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw ) 
    689       CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 
     698      CALL wrk_dealloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw, zevap_rema ) 
     699      CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i ) 
    690700      CALL wrk_dealloc( jpij, nlay_i, zdeltah, zh_i ) 
    691701      CALL wrk_dealloc( jpij, nlay_i, icount ) 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90

    r5202 r6455  
    7575      INTEGER ::   ii, ij, iter     !   -       - 
    7676      REAL(wp)  ::   ztmelts, zdv, zfrazb, zweight, zde                         ! local scalars 
    77       REAL(wp) ::   zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf , zhicol_new        !   -      - 
     77      REAL(wp) ::   zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf                     !   -      - 
    7878      REAL(wp) ::   ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit   !   -      - 
    79       LOGICAL  ::   iterate_frazil   ! iterate frazil ice collection thickness 
    8079      CHARACTER (len = 15) :: fieldid 
    8180 
     
    108107      REAL(wp), POINTER, DIMENSION(:,:) ::   zsmv_i_1d ! 1-D version of smv_i 
    109108 
    110       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze_i_1d   !: 1-D version of e_i 
    111  
    112       REAL(wp), POINTER, DIMENSION(:,:) ::   zvrel                   ! relative ice / frazil velocity 
    113  
    114       REAL(wp) :: zcai = 1.4e-3_wp 
     109      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze_i_1d !: 1-D version of e_i 
     110 
     111      REAL(wp), POINTER, DIMENSION(:,:) ::   zvrel     ! relative ice / frazil velocity 
     112 
     113      REAL(wp) :: zcai = 1.4e-3_wp                     ! ice-air drag (clem: should be dependent on coupling/forcing used) 
    115114      !!-----------------------------------------------------------------------! 
    116115 
     
    143142      !------------------------------------------------------------------------------!     
    144143      ! hicol is the thickness of new ice formed in open water 
    145       ! hicol can be either prescribed (frazswi = 0) 
    146       ! or computed (frazswi = 1) 
     144      ! hicol can be either prescribed (frazswi = 0) or computed (frazswi = 1) 
    147145      ! Frazil ice forms in open water, is transported by wind 
    148146      ! accumulates at the edge of the consolidated ice edge 
     
    155153      zvrel(:,:) = 0._wp 
    156154 
    157       ! Default new ice thickness  
    158       hicol(:,:) = rn_hnewice 
     155      ! Default new ice thickness 
     156      WHERE( qlead(:,:) < 0._wp ) ; hicol = rn_hnewice 
     157      ELSEWHERE                   ; hicol = 0._wp 
     158      END WHERE 
    159159 
    160160      IF( ln_frazil ) THEN 
     
    182182                     &          +   vtau_ice(ji  ,jj  ) * vmask(ji  ,jj  ,1) ) * 0.5_wp 
    183183                  ! Square root of wind stress 
    184                   ztenagm       =  SQRT( SQRT( ztaux**2 + ztauy**2 ) ) 
     184                  ztenagm       =  SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) ) 
    185185 
    186186                  !--------------------- 
     
    205205                  zvrel2 = MAX(  ( zvfrx - zvgx ) * ( zvfrx - zvgx )   & 
    206206                     &         + ( zvfry - zvgy ) * ( zvfry - zvgy ) , 0.15 * 0.15 ) 
    207                   zvrel(ji,jj)  = SQRT( zvrel2 ) 
     207                  zvrel(ji,jj) = SQRT( zvrel2 ) 
    208208 
    209209                  !--------------------- 
    210210                  ! Iterative procedure 
    211211                  !--------------------- 
    212                   hicol(ji,jj) = zhicrit + 0.1  
    213                   hicol(ji,jj) = zhicrit +   hicol(ji,jj)    & 
    214                      &                   / ( hicol(ji,jj) * hicol(ji,jj) -  zhicrit * zhicrit ) * ztwogp * zvrel2 
    215  
    216 !!gm better coding: above: hicol(ji,jj) * hicol(ji,jj) = (zhicrit + 0.1)*(zhicrit + 0.1) 
    217 !!gm                                                   = zhicrit**2 + 0.2*zhicrit +0.01 
    218 !!gm                therefore the 2 lines with hicol can be replaced by 1 line: 
    219 !!gm              hicol(ji,jj) = zhicrit + (zhicrit + 0.1) / ( 0.2 * zhicrit + 0.01 ) * ztwogp * zvrel2 
    220 !!gm further more (zhicrit + 0.1)/(0.2 * zhicrit + 0.01 )*ztwogp can be computed one for all outside the DO loop 
     212                  hicol(ji,jj) = zhicrit +   ( zhicrit + 0.1 )    & 
     213                     &                   / ( ( zhicrit + 0.1 ) * ( zhicrit + 0.1 ) -  zhicrit * zhicrit ) * ztwogp * zvrel2 
    221214 
    222215                  iter = 1 
    223                   iterate_frazil = .true. 
    224  
    225                   DO WHILE ( iter < 100 .AND. iterate_frazil )  
    226                      zf = ( hicol(ji,jj) - zhicrit ) * ( hicol(ji,jj)**2 - zhicrit**2 ) & 
    227                         - hicol(ji,jj) * zhicrit * ztwogp * zvrel2 
    228                      zfp = ( hicol(ji,jj) - zhicrit ) * ( 3.0*hicol(ji,jj) + zhicrit ) & 
    229                         - zhicrit * ztwogp * zvrel2 
    230                      zhicol_new = hicol(ji,jj) - zf/zfp 
    231                      hicol(ji,jj)   = zhicol_new 
    232  
     216                  DO WHILE ( iter < 20 )  
     217                     zf  = ( hicol(ji,jj) - zhicrit ) * ( hicol(ji,jj) * hicol(ji,jj) - zhicrit * zhicrit ) -   & 
     218                        &    hicol(ji,jj) * zhicrit * ztwogp * zvrel2 
     219                     zfp = ( hicol(ji,jj) - zhicrit ) * ( 3.0 * hicol(ji,jj) + zhicrit ) - zhicrit * ztwogp * zvrel2 
     220 
     221                     hicol(ji,jj) = hicol(ji,jj) - zf/zfp 
    233222                     iter = iter + 1 
    234  
    235                   END DO ! do while 
     223                  END DO 
    236224 
    237225               ENDIF ! end of selection of pixels where ice forms 
    238226 
    239             END DO ! loop on ji ends 
    240          END DO ! loop on jj ends 
    241       !  
    242       CALL lbc_lnk( zvrel(:,:), 'T', 1. ) 
    243       CALL lbc_lnk( hicol(:,:), 'T', 1. ) 
     227            END DO  
     228         END DO  
     229         !  
     230         CALL lbc_lnk( zvrel(:,:), 'T', 1. ) 
     231         CALL lbc_lnk( hicol(:,:), 'T', 1. ) 
    244232 
    245233      ENDIF ! End of computation of frazil ice collection thickness 
     
    282270      ! Move from 2-D to 1-D vectors 
    283271      !------------------------------ 
    284       ! If ocean gains heat do nothing  
    285       ! 0therwise compute new ice formation 
     272      ! If ocean gains heat do nothing. Otherwise compute new ice formation 
    286273 
    287274      IF ( nbpac > 0 ) THEN 
     
    297284         END DO 
    298285 
    299          CALL tab_2d_1d( nbpac, qlead_1d  (1:nbpac)     , qlead  , jpi, jpj, npac(1:nbpac) ) 
    300          CALL tab_2d_1d( nbpac, t_bo_1d   (1:nbpac)     , t_bo   , jpi, jpj, npac(1:nbpac) ) 
    301          CALL tab_2d_1d( nbpac, sfx_opw_1d(1:nbpac)     , sfx_opw, jpi, jpj, npac(1:nbpac) ) 
    302          CALL tab_2d_1d( nbpac, wfx_opw_1d(1:nbpac)     , wfx_opw, jpi, jpj, npac(1:nbpac) ) 
    303          CALL tab_2d_1d( nbpac, hicol_1d  (1:nbpac)     , hicol  , jpi, jpj, npac(1:nbpac) ) 
    304          CALL tab_2d_1d( nbpac, zvrel_1d  (1:nbpac)     , zvrel  , jpi, jpj, npac(1:nbpac) ) 
    305  
    306          CALL tab_2d_1d( nbpac, hfx_thd_1d(1:nbpac)     , hfx_thd, jpi, jpj, npac(1:nbpac) ) 
    307          CALL tab_2d_1d( nbpac, hfx_opw_1d(1:nbpac)     , hfx_opw, jpi, jpj, npac(1:nbpac) ) 
     286         CALL tab_2d_1d( nbpac, qlead_1d  (1:nbpac)     , qlead     , jpi, jpj, npac(1:nbpac) ) 
     287         CALL tab_2d_1d( nbpac, t_bo_1d   (1:nbpac)     , t_bo      , jpi, jpj, npac(1:nbpac) ) 
     288         CALL tab_2d_1d( nbpac, sfx_opw_1d(1:nbpac)     , sfx_opw   , jpi, jpj, npac(1:nbpac) ) 
     289         CALL tab_2d_1d( nbpac, wfx_opw_1d(1:nbpac)     , wfx_opw   , jpi, jpj, npac(1:nbpac) ) 
     290         CALL tab_2d_1d( nbpac, hicol_1d  (1:nbpac)     , hicol     , jpi, jpj, npac(1:nbpac) ) 
     291         CALL tab_2d_1d( nbpac, zvrel_1d  (1:nbpac)     , zvrel     , jpi, jpj, npac(1:nbpac) ) 
     292 
     293         CALL tab_2d_1d( nbpac, hfx_thd_1d(1:nbpac)     , hfx_thd   , jpi, jpj, npac(1:nbpac) ) 
     294         CALL tab_2d_1d( nbpac, hfx_opw_1d(1:nbpac)     , hfx_opw   , jpi, jpj, npac(1:nbpac) ) 
     295         CALL tab_2d_1d( nbpac, rn_amax_1d(1:nbpac)     , rn_amax_2d, jpi, jpj, npac(1:nbpac) ) 
    308296 
    309297         !------------------------------------------------------------------------------! 
     
    316304         zv_b(1:nbpac,:) = zv_i_1d(1:nbpac,:)  
    317305         za_b(1:nbpac,:) = za_i_1d(1:nbpac,:) 
     306 
    318307         !---------------------- 
    319308         ! Thickness of new ice 
    320309         !---------------------- 
    321          DO ji = 1, nbpac 
    322             zh_newice(ji) = rn_hnewice 
    323          END DO 
    324          IF( ln_frazil ) zh_newice(1:nbpac) = hicol_1d(1:nbpac) 
     310         zh_newice(1:nbpac) = hicol_1d(1:nbpac) 
    325311 
    326312         !---------------------- 
     
    384370            ! salt flux 
    385371            sfx_opw_1d(ji) = sfx_opw_1d(ji) - zv_newice(ji) * rhoic * zs_newice(ji) * r1_rdtice 
    386  
     372         END DO 
     373          
     374         zv_frazb(:) = 0._wp 
     375         IF( ln_frazil ) THEN 
    387376            ! A fraction zfrazb of frazil ice is accreted at the ice bottom 
    388             rswitch       = 1._wp - MAX( 0._wp, SIGN( 1._wp , - zat_i_1d(ji) ) ) 
    389             zfrazb        = rswitch * ( TANH ( rn_Cfrazb * ( zvrel_1d(ji) - rn_vfrazb ) ) + 1.0 ) * 0.5 * rn_maxfrazb 
    390             zv_frazb(ji)  =         zfrazb   * zv_newice(ji) 
    391             zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji) 
    392          END DO 
    393  
     377            DO ji = 1, nbpac 
     378               rswitch       = 1._wp - MAX( 0._wp, SIGN( 1._wp , - zat_i_1d(ji) ) ) 
     379               zfrazb        = rswitch * ( TANH( rn_Cfrazb * ( zvrel_1d(ji) - rn_vfrazb ) ) + 1.0 ) * 0.5 * rn_maxfrazb 
     380               zv_frazb(ji)  =         zfrazb   * zv_newice(ji) 
     381               zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji) 
     382            END DO 
     383         END IF 
     384          
    394385         !----------------- 
    395386         ! Area of new ice 
     
    409400         ! we keep the excessive volume in memory and attribute it later to bottom accretion 
    410401         DO ji = 1, nbpac 
    411             IF ( za_newice(ji) >  ( rn_amax - zat_i_1d(ji) ) ) THEN 
    412                zda_res(ji)   = za_newice(ji) - ( rn_amax - zat_i_1d(ji) ) 
     402            IF ( za_newice(ji) >  ( rn_amax_1d(ji) - zat_i_1d(ji) ) ) THEN 
     403               zda_res(ji)   = za_newice(ji) - ( rn_amax_1d(ji) - zat_i_1d(ji) ) 
    413404               zdv_res(ji)   = zda_res  (ji) * zh_newice(ji)  
    414405               za_newice(ji) = za_newice(ji) - zda_res  (ji) 
     
    443434               jl = jcat(ji) 
    444435               rswitch = MAX( 0._wp, SIGN( 1._wp , zv_i_1d(ji,jl) - epsi20 ) ) 
    445                ze_i_1d(ji,jk,jl) = zswinew(ji)   *   ze_newice(ji) +                                                      & 
     436               ze_i_1d(ji,jk,jl) = zswinew(ji)   *   ze_newice(ji) +                                                    & 
    446437                  &        ( 1.0 - zswinew(ji) ) * ( ze_newice(ji) * zv_newice(ji) + ze_i_1d(ji,jk,jl) * zv_b(ji,jl) )  & 
    447438                  &        * rswitch / MAX( zv_i_1d(ji,jl), epsi20 ) 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90

    r5202 r6455  
    422422            DO jj = 1, jpj 
    423423               DO ji = 1, jpi 
    424                   a_i(ji,jj,1)  = MIN( a_i(ji,jj,1), rn_amax ) 
     424                  a_i(ji,jj,1)  = MIN( a_i(ji,jj,1), rn_amax_2d(ji,jj) ) 
    425425               END DO 
    426426            END DO 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90

    r5215 r6455  
    8080         DO jj = 1, jpj 
    8181            DO ji = 1, jpi 
    82                IF( at_i(ji,jj) > rn_amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 
    83                   a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 
    84                   oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 
     82               IF( at_i(ji,jj) > rn_amax_2d(ji,jj) .AND. a_i(ji,jj,jl) > 0._wp ) THEN 
     83                  a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax_2d(ji,jj) / at_i(ji,jj) ) ) 
     84                  oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax_2d(ji,jj) / at_i(ji,jj) ) ) 
    8585               ENDIF 
    8686            END DO 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90

    r5410 r6455  
    9494         DO jj = 1, jpj 
    9595            DO ji = 1, jpi 
    96                IF( at_i(ji,jj) > rn_amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 
    97                   a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 
    98                   oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 
     96               IF( at_i(ji,jj) > rn_amax_2d(ji,jj) .AND. a_i(ji,jj,jl) > 0._wp ) THEN 
     97                  a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax_2d(ji,jj) / at_i(ji,jj) ) ) 
     98                  oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax_2d(ji,jj) / at_i(ji,jj) ) ) 
    9999               ENDIF 
    100100            END DO 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90

    r5202 r6455  
    163163               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) )   !0 if no ice and 1 if yes 
    164164               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
     165            END DO 
     166         END DO 
     167      END DO 
     168      ! Force the upper limit of ht_i to always be < hi_max (99 m). 
     169      DO jj = 1, jpj 
     170         DO ji = 1, jpi 
     171            rswitch = MAX( 0._wp , SIGN( 1._wp, ht_i(ji,jj,jpl) - epsi20 ) ) 
     172            ht_i(ji,jj,jpl) = MIN( ht_i(ji,jj,jpl) , hi_max(jpl) ) 
     173            a_i (ji,jj,jpl) = v_i(ji,jj,jpl) / MAX( ht_i(ji,jj,jpl) , epsi20 ) * rswitch 
     174         END DO 
     175      END DO 
     176 
     177      DO jl = 1, jpl 
     178         DO jj = 1, jpj 
     179            DO ji = 1, jpi 
     180               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) )   !0 if no ice and 1 if yes 
    165181               ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
    166182               o_i(ji,jj,jl)  = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
     
    168184         END DO 
    169185      END DO 
    170  
     186       
    171187      IF(  nn_icesal == 2  )THEN 
    172188         DO jl = 1, jpl 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90

    r5517 r6455  
    157157      ENDIF 
    158158 
    159       IF ( iom_use( "icecolf" ) ) THEN  
    160          DO jj = 1, jpj 
    161             DO ji = 1, jpi 
    162                rswitch  = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) ) ) 
    163                z2d(ji,jj) = hicol(ji,jj) * rswitch 
    164             END DO 
    165          END DO 
    166          CALL iom_put( "icecolf"     , z2d              )        ! frazil ice collection thickness 
    167       ENDIF 
     159      IF ( iom_use( "icecolf" ) )   CALL iom_put( "icecolf", hicol )  ! frazil ice collection thickness 
    168160 
    169161      CALL iom_put( "isst"        , sst_m               )        ! sea surface temperature 
     
    190182      CALL iom_put( "destrp"      , diag_trp_es         )        ! advected snw enthalpy (W/m2) 
    191183 
    192       CALL iom_put( "sfxbog"      , sfx_bog * rday      )        ! salt flux from brines 
    193       CALL iom_put( "sfxbom"      , sfx_bom * rday      )        ! salt flux from brines 
    194       CALL iom_put( "sfxsum"      , sfx_sum * rday      )        ! salt flux from brines 
    195       CALL iom_put( "sfxsni"      , sfx_sni * rday      )        ! salt flux from brines 
    196       CALL iom_put( "sfxopw"      , sfx_opw * rday      )        ! salt flux from brines 
     184      CALL iom_put( "sfxbog"      , sfx_bog * rday      )        ! salt flux from bottom growth 
     185      CALL iom_put( "sfxbom"      , sfx_bom * rday      )        ! salt flux from bottom melt 
     186      CALL iom_put( "sfxsum"      , sfx_sum * rday      )        ! salt flux from surface melt 
     187      CALL iom_put( "sfxsni"      , sfx_sni * rday      )        ! salt flux from snow ice formation 
     188      CALL iom_put( "sfxopw"      , sfx_opw * rday      )        ! salt flux from open water formation 
    197189      CALL iom_put( "sfxdyn"      , sfx_dyn * rday      )        ! salt flux from ridging rafting 
    198       CALL iom_put( "sfxres"      , sfx_res * rday      )        ! salt flux from limupdate (resultant) 
     190      CALL iom_put( "sfxres"      , sfx_res * rday      )        ! salt flux from residual 
    199191      CALL iom_put( "sfxbri"      , sfx_bri * rday      )        ! salt flux from brines 
     192      CALL iom_put( "sfxsub"      , sfx_sub * rday      )        ! salt flux from sublimation 
    200193      CALL iom_put( "sfx"         , sfx     * rday      )        ! total salt flux 
    201194 
     
    235228      CALL iom_put ('hfxdhc'     , diag_heat(:,:)       )   ! Heat content variation in snow and ice  
    236229      CALL iom_put ('hfxspr'     , hfx_spr(:,:)         )   ! Heat content of snow precip  
     230 
     231 
     232      IF ( iom_use( "vfxthin" ) ) THEN   ! ice production for open water + thin ice (<20cm) => comparable to observations   
     233         DO jj = 1, jpj  
     234            DO ji = 1, jpi 
     235               z2d(ji,jj)  = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zswi(ji,jj) ! mean ice thickness 
     236            END DO 
     237         END DO 
     238         WHERE( z2d(:,:) < 0.2 .AND. z2d(:,:) > 0. ) ; z2da = wfx_bog 
     239         ELSEWHERE                                   ; z2da = 0._wp 
     240         END WHERE 
     241         CALL iom_put( "vfxthin", ( wfx_opw + z2da ) * ztmp ) 
     242      ENDIF 
    237243       
    238244      !-------------------------------- 
     
    311317      !! 
    312318      !! History : 
    313       !!   4.1  !  2013-06  (C. Rousset) 
     319      !!   4.0  !  2013-06  (C. Rousset) 
    314320      !!---------------------------------------------------------------------- 
    315321      INTEGER, INTENT( in ) ::   kt               ! ocean time-step index) 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90

    r5407 r6455  
    4545   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qns_ice_1d   
    4646   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_bo_1d      
     47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rn_amax_1d 
    4748 
    4849   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_sum_1d 
     
    8384   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_res_1d   
    8485 
     86   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sub_1d 
     87 
    8588   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sprecip_1d    !: <==> the 2D  sprecip 
    8689   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   frld_1d       !: <==> the 2D  frld 
     
    9194   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   evap_ice_1d   !: <==> the 2D  evap_ice 
    9295   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qprec_ice_1d  !: <==> the 2D  qprec_ice 
     96   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qevap_ice_1d  !: <==> the 3D  qevap_ice 
    9397   !                                                     ! to reintegrate longwave flux inside the ice thermodynamics 
    9498   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   i0            !: fraction of radiation transmitted to the ice 
     
    107111   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_s_tot      !: Snow accretion/ablation        [m] 
    108112   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_surf     !: Ice surface accretion/ablation [m] 
     113   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_sub      !: Ice surface sublimation [m] 
    109114   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_bott     !: Ice bottom accretion/ablation  [m] 
    110115   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_snowice    !: Snow ice formation             [m of ice] 
     
    144149         &      hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) ,    &  
    145150         &      hfx_dif_1d(jpij) , hfx_opw_1d(jpij) ,                      & 
     151         &      rn_amax_1d(jpij) ,                                         & 
    146152         &      hfx_thd_1d(jpij) , hfx_spr_1d(jpij) ,                      & 
    147153         &      hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) ,   & 
     
    153159         &      wfx_sum_1d(jpij)  , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) , wfx_res_1d(jpij) ,  & 
    154160         &      dqns_ice_1d(jpij) , evap_ice_1d (jpij),                                         & 
    155          &      qprec_ice_1d(jpij), i0         (jpij) ,                                         &   
     161         &      qprec_ice_1d(jpij), qevap_ice_1d(jpij), i0         (jpij) ,                     &   
    156162         &      sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) , sfx_sum_1d (jpij),  & 
    157          &      sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) ,                     & 
     163         &      sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , sfx_sub_1d (jpij),  & 
    158164         &      dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) ,                     &      
    159165         &      dsm_i_si_1d(jpij) , hicol_1d    (jpij)                     , STAT=ierr(2) ) 
     
    161167      ALLOCATE( t_su_1d   (jpij) , a_i_1d   (jpij) , ht_i_1d  (jpij) ,    &    
    162168         &      ht_s_1d   (jpij) , fc_su    (jpij) , fc_bo_i  (jpij) ,    &     
    163          &      dh_s_tot  (jpij) , dh_i_surf(jpij) , dh_i_bott(jpij) ,    &     
    164          &      dh_snowice(jpij) , sm_i_1d  (jpij) , s_i_new  (jpij) ,    & 
     169         &      dh_s_tot  (jpij) , dh_i_surf(jpij) , dh_i_sub (jpij) ,    &     
     170         &      dh_i_bott (jpij) ,dh_snowice(jpij) , sm_i_1d  (jpij) , s_i_new  (jpij) ,    & 
    165171         &      t_s_1d(jpij,nlay_s) , t_i_1d(jpij,nlay_i) , s_i_1d(jpij,nlay_i) ,  &             
    166172         &      q_i_1d(jpij,nlay_i+1) , q_s_1d(jpij,nlay_s) ,                        & 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r6204 r6455  
    145145      ENDIF 
    146146 
    147       IF( .NOT.lk_vvl ) THEN 
    148          CALL iom_put( "e3t" , fse3t_n(:,:,:) ) 
    149          CALL iom_put( "e3u" , fse3u_n(:,:,:) ) 
    150          CALL iom_put( "e3v" , fse3v_n(:,:,:) ) 
    151          CALL iom_put( "e3w" , fse3w_n(:,:,:) ) 
    152       ENDIF 
     147      ! Output of initial vertical scale factor 
     148      CALL iom_put("e3t_0", e3t_0(:,:,:) ) 
     149      CALL iom_put("e3u_0", e3t_0(:,:,:) ) 
     150      CALL iom_put("e3v_0", e3t_0(:,:,:) ) 
     151      ! 
     152      CALL iom_put( "e3t" , fse3t_n(:,:,:) ) 
     153      CALL iom_put( "e3u" , fse3u_n(:,:,:) ) 
     154      CALL iom_put( "e3v" , fse3v_n(:,:,:) ) 
     155      CALL iom_put( "e3w" , fse3w_n(:,:,:) ) 
     156      IF( iom_use("e3tdef") )   & 
     157         CALL iom_put( "e3tdef"  , ( ( fse3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 ) 
     158 
    153159 
    154160      CALL iom_put( "ssh" , sshn )                 ! sea surface height 
    155       if( iom_use('ssh2') )   CALL iom_put( "ssh2", sshn(:,:) * sshn(:,:) )   ! square of sea surface height 
    156161       
    157162      CALL iom_put( "toce", tsn(:,:,:,jp_tem) )    ! 3D temperature 
     
    243248      CALL iom_put( "avm" , avmu                       )    ! T vert. eddy visc. coef. 
    244249      CALL iom_put( "avs" , fsavs(:,:,:)               )    ! S vert. eddy diff. coef. (useful only with key_zdfddm) 
     250                                                            ! Log of eddy diff coef 
     251      IF( iom_use('logavt') )   CALL iom_put( "logavt", LOG( MAX( 1.e-20_wp, avt  (:,:,:) ) ) ) 
     252      IF( iom_use('logavs') )   CALL iom_put( "logavs", LOG( MAX( 1.e-20_wp, fsavs(:,:,:) ) ) ) 
    245253 
    246254      IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN 
     
    307315         CALL iom_put( "eken", rke )            
    308316      ENDIF 
    309           
     317      ! 
     318      CALL iom_put( "hdiv", hdivn )                  ! Horizontal divergence 
     319      ! 
    310320      IF( iom_use("u_masstr") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 
    311321         z3d(:,:,jpk) = 0.e0 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r5506 r6455  
    665665         ht(:,:) = ht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk) 
    666666      END DO 
    667  
    668       ! Write outputs 
    669       ! ============= 
    670       CALL iom_put(     "e3t" , fse3t_n  (:,:,:) ) 
    671       CALL iom_put(     "e3u" , fse3u_n  (:,:,:) ) 
    672       CALL iom_put(     "e3v" , fse3v_n  (:,:,:) ) 
    673       CALL iom_put(     "e3w" , fse3w_n  (:,:,:) ) 
    674       CALL iom_put( "tpt_dep" , fsde3w_n (:,:,:) ) 
    675       IF( iom_use("e3tdef") )   & 
    676          CALL iom_put( "e3tdef"  , ( ( fse3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 ) 
    677667 
    678668      ! write restart file 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r6204 r6455  
    139139      ! horizontal grid definition 
    140140 
    141 #if ! defined key_xios2 
    142141      CALL set_scalar 
    143 #endif 
    144142 
    145143      IF( TRIM(cdname) == TRIM(cxios_context) ) THEN   
     
    11931191      REAL(wp), DIMENSION(:)   , OPTIONAL, INTENT(in) ::   lonvalue, latvalue 
    11941192      REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat, area 
    1195       LOGICAL,  DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   mask 
     1193#if ! defined key_xios2 
     1194     LOGICAL,  DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   mask 
     1195#else 
     1196      LOGICAL,  DIMENSION(:) , OPTIONAL, INTENT(in) ::   mask 
     1197#endif 
    11961198 
    11971199#if ! defined key_xios2 
     
    12151217         CALL xios_set_domain_attr     ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
    12161218            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   & 
    1217             &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_2D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,      & 
     1219            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,                  & 
    12181220            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear') 
    12191221     ENDIF 
     
    12211223         CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
    12221224            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   & 
    1223             &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_2D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,      & 
     1225            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,                  & 
    12241226            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear' ) 
    12251227      ENDIF 
     
    12341236     INTEGER                  , OPTIONAL, INTENT(in) ::   ibegin, jbegin, ni, nj 
    12351237 
    1236      IF ( xios_is_valid_domain     (cdid) ) THEN 
     1238     IF ( xios_is_valid_zoom_domain     (cdid) ) THEN 
    12371239         CALL xios_set_zoom_domain_attr     ( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni,    & 
    12381240           &   nj=nj) 
     
    13261328      IF ( xios_is_valid_gridgroup(cdid) )   CALL xios_set_gridgroup_attr( cdid, mask=mask ) 
    13271329#else 
    1328       IF ( xios_is_valid_grid     (cdid) )   CALL xios_set_grid_attr     ( cdid, mask3=mask ) 
    1329       IF ( xios_is_valid_gridgroup(cdid) )   CALL xios_set_gridgroup_attr( cdid, mask3=mask ) 
     1330      IF ( xios_is_valid_grid     (cdid) )   CALL xios_set_grid_attr     ( cdid, mask_3D=mask ) 
     1331      IF ( xios_is_valid_gridgroup(cdid) )   CALL xios_set_gridgroup_attr( cdid, mask_3D=mask ) 
    13301332#endif 
    13311333      CALL xios_solve_inheritance() 
     
    13881390         END SELECT 
    13891391         ! 
     1392#if ! defined key_xios2 
    13901393         CALL iom_set_domain_attr( "grid_"//cdgrd       , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni,nj    /)) /= 0. ) 
     1394#else 
     1395         CALL iom_set_domain_attr( "grid_"//cdgrd       , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni*nj    /)) /= 0. ) 
     1396#endif   
    13911397         CALL iom_set_grid_attr  ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. ) 
    13921398      ENDIF 
     
    15321538#else 
    15331539! Pas teste : attention aux indices ! 
    1534       CALL iom_set_domain_attr("ptr", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 
    1535       CALL iom_set_domain_attr("ptr", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
    1536       CALL iom_set_domain_attr("ptr", lonvalue = zlon,   & 
     1540      CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 
     1541      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
     1542      CALL iom_set_domain_attr("gznl", lonvalue = zlon,   & 
    15371543         &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))   
    1538        CALL iom_set_zoom_domain_attr ('ptr', ibegin=ix, nj=jpjglo) 
     1544       CALL iom_set_zoom_domain_attr ("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo) 
    15391545#endif 
    15401546 
     
    15521558      REAL(wp), DIMENSION(1)   ::   zz = 1. 
    15531559      !!---------------------------------------------------------------------- 
     1560#if ! defined key_xios2 
    15541561      CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1) 
     1562#else 
     1563      CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea-1, jbegin=0, ni=1, nj=1) 
     1564#endif 
    15551565      CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1) 
    15561566       
     
    17781788            idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 
    17791789            DO WHILE ( idx /= 0 )  
    1780               IF ( output_freq%hour /= 0 ) THEN 
     1790              IF ( output_freq%timestep /= 0) THEN 
     1791                  WRITE(clfreq,'(I18,A2)')INT(output_freq%timestep),'ts'  
     1792                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
     1793              ELSE IF ( output_freq%hour /= 0 ) THEN 
    17811794                  WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h'  
    17821795                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90

    r4679 r6455  
    201201       
    202202#endif 
    203       IF(lwp) THEN 
    204          WRITE(numout,*) 
    205          WRITE(numout,*) '           defines mpp subdomains' 
    206          WRITE(numout,*) '           ----------------------' 
    207          WRITE(numout,*) '           iresti=',iresti,' irestj=',irestj 
    208          WRITE(numout,*) '           jpni  =',jpni  ,' jpnj  =',jpnj 
    209          ifreq = 4 
    210          il1   = 1 
    211          DO jn = 1, (jpni-1)/ifreq+1 
    212             il2 = MIN( jpni, il1+ifreq-1 ) 
    213             WRITE(numout,*) 
    214             WRITE(numout,9200) ('***',ji = il1,il2-1) 
    215             DO jj = jpnj, 1, -1 
    216                WRITE(numout,9203) ('   ',ji = il1,il2-1) 
    217                WRITE(numout,9202) jj, ( ilcit(ji,jj),ilcjt(ji,jj),ji = il1,il2 ) 
    218                WRITE(numout,9203) ('   ',ji = il1,il2-1) 
    219                WRITE(numout,9200) ('***',ji = il1,il2-1) 
    220             END DO 
    221             WRITE(numout,9201) (ji,ji = il1,il2) 
    222             il1 = il1+ifreq 
    223          END DO 
    224  9200    FORMAT('     ***',20('*************',a3)) 
    225  9203    FORMAT('     *     ',20('         *   ',a3)) 
    226  9201    FORMAT('        ',20('   ',i3,'          ')) 
    227  9202    FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   ')) 
    228       ENDIF 
    229  
    230       zidom = nreci 
    231       DO ji = 1, jpni 
    232          zidom = zidom + ilcit(ji,1) - nreci 
    233       END DO 
    234       IF(lwp) WRITE(numout,*) 
    235       IF(lwp) WRITE(numout,*)' sum ilcit(i,1) = ', zidom, ' jpiglo = ', jpiglo 
    236        
    237       zjdom = nrecj 
    238       DO jj = 1, jpnj 
    239          zjdom = zjdom + ilcjt(1,jj) - nrecj 
    240       END DO 
    241       IF(lwp) WRITE(numout,*)' sum ilcit(1,j) = ', zjdom, ' jpjglo = ', jpjglo 
    242       IF(lwp) WRITE(numout,*) 
    243        
    244203 
    245204      !  2. Index arrays for subdomains 
     
    304263         nlejt(jn) = nlej 
    305264      END DO 
    306        
    307  
    308       ! 4. From global to local 
     265 
     266      ! 4. Subdomain print 
     267      ! ------------------ 
     268       
     269      IF(lwp) WRITE(numout,*) 
     270      IF(lwp) WRITE(numout,*) ' mpp_init: defines mpp subdomains' 
     271      IF(lwp) WRITE(numout,*) ' ~~~~~~  ----------------------' 
     272      IF(lwp) WRITE(numout,*) 
     273      IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj 
     274      IF(lwp) WRITE(numout,*) 
     275      IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj 
     276      zidom = nreci 
     277      DO ji = 1, jpni 
     278         zidom = zidom + ilcit(ji,1) - nreci 
     279      END DO 
     280      IF(lwp) WRITE(numout,*) 
     281      IF(lwp) WRITE(numout,*)' sum ilcit(i,1)=', zidom, ' jpiglo=', jpiglo 
     282 
     283      zjdom = nrecj 
     284      DO jj = 1, jpnj 
     285         zjdom = zjdom + ilcjt(1,jj) - nrecj 
     286      END DO 
     287      IF(lwp) WRITE(numout,*)' sum ilcit(1,j)=', zjdom, ' jpjglo=', jpjglo 
     288      IF(lwp) WRITE(numout,*) 
     289 
     290      IF(lwp) THEN 
     291         ifreq = 4 
     292         il1   = 1 
     293         DO jn = 1, (jpni-1)/ifreq+1 
     294            il2 = MIN( jpni, il1+ifreq-1 ) 
     295            WRITE(numout,*) 
     296            WRITE(numout,9200) ('***',ji = il1,il2-1) 
     297            DO jj = jpnj, 1, -1 
     298               WRITE(numout,9203) ('   ',ji = il1,il2-1) 
     299               WRITE(numout,9202) jj, ( ilcit(ji,jj),ilcjt(ji,jj),ji = il1,il2 ) 
     300               WRITE(numout,9204) (nfipproc(ji,jj),ji=il1,il2) 
     301               WRITE(numout,9203) ('   ',ji = il1,il2-1) 
     302               WRITE(numout,9200) ('***',ji = il1,il2-1) 
     303            END DO 
     304            WRITE(numout,9201) (ji,ji = il1,il2) 
     305            il1 = il1+ifreq 
     306         END DO 
     307 9200     FORMAT('     ***',20('*************',a3)) 
     308 9203     FORMAT('     *     ',20('         *   ',a3)) 
     309 9201     FORMAT('        ',20('   ',i3,'          ')) 
     310 9202     FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   ')) 
     311 9204     FORMAT('     *  ',20('      ',i3,'   *   ')) 
     312      ENDIF 
     313 
     314      ! 5. From global to local 
    309315      ! ----------------------- 
    310316 
     
    313319 
    314320 
    315       ! 5. Subdomain neighbours 
     321      ! 6. Subdomain neighbours 
    316322      ! ---------------------- 
    317323 
     
    436442         WRITE(numout,*) ' nimpp  = ', nimpp 
    437443         WRITE(numout,*) ' njmpp  = ', njmpp 
    438          WRITE(numout,*) ' nbse   = ', nbse  , ' npse   = ', npse 
    439          WRITE(numout,*) ' nbsw   = ', nbsw  , ' npsw   = ', npsw 
    440          WRITE(numout,*) ' nbne   = ', nbne  , ' npne   = ', npne 
    441          WRITE(numout,*) ' nbnw   = ', nbnw  , ' npnw   = ', npnw 
     444         WRITE(numout,*) ' nreci  = ', nreci  , ' npse   = ', npse 
     445         WRITE(numout,*) ' nrecj  = ', nrecj  , ' npsw   = ', npsw 
     446         WRITE(numout,*) ' jpreci = ', jpreci , ' npne   = ', npne 
     447         WRITE(numout,*) ' jprecj = ', jprecj , ' npnw   = ', npnw 
     448         WRITE(numout,*) 
    442449      ENDIF 
    443450 
     
    446453      ! Prepare mpp north fold 
    447454 
    448       IF (jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN 
     455      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN 
    449456         CALL mpp_ini_north 
    450       END IF 
     457         IF(lwp) WRITE(numout,*) ' mpp_init : North fold boundary prepared for jpni >1' 
     458      ENDIF 
    451459 
    452460      ! Prepare NetCDF output file (if necessary) 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90

    r5130 r6455  
    318318         ENDIF 
    319319 
     320         ! Check wet points over the entire domain to preserve the MPI communication stencil 
    320321         isurf = 0 
    321          DO jj = 1+jprecj, ilj-jprecj 
    322             DO  ji = 1+jpreci, ili-jpreci 
     322         DO jj = 1, ilj 
     323            DO  ji = 1, ili 
    323324               IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1 
    324325            END DO 
    325326         END DO 
     327 
    326328         IF(isurf /= 0) THEN 
    327329            icont = icont + 1 
     
    333335 
    334336      nfipproc(:,:) = ipproc(:,:) 
    335  
    336337 
    337338      ! Control 
     
    441442      ii = iin(narea) 
    442443      ij = ijn(narea) 
     444 
     445      ! set default neighbours 
     446      noso = ioso(ii,ij) 
     447      nowe = iowe(ii,ij) 
     448      noea = ioea(ii,ij) 
     449      nono = iono(ii,ij)  
     450      npse = iose(ii,ij) 
     451      npsw = iosw(ii,ij) 
     452      npne = ione(ii,ij) 
     453      npnw = ionw(ii,ij) 
     454 
     455      ! check neighbours location 
    443456      IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN  
    444457         iiso = 1 + MOD(ioso(ii,ij),jpni) 
     
    511524      IF (lwp) THEN 
    512525         CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 
     526         WRITE(inum,'(a)') '   jpnij     jpi     jpj     jpk  jpiglo  jpjglo' 
    513527         WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo 
    514528         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp' 
     
    523537      END IF 
    524538 
    525       IF( nperio == 1 .AND.jpni /= 1 ) CALL ctl_stop( ' mpp_init2:  error on cyclicity' ) 
    526  
    527       ! Prepare mpp north fold 
    528  
    529       IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN 
    530          CALL mpp_ini_north 
    531          IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1' 
    532       ENDIF 
    533  
    534539      ! Defined npolj, either 0, 3 , 4 , 5 , 6 
    535540      ! In this case the important thing is that npolj /= 0 
     
    548553      ENDIF 
    549554 
     555      ! Periodicity : no corner if nbondi = 2 and nperio != 1 
     556 
     557      IF(lwp) THEN 
     558         WRITE(numout,*) ' nproc  = ', nproc 
     559         WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea 
     560         WRITE(numout,*) ' nono   = ', nono  , ' noso   =  ', noso 
     561         WRITE(numout,*) ' nbondi = ', nbondi 
     562         WRITE(numout,*) ' nbondj = ', nbondj 
     563         WRITE(numout,*) ' npolj  = ', npolj 
     564         WRITE(numout,*) ' nperio = ', nperio 
     565         WRITE(numout,*) ' nlci   = ', nlci 
     566         WRITE(numout,*) ' nlcj   = ', nlcj 
     567         WRITE(numout,*) ' nimpp  = ', nimpp 
     568         WRITE(numout,*) ' njmpp  = ', njmpp 
     569         WRITE(numout,*) ' nreci  = ', nreci  , ' npse   = ', npse 
     570         WRITE(numout,*) ' nrecj  = ', nrecj  , ' npsw   = ', npsw 
     571         WRITE(numout,*) ' jpreci = ', jpreci , ' npne   = ', npne 
     572         WRITE(numout,*) ' jprecj = ', jprecj , ' npnw   = ', npnw 
     573         WRITE(numout,*) 
     574      ENDIF 
     575 
     576      IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init2: error on cyclicity' ) 
     577 
     578      ! Prepare mpp north fold 
     579 
     580      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN 
     581         CALL mpp_ini_north 
     582         IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1' 
     583      ENDIF 
     584 
    550585      ! Prepare NetCDF output file (if necessary) 
    551586      CALL mpp_init_ioipsl 
    552587 
    553       ! Periodicity : no corner if nbondi = 2 and nperio != 1 
    554  
    555       IF(lwp) THEN 
    556          WRITE(numout,*) ' nproc=  ',nproc 
    557          WRITE(numout,*) ' nowe=   ',nowe 
    558          WRITE(numout,*) ' noea=   ',noea 
    559          WRITE(numout,*) ' nono=   ',nono 
    560          WRITE(numout,*) ' noso=   ',noso 
    561          WRITE(numout,*) ' nbondi= ',nbondi 
    562          WRITE(numout,*) ' nbondj= ',nbondj 
    563          WRITE(numout,*) ' npolj=  ',npolj 
    564          WRITE(numout,*) ' nperio= ',nperio 
    565          WRITE(numout,*) ' nlci=   ',nlci 
    566          WRITE(numout,*) ' nlcj=   ',nlcj 
    567          WRITE(numout,*) ' nimpp=  ',nimpp 
    568          WRITE(numout,*) ' njmpp=  ',njmpp 
    569          WRITE(numout,*) ' nbse=   ',nbse,' npse= ',npse 
    570          WRITE(numout,*) ' nbsw=   ',nbsw,' npsw= ',npsw 
    571          WRITE(numout,*) ' nbne=   ',nbne,' npne= ',npne 
    572          WRITE(numout,*) ' nbnw=   ',nbnw,' npnw= ',npnw 
    573       ENDIF 
    574588 
    575589   END SUBROUTINE mpp_init2 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r5120 r6455  
    188188            DO jj = 2, jpjm1 
    189189               DO ji = fs_2, fs_jpim1   ! vector opt. 
    190                   IF (miku(ji,jj) .GT. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji  ,jj  ),                   5._wp) 
    191                   IF (miku(ji,jj) .LT. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji+1,jj  ),                   5._wp) 
    192                   IF (miku(ji,jj) .EQ. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji  ,jj  ), hmlpt(ji+1,jj  ), 5._wp) 
    193                   IF (mikv(ji,jj) .GT. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji  ,jj  ),                   5._wp) 
    194                   IF (mikv(ji,jj) .LT. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji  ,jj+1),                   5._wp) 
    195                   IF (mikv(ji,jj) .EQ. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji  ,jj  ), hmlpt(ji  ,jj+1), 5._wp) 
     190               zhmlpu(ji,jj) = ( MAX(hmlpt(ji,jj)  , hmlpt  (ji+1,jj  ), 5._wp)   & 
     191                  &            - MAX(risfdep(ji,jj), risfdep(ji+1,jj  )       )   ) 
     192               zhmlpv(ji,jj) = ( MAX(hmlpt  (ji,jj), hmlpt  (ji  ,jj+1), 5._wp)   & 
     193                  &            - MAX(risfdep(ji,jj), risfdep(ji  ,jj+1)       )   ) 
    196194               ENDDO 
    197195            ENDDO 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90

    r4147 r6455  
    4141 
    4242   REAL(wp), PUBLIC ::   rldf                        !: multiplicative factor of diffusive coefficient 
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   r_fact_lap 
    4344                                                     !: Needed to define the ratio between passive and active tracer diffusion coef.  
    4445 
     
    9293      !!                 ***  FUNCTION ldftra_oce_alloc  *** 
    9394     !!---------------------------------------------------------------------- 
    94      INTEGER, DIMENSION(3) :: ierr 
     95     INTEGER, DIMENSION(4) :: ierr 
    9596     !!---------------------------------------------------------------------- 
    9697     ierr(:) = 0 
     
    116117# endif 
    117118#endif 
     119      ALLOCATE( r_fact_lap(jpi,jpj,jpk), STAT=ierr(4) ) 
    118120      ldftra_oce_alloc = MAXVAL( ierr ) 
    119121      IF( ldftra_oce_alloc /= 0 )   CALL ctl_warn('ldftra_oce_alloc: failed to allocate arrays') 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_substitute.h90

    r3294 r6455  
    1313!   'key_traldf_c3d' :                 aht: 3D coefficient 
    1414#       define   fsahtt(i,j,k)   rldf * ahtt(i,j,k) 
    15 #       define   fsahtu(i,j,k)   rldf * ahtu(i,j,k) 
     15#       define   fsahtu(i,j,k)   rldf * ahtu(i,j,k) * r_fact_lap(i,j,k) 
    1616#       define   fsahtv(i,j,k)   rldf * ahtv(i,j,k) 
    1717#       define   fsahtw(i,j,k)   rldf * ahtw(i,j,k) 
     
    1919!   'key_traldf_c2d' :                 aht: 2D coefficient 
    2020#       define   fsahtt(i,j,k)   rldf * ahtt(i,j) 
    21 #       define   fsahtu(i,j,k)   rldf * ahtu(i,j) 
     21#       define   fsahtu(i,j,k)   rldf * ahtu(i,j) * r_fact_lap(i,j,k) 
    2222#       define   fsahtv(i,j,k)   rldf * ahtv(i,j) 
    2323#       define   fsahtw(i,j,k)   rldf * ahtw(i,j) 
     
    2525!   'key_traldf_c1d' :                aht: 1D coefficient 
    2626#       define   fsahtt(i,j,k)   rldf * ahtt(k) 
    27 #       define   fsahtu(i,j,k)   rldf * ahtu(k) 
     27#       define   fsahtu(i,j,k)   rldf * ahtu(k) * r_fact_lap(i,j,k) 
    2828#       define   fsahtv(i,j,k)   rldf * ahtv(k) 
    2929#       define   fsahtw(i,j,k)   rldf * ahtw(k) 
     
    3131!   Default option :             aht: Constant coefficient 
    3232#      define   fsahtt(i,j,k)   rldf * aht0 
    33 #      define   fsahtu(i,j,k)   rldf * aht0 
     33#      define   fsahtu(i,j,k)   rldf * aht0 * r_fact_lap(i,j,k) 
    3434#      define   fsahtv(i,j,k)   rldf * aht0 
    3535#      define   fsahtw(i,j,k)   rldf * aht0 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90

    r4624 r6455  
    99   !!             -   ! 2001-06  (M. Vancoppenolle) LIM 3.0 
    1010   !!             -   ! 2006-08  (G. Madec)  cleaning for surface module 
     11   !!            3.6  ! 2016-01  (C. Rousset) new parameterization for sea ice albedo 
    1112   !!---------------------------------------------------------------------- 
    1213 
     
    2930 
    3031   INTEGER  ::   albd_init = 0      !: control flag for initialization 
    31    REAL(wp) ::   zzero     = 0.e0   ! constant values 
    32    REAL(wp) ::   zone      = 1.e0   !    "       " 
    33  
    34    REAL(wp) ::   c1     = 0.05    ! constants values 
    35    REAL(wp) ::   c2     = 0.10    !    "        " 
    36    REAL(wp) ::   rmue   = 0.40    !  cosine of local solar altitude 
    37  
     32   
     33   REAL(wp) ::   rmue     = 0.40    !  cosine of local solar altitude 
     34   REAL(wp) ::   ralb_oce = 0.066   ! ocean or lead albedo (Pegau and Paulson, Ann. Glac. 2001) 
     35   REAL(wp) ::   c1       = 0.05    ! snow thickness (only for nn_ice_alb=0) 
     36   REAL(wp) ::   c2       = 0.10    !  "        " 
     37   REAL(wp) ::   rcloud   = 0.06    ! cloud effect on albedo (only-for nn_ice_alb=0) 
     38  
    3839   !                             !!* namelist namsbc_alb 
    39    REAL(wp) ::   rn_cloud         !  cloudiness effect on snow or ice albedo (Grenfell & Perovich, 1984) 
    40 #if defined key_lim3 
    41    REAL(wp) ::   rn_albice        !  albedo of melting ice in the arctic and antarctic (Shine & Hendersson-Sellers) 
    42 #else 
    43    REAL(wp) ::   rn_albice        !  albedo of melting ice in the arctic and antarctic (Shine & Hendersson-Sellers) 
    44 #endif 
    45    REAL(wp) ::   rn_alphd         !  coefficients for linear interpolation used to compute 
    46    REAL(wp) ::   rn_alphdi        !  albedo between two extremes values (Pyane, 1972) 
    47    REAL(wp) ::   rn_alphc         !  
     40   INTEGER  ::   nn_ice_alb 
     41   REAL(wp) ::   rn_albice 
    4842 
    4943   !!---------------------------------------------------------------------- 
     
    5953      !!           
    6054      !! ** Purpose :   Computation of the albedo of the snow/ice system  
    61       !!                as well as the ocean one 
    6255      !!        
    63       !! ** Method  : - Computation of the albedo of snow or ice (choose the  
    64       !!                rignt one by a large number of tests 
    65       !!              - Computation of the albedo of the ocean 
    66       !! 
    67       !! References :   Shine and Hendersson-Sellers 1985, JGR, 90(D1), 2243-2250. 
     56      !! ** Method  :   Two schemes are available (from namelist parameter nn_ice_alb) 
     57      !!                  0: the scheme is that of Shine & Henderson-Sellers (JGR 1985) for clear-skies 
     58      !!                  1: the scheme is "home made" (for cloudy skies) and based on Brandt et al. (J. Climate 2005) 
     59      !!                                                                           and Grenfell & Perovich (JGR 2004) 
     60      !!                Description of scheme 1: 
     61      !!                  1) Albedo dependency on ice thickness follows the findings from Brandt et al (2005) 
     62      !!                     which are an update of Allison et al. (JGR 1993) ; Brandt et al. 1999 
     63      !!                     0-5cm  : linear function of ice thickness 
     64      !!                     5-150cm: log    function of ice thickness 
     65      !!                     > 150cm: constant 
     66      !!                  2) Albedo dependency on snow thickness follows the findings from Grenfell & Perovich (2004) 
     67      !!                     i.e. it increases as -EXP(-snw_thick/0.02) during freezing and -EXP(-snw_thick/0.03) during melting 
     68      !!                  3) Albedo dependency on clouds is speculated from measurements of Grenfell and Perovich (2004) 
     69      !!                     i.e. cloudy-clear albedo depend on cloudy albedo following a 2d order polynomial law 
     70      !!                  4) The needed 4 parameters are: dry and melting snow, freezing ice and bare puddled ice 
     71      !! 
     72      !! ** Note    :   The parameterization from Shine & Henderson-Sellers presents several misconstructions: 
     73      !!                  1) ice albedo when ice thick. tends to 0 is different than ocean albedo 
     74      !!                  2) for small ice thick. covered with some snow (<3cm?), albedo is larger  
     75      !!                     under melting conditions than under freezing conditions 
     76      !!                  3) the evolution of ice albedo as a function of ice thickness shows   
     77      !!                     3 sharp inflexion points (at 5cm, 100cm and 150cm) that look highly unrealistic 
     78      !! 
     79      !! References :   Shine & Henderson-Sellers 1985, JGR, 90(D1), 2243-2250. 
     80      !!                Brandt et al. 2005, J. Climate, vol 18 
     81      !!                Grenfell & Perovich 2004, JGR, vol 109  
    6882      !!---------------------------------------------------------------------- 
    6983      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pt_ice      !  ice surface temperature (Kelvin) 
     
    7387      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pa_ice_os   !  albedo of ice under overcast sky 
    7488      !! 
    75       INTEGER  ::   ji, jj, jl    ! dummy loop indices 
    76       INTEGER  ::   ijpl          ! number of ice categories (3rd dim of ice input arrays) 
    77       REAL(wp) ::   zalbpsnm      ! albedo of ice under clear sky when snow is melting 
    78       REAL(wp) ::   zalbpsnf      ! albedo of ice under clear sky when snow is freezing 
    79       REAL(wp) ::   zalbpsn       ! albedo of snow/ice system when ice is coverd by snow 
    80       REAL(wp) ::   zalbpic       ! albedo of snow/ice system when ice is free of snow 
    81       REAL(wp) ::   zithsn        ! = 1 for hsn >= 0 ( ice is cov. by snow ) ; = 0 otherwise (ice is free of snow) 
    82       REAL(wp) ::   zitmlsn       ! = 1 freezinz snow (pt_ice >=rt0_snow) ; = 0 melting snow (pt_ice<rt0_snow) 
    83       REAL(wp) ::   zihsc1        ! = 1 hsn <= c1 ; = 0 hsn > c1 
    84       REAL(wp) ::   zihsc2        ! = 1 hsn >= c2 ; = 0 hsn < c2 
    85       !! 
    86       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalbfz    ! = rn_alphdi for freezing ice ; = rn_albice for melting ice 
    87       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zficeth   !  function of ice thickness 
     89      INTEGER  ::   ji, jj, jl         ! dummy loop indices 
     90      INTEGER  ::   ijpl               ! number of ice categories (3rd dim of ice input arrays) 
     91      REAL(wp)            ::   ralb_im, ralb_sf, ralb_sm, ralb_if 
     92      REAL(wp)            ::   zswitch, z1_c1, z1_c2 
     93      REAL(wp)                            ::   zalb_sm, zalb_sf, zalb_st ! albedo of snow melting, freezing, total 
     94      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalb_it             ! intermediate variable & albedo of ice (snow free) 
    8895      !!--------------------------------------------------------------------- 
    89        
     96 
    9097      ijpl = SIZE( pt_ice, 3 )                     ! number of ice categories 
    91  
    92       CALL wrk_alloc( jpi,jpj,ijpl, zalbfz, zficeth ) 
     98       
     99      CALL wrk_alloc( jpi,jpj,ijpl, zalb, zalb_it ) 
    93100 
    94101      IF( albd_init == 0 )   CALL albedo_init      ! initialization  
    95102 
    96       !--------------------------- 
    97       !  Computation of  zficeth 
    98       !--------------------------- 
    99       ! ice free of snow and melts 
    100       WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalbfz(:,:,:) = rn_albice 
    101       ELSE WHERE                                              ;   zalbfz(:,:,:) = rn_alphdi 
    102       END  WHERE 
    103  
    104       WHERE     ( 1.5  < ph_ice                     )  ;  zficeth = zalbfz 
    105       ELSE WHERE( 1.0  < ph_ice .AND. ph_ice <= 1.5 )  ;  zficeth = 0.472  + 2.0 * ( zalbfz - 0.472 ) * ( ph_ice - 1.0 ) 
    106       ELSE WHERE( 0.05 < ph_ice .AND. ph_ice <= 1.0 )  ;  zficeth = 0.2467 + 0.7049 * ph_ice              & 
    107          &                                                                 - 0.8608 * ph_ice * ph_ice     & 
    108          &                                                                 + 0.3812 * ph_ice * ph_ice * ph_ice 
    109       ELSE WHERE                                       ;  zficeth = 0.1    + 3.6    * ph_ice 
    110       END WHERE 
    111  
    112 !!gm old code 
    113 !      DO jl = 1, ijpl 
    114 !         DO jj = 1, jpj 
    115 !            DO ji = 1, jpi 
    116 !               IF( ph_ice(ji,jj,jl) > 1.5 ) THEN 
    117 !                  zficeth(ji,jj,jl) = zalbfz(ji,jj,jl) 
    118 !               ELSEIF( ph_ice(ji,jj,jl) > 1.0  .AND. ph_ice(ji,jj,jl) <= 1.5 ) THEN 
    119 !                  zficeth(ji,jj,jl) = 0.472 + 2.0 * ( zalbfz(ji,jj,jl) - 0.472 ) * ( ph_ice(ji,jj,jl) - 1.0 ) 
    120 !               ELSEIF( ph_ice(ji,jj,jl) > 0.05 .AND. ph_ice(ji,jj,jl) <= 1.0 ) THEN 
    121 !                  zficeth(ji,jj,jl) = 0.2467 + 0.7049 * ph_ice(ji,jj,jl)                               & 
    122 !                     &                    - 0.8608 * ph_ice(ji,jj,jl) * ph_ice(ji,jj,jl)                 & 
    123 !                     &                    + 0.3812 * ph_ice(ji,jj,jl) * ph_ice(ji,jj,jl) * ph_ice (ji,jj,jl) 
    124 !               ELSE 
    125 !                  zficeth(ji,jj,jl) = 0.1 + 3.6 * ph_ice(ji,jj,jl)  
    126 !               ENDIF 
    127 !            END DO 
    128 !         END DO 
    129 !      END DO 
    130 !!gm end old code 
    131        
    132       !-----------------------------------------------  
    133       !    Computation of the snow/ice albedo system  
    134       !-------------------------- --------------------- 
    135        
    136       !    Albedo of snow-ice for clear sky. 
    137       !-----------------------------------------------     
    138       DO jl = 1, ijpl 
    139          DO jj = 1, jpj 
    140             DO ji = 1, jpi 
    141                !  Case of ice covered by snow.              
    142                !                                        !  freezing snow         
    143                zihsc1   = 1.0 - MAX( zzero , SIGN( zone , - ( ph_snw(ji,jj,jl) - c1 ) ) ) 
    144                zalbpsnf = ( 1.0 - zihsc1 ) * (  zficeth(ji,jj,jl)                                             & 
    145                   &                           + ph_snw(ji,jj,jl) * ( rn_alphd - zficeth(ji,jj,jl) ) / c1  )   & 
    146                   &     +         zihsc1   * rn_alphd   
    147                !                                        !  melting snow                 
    148                zihsc2   = MAX( zzero , SIGN( zone , ph_snw(ji,jj,jl) - c2 ) ) 
    149                zalbpsnm = ( 1.0 - zihsc2 ) * ( rn_albice + ph_snw(ji,jj,jl) * ( rn_alphc - rn_albice ) / c2 )   & 
    150                   &     +         zihsc2   *   rn_alphc  
    151                ! 
    152                zitmlsn  =  MAX( zzero , SIGN( zone , pt_ice(ji,jj,jl) - rt0_snow ) )    
    153                zalbpsn  =  zitmlsn * zalbpsnm + ( 1.0 - zitmlsn ) * zalbpsnf 
    154              
    155                !  Case of ice free of snow. 
    156                zalbpic  = zficeth(ji,jj,jl)  
    157              
    158                ! albedo of the system    
    159                zithsn   = 1.0 - MAX( zzero , SIGN( zone , - ph_snw(ji,jj,jl) ) ) 
    160                pa_ice_cs(ji,jj,jl) =  zithsn * zalbpsn + ( 1.0 - zithsn ) *  zalbpic 
     103       
     104      SELECT CASE ( nn_ice_alb ) 
     105 
     106      !------------------------------------------ 
     107      !  Shine and Henderson-Sellers (1985) 
     108      !------------------------------------------ 
     109      CASE( 0 ) 
     110        
     111         ralb_sf = 0.80       ! dry snow 
     112         ralb_sm = 0.65       ! melting snow 
     113         ralb_if = 0.72       ! bare frozen ice 
     114         ralb_im = rn_albice  ! bare puddled ice  
     115          
     116         !  Computation of ice albedo (free of snow) 
     117         WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalb(:,:,:) = ralb_im 
     118         ELSE WHERE                                              ;   zalb(:,:,:) = ralb_if 
     119         END  WHERE 
     120       
     121         WHERE     ( 1.5  < ph_ice                     )  ;  zalb_it = zalb 
     122         ELSE WHERE( 1.0  < ph_ice .AND. ph_ice <= 1.5 )  ;  zalb_it = 0.472  + 2.0 * ( zalb - 0.472 ) * ( ph_ice - 1.0 ) 
     123         ELSE WHERE( 0.05 < ph_ice .AND. ph_ice <= 1.0 )  ;  zalb_it = 0.2467 + 0.7049 * ph_ice              & 
     124            &                                                                 - 0.8608 * ph_ice * ph_ice     & 
     125            &                                                                 + 0.3812 * ph_ice * ph_ice * ph_ice 
     126         ELSE WHERE                                       ;  zalb_it = 0.1    + 3.6    * ph_ice 
     127         END WHERE 
     128      
     129         DO jl = 1, ijpl 
     130            DO jj = 1, jpj 
     131               DO ji = 1, jpi 
     132                  ! freezing snow 
     133                  ! no effect of underlying ice layer IF snow thickness > c1. Albedo does not depend on snow thick if > c2 
     134                  !                                        !  freezing snow         
     135                  zswitch   = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ( ph_snw(ji,jj,jl) - c1 ) ) ) 
     136                  zalb_sf   = ( 1._wp - zswitch ) * (  zalb_it(ji,jj,jl)  & 
     137                     &                           + ph_snw(ji,jj,jl) * ( ralb_sf - zalb_it(ji,jj,jl) ) / c1  )   & 
     138                     &        +         zswitch   * ralb_sf   
     139 
     140                  ! melting snow 
     141                  ! no effect of underlying ice layer. Albedo does not depend on snow thick IF > c2 
     142                  zswitch   = MAX( 0._wp , SIGN( 1._wp , ph_snw(ji,jj,jl) - c2 ) ) 
     143                  zalb_sm = ( 1._wp - zswitch ) * ( ralb_im + ph_snw(ji,jj,jl) * ( ralb_sm - ralb_im ) / c2 )   & 
     144                      &     +         zswitch   *   ralb_sm  
     145                  ! 
     146                  ! snow albedo 
     147                  zswitch  =  MAX( 0._wp , SIGN( 1._wp , pt_ice(ji,jj,jl) - rt0_snow ) )    
     148                  zalb_st  =  zswitch * zalb_sm + ( 1._wp - zswitch ) * zalb_sf 
     149                
     150                  ! Ice/snow albedo 
     151                  zswitch   = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ph_snw(ji,jj,jl) ) ) 
     152                  pa_ice_cs(ji,jj,jl) =  zswitch * zalb_st + ( 1._wp - zswitch ) * zalb_it(ji,jj,jl) 
     153                  ! 
     154               END DO 
    161155            END DO 
    162156         END DO 
    163       END DO 
    164        
    165       !    Albedo of snow-ice for overcast sky. 
    166       !----------------------------------------------   
    167       pa_ice_os(:,:,:) = pa_ice_cs(:,:,:) + rn_cloud       ! Oberhuber correction 
    168       ! 
    169       CALL wrk_dealloc( jpi,jpj,ijpl, zalbfz, zficeth ) 
     157 
     158         pa_ice_os(:,:,:) = pa_ice_cs(:,:,:) + rcloud       ! Oberhuber correction for overcast sky 
     159 
     160      !------------------------------------------ 
     161      !  New parameterization (2016) 
     162      !------------------------------------------ 
     163      CASE( 1 )  
     164 
     165         ralb_im = rn_albice  ! bare puddled ice 
     166! compilation of values from literature 
     167         ralb_sf = 0.85      ! dry snow 
     168         ralb_sm = 0.75      ! melting snow 
     169         ralb_if = 0.60      ! bare frozen ice 
     170! Perovich et al 2002 (Sheba) => the only dataset for which all types of ice/snow were retrieved 
     171!         ralb_sf = 0.85       ! dry snow 
     172!         ralb_sm = 0.72       ! melting snow 
     173!         ralb_if = 0.65       ! bare frozen ice 
     174! Brandt et al 2005 (East Antarctica) 
     175!         ralb_sf = 0.87      ! dry snow 
     176!         ralb_sm = 0.82      ! melting snow 
     177!         ralb_if = 0.54      ! bare frozen ice 
     178!  
     179         !  Computation of ice albedo (free of snow) 
     180         z1_c1 = 1. / ( LOG(1.5) - LOG(0.05) )  
     181         z1_c2 = 1. / 0.05 
     182         WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalb = ralb_im 
     183         ELSE WHERE                                              ;   zalb = ralb_if 
     184         END  WHERE 
     185          
     186         WHERE     ( 1.5  < ph_ice                     )  ;  zalb_it = zalb 
     187         ELSE WHERE( 0.05 < ph_ice .AND. ph_ice <= 1.5 )  ;  zalb_it = zalb     + ( 0.18 - zalb     ) * z1_c1 *  & 
     188            &                                                                     ( LOG(1.5) - LOG(ph_ice) ) 
     189         ELSE WHERE                                       ;  zalb_it = ralb_oce + ( 0.18 - ralb_oce ) * z1_c2 * ph_ice 
     190         END WHERE 
     191 
     192         z1_c1 = 1. / 0.02 
     193         z1_c2 = 1. / 0.03 
     194         !  Computation of the snow/ice albedo 
     195         DO jl = 1, ijpl 
     196            DO jj = 1, jpj 
     197               DO ji = 1, jpi 
     198                  zalb_sf = ralb_sf - ( ralb_sf - zalb_it(ji,jj,jl)) * EXP( - ph_snw(ji,jj,jl) * z1_c1 ); 
     199                  zalb_sm = ralb_sm - ( ralb_sm - zalb_it(ji,jj,jl)) * EXP( - ph_snw(ji,jj,jl) * z1_c2 ); 
     200 
     201                   ! snow albedo 
     202                  zswitch = MAX( 0._wp , SIGN( 1._wp , pt_ice(ji,jj,jl) - rt0_snow ) )    
     203                  zalb_st = zswitch * zalb_sm + ( 1._wp - zswitch ) * zalb_sf 
     204 
     205                  ! Ice/snow albedo    
     206                  zswitch             = MAX( 0._wp , SIGN( 1._wp , - ph_snw(ji,jj,jl) ) ) 
     207                  pa_ice_os(ji,jj,jl) = ( 1._wp - zswitch ) * zalb_st + zswitch *  zalb_it(ji,jj,jl) 
     208 
     209              END DO 
     210            END DO 
     211         END DO 
     212         ! Effect of the clouds (2d order polynomial) 
     213         pa_ice_cs = pa_ice_os - ( - 0.1010 * pa_ice_os * pa_ice_os + 0.1933 * pa_ice_os - 0.0148 );  
     214 
     215      END SELECT 
     216       
     217      CALL wrk_dealloc( jpi,jpj,ijpl, zalb, zalb_it ) 
    170218      ! 
    171219   END SUBROUTINE albedo_ice 
     
    181229      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pa_oce_cs   !  albedo of ocean under clear sky 
    182230      !! 
    183       REAL(wp) ::   zcoef   ! local scalar 
    184       !!---------------------------------------------------------------------- 
    185       ! 
    186       zcoef = 0.05 / ( 1.1 * rmue**1.4 + 0.15 )      ! Parameterization of Briegled and Ramanathan, 1982  
    187       pa_oce_cs(:,:) = zcoef                
    188       pa_oce_os(:,:)  = 0.06                         ! Parameterization of Kondratyev, 1969 and Payne, 1972 
     231      REAL(wp) :: zcoef  
     232      !!---------------------------------------------------------------------- 
     233      ! 
     234      zcoef = 0.05 / ( 1.1 * rmue**1.4 + 0.15 )   ! Parameterization of Briegled and Ramanathan, 1982 
     235      pa_oce_cs(:,:) = zcoef  
     236      pa_oce_os(:,:) = 0.06                       ! Parameterization of Kondratyev, 1969 and Payne, 1972 
    189237      ! 
    190238   END SUBROUTINE albedo_oce 
     
    200248      !!---------------------------------------------------------------------- 
    201249      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    202       NAMELIST/namsbc_alb/ rn_cloud, rn_albice, rn_alphd, rn_alphdi, rn_alphc 
     250      NAMELIST/namsbc_alb/ nn_ice_alb, rn_albice  
    203251      !!---------------------------------------------------------------------- 
    204252      ! 
     
    219267         WRITE(numout,*) '~~~~~~~' 
    220268         WRITE(numout,*) '   Namelist namsbc_alb : albedo ' 
    221          WRITE(numout,*) '      correction for snow and ice albedo                  rn_cloud  = ', rn_cloud 
    222          WRITE(numout,*) '      albedo of melting ice in the arctic and antarctic   rn_albice = ', rn_albice 
    223          WRITE(numout,*) '      coefficients for linear                             rn_alphd  = ', rn_alphd 
    224          WRITE(numout,*) '      interpolation used to compute albedo                rn_alphdi = ', rn_alphdi 
    225          WRITE(numout,*) '      between two extremes values (Pyane, 1972)           rn_alphc  = ', rn_alphc 
     269         WRITE(numout,*) '      choose the albedo parameterization                  nn_ice_alb = ', nn_ice_alb 
     270         WRITE(numout,*) '      albedo of bare puddled ice                          rn_albice  = ', rn_albice 
    226271      ENDIF 
    227272      ! 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r5407 r6455  
    8080   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qemp_oce       !: heat flux of precip and evap over ocean     [W/m2] 
    8181   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qemp_ice       !: heat flux of precip and evap over ice       [W/m2] 
    82    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qprec_ice      !: heat flux of precip over ice                [J/m3] 
     82   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qevap_ice      !: heat flux of evap over ice                  [W/m2] 
     83   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qprec_ice      !: enthalpy of precip over ice                 [J/m3] 
    8384   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_oce        !: evap - precip over ocean                 [kg/m2/s] 
    8485#endif 
     
    144145#endif 
    145146#if defined key_lim3 
    146          &      evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice(jpi,jpj) ,  & 
    147          &      qemp_ice(jpi,jpj)     , qemp_oce(jpi,jpj)      ,                       & 
    148          &      qns_oce (jpi,jpj)     , qsr_oce (jpi,jpj)      , emp_oce (jpi,jpj)  ,  & 
     147         &      evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice(jpi,jpj) ,   & 
     148         &      qemp_ice(jpi,jpj)     , qevap_ice(jpi,jpj,jpl) , qemp_oce (jpi,jpj) ,   & 
     149         &      qns_oce (jpi,jpj)     , qsr_oce  (jpi,jpj)     , emp_oce (jpi,jpj)  ,   & 
    149150#endif 
    150151         &      emp_ice(jpi,jpj)      ,  STAT= ierr(1) ) 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

    r5487 r6455  
    684684      qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
    685685 
     686      ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- ! 
     687      DO jl = 1, jpl 
     688         qevap_ice(:,:,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     689                                   ! but then qemp_ice should also include sublimation  
     690      END DO 
     691 
    686692      CALL wrk_dealloc( jpi,jpj, zevap, zsnw )  
    687693#endif 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r5582 r6455  
    612612      ! --- evaporation --- ! 
    613613      z1_lsub = 1._wp / Lsub 
    614       evap_ice (:,:,:) = qla_ice (:,:,:) * z1_lsub ! sublimation 
    615       devap_ice(:,:,:) = dqla_ice(:,:,:) * z1_lsub 
    616       zevap    (:,:)   = emp(:,:) + tprecip(:,:)   ! evaporation over ocean 
     614      evap_ice (:,:,:) = rn_efac * qla_ice (:,:,:) * z1_lsub    ! sublimation 
     615      devap_ice(:,:,:) = rn_efac * dqla_ice(:,:,:) * z1_lsub    ! d(sublimation)/dT 
     616      zevap    (:,:)   = rn_efac * ( emp(:,:) + tprecip(:,:) )  ! evaporation over ocean 
    617617 
    618618      ! --- evaporation minus precipitation --- ! 
     
    637637      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
    638638      qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     639 
     640      ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- ! 
     641      DO jl = 1, jpl 
     642         qevap_ice(:,:,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * cpic * tmask(:,:,1) ) 
     643                                   ! But we do not have Tice => consider it at 0°C => evap=0  
     644      END DO 
    639645 
    640646      CALL wrk_dealloc( jpi,jpj, zevap, zsnw )  
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r6204 r6455  
    13781378      ! 
    13791379      INTEGER ::   jl         ! dummy loop index 
    1380       REAL(wp), POINTER, DIMENSION(:,:  ) ::   zcptn, ztmp, zicefr, zmsk 
    1381       REAL(wp), POINTER, DIMENSION(:,:  ) ::   zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot 
    1382       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zqns_ice, zqsr_ice, zdqns_ice 
    1383       REAL(wp), POINTER, DIMENSION(:,:  ) ::   zevap, zsnw, zqns_oce, zqsr_oce, zqprec_ice, zqemp_oce ! for LIM3 
     1380      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zcptn, ztmp, zicefr, zmsk, zsnw 
     1381      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap, zevap_ice, zdevap_ice 
     1382      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 
     1383      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice 
    13841384      !!---------------------------------------------------------------------- 
    13851385      ! 
    13861386      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_ice_flx') 
    13871387      ! 
    1388       CALL wrk_alloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 
    1389       CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 
     1388      CALL wrk_alloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zsnw ) 
     1389      CALL wrk_alloc( jpi,jpj,     zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap, zevap_ice, zdevap_ice ) 
     1390      CALL wrk_alloc( jpi,jpj,     zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 
     1391      CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) 
    13901392 
    13911393      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0) 
     
    14231425      END SELECT 
    14241426 
    1425       IF( iom_use('subl_ai_cea') )   & 
    1426          CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average) 
    1427       !    
    1428       !                                                           ! runoffs and calving (put in emp_tot) 
     1427#if defined key_lim3 
     1428      ! zsnw = snow percentage over ice after wind blowing 
     1429      zsnw(:,:) = 0._wp 
     1430      CALL lim_thd_snwblow( p_frld, zsnw ) 
     1431       
     1432      ! --- evaporation (kg/m2/s) --- ! 
     1433      zevap_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) 
     1434      ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 
     1435      ! therefore, sublimation is not redistributed over the ice categories in case no subgrid scale fluxes are provided by atm. 
     1436      zdevap_ice(:,:) = 0._wp 
     1437       
     1438      ! --- evaporation minus precipitation corrected for the effect of wind blowing on snow --- ! 
     1439      zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) - zsprecip * (1._wp - zsnw) 
     1440      zemp_ice(:,:) = zemp_ice(:,:) + zsprecip * (1._wp - zsnw)           
     1441 
     1442      ! Sublimation over sea-ice (cell average) 
     1443      IF( iom_use('subl_ai_cea') )  CALL iom_put( 'subl_ai_cea', zevap_ice(:,:) * zicefr(:,:) ) 
     1444      ! runoffs and calving (put in emp_tot) 
     1445      IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1446      IF( srcv(jpr_cal)%laction ) THEN  
     1447         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 
     1448         CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 
     1449      ENDIF 
     1450 
     1451      IF( ln_mixcpl ) THEN 
     1452         emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 
     1453         emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 
     1454         emp_oce(:,:) = emp_oce(:,:) * xcplmask(:,:,0) + zemp_oce(:,:) * zmsk(:,:) 
     1455         sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 
     1456         tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 
     1457         DO jl=1,jpl 
     1458            evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,:) * zmsk(:,:) 
     1459            devap_ice(:,:,jl) = devap_ice(:,:,jl) * xcplmask(:,:,0) + zdevap_ice(:,:) * zmsk(:,:) 
     1460         ENDDO 
     1461      ELSE 
     1462         emp_tot(:,:) =         zemp_tot(:,:) 
     1463         emp_ice(:,:) =         zemp_ice(:,:) 
     1464         emp_oce(:,:) =         zemp_oce(:,:)      
     1465         sprecip(:,:) =         zsprecip(:,:) 
     1466         tprecip(:,:) =         ztprecip(:,:) 
     1467         DO jl=1,jpl 
     1468            evap_ice (:,:,jl) = zevap_ice (:,:) 
     1469            devap_ice(:,:,jl) = zdevap_ice(:,:) 
     1470         ENDDO 
     1471      ENDIF 
     1472 
     1473                                     CALL iom_put( 'snowpre'    , sprecip                         )  ! Snow 
     1474      IF( iom_use('snow_ao_cea') )   CALL iom_put( 'snow_ao_cea', sprecip(:,:) * ( 1._wp - zsnw ) )  ! Snow over ice-free ocean  (cell average) 
     1475      IF( iom_use('snow_ai_cea') )   CALL iom_put( 'snow_ai_cea', sprecip(:,:) *           zsnw   )  ! Snow over sea-ice         (cell average)     
     1476#else 
     1477      ! Sublimation over sea-ice (cell average) 
     1478      IF( iom_use('subl_ai_cea') )  CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) 
     1479      ! runoffs and calving (put in emp_tot) 
    14291480      IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
    14301481      IF( srcv(jpr_cal)%laction ) THEN  
     
    14501501      IF( iom_use('snow_ai_cea') )   & 
    14511502         CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:)             )   ! Snow        over sea-ice         (cell average) 
     1503#endif 
    14521504 
    14531505      !                                                      ! ========================= ! 
     
    15051557      IF( iom_use('hflx_snow_cea') )    CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average) 
    15061558 
    1507 #if defined key_lim3 
    1508       CALL wrk_alloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce )  
    1509  
     1559#if defined key_lim3       
    15101560      ! --- evaporation --- ! 
    1511       ! clem: evap_ice is set to 0 for LIM3 since we still do not know what to do with sublimation 
    1512       ! the problem is: the atm. imposes both mass evaporation and heat removed from the snow/ice 
    1513       !                 but it is incoherent WITH the ice model   
    1514       DO jl=1,jpl 
    1515          evap_ice(:,:,jl) = 0._wp  ! should be: frcv(jpr_ievp)%z3(:,:,1) 
    1516       ENDDO 
    15171561      zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean 
    1518  
    1519       ! --- evaporation minus precipitation --- ! 
    1520       emp_oce(:,:) = emp_tot(:,:) - emp_ice(:,:) 
    15211562 
    15221563      ! --- non solar flux over ocean --- ! 
     
    15251566      WHERE( p_frld /= 0._wp )  zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:) 
    15261567 
    1527       ! --- heat flux associated with emp --- ! 
    1528       zsnw(:,:) = 0._wp 
    1529       CALL lim_thd_snwblow( p_frld, zsnw )  ! snow distribution over ice after wind blowing 
     1568      ! --- heat flux associated with emp (W/m2) --- ! 
    15301569      zqemp_oce(:,:) = -      zevap(:,:)                   * p_frld(:,:)      *   zcptn(:,:)   &      ! evap 
    15311570         &             + ( ztprecip(:,:) - zsprecip(:,:) )                    *   zcptn(:,:)   &      ! liquid precip 
    15321571         &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean 
    1533       qemp_ice(:,:)  = -   frcv(jpr_ievp)%z3(:,:,1)        * zicefr(:,:)      *   zcptn(:,:)   &      ! ice evap 
    1534          &             +   zsprecip(:,:)                   * zsnw             * ( zcptn(:,:) - lfus ) ! solid precip over ice 
    1535  
     1572!      zqemp_ice(:,:) = -   frcv(jpr_ievp)%z3(:,:,1)        * zicefr(:,:)      *   zcptn(:,:)   &      ! ice evap 
     1573!         &             +   zsprecip(:,:)                   * zsnw             * ( zcptn(:,:) - lfus ) ! solid precip over ice 
     1574      zqemp_ice(:,:) =      zsprecip(:,:)                   * zsnw             * ( zcptn(:,:) - lfus ) ! solid precip over ice (only) 
     1575                                                                                                       ! qevap_ice=0 since we consider Tice=0°C 
     1576       
    15361577      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
    15371578      zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 
    15381579 
    1539       ! --- total non solar flux --- ! 
    1540       zqns_tot(:,:) = zqns_tot(:,:) + qemp_ice(:,:) + zqemp_oce(:,:) 
     1580      ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- ! 
     1581      DO jl = 1, jpl 
     1582         zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but we do not have Tice, so we consider Tice=0°C 
     1583      END DO 
     1584 
     1585      ! --- total non solar flux (including evap/precip) --- ! 
     1586      zqns_tot(:,:) = zqns_tot(:,:) + zqemp_ice(:,:) + zqemp_oce(:,:) 
    15411587 
    15421588      ! --- in case both coupled/forced are active, we must mix values --- !  
     
    15451591         qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:) 
    15461592         DO jl=1,jpl 
    1547             qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) +  zqns_ice(:,:,jl)* zmsk(:,:) 
     1593            qns_ice  (:,:,jl) = qns_ice  (:,:,jl) * xcplmask(:,:,0) +  zqns_ice  (:,:,jl)* zmsk(:,:) 
     1594            qevap_ice(:,:,jl) = qevap_ice(:,:,jl) * xcplmask(:,:,0) +  zqevap_ice(:,:,jl)* zmsk(:,:) 
    15481595         ENDDO 
    15491596         qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:) 
    15501597         qemp_oce (:,:) =  qemp_oce(:,:) * xcplmask(:,:,0) +  zqemp_oce(:,:)* zmsk(:,:) 
    1551 !!clem         evap_ice(:,:) = evap_ice(:,:) * xcplmask(:,:,0) 
     1598         qemp_ice (:,:) =  qemp_ice(:,:) * xcplmask(:,:,0) +  zqemp_ice(:,:)* zmsk(:,:) 
    15521599      ELSE 
    15531600         qns_tot  (:,:  ) = zqns_tot  (:,:  ) 
    15541601         qns_oce  (:,:  ) = zqns_oce  (:,:  ) 
    15551602         qns_ice  (:,:,:) = zqns_ice  (:,:,:) 
    1556          qprec_ice(:,:)   = zqprec_ice(:,:) 
    1557          qemp_oce (:,:)   = zqemp_oce (:,:) 
    1558       ENDIF 
    1559  
    1560       CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce )  
     1603         qevap_ice(:,:,:) = zqevap_ice(:,:,:) 
     1604         qprec_ice(:,:  ) = zqprec_ice(:,:  ) 
     1605         qemp_oce (:,:  ) = zqemp_oce (:,:  ) 
     1606         qemp_ice (:,:  ) = zqemp_ice (:,:  ) 
     1607      ENDIF 
    15611608#else 
    1562  
    15631609      ! clem: this formulation is certainly wrong... but better than it was... 
    15641610      zqns_tot(:,:) = zqns_tot(:,:)                       &            ! zqns_tot update over free ocean with: 
     
    15771623         qns_ice(:,:,:) = zqns_ice(:,:,:) 
    15781624      ENDIF 
    1579  
    15801625#endif 
    15811626 
     
    16281673 
    16291674#if defined key_lim3 
    1630       CALL wrk_alloc( jpi,jpj, zqsr_oce )  
    16311675      ! --- solar flux over ocean --- ! 
    16321676      !         note: p_frld cannot be = 0 since we limit the ice concentration to amax 
     
    16361680      IF( ln_mixcpl ) THEN   ;   qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) +  zqsr_oce(:,:)* zmsk(:,:) 
    16371681      ELSE                   ;   qsr_oce(:,:) = zqsr_oce(:,:)   ;   ENDIF 
    1638  
    1639       CALL wrk_dealloc( jpi,jpj, zqsr_oce )  
    16401682#endif 
    16411683 
     
    16881730      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
    16891731 
    1690       CALL wrk_dealloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 
    1691       CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 
     1732      CALL wrk_dealloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zsnw ) 
     1733      CALL wrk_dealloc( jpi,jpj,     zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap, zevap_ice, zdevap_ice ) 
     1734      CALL wrk_dealloc( jpi,jpj,     zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 
     1735      CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) 
    16921736      ! 
    16931737      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_ice_flx') 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r5540 r6455  
    110110      INTEGER  ::   jl                 ! dummy loop index 
    111111      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_os, zalb_cs  ! ice albedo under overcast/clear sky 
    112       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_ice          ! mean ice albedo (for coupled) 
    113112      REAL(wp), POINTER, DIMENSION(:,:  )   ::   zutau_ice, zvtau_ice  
    114113      !!---------------------------------------------------------------------- 
     
    197196         ! fr1_i0  , fr2_i0   : 1sr & 2nd fraction of qsr penetration in ice             [%] 
    198197         !---------------------------------------------------------------------------------------- 
    199          CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 
     198         CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs ) 
    200199         CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 
    201200 
     
    203202         CASE( jp_clio )                                       ! CLIO bulk formulation 
    204203            ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo  
    205             ! (zalb_ice) is computed within the bulk routine 
    206             CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, zalb_ice ) 
    207             IF( ln_mixcpl      ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 
    208             IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
     204            ! (alb_ice) is computed within the bulk routine 
     205                                 CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, alb_ice ) 
     206            IF( ln_mixcpl      ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 
     207            IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
    209208         CASE( jp_core )                                       ! CORE bulk formulation 
    210209            ! albedo depends on cloud fraction because of non-linear spectral effects 
    211             zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    212             CALL blk_ice_core_flx( t_su, zalb_ice ) 
    213             IF( ln_mixcpl      ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 
    214             IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
     210            alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     211                                 CALL blk_ice_core_flx( t_su, alb_ice ) 
     212            IF( ln_mixcpl      ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 
     213            IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
    215214         CASE ( jp_purecpl ) 
    216215            ! albedo depends on cloud fraction because of non-linear spectral effects 
    217             zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    218                                  CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 
    219             ! clem: evap_ice is forced to 0 in coupled mode for now  
    220             !       but it needs to be changed (along with modif in limthd_dh) once heat flux from evap will be avail. from atm. models 
    221             evap_ice  (:,:,:) = 0._wp   ;   devap_ice (:,:,:) = 0._wp 
    222             IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
     216            alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     217                                 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 
     218            IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
    223219         END SELECT 
    224          CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 
     220         CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs ) 
    225221 
    226222         !----------------------------! 
     
    265261      !!---------------------------------------------------------------------- 
    266262      INTEGER :: ierr 
     263      INTEGER :: ji, jj 
    267264      !!---------------------------------------------------------------------- 
    268265      IF(lwp) WRITE(numout,*) 
     
    321318      tn_ice(:,:,:) = t_su(:,:,:)       ! initialisation of surface temp for coupled simu 
    322319      ! 
     320      DO jj = 1, jpj 
     321         DO ji = 1, jpi 
     322            IF( gphit(ji,jj) > 0._wp ) THEN  ;  rn_amax_2d(ji,jj) = rn_amax_n  ! NH 
     323            ELSE                             ;  rn_amax_2d(ji,jj) = rn_amax_s  ! SH 
     324            ENDIF 
     325        ENDDO 
     326      ENDDO  
     327      ! 
    323328      nstart = numit  + nn_fsbc       
    324329      nitrun = nitend - nit000 + 1  
     
    343348      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    344349      NAMELIST/namicerun/ jpl, nlay_i, nlay_s, cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir,  & 
    345          &                ln_limdyn, rn_amax, ln_limdiahsb, ln_limdiaout, ln_icectl, iiceprt, jiceprt   
     350         &                ln_limdyn, rn_amax_n, rn_amax_s, ln_limdiahsb, ln_limdiaout, ln_icectl, iiceprt, jiceprt   
    346351      !!------------------------------------------------------------------- 
    347352      !                     
     
    364369         WRITE(numout,*) '   number of snow layers                                   = ', nlay_s 
    365370         WRITE(numout,*) '   switch for ice dynamics (1) or not (0)      ln_limdyn   = ', ln_limdyn 
    366          WRITE(numout,*) '   maximum ice concentration                               = ', rn_amax  
     371         WRITE(numout,*) '   maximum ice concentration for NH                        = ', rn_amax_n  
     372         WRITE(numout,*) '   maximum ice concentration for SH                        = ', rn_amax_s 
    367373         WRITE(numout,*) '   Diagnose heat/salt budget or not          ln_limdiahsb  = ', ln_limdiahsb 
    368374         WRITE(numout,*) '   Output   heat/salt budget or not          ln_limdiaout  = ', ln_limdiaout 
     
    579585      sfx_bog(:,:) = 0._wp   ;   sfx_dyn(:,:) = 0._wp 
    580586      sfx_bom(:,:) = 0._wp   ;   sfx_sum(:,:) = 0._wp 
    581       sfx_res(:,:) = 0._wp 
     587      sfx_res(:,:) = 0._wp   ;   sfx_sub(:,:) = 0._wp 
    582588       
    583589      wfx_snw(:,:) = 0._wp   ;   wfx_ice(:,:) = 0._wp 
     
    595601      hfx_spr(:,:) = 0._wp   ;   hfx_dif(:,:) = 0._wp  
    596602      hfx_err(:,:) = 0._wp   ;   hfx_err_rem(:,:) = 0._wp 
    597       hfx_err_dif(:,:) = 0._wp   ; 
    598  
     603      hfx_err_dif(:,:) = 0._wp 
     604      wfx_err_sub(:,:) = 0._wp 
     605       
    599606      afx_tot(:,:) = 0._wp   ; 
    600607      afx_dyn(:,:) = 0._wp   ;   afx_thd(:,:) = 0._wp 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r5628 r6455  
    456456      !                                                ! ---------------------------------------- ! 
    457457      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 
    458          CALL iom_put( "empmr" , emp  - rnf )                   ! upward water flux 
     458         CALL iom_put( "empmr"  , emp    - rnf )                ! upward water flux 
     459         CALL iom_put( "empbmr" , emp_b  - rnf )                ! before upward water flux ( needed to recalculate the time evolution of ssh in offline ) 
    459460         CALL iom_put( "saltflx", sfx  )                        ! downward salt flux   
    460461                                                                ! (includes virtual salt flux beneath ice  
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90

    r5120 r6455  
    6868      ! 
    6969      rldf = 1     ! For active tracers the  
     70      r_fact_lap(:,:,:) = 1.0 
    7071 
    7172      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
     
    214215      IF( ierr == 1 )   CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' ) 
    215216      IF( ierr == 2 )   CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' ) 
     217      IF( ln_traldf_grif .AND. ln_isfcav         )   & 
     218           CALL ctl_stop( ' ice shelf and traldf_grif not tested') 
    216219      IF( lk_traldf_eiv .AND. .NOT.ln_traldf_iso )   & 
    217220           CALL ctl_stop( '          eddy induced velocity on tracers',   & 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r5407 r6455  
    1010   !!             -   !  2005-11  (G. Madec) zco, zps, sco coordinate 
    1111   !!            3.2  !  2009-04  (G. Madec & NEMO team)  
    12    !!            4.0  !  2012-05  (C. Rousset) store attenuation coef for use in ice model  
     12   !!            3.4  !  2012-05  (C. Rousset) store attenuation coef for use in ice model  
     13   !!            3.6  !  2015-12  (O. Aumont, J. Jouanno, C. Ethe) use vertical profile of chlorophyll 
    1314   !!---------------------------------------------------------------------- 
    1415 
     
    9394      !! Reference  : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp. 
    9495      !!              Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516. 
     96      !!              Morel, A. et Berthon, JF, 1989, Limnol Oceanogr 34(8), 1545-1562 
    9597      !!---------------------------------------------------------------------- 
    9698      ! 
     
    101103      REAL(wp) ::   zchl, zcoef, zfact   ! local scalars 
    102104      REAL(wp) ::   zc0, zc1, zc2, zc3   !    -         - 
    103       REAL(wp) ::   zzc0, zzc1, zzc2, zzc3   !    -         - 
    104105      REAL(wp) ::   zz0, zz1, z1_e3t     !    -         - 
     106      REAL(wp) ::   zCb, zCmax, zze, zpsi, zpsimax, zdelpsi, zCtot, zCze 
     107      REAL(wp) ::   zlogc, zlogc2, zlogc3  
    105108      REAL(wp), POINTER, DIMENSION(:,:  ) :: zekb, zekg, zekr 
    106       REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt 
    107       !!---------------------------------------------------------------------- 
     109      REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt, zchl3d 
     110      !!-------------------------------------------------------------------------- 
    108111      ! 
    109112      IF( nn_timing == 1 )  CALL timing_start('tra_qsr') 
    110113      ! 
    111114      CALL wrk_alloc( jpi, jpj,      zekb, zekg, zekr        )  
    112       CALL wrk_alloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea )  
     115      CALL wrk_alloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea, zchl3d )  
    113116      ! 
    114117      IF( kt == nit000 ) THEN 
     
    183186            !                                             ! ------------------------- ! 
    184187            ! Set chlorophyl concentration 
    185             IF( nn_chldta == 1 .OR. lk_vvl ) THEN            !*  Variable Chlorophyll or ocean volume 
    186                ! 
    187                IF( nn_chldta == 1 ) THEN                             !*  Variable Chlorophyll 
    188                   ! 
    189                   CALL fld_read( kt, 1, sf_chl )                         ! Read Chl data and provides it at the current time step 
    190                   !          
    191 !CDIR COLLAPSE 
     188            IF( nn_chldta == 1 .OR. nn_chldta == 2 .OR. lk_vvl ) THEN    !*  Variable Chlorophyll or ocean volume 
     189               ! 
     190               IF( nn_chldta == 1 ) THEN        !*  2D Variable Chlorophyll 
     191                  ! 
     192                  CALL fld_read( kt, 1, sf_chl )            ! Read Chl data and provides it at the current time step 
     193                  DO jk = 1, nksr + 1 
     194                     zchl3d(:,:,jk) = sf_chl(1)%fnow(:,:,1)  
     195                  ENDDO 
     196                  ! 
     197               ELSE IF( nn_chldta == 2 ) THEN    !*   -3-D Variable Chlorophyll 
     198                  ! 
     199                  CALL fld_read( kt, 1, sf_chl )            ! Read Chl data and provides it at the current time step 
     200!CDIR NOVERRCHK   ! 
     201                  DO jj = 1, jpj 
    192202!CDIR NOVERRCHK 
    193                   DO jj = 1, jpj                                         ! Separation in R-G-B depending of the surface Chl 
    194 !CDIR NOVERRCHK 
    195                      DO ji = 1, jpi 
    196                         zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) 
    197                         irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) 
    198                         zekb(ji,jj) = rkrgb(1,irgb) 
    199                         zekg(ji,jj) = rkrgb(2,irgb) 
    200                         zekr(ji,jj) = rkrgb(3,irgb) 
    201                      END DO 
    202                   END DO 
    203                ELSE                                            ! Variable ocean volume but constant chrlorophyll 
    204                   zchl = 0.05                                     ! constant chlorophyll 
    205                   irgb = NINT( 41 + 20.*LOG10( zchl ) + 1.e-15 ) 
    206                   zekb(:,:) = rkrgb(1,irgb)                       ! Separation in R-G-B depending of the chlorophyll  
    207                   zekg(:,:) = rkrgb(2,irgb) 
    208                   zekr(:,:) = rkrgb(3,irgb) 
     203                     DO ji = 1, jpi 
     204                        zchl    = sf_chl(1)%fnow(ji,jj,1) 
     205                        zCtot   = 40.6  * zchl**0.459 
     206                        zze     = 568.2 * zCtot**(-0.746) 
     207                        IF( zze > 102. ) zze = 200.0 * zCtot**(-0.293) 
     208                        zlogc   = LOG( zchl ) 
     209                        zlogc2  = zlogc * zlogc 
     210                        zlogc3  = zlogc * zlogc * zlogc 
     211                        zCb     = 0.768 + 0.087 * zlogc - 0.179 * zlogc2 - 0.025 * zlogc3 
     212                        zCmax   = 0.299 - 0.289 * zlogc + 0.579 * zlogc2 
     213                        zpsimax = 0.6   - 0.640 * zlogc + 0.021 * zlogc2 + 0.115 * zlogc3 
     214                        zdelpsi = 0.710 + 0.159 * zlogc + 0.021 * zlogc2 
     215                        zCze    = 1.12  * (zchl)**0.803  
     216                        DO jk = 1, nksr + 1 
     217                           zpsi = fsdept(ji,jj,jk) / zze 
     218                           zchl3d(ji,jj,jk) = zCze * ( zCb + zCmax * EXP( -( (zpsi - zpsimax) / zdelpsi )**2 ) ) 
     219                        END DO 
     220                        ! 
     221                      END DO 
     222                   END DO 
     223                     ! 
     224               ELSE                              !* Variable ocean volume but constant chrlorophyll 
     225                  DO jk = 1, nksr + 1 
     226                     zchl3d(:,:,jk) = 0.05  
     227                  ENDDO 
    209228               ENDIF 
    210229               ! 
    211                zcoef  = ( 1. - rn_abs ) / 3.e0                        ! equi-partition in R-G-B 
     230               zcoef  = ( 1. - rn_abs ) / 3.e0                        !  equi-partition in R-G-B 
    212231               ze0(:,:,1) = rn_abs  * qsr(:,:) 
    213232               ze1(:,:,1) = zcoef * qsr(:,:) 
     
    217236               ! 
    218237               DO jk = 2, nksr+1 
     238                  ! 
     239                  DO jj = 1, jpj                                         ! Separation in R-G-B depending of vertical profile of Chl 
     240!CDIR NOVERRCHK 
     241                     DO ji = 1, jpi 
     242                        zchl = MIN( 10. , MAX( 0.03, zchl3d(ji,jj,jk) ) ) 
     243                        irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) 
     244                        zekb(ji,jj) = rkrgb(1,irgb) 
     245                        zekg(ji,jj) = rkrgb(2,irgb) 
     246                        zekr(ji,jj) = rkrgb(3,irgb) 
     247                     END DO 
     248                  END DO 
    219249!CDIR NOVERRCHK 
    220250                  DO jj = 1, jpj 
     
    233263                  END DO 
    234264               END DO 
    235                ! clem: store attenuation coefficient of the first ocean level 
    236                IF ( ln_qsr_ice ) THEN 
    237                   DO jj = 1, jpj 
    238                      DO ji = 1, jpi 
    239                         zzc0 = rn_abs * EXP( - fse3t(ji,jj,1) * xsi0r     ) 
    240                         zzc1 = zcoef  * EXP( - fse3t(ji,jj,1) * zekb(ji,jj) ) 
    241                         zzc2 = zcoef  * EXP( - fse3t(ji,jj,1) * zekg(ji,jj) ) 
    242                         zzc3 = zcoef  * EXP( - fse3t(ji,jj,1) * zekr(ji,jj) ) 
    243                         fraqsr_1lev(ji,jj) = 1.0 - ( zzc0 + zzc1 + zzc2  + zzc3  ) * tmask(ji,jj,2)  
    244                      END DO 
    245                   END DO 
    246                ENDIF 
    247265               ! 
    248266               DO jk = 1, nksr                                        ! compute and add qsr trend to ta 
     
    251269               zea(:,:,nksr+1:jpk) = 0.e0     ! below 400m set to zero 
    252270               CALL iom_put( 'qsr3d', zea )   ! Shortwave Radiation 3D distribution 
     271               ! 
     272               IF ( ln_qsr_ice ) THEN    ! store attenuation coefficient of the first ocean level 
     273!CDIR NOVERRCHK 
     274                  DO jj = 1, jpj                                         ! Separation in R-G-B depending of the surface Chl 
     275!CDIR NOVERRCHK 
     276                     DO ji = 1, jpi 
     277                        zchl = MIN( 10. , MAX( 0.03, zchl3d(ji,jj,1) ) ) 
     278                        irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) 
     279                        zekb(ji,jj) = rkrgb(1,irgb) 
     280                        zekg(ji,jj) = rkrgb(2,irgb) 
     281                        zekr(ji,jj) = rkrgb(3,irgb) 
     282                     END DO 
     283                  END DO 
     284                  !  
     285                  DO jj = 1, jpj 
     286                     DO ji = 1, jpi 
     287                        zc0 = rn_abs * EXP( - fse3t(ji,jj,1) * xsi0r     ) 
     288                        zc1 = zcoef  * EXP( - fse3t(ji,jj,1) * zekb(ji,jj) ) 
     289                        zc2 = zcoef  * EXP( - fse3t(ji,jj,1) * zekg(ji,jj) ) 
     290                        zc3 = zcoef  * EXP( - fse3t(ji,jj,1) * zekr(ji,jj) ) 
     291                        fraqsr_1lev(ji,jj) = 1.0 - ( zc0 + zc1 + zc2  + zc3  ) * tmask(ji,jj,2)  
     292                     END DO 
     293                  END DO 
     294                  ! 
     295               ENDIF 
    253296               ! 
    254297            ELSE                                                 !*  Constant Chlorophyll 
     
    256299                  qsr_hc(:,:,jk) =  etot3(:,:,jk) * qsr(:,:) 
    257300               END DO 
    258                ! clem: store attenuation coefficient of the first ocean level 
    259                IF ( ln_qsr_ice ) THEN 
     301               ! store attenuation coefficient of the first ocean level 
     302               IF( ln_qsr_ice ) THEN 
    260303                  fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp 
    261304               ENDIF 
     
    339382      ! 
    340383      CALL wrk_dealloc( jpi, jpj,      zekb, zekg, zekr        )  
    341       CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea )  
     384      CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea, zchl3d )  
    342385      ! 
    343386      IF( nn_timing == 1 )  CALL timing_stop('tra_qsr') 
     
    405448         WRITE(numout,*) '      bio-model            light penetration   ln_qsr_bio = ', ln_qsr_bio 
    406449         WRITE(numout,*) '      light penetration for ice-model LIM3     ln_qsr_ice = ', ln_qsr_ice 
    407          WRITE(numout,*) '      RGB : Chl data (=1) or cst value (=0)    nn_chldta  = ', nn_chldta 
     450         WRITE(numout,*) '      RGB : Chl data (=1/2) or cst value (=0)  nn_chldta  = ', nn_chldta 
    408451         WRITE(numout,*) '      RGB & 2 bands: fraction of light (rn_si1)    rn_abs = ', rn_abs 
    409452         WRITE(numout,*) '      RGB & 2 bands: shortess depth of extinction  rn_si0 = ', rn_si0 
     
    429472         IF( ln_qsr_rgb .AND. nn_chldta == 0 )   nqsr =  1  
    430473         IF( ln_qsr_rgb .AND. nn_chldta == 1 )   nqsr =  2 
    431          IF( ln_qsr_2bd                      )   nqsr =  3 
    432          IF( ln_qsr_bio                      )   nqsr =  4 
     474         IF( ln_qsr_rgb .AND. nn_chldta == 2 )   nqsr =  3 
     475         IF( ln_qsr_2bd                      )   nqsr =  4 
     476         IF( ln_qsr_bio                      )   nqsr =  5 
    433477         ! 
    434478         IF(lwp) THEN                   ! Print the choice 
    435479            WRITE(numout,*) 
    436480            IF( nqsr ==  1 )   WRITE(numout,*) '         R-G-B   light penetration - Constant Chlorophyll' 
    437             IF( nqsr ==  2 )   WRITE(numout,*) '         R-G-B   light penetration - Chl data ' 
    438             IF( nqsr ==  3 )   WRITE(numout,*) '         2 bands light penetration' 
    439             IF( nqsr ==  4 )   WRITE(numout,*) '         bio-model light penetration' 
     481            IF( nqsr ==  2 )   WRITE(numout,*) '         R-G-B   light penetration - 2D Chl data ' 
     482            IF( nqsr ==  3 )   WRITE(numout,*) '         R-G-B   light penetration - 3D Chl data ' 
     483            IF( nqsr ==  4 )   WRITE(numout,*) '         2 bands light penetration' 
     484            IF( nqsr ==  5 )   WRITE(numout,*) '         bio-model light penetration' 
    440485         ENDIF 
    441486         ! 
     
    460505            IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m' 
    461506            ! 
    462             IF( nn_chldta == 1 ) THEN           !* Chl data : set sf_chl structure 
     507            IF( nn_chldta == 1  .OR. nn_chldta == 2 ) THEN           !* Chl data : set sf_chl structure 
    463508               IF(lwp) WRITE(numout,*) 
    464509               IF(lwp) WRITE(numout,*) '        Chlorophyll read in a file' 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90

    r5120 r6455  
    177177                  &                             +  0.15 * zrau(ji,jj)          * zmskd2(ji,jj)  ) 
    178178               ! add to the eddy viscosity coef. previously computed 
     179# if defined key_zdftmx_new 
     180               ! key_zdftmx_new: New internal wave-driven param: use avs value computed by zdftmx 
     181               avs (ji,jj,jk) = avs(ji,jj,jk) + zavfs + zavds 
     182# else 
    179183               avs (ji,jj,jk) = avt(ji,jj,jk) + zavfs + zavds 
     184# endif 
    180185               avt (ji,jj,jk) = avt(ji,jj,jk) + zavft + zavdt 
    181186               avm (ji,jj,jk) = avm(ji,jj,jk) + MAX( zavft + zavdt, zavfs + zavds ) 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90

    r6204 r6455  
    8080      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    8181      ! 
    82       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    83       INTEGER  ::   iikn, iiki, ikt, imkt  ! local integer 
    84       REAL(wp) ::   zN2_c        ! local scalar 
     82      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
     83      INTEGER  ::   iikn, iiki, ikt ! local integer 
     84      REAL(wp) ::   zN2_c           ! local scalar 
    8585      INTEGER, POINTER, DIMENSION(:,:) ::   imld   ! 2D workspace 
    8686      !!---------------------------------------------------------------------- 
     
    117117         DO jj = 1, jpj 
    118118            DO ji = 1, jpi 
    119                imkt = mikt(ji,jj) 
    120                IF( avt (ji,jj,jk) < avt_c )   imld(ji,jj) = MAX( imkt, jk )      ! Turbocline  
     119               IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) )   imld(ji,jj) = jk      ! Turbocline  
    121120            END DO 
    122121         END DO 
     
    127126            iiki = imld(ji,jj) 
    128127            iikn = nmln(ji,jj) 
    129             imkt = mikt(ji,jj) 
    130             hmld (ji,jj) = ( fsdepw(ji,jj,iiki  ) - fsdepw(ji,jj,imkt ) ) * ssmask(ji,jj)    ! Turbocline depth  
    131             hmlp (ji,jj) = ( fsdepw(ji,jj,iikn  ) - fsdepw(ji,jj,imkt ) ) * ssmask(ji,jj)    ! Mixed layer depth 
    132             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 
     128            hmld (ji,jj) = fsdepw(ji,jj,iiki  ) * ssmask(ji,jj)    ! Turbocline depth  
     129            hmlp (ji,jj) = fsdepw(ji,jj,iikn  ) * ssmask(ji,jj)    ! Mixed layer depth 
     130            hmlpt(ji,jj) = fsdept(ji,jj,iikn-1) * ssmask(ji,jj)    ! depth of the last T-point inside the mixed layer 
    133131         END DO 
    134132      END DO 
    135       IF( .NOT.lk_offline ) THEN            ! no need to output in offline mode 
    136          CALL iom_put( "mldr10_1", hmlp )   ! mixed layer depth 
    137          CALL iom_put( "mldkz5"  , hmld )   ! turbocline depth 
     133      ! no need to output in offline mode 
     134      IF( .NOT.lk_offline ) THEN    
     135         IF ( iom_use("mldr10_1") ) THEN 
     136            IF( ln_isfcav ) THEN 
     137               CALL iom_put( "mldr10_1", hmlp - risfdep)   ! mixed layer thickness 
     138            ELSE 
     139               CALL iom_put( "mldr10_1", hmlp )            ! mixed layer depth 
     140            END IF 
     141         END IF 
     142         IF ( iom_use("mldkz5") ) THEN 
     143            IF( ln_isfcav ) THEN 
     144               CALL iom_put( "mldkz5"  , hmld - risfdep )   ! turbocline thickness 
     145            ELSE 
     146               CALL iom_put( "mldkz5"  , hmld )             ! turbocline depth 
     147            END IF 
     148         END IF 
    138149      ENDIF 
    139150       
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r6204 r6455  
    357357            DO ji = fs_2, fs_jpim1   ! vector opt. 
    358358               zcof   = zfact1 * tmask(ji,jj,jk) 
     359# if defined key_zdftmx_new 
     360               ! key_zdftmx_new: New internal wave-driven param: set a minimum value for Kz on TKE (ensure numerical stability) 
     361               zzd_up = zcof * ( MAX( avm(ji,jj,jk+1) + avm(ji,jj,jk), 2.e-5_wp ) )   &  ! upper diagonal 
     362                  &          / ( fse3t(ji,jj,jk  ) * fse3w(ji,jj,jk  ) ) 
     363               zzd_lw = zcof * ( MAX( avm(ji,jj,jk) + avm(ji,jj,jk-1), 2.e-5_wp ) )   &  ! lower diagonal 
     364                  &          / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) ) 
     365# else 
    359366               zzd_up = zcof * ( avm  (ji,jj,jk+1) + avm  (ji,jj,jk  ) )   &  ! upper diagonal 
    360367                  &          / ( fse3t(ji,jj,jk  ) * fse3w(ji,jj,jk  ) ) 
    361368               zzd_lw = zcof * ( avm  (ji,jj,jk  ) + avm  (ji,jj,jk-1) )   &  ! lower diagonal 
    362369                  &          / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) ) 
     370# endif 
    363371                  !                                                           ! shear prod. at w-point weightened by mask 
    364372               zesh2  =  ( avmu(ji-1,jj,jk) + avmu(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   & 
     
    735743      ! 
    736744      ri_cri   = 2._wp    / ( 2._wp + rn_ediss / rn_ediff )   ! resulting critical Richardson number 
     745# if defined key_zdftmx_new 
     746      ! key_zdftmx_new: New internal wave-driven param: specified value of rn_emin & rmxl_min are used 
     747      rn_emin  = 1.e-10_wp 
     748      rmxl_min = 1.e-03_wp 
     749      IF(lwp) THEN                  ! Control print 
     750         WRITE(numout,*) 
     751         WRITE(numout,*) 'zdf_tke_init :  New tidal mixing case: force rn_emin = 1.e-10 and rmxl_min = 1.e-3 ' 
     752         WRITE(numout,*) '~~~~~~~~~~~~' 
     753      ENDIF 
     754# else 
    737755      rmxl_min = 1.e-6_wp / ( rn_ediff * SQRT( rn_emin ) )    ! resulting minimum length to recover molecular viscosity 
     756# endif 
    738757      ! 
    739758      IF(lwp) THEN                    !* Control print 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90

    r5130 r6455  
    561561   END SUBROUTINE zdf_tmx_init 
    562562 
     563#elif defined key_zdftmx_new 
     564   !!---------------------------------------------------------------------- 
     565   !!   'key_zdftmx_new'               Internal wave-driven vertical mixing 
     566   !!---------------------------------------------------------------------- 
     567   !!   zdf_tmx       : global     momentum & tracer Kz with wave induced Kz 
     568   !!   zdf_tmx_init  : global     momentum & tracer Kz with wave induced Kz 
     569   !!---------------------------------------------------------------------- 
     570   USE oce            ! ocean dynamics and tracers variables 
     571   USE dom_oce        ! ocean space and time domain variables 
     572   USE zdf_oce        ! ocean vertical physics variables 
     573   USE zdfddm         ! ocean vertical physics: double diffusive mixing 
     574   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     575   USE eosbn2         ! ocean equation of state 
     576   USE phycst         ! physical constants 
     577   USE prtctl         ! Print control 
     578   USE in_out_manager ! I/O manager 
     579   USE iom            ! I/O Manager 
     580   USE lib_mpp        ! MPP library 
     581   USE wrk_nemo       ! work arrays 
     582   USE timing         ! Timing 
     583   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     584 
     585   IMPLICIT NONE 
     586   PRIVATE 
     587 
     588   PUBLIC   zdf_tmx         ! called in step module  
     589   PUBLIC   zdf_tmx_init    ! called in nemogcm module  
     590   PUBLIC   zdf_tmx_alloc   ! called in nemogcm module 
     591 
     592   LOGICAL, PUBLIC, PARAMETER ::   lk_zdftmx = .TRUE.    !: wave-driven mixing flag 
     593 
     594   !                       !!* Namelist  namzdf_tmx : internal wave-driven mixing * 
     595   INTEGER  ::  nn_zpyc     ! pycnocline-intensified mixing energy proportional to N (=1) or N^2 (=2) 
     596   LOGICAL  ::  ln_mevar    ! variable (=T) or constant (=F) mixing efficiency 
     597   LOGICAL  ::  ln_tsdiff   ! account for differential T/S wave-driven mixing (=T) or not (=F) 
     598 
     599   REAL(wp) ::  r1_6 = 1._wp / 6._wp 
     600 
     601   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ebot_tmx     ! power available from high-mode wave breaking (W/m2) 
     602   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   epyc_tmx     ! power available from low-mode, pycnocline-intensified wave breaking (W/m2) 
     603   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ecri_tmx     ! power available from low-mode, critical slope wave breaking (W/m2) 
     604   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hbot_tmx     ! WKB decay scale for high-mode energy dissipation (m) 
     605   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hcri_tmx     ! decay scale for low-mode critical slope dissipation (m) 
     606   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   emix_tmx     ! local energy density available for mixing (W/kg) 
     607   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   bflx_tmx     ! buoyancy flux Kz * N^2 (W/kg) 
     608   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   pcmap_tmx    ! vertically integrated buoyancy flux (W/m2) 
     609   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zav_ratio    ! S/T diffusivity ratio (only for ln_tsdiff=T) 
     610   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zav_wave     ! Internal wave-induced diffusivity 
     611 
     612   !! * Substitutions 
     613#  include "zdfddm_substitute.h90" 
     614#  include "domzgr_substitute.h90" 
     615#  include "vectopt_loop_substitute.h90" 
     616   !!---------------------------------------------------------------------- 
     617   !! NEMO/OPA 4.0 , NEMO Consortium (2016) 
     618   !! $Id$ 
     619   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     620   !!---------------------------------------------------------------------- 
     621CONTAINS 
     622 
     623   INTEGER FUNCTION zdf_tmx_alloc() 
     624      !!---------------------------------------------------------------------- 
     625      !!                ***  FUNCTION zdf_tmx_alloc  *** 
     626      !!---------------------------------------------------------------------- 
     627      ALLOCATE(     ebot_tmx(jpi,jpj),  epyc_tmx(jpi,jpj),  ecri_tmx(jpi,jpj)    ,   & 
     628      &             hbot_tmx(jpi,jpj),  hcri_tmx(jpi,jpj),  emix_tmx(jpi,jpj,jpk),   & 
     629      &         bflx_tmx(jpi,jpj,jpk), pcmap_tmx(jpi,jpj), zav_ratio(jpi,jpj,jpk),   &  
     630      &         zav_wave(jpi,jpj,jpk), STAT=zdf_tmx_alloc     ) 
     631      ! 
     632      IF( lk_mpp             )   CALL mpp_sum ( zdf_tmx_alloc ) 
     633      IF( zdf_tmx_alloc /= 0 )   CALL ctl_warn('zdf_tmx_alloc: failed to allocate arrays') 
     634   END FUNCTION zdf_tmx_alloc 
     635 
     636 
     637   SUBROUTINE zdf_tmx( kt ) 
     638      !!---------------------------------------------------------------------- 
     639      !!                  ***  ROUTINE zdf_tmx  *** 
     640      !!                    
     641      !! ** Purpose :   add to the vertical mixing coefficients the effect of 
     642      !!              breaking internal waves. 
     643      !! 
     644      !! ** Method  : - internal wave-driven vertical mixing is given by: 
     645      !!                  Kz_wave = min(  100 cm2/s, f(  Reb = emix_tmx /( Nu * N^2 )  ) 
     646      !!              where emix_tmx is the 3D space distribution of the wave-breaking  
     647      !!              energy and Nu the molecular kinematic viscosity. 
     648      !!              The function f(Reb) is linear (constant mixing efficiency) 
     649      !!              if the namelist parameter ln_mevar = F and nonlinear if ln_mevar = T. 
     650      !! 
     651      !!              - Compute emix_tmx, the 3D power density that allows to compute 
     652      !!              Reb and therefrom the wave-induced vertical diffusivity. 
     653      !!              This is divided into three components: 
     654      !!                 1. Bottom-intensified low-mode dissipation at critical slopes 
     655      !!                     emix_tmx(z) = ( ecri_tmx / rau0 ) * EXP( -(H-z)/hcri_tmx ) 
     656      !!                                   / ( 1. - EXP( - H/hcri_tmx ) ) * hcri_tmx 
     657      !!              where hcri_tmx is the characteristic length scale of the bottom  
     658      !!              intensification, ecri_tmx a map of available power, and H the ocean depth. 
     659      !!                 2. Pycnocline-intensified low-mode dissipation 
     660      !!                     emix_tmx(z) = ( epyc_tmx / rau0 ) * ( sqrt(rn2(z))^nn_zpyc ) 
     661      !!                                   / SUM( sqrt(rn2(z))^nn_zpyc * e3w(z) ) 
     662      !!              where epyc_tmx is a map of available power, and nn_zpyc 
     663      !!              is the chosen stratification-dependence of the internal wave 
     664      !!              energy dissipation. 
     665      !!                 3. WKB-height dependent high mode dissipation 
     666      !!                     emix_tmx(z) = ( ebot_tmx / rau0 ) * rn2(z) * EXP(-z_wkb(z)/hbot_tmx) 
     667      !!                                   / SUM( rn2(z) * EXP(-z_wkb(z)/hbot_tmx) * e3w(z) ) 
     668      !!              where hbot_tmx is the characteristic length scale of the WKB bottom  
     669      !!              intensification, ebot_tmx is a map of available power, and z_wkb is the 
     670      !!              WKB-stretched height above bottom defined as 
     671      !!                    z_wkb(z) = H * SUM( sqrt(rn2(z'>=z)) * e3w(z'>=z) ) 
     672      !!                                 / SUM( sqrt(rn2(z'))    * e3w(z')    ) 
     673      !! 
     674      !!              - update the model vertical eddy viscosity and diffusivity:  
     675      !!                     avt  = avt  +    av_wave 
     676      !!                     avm  = avm  +    av_wave 
     677      !!                     avmu = avmu + mi(av_wave) 
     678      !!                     avmv = avmv + mj(av_wave) 
     679      !! 
     680      !!              - if namelist parameter ln_tsdiff = T, account for differential mixing: 
     681      !!                     avs  = avt  +    av_wave * diffusivity_ratio(Reb) 
     682      !! 
     683      !! ** Action  : - Define emix_tmx used to compute internal wave-induced mixing 
     684      !!              - avt, avs, avm, avmu, avmv increased by internal wave-driven mixing     
     685      !! 
     686      !! References :  de Lavergne et al. 2015, JPO; 2016, in prep. 
     687      !!---------------------------------------------------------------------- 
     688      INTEGER, INTENT(in) ::   kt   ! ocean time-step  
     689      ! 
     690      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     691      REAL(wp) ::   ztpc         ! scalar workspace 
     692      REAL(wp), DIMENSION(:,:)  , POINTER ::  zfact     ! Used for vertical structure 
     693      REAL(wp), DIMENSION(:,:)  , POINTER ::  zhdep     ! Ocean depth 
     694      REAL(wp), DIMENSION(:,:,:), POINTER ::  zwkb      ! WKB-stretched height above bottom 
     695      REAL(wp), DIMENSION(:,:,:), POINTER ::  zweight   ! Weight for high mode vertical distribution 
     696      REAL(wp), DIMENSION(:,:,:), POINTER ::  znu_t     ! Molecular kinematic viscosity (T grid) 
     697      REAL(wp), DIMENSION(:,:,:), POINTER ::  znu_w     ! Molecular kinematic viscosity (W grid) 
     698      REAL(wp), DIMENSION(:,:,:), POINTER ::  zReb      ! Turbulence intensity parameter 
     699      !!---------------------------------------------------------------------- 
     700      ! 
     701      IF( nn_timing == 1 )   CALL timing_start('zdf_tmx') 
     702      ! 
     703      CALL wrk_alloc( jpi,jpj,       zfact, zhdep ) 
     704      CALL wrk_alloc( jpi,jpj,jpk,   zwkb, zweight, znu_t, znu_w, zReb ) 
     705 
     706      !                          ! ----------------------------- ! 
     707      !                          !  Internal wave-driven mixing  !  (compute zav_wave) 
     708      !                          ! ----------------------------- ! 
     709      !                              
     710      !                        !* Critical slope mixing: distribute energy over the time-varying ocean depth, 
     711      !                                                 using an exponential decay from the seafloor. 
     712      DO jj = 1, jpj                ! part independent of the level 
     713         DO ji = 1, jpi 
     714            zhdep(ji,jj) = fsdepw(ji,jj,mbkt(ji,jj)+1)       ! depth of the ocean 
     715            zfact(ji,jj) = rau0 * (  1._wp - EXP( -zhdep(ji,jj) / hcri_tmx(ji,jj) )  ) 
     716            IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = ecri_tmx(ji,jj) / zfact(ji,jj) 
     717         END DO 
     718      END DO 
     719 
     720      DO jk = 2, jpkm1              ! complete with the level-dependent part 
     721         emix_tmx(:,:,jk) = zfact(:,:) * (  EXP( ( fsde3w(:,:,jk  ) - zhdep(:,:) ) / hcri_tmx(:,:) )                      & 
     722            &                             - EXP( ( fsde3w(:,:,jk-1) - zhdep(:,:) ) / hcri_tmx(:,:) )  ) * wmask(:,:,jk)   & 
     723            &                          / ( fsde3w(:,:,jk) - fsde3w(:,:,jk-1) ) 
     724      END DO 
     725 
     726      !                        !* Pycnocline-intensified mixing: distribute energy over the time-varying  
     727      !                        !* ocean depth as proportional to sqrt(rn2)^nn_zpyc 
     728 
     729      SELECT CASE ( nn_zpyc ) 
     730 
     731      CASE ( 1 )               ! Dissipation scales as N (recommended) 
     732 
     733         zfact(:,:) = 0._wp 
     734         DO jk = 2, jpkm1              ! part independent of the level 
     735            zfact(:,:) = zfact(:,:) + fse3w(:,:,jk) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk) 
     736         END DO 
     737 
     738         DO jj = 1, jpj 
     739            DO ji = 1, jpi 
     740               IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_tmx(ji,jj) / ( rau0 * zfact(ji,jj) ) 
     741            END DO 
     742         END DO 
     743 
     744         DO jk = 2, jpkm1              ! complete with the level-dependent part 
     745            emix_tmx(:,:,jk) = emix_tmx(:,:,jk) + zfact(:,:) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk) 
     746         END DO 
     747 
     748      CASE ( 2 )               ! Dissipation scales as N^2 
     749 
     750         zfact(:,:) = 0._wp 
     751         DO jk = 2, jpkm1              ! part independent of the level 
     752            zfact(:,:) = zfact(:,:) + fse3w(:,:,jk) * MAX( 0._wp, rn2(:,:,jk) ) * wmask(:,:,jk) 
     753         END DO 
     754 
     755         DO jj= 1, jpj 
     756            DO ji = 1, jpi 
     757               IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_tmx(ji,jj) / ( rau0 * zfact(ji,jj) ) 
     758            END DO 
     759         END DO 
     760 
     761         DO jk = 2, jpkm1              ! complete with the level-dependent part 
     762            emix_tmx(:,:,jk) = emix_tmx(:,:,jk) + zfact(:,:) * MAX( 0._wp, rn2(:,:,jk) ) * wmask(:,:,jk) 
     763         END DO 
     764 
     765      END SELECT 
     766 
     767      !                        !* WKB-height dependent mixing: distribute energy over the time-varying  
     768      !                        !* ocean depth as proportional to rn2 * exp(-z_wkb/rn_hbot) 
     769       
     770      zwkb(:,:,:) = 0._wp 
     771      zfact(:,:) = 0._wp 
     772      DO jk = 2, jpkm1 
     773         zfact(:,:) = zfact(:,:) + fse3w(:,:,jk) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk) 
     774         zwkb(:,:,jk) = zfact(:,:) 
     775      END DO 
     776 
     777      DO jk = 2, jpkm1 
     778         DO jj = 1, jpj 
     779            DO ji = 1, jpi 
     780               IF( zfact(ji,jj) /= 0 )   zwkb(ji,jj,jk) = zhdep(ji,jj) * ( zfact(ji,jj) - zwkb(ji,jj,jk) )   & 
     781                                            &           * tmask(ji,jj,jk) / zfact(ji,jj) 
     782            END DO 
     783         END DO 
     784      END DO 
     785      zwkb(:,:,1) = zhdep(:,:) * tmask(:,:,1) 
     786 
     787      zweight(:,:,:) = 0._wp 
     788      DO jk = 2, jpkm1 
     789         zweight(:,:,jk) = MAX( 0._wp, rn2(:,:,jk) ) * hbot_tmx(:,:) * wmask(:,:,jk)                    & 
     790            &   * (  EXP( -zwkb(:,:,jk) / hbot_tmx(:,:) ) - EXP( -zwkb(:,:,jk-1) / hbot_tmx(:,:) )  ) 
     791      END DO 
     792 
     793      zfact(:,:) = 0._wp 
     794      DO jk = 2, jpkm1              ! part independent of the level 
     795         zfact(:,:) = zfact(:,:) + zweight(:,:,jk) 
     796      END DO 
     797 
     798      DO jj = 1, jpj 
     799         DO ji = 1, jpi 
     800            IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = ebot_tmx(ji,jj) / ( rau0 * zfact(ji,jj) ) 
     801         END DO 
     802      END DO 
     803 
     804      DO jk = 2, jpkm1              ! complete with the level-dependent part 
     805         emix_tmx(:,:,jk) = emix_tmx(:,:,jk) + zweight(:,:,jk) * zfact(:,:) * wmask(:,:,jk)   & 
     806            &                                / ( fsde3w(:,:,jk) - fsde3w(:,:,jk-1) ) 
     807      END DO 
     808 
     809 
     810      ! Calculate molecular kinematic viscosity 
     811      znu_t(:,:,:) = 1.e-4_wp * (  17.91_wp - 0.53810_wp * tsn(:,:,:,jp_tem) + 0.00694_wp * tsn(:,:,:,jp_tem) * tsn(:,:,:,jp_tem)  & 
     812         &                                  + 0.02305_wp * tsn(:,:,:,jp_sal)  ) * tmask(:,:,:) * r1_rau0 
     813      DO jk = 2, jpkm1 
     814         znu_w(:,:,jk) = 0.5_wp * ( znu_t(:,:,jk-1) + znu_t(:,:,jk) ) * wmask(:,:,jk) 
     815      END DO 
     816 
     817      ! Calculate turbulence intensity parameter Reb 
     818      DO jk = 2, jpkm1 
     819         zReb(:,:,jk) = emix_tmx(:,:,jk) / MAX( 1.e-20_wp, znu_w(:,:,jk) * rn2(:,:,jk) ) 
     820      END DO 
     821 
     822      ! Define internal wave-induced diffusivity 
     823      DO jk = 2, jpkm1 
     824         zav_wave(:,:,jk) = znu_w(:,:,jk) * zReb(:,:,jk) * r1_6   ! This corresponds to a constant mixing efficiency of 1/6 
     825      END DO 
     826 
     827      IF( ln_mevar ) THEN              ! Variable mixing efficiency case : modify zav_wave in the 
     828         DO jk = 2, jpkm1              ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes 
     829            DO jj = 1, jpj 
     830               DO ji = 1, jpi 
     831                  IF( zReb(ji,jj,jk) > 480.00_wp ) THEN 
     832                     zav_wave(ji,jj,jk) = 3.6515_wp * znu_w(ji,jj,jk) * SQRT( zReb(ji,jj,jk) ) 
     833                  ELSEIF( zReb(ji,jj,jk) < 10.224_wp ) THEN 
     834                     zav_wave(ji,jj,jk) = 0.052125_wp * znu_w(ji,jj,jk) * zReb(ji,jj,jk) * SQRT( zReb(ji,jj,jk) ) 
     835                  ENDIF 
     836               END DO 
     837            END DO 
     838         END DO 
     839      ENDIF 
     840 
     841      DO jk = 2, jpkm1                 ! Bound diffusivity by molecular value and 100 cm2/s 
     842         zav_wave(:,:,jk) = MIN(  MAX( 1.4e-7_wp, zav_wave(:,:,jk) ), 1.e-2_wp  ) * wmask(:,:,jk) 
     843      END DO 
     844 
     845      IF( kt == nit000 ) THEN        !* Control print at first time-step: diagnose the energy consumed by zav_wave 
     846         ztpc = 0._wp 
     847         DO jk = 2, jpkm1 
     848            DO jj = 1, jpj 
     849               DO ji = 1, jpi 
     850                  ztpc = ztpc + fse3w(ji,jj,jk) * e1e2t(ji,jj)   & 
     851                     &         * MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 
     852               END DO 
     853            END DO 
     854         END DO 
     855         IF( lk_mpp )   CALL mpp_sum( ztpc ) 
     856         ztpc = rau0 * ztpc ! Global integral of rauo * Kz * N^2 = power contributing to mixing  
     857  
     858         IF(lwp) THEN 
     859            WRITE(numout,*) 
     860            WRITE(numout,*) 'zdf_tmx : Internal wave-driven mixing (tmx)' 
     861            WRITE(numout,*) '~~~~~~~ ' 
     862            WRITE(numout,*) 
     863            WRITE(numout,*) '      Total power consumption by av_wave: ztpc =  ', ztpc * 1.e-12_wp, 'TW' 
     864         ENDIF 
     865      ENDIF 
     866 
     867      !                          ! ----------------------- ! 
     868      !                          !   Update  mixing coefs  !                           
     869      !                          ! ----------------------- ! 
     870      !       
     871      IF( ln_tsdiff ) THEN          !* Option for differential mixing of salinity and temperature 
     872         DO jk = 2, jpkm1              ! Calculate S/T diffusivity ratio as a function of Reb 
     873            DO jj = 1, jpj 
     874               DO ji = 1, jpi 
     875                  zav_ratio(ji,jj,jk) = ( 0.505_wp + 0.495_wp *                                                                  & 
     876                      &   TANH(    0.92_wp * (   LOG10(  MAX( 1.e-20_wp, zReb(ji,jj,jk) * 5._wp * r1_6 )  ) - 0.60_wp   )    )   & 
     877                      &                 ) * wmask(ji,jj,jk) 
     878               END DO 
     879            END DO 
     880         END DO 
     881         CALL iom_put( "av_ratio", zav_ratio ) 
     882         DO jk = 2, jpkm1           !* update momentum & tracer diffusivity with wave-driven mixing 
     883            fsavs(:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk) * zav_ratio(:,:,jk) 
     884            avt  (:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk) 
     885            avm  (:,:,jk) = avm(:,:,jk) + zav_wave(:,:,jk) 
     886         END DO 
     887         ! 
     888      ELSE                          !* update momentum & tracer diffusivity with wave-driven mixing 
     889         DO jk = 2, jpkm1 
     890            fsavs(:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk) 
     891            avt  (:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk) 
     892            avm  (:,:,jk) = avm(:,:,jk) + zav_wave(:,:,jk) 
     893         END DO 
     894      ENDIF 
     895 
     896      DO jk = 2, jpkm1              !* update momentum diffusivity at wu and wv points 
     897         DO jj = 2, jpjm1 
     898            DO ji = fs_2, fs_jpim1  ! vector opt. 
     899               avmu(ji,jj,jk) = avmu(ji,jj,jk) + 0.5_wp * ( zav_wave(ji,jj,jk) + zav_wave(ji+1,jj  ,jk) ) * wumask(ji,jj,jk) 
     900               avmv(ji,jj,jk) = avmv(ji,jj,jk) + 0.5_wp * ( zav_wave(ji,jj,jk) + zav_wave(ji  ,jj+1,jk) ) * wvmask(ji,jj,jk) 
     901            END DO 
     902         END DO 
     903      END DO 
     904      CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )      ! lateral boundary condition 
     905 
     906      !                             !* output internal wave-driven mixing coefficient 
     907      CALL iom_put( "av_wave", zav_wave ) 
     908                                    !* output useful diagnostics: N^2, Kz * N^2 (bflx_tmx),  
     909                                    !  vertical integral of rau0 * Kz * N^2 (pcmap_tmx), energy density (emix_tmx) 
     910      IF( iom_use("bflx_tmx") .OR. iom_use("pcmap_tmx") ) THEN 
     911         bflx_tmx(:,:,:) = MAX( 0._wp, rn2(:,:,:) ) * zav_wave(:,:,:) 
     912         pcmap_tmx(:,:) = 0._wp 
     913         DO jk = 2, jpkm1 
     914            pcmap_tmx(:,:) = pcmap_tmx(:,:) + fse3w(:,:,jk) * bflx_tmx(:,:,jk) * wmask(:,:,jk) 
     915         END DO 
     916         pcmap_tmx(:,:) = rau0 * pcmap_tmx(:,:) 
     917         CALL iom_put( "bflx_tmx", bflx_tmx ) 
     918         CALL iom_put( "pcmap_tmx", pcmap_tmx ) 
     919      ENDIF 
     920      CALL iom_put( "bn2", rn2 ) 
     921      CALL iom_put( "emix_tmx", emix_tmx ) 
     922       
     923      CALL wrk_dealloc( jpi,jpj,       zfact, zhdep ) 
     924      CALL wrk_dealloc( jpi,jpj,jpk,   zwkb, zweight, znu_t, znu_w, zReb ) 
     925 
     926      IF(ln_ctl)   CALL prt_ctl(tab3d_1=zav_wave , clinfo1=' tmx - av_wave: ', tab3d_2=avt, clinfo2=' avt: ', ovlap=1, kdim=jpk) 
     927      ! 
     928      IF( nn_timing == 1 )   CALL timing_stop('zdf_tmx') 
     929      ! 
     930   END SUBROUTINE zdf_tmx 
     931 
     932 
     933   SUBROUTINE zdf_tmx_init 
     934      !!---------------------------------------------------------------------- 
     935      !!                  ***  ROUTINE zdf_tmx_init  *** 
     936      !!                      
     937      !! ** Purpose :   Initialization of the wave-driven vertical mixing, reading 
     938      !!              of input power maps and decay length scales in netcdf files. 
     939      !! 
     940      !! ** Method  : - Read the namzdf_tmx namelist and check the parameters 
     941      !! 
     942      !!              - Read the input data in NetCDF files : 
     943      !!              power available from high-mode wave breaking (mixing_power_bot.nc) 
     944      !!              power available from pycnocline-intensified wave-breaking (mixing_power_pyc.nc) 
     945      !!              power available from critical slope wave-breaking (mixing_power_cri.nc) 
     946      !!              WKB decay scale for high-mode wave-breaking (decay_scale_bot.nc) 
     947      !!              decay scale for critical slope wave-breaking (decay_scale_cri.nc) 
     948      !! 
     949      !! ** input   : - Namlist namzdf_tmx 
     950      !!              - NetCDF files : mixing_power_bot.nc, mixing_power_pyc.nc, mixing_power_cri.nc, 
     951      !!              decay_scale_bot.nc decay_scale_cri.nc 
     952      !! 
     953      !! ** Action  : - Increase by 1 the nstop flag is setting problem encounter 
     954      !!              - Define ebot_tmx, epyc_tmx, ecri_tmx, hbot_tmx, hcri_tmx 
     955      !! 
     956      !! References : de Lavergne et al. 2015, JPO; 2016, in prep. 
     957      !!          
     958      !!---------------------------------------------------------------------- 
     959      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     960      INTEGER  ::   inum         ! local integer 
     961      INTEGER  ::   ios 
     962      REAL(wp) ::   zbot, zpyc, zcri   ! local scalars 
     963      !! 
     964      NAMELIST/namzdf_tmx_new/ nn_zpyc, ln_mevar, ln_tsdiff 
     965      !!---------------------------------------------------------------------- 
     966      ! 
     967      IF( nn_timing == 1 )  CALL timing_start('zdf_tmx_init') 
     968      ! 
     969      REWIND( numnam_ref )              ! Namelist namzdf_tmx in reference namelist : Wave-driven mixing 
     970      READ  ( numnam_ref, namzdf_tmx_new, IOSTAT = ios, ERR = 901) 
     971901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_tmx in reference namelist', lwp ) 
     972      ! 
     973      REWIND( numnam_cfg )              ! Namelist namzdf_tmx in configuration namelist : Wave-driven mixing 
     974      READ  ( numnam_cfg, namzdf_tmx_new, IOSTAT = ios, ERR = 902 ) 
     975902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_tmx in configuration namelist', lwp ) 
     976      IF(lwm) WRITE ( numond, namzdf_tmx_new ) 
     977      ! 
     978      IF(lwp) THEN                  ! Control print 
     979         WRITE(numout,*) 
     980         WRITE(numout,*) 'zdf_tmx_init : internal wave-driven mixing' 
     981         WRITE(numout,*) '~~~~~~~~~~~~' 
     982         WRITE(numout,*) '   Namelist namzdf_tmx_new : set wave-driven mixing parameters' 
     983         WRITE(numout,*) '      Pycnocline-intensified diss. scales as N (=1) or N^2 (=2) = ', nn_zpyc 
     984         WRITE(numout,*) '      Variable (T) or constant (F) mixing efficiency            = ', ln_mevar 
     985         WRITE(numout,*) '      Differential internal wave-driven mixing (T) or not (F)   = ', ln_tsdiff 
     986      ENDIF 
     987       
     988      ! The new wave-driven mixing parameterization elevates avt and avm in the interior, and 
     989      ! ensures that avt remains larger than its molecular value (=1.4e-7). Therefore, avtb should  
     990      ! be set here to a very small value, and avmb to its (uniform) molecular value (=1.4e-6). 
     991      avmb(:) = 1.4e-6_wp        ! viscous molecular value 
     992      avtb(:) = 1.e-10_wp        ! very small diffusive minimum (background avt is specified in zdf_tmx)     
     993      avtb_2d(:,:) = 1.e0_wp     ! uniform  
     994      IF(lwp) THEN                  ! Control print 
     995         WRITE(numout,*) 
     996         WRITE(numout,*) '   Force the background value applied to avm & avt in TKE to be everywhere ',   & 
     997            &               'the viscous molecular value & a very small diffusive value, resp.' 
     998      ENDIF 
     999       
     1000      IF( .NOT.lk_zdfddm )   CALL ctl_stop( 'STOP', 'zdf_tmx_init_new : key_zdftmx_new requires key_zdfddm' ) 
     1001       
     1002      !                             ! allocate tmx arrays 
     1003      IF( zdf_tmx_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_tmx_init : unable to allocate tmx arrays' ) 
     1004      ! 
     1005      !                             ! read necessary fields 
     1006      CALL iom_open('mixing_power_bot',inum)       ! energy flux for high-mode wave breaking [W/m2] 
     1007      CALL iom_get  (inum, jpdom_data, 'field', ebot_tmx, 1 )  
     1008      CALL iom_close(inum) 
     1009      ! 
     1010      CALL iom_open('mixing_power_pyc',inum)       ! energy flux for pynocline-intensified wave breaking [W/m2] 
     1011      CALL iom_get  (inum, jpdom_data, 'field', epyc_tmx, 1 ) 
     1012      CALL iom_close(inum) 
     1013      ! 
     1014      CALL iom_open('mixing_power_cri',inum)       ! energy flux for critical slope wave breaking [W/m2] 
     1015      CALL iom_get  (inum, jpdom_data, 'field', ecri_tmx, 1 ) 
     1016      CALL iom_close(inum) 
     1017      ! 
     1018      CALL iom_open('decay_scale_bot',inum)        ! spatially variable decay scale for high-mode wave breaking [m] 
     1019      CALL iom_get  (inum, jpdom_data, 'field', hbot_tmx, 1 ) 
     1020      CALL iom_close(inum) 
     1021      ! 
     1022      CALL iom_open('decay_scale_cri',inum)        ! spatially variable decay scale for critical slope wave breaking [m] 
     1023      CALL iom_get  (inum, jpdom_data, 'field', hcri_tmx, 1 ) 
     1024      CALL iom_close(inum) 
     1025 
     1026      ebot_tmx(:,:) = ebot_tmx(:,:) * ssmask(:,:) 
     1027      epyc_tmx(:,:) = epyc_tmx(:,:) * ssmask(:,:) 
     1028      ecri_tmx(:,:) = ecri_tmx(:,:) * ssmask(:,:) 
     1029 
     1030      ! Set once for all to zero the first and last vertical levels of appropriate variables 
     1031      emix_tmx (:,:, 1 ) = 0._wp 
     1032      emix_tmx (:,:,jpk) = 0._wp 
     1033      zav_ratio(:,:, 1 ) = 0._wp 
     1034      zav_ratio(:,:,jpk) = 0._wp 
     1035      zav_wave (:,:, 1 ) = 0._wp 
     1036      zav_wave (:,:,jpk) = 0._wp 
     1037 
     1038      zbot = glob_sum( e1e2t(:,:) * ebot_tmx(:,:) ) 
     1039      zpyc = glob_sum( e1e2t(:,:) * epyc_tmx(:,:) ) 
     1040      zcri = glob_sum( e1e2t(:,:) * ecri_tmx(:,:) ) 
     1041      IF(lwp) THEN 
     1042         WRITE(numout,*) '      High-mode wave-breaking energy:             ', zbot * 1.e-12_wp, 'TW' 
     1043         WRITE(numout,*) '      Pycnocline-intensifed wave-breaking energy: ', zpyc * 1.e-12_wp, 'TW' 
     1044         WRITE(numout,*) '      Critical slope wave-breaking energy:        ', zcri * 1.e-12_wp, 'TW' 
     1045      ENDIF 
     1046      ! 
     1047      IF( nn_timing == 1 )  CALL timing_stop('zdf_tmx_init') 
     1048      ! 
     1049   END SUBROUTINE zdf_tmx_init 
     1050 
    5631051#else 
    5641052   !!---------------------------------------------------------------------- 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/OPA_SRC/step.F90

    r6204 r6455  
    338338      ! 
    339339      IF( lrst_oce         )   CALL rst_write( kstp )       ! write output ocean restart file 
     340      IF( ln_sto_eos       )   CALL sto_rst_write( kstp )   ! write restart file for stochastic parameters 
    340341 
    341342#if defined key_agrif 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90

    r6453 r6455  
    121121   REAL(wp) :: devk510  = 0.0 
    122122   ! 
    123  
    124  
    125123   ! General parameters 
    126124   REAL(wp), PARAMETER :: pp_rdel_ah_target = 1.E-4_wp 
     
    133131   ! - SOLVE_AT_GENERAL 
    134132   INTEGER :: niter_atgen    = jp_maxniter_atgen 
    135  
    136  
    137133 
    138134   !!* Substitution 
     
    182178            zcek1 = 9345.17/ztkel - 60.2409 + 23.3585 * LOG(zt) + zsal*(0.023517 - 0.00023656*ztkel    & 
    183179            &       + 0.0047036e-4*ztkel**2) 
    184             !                             ! SET SOLUBILITIES OF O2 AND CO2  
    185180            chemc(ji,jj,1) = EXP( zcek1 ) * 1E-6 ! mol/(kg atm) 
    186181            chemc(ji,jj,2) = -1636.75 + 12.0408*ztkel - 0.0327957*ztkel**2 + 0.0000316528*ztkel**3 
     
    261256               &         + LOG(1.0 - 0.001005 * zsal)) 
    262257 
    263  
    264258               ! DISSOCIATION CONSTANT FOR FLUORIDES on free H scale (Dickson and Riley 79) 
    265259               zckf    = EXP( 1590.2*ztr - 12.641 + 1.525*zisqrt   & 
     
    267261               &         + LOG(1.0d0 + zst/zcks)) 
    268262 
    269  
    270                ! DISSOCIATION CONSTANT FOR BORATE 
     263               ! DISSOCIATION CONSTANT FOR CARBONATE AND BORATE 
    271264               zckb=  (-8966.90 - 2890.53*zsqrt - 77.942*zsal        & 
    272265               &      + 1.728*zsal15 - 0.0996*zsal*zsal)*ztr         & 
    273266               &      + (148.0248 + 137.1942*zsqrt + 1.62142*zsal)   & 
    274                &      + (-24.4344 - 25.085*zsqrt - 0.2474*zsal)      & 
     267               &      + (-24.4344 - 25.085*zsqrt - 0.2474*zsal)      &  
    275268               &      * zlogt + 0.053105*zsqrt*ztkel 
    276269 
     
    281274               zck2    = -1.0*(471.78*ztr + 25.9290 - 3.16967*zlogt      & 
    282275                  - 0.01781*zsal + 0.0001122*zsal*zsal) 
    283  
    284276 
    285277               ! PKW (H2O) (MILLERO, 1995) from composite data 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90

    r6453 r6455  
    178178            zfco2 = satmco2(ji,jj) * ( patm(ji,jj) - zvapsw ) * zfugcoeff 
    179179            ! Compute CO2 flux for the sea and air 
    180             zfld = zfco2 * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj)   ! (mol/L) * (m/s) 
     180            zfld = satmco2(ji,jj) * patm(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj)   ! (mol/L) * (m/s) 
    181181            zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj)                                   ! (mol/L) (m/s) ? 
    182182            oce_co2(ji,jj) = ( zfld - zflu ) * rfact2 * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000. 
     
    216216         ENDIF 
    217217         IF( iom_use( "Dpco2" ) ) THEN 
    218            zw2d(:,:) = oce_co2(:,:) / e1e2t(:,:) / 1000. * rfact2r * tmask(:,:,1) / ( zkgco2(:,:) * chemc(:,:,1) + rtrn ) 
     218           zw2d(:,:) = ( satmco2(:,:) * patm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) 
    219219           CALL iom_put( "Dpco2" ,  zw2d ) 
    220220         ENDIF 
     
    233233            trc2d(:,:,jp_pcs0_2d + 2) = zkgco2(:,:) * tmask(:,:,1) 
    234234            trc2d(:,:,jp_pcs0_2d + 3) = ( satmco2(:,:) * patm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) 
    235          ENDIF 
    236       ENDIF 
    237  
    238       IF( ln_diatrc ) THEN 
    239          IF( lk_iomput .AND. knt == nrdttrc ) THEN 
    240             CALL iom_put( "Cflx" , oce_co2(:,:) / e1e2t(:,:) / rfact )  
    241             CALL iom_put( "Oflx" , zoflx(:,:) * 1000 * tmask(:,:,1)  ) 
    242             CALL iom_put( "Kg"   , zkgco2(:,:) * tmask(:,:,1) ) 
    243             CALL iom_put( "Dpco2", ( satmco2(:,:) * patm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) ) 
    244             CALL iom_put( "Dpo2" , ( atcox * patm(:,:) - trb(:,:,1,jpoxy) * atcox / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1) ) 
    245          ELSE 
    246             trc2d(:,:,jp_pcs0_2d    ) = oce_co2(:,:) / e1e2t(:,:) / rfact  
    247             trc2d(:,:,jp_pcs0_2d + 1) = zoflx(:,:) * 1000 * tmask(:,:,1)  
    248             trc2d(:,:,jp_pcs0_2d + 2) = zkgco2(:,:) * tmask(:,:,1)  
    249             trc2d(:,:,jp_pcs0_2d + 3) = ( satmco2(:,:) * patm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1)  
    250235         ENDIF 
    251236      ENDIF 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90

    r6453 r6455  
    7272      CHARACTER (len=25) :: charout 
    7373      REAL(wp), POINTER, DIMENSION(:,:  ) :: zpdep, zsidep, zwork1, zwork2, zwork3 
     74      REAL(wp), POINTER, DIMENSION(:,:)   :: zsedcal, zsedsi, zsedc 
    7475      REAL(wp), POINTER, DIMENSION(:,:  ) :: zdenit2d, zironice, zbureff 
    7576      REAL(wp), POINTER, DIMENSION(:,:  ) :: zwsbio3, zwsbio4, zwscal 
     
    8788      ! Allocate temporary workspace 
    8889      CALL wrk_alloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff ) 
     90      CALL wrk_alloc( jpi, jpj, zsedcal,  zsedsi, zsedc ) 
    8991      CALL wrk_alloc( jpi, jpj, zwsbio3, zwsbio4, zwscal ) 
    9092      CALL wrk_alloc( jpi, jpj, jpk, zsoufer ) 
     
    98100      zwork2  (:,:) = 0.e0 
    99101      zwork3  (:,:) = 0.e0 
     102      zsedsi   (:,:) = 0.e0 
     103      zsedcal  (:,:) = 0.e0 
     104      zsedc    (:,:) = 0.e0 
    100105 
    101106      ! Iron input/uptake due to sea ice : Crude parameterization based on Lancelot et al. 
     
    315320            tra(ji,jj,ikt,jptal) =  tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0 
    316321            tra(ji,jj,ikt,jpdic) =  tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk 
     322            zsedcal(ji,jj) = (1.0 - zrivalk) * zcaloss / zdep 
     323            zsedsi (ji,jj) = (1.0 - zrivsil) * zsiloss / zdep 
    317324#endif 
    318325         END DO 
     
    362369            tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * (zpdenit + zdenitt) ) 
    363370            tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit + zdenitt 
    364             sdenit(ji,jj) = rdenit * zpdenit * fse3t(ji,jj,ikt) 
     371            sdenit(ji,jj) = rdenit * zpdenit / zdep 
     372            zsedc(ji,jj)   = (1. - zrivno3) * zwstpoc / zdep 
    365373#endif 
    366374         END DO 
     
    418426               CALL iom_put( "INTNFIX" , zwork1 )  
    419427            ENDIF 
     428            IF( iom_use("SedCal" ) ) CALL iom_put( "SedCal", zsedcal(:,:) * 1.e+3 ) 
     429            IF( iom_use("SedSi" ) )  CALL iom_put( "SedSi",  zsedsi (:,:) * 1.e+3 ) 
     430            IF( iom_use("SedC" ) )   CALL iom_put( "SedC",   zsedc  (:,:) * 1.e+3 ) 
     431            IF( iom_use("Sdenit" ) ) CALL iom_put( "Sdenit", sdenit (:,:) * 1.e+3 * rno3 ) 
    420432         ENDIF 
    421433      ELSE 
     
    431443      ! 
    432444      CALL wrk_dealloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff ) 
     445      CALL wrk_dealloc( jpi, jpj, zsedcal , zsedsi, zsedc ) 
    433446      CALL wrk_dealloc( jpi, jpj, zwsbio3, zwsbio4, zwscal ) 
    434447      CALL wrk_dealloc( jpi, jpj, jpk, zsoufer ) 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90

    r6453 r6455  
    100100   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hi         !: ??? 
    101101   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   excess     !: ??? 
     102   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aphscale   !:  
     103 
    102104 
    103105   !!* Temperature dependancy of SMS terms 
     
    168170      ALLOCATE( ak13  (jpi,jpj,jpk) ,                              & 
    169171         &      ak23(jpi,jpj,jpk)    , aksp  (jpi,jpj,jpk) ,       & 
    170          &      hi  (jpi,jpj,jpk)    , excess(jpi,jpj,jpk) ,     STAT=ierr(4) ) 
     172         &      hi  (jpi,jpj,jpk)    , excess(jpi,jpj,jpk) ,       & 
     173         &      aphscale(jpi,jpj,jpk),                           STAT=ierr(4) ) 
    171174         ! 
    172175      !* Temperature dependancy of SMS terms 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90

    r6453 r6455  
    277277      po4r    =   1._wp / 122._wp 
    278278      o2nit   =  32._wp / 122._wp 
    279       rdenit  = 105._wp /  16._wp 
     279      o2ut    = 133._wp / 122._wp 
     280      rdenit  =  ( ( o2ut + o2nit ) * 0.80 - rno3 - rno3 * 0.60 ) / rno3 
    280281      rdenita =   3._wp /  5._wp 
    281       o2ut    = 133._wp / 122._wp 
     282 
    282283 
    283284      ! Initialization of tracer concentration in case of  no restart  
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    r5506 r6455  
    107107                
    108108               jl = n_trc_index(jn)  
    109                CALL trc_dta( kt, sf_trcdta(jl),rf_trfac(jl) )   ! read tracer data at nit000 
    110                ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) 
     109               CALL trc_dta( kt, sf_trcdta(jl) )   ! read tracer data at nit000 
     110               ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) * tmask(:,:,:) * rf_trfac(jl) 
    111111 
    112112               SELECT CASE ( nn_zdmp_tr ) 
     
    187187      INTEGER :: ji , jj, jk, jn, jl, jc                     ! dummy loop indicesa 
    188188      INTEGER :: isrow                                      ! local index 
    189       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta       ! 3D  workspace 
    190189 
    191190      !!---------------------------------------------------------------------- 
     
    278277         IF(lwp)  WRITE(numout,*) 
    279278         ! 
    280          CALL wrk_alloc( jpi, jpj, jpk, ztrcdta )   ! Memory allocation 
    281          ! 
    282279         DO jn = 1, jptra 
    283280            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
    284281                jl = n_trc_index(jn) 
    285                 CALL trc_dta( kt, sf_trcdta(jl),rf_trfac(jl) )   ! read tracer data at nit000 
    286                 ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) 
     282                CALL trc_dta( kt, sf_trcdta(jl) )   ! read tracer data at nit000 
    287283                DO jc = 1, npncts 
    288284                   DO jk = 1, jpkm1 
    289285                      DO jj = nctsj1(jc), nctsj2(jc) 
    290286                         DO ji = nctsi1(jc), nctsi2(jc) 
    291                             trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk) * tmask(ji,jj,jk) 
     287                            trn(ji,jj,jk,jn) = sf_trcdta(jl)%fnow(ji,jj,jk) * tmask(ji,jj,jk) * rf_trfac(jl) 
    292288                            trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 
    293289                         ENDDO 
     
    297293             ENDIF 
    298294          ENDDO 
    299           CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 
     295          ! 
    300296      ENDIF 
    301297      ! 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90

    r5385 r6455  
    5656      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    5757      !! 
    58       INTEGER            :: jn 
     58      INTEGER            :: ji, jj, jk, jn 
     59      REAL(wp)           :: zdep 
    5960      CHARACTER (len=22) :: charout 
    6061      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd 
     
    6667 
    6768      rldf = rldf_rat 
    68  
     69      ! 
     70      r_fact_lap(:,:,:) = 1. 
     71      DO jk= 1, jpk 
     72         DO jj = 1, jpj 
     73            DO ji = 1, jpi 
     74               IF( fsdept(ji,jj,jk) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN 
     75                  zdep = MAX( fsdept(ji,jj,jk) - 1000., 0. ) / 1000. 
     76                  r_fact_lap(ji,jj,jk) = MAX( 1., rn_fact_lap * EXP( -zdep ) ) 
     77               ENDIF 
     78            END DO 
     79         END DO 
     80      END DO 
     81      ! 
    6982      IF( l_trdtrc )  THEN 
    7083         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90

    r5385 r6455  
    4040   REAL(wp), PUBLIC ::   rn_ahtrc_0          !: diffusivity coefficient for passive tracer (m2/s) 
    4141   REAL(wp), PUBLIC ::   rn_ahtrb_0          !: background diffusivity coefficient for passive tracer (m2/s) 
     42   REAL(wp), PUBLIC ::   rn_fact_lap         !: Enhanced zonal diffusivity coefficent in the equatorial domain 
    4243 
    4344   !                                        !!: ** Treatment of Negative concentrations ( nam_trcrad ) 
     
    7475      NAMELIST/namtrc_ldf/ ln_trcldf_lap  ,     & 
    7576         &                 ln_trcldf_bilap, ln_trcldf_level,     & 
    76          &                 ln_trcldf_hor  , ln_trcldf_iso  , rn_ahtrc_0, rn_ahtrb_0 
     77         &                 ln_trcldf_hor  , ln_trcldf_iso  , rn_ahtrc_0, rn_ahtrb_0,   & 
     78         &                 rn_fact_lap 
     79 
    7780      NAMELIST/namtrc_zdf/ ln_trczdf_exp  , nn_trczdf_exp 
    7881      NAMELIST/namtrc_rad/ ln_trcrad 
     
    127130         WRITE(numout,*) '      diffusivity coefficient                                 rn_ahtrc_0 = ', rn_ahtrc_0 
    128131         WRITE(numout,*) '      background hor. diffusivity                             rn_ahtrb_0 = ', rn_ahtrb_0 
     132         WRITE(numout,*) '      enhanced zonal diffusivity                             rn_fact_lap = ', rn_fact_lap 
    129133      ENDIF 
    130134 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r5385 r6455  
    170170            END DO 
    171171         ENDIF 
     172         ! 
     173         CALL lbc_lnk( sbc_trc(:,:,jn), 'T', 1. ) 
    172174         !                                       Concentration dilution effect on tracers due to evaporation & precipitation  
    173175         DO jj = 2, jpj 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    r5120 r6455  
    6767         IF( lk_trabbl )        CALL trc_bbl( kstp )            ! advective (and/or diffusive) bottom boundary layer scheme 
    6868         IF( ln_trcdmp )        CALL trc_dmp( kstp )            ! internal damping trends 
    69          IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kstp )        ! internal damping trends on closed seas only 
    7069                                CALL trc_adv( kstp )            ! horizontal & vertical advection  
    7170                                CALL trc_ldf( kstp )            ! lateral mixing 
     
    7877                                CALL trc_nxt( kstp )            ! tracer fields at next time step      
    7978         IF( ln_trcrad )        CALL trc_rad( kstp )            ! Correct artificial negative concentrations 
     79         IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kstp )        ! internal damping trends on closed seas only 
    8080 
    8181#if defined key_agrif 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90

    r5385 r6455  
    116116   USE ldftra_oce , ONLY :  aeiw     =>   aeiw        !: eddy induced velocity coef. at w-points (m2/s)  
    117117   USE ldftra_oce , ONLY :  lk_traldf_eiv  =>  lk_traldf_eiv     !: eddy induced velocity flag 
     118   USE ldftra_oce , ONLY :  r_fact_lap     =>  r_fact_lap        !: enhanced zonal diffusivity coefficient 
    118119 
    119120   !* vertical diffusion * 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    r5385 r6455  
    151151 
    152152 
    153    SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac ) 
     153   SUBROUTINE trc_dta( kt, sf_dta ) 
    154154      !!---------------------------------------------------------------------- 
    155155      !!                   ***  ROUTINE trc_dta  *** 
     
    165165      INTEGER                     , INTENT(in   ) ::   kt     ! ocean time-step 
    166166      TYPE(FLD), DIMENSION(1)   , INTENT(inout) ::   sf_dta     ! array of information on the field to read 
    167       REAL(wp)                  , INTENT(in   ) ::   zrf_trfac  ! multiplication factor 
    168167      ! 
    169168      INTEGER ::   ji, jj, jk, jl, jkk, ik    ! dummy loop indices 
     
    234233         ENDIF 
    235234         ! 
    236          sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * zrf_trfac   !  multiplicative factor 
    237          ! 
    238235         IF( lwp .AND. kt == nit000 ) THEN 
    239236               clndta = TRIM( sf_dta(1)%clvar )  
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r5407 r6455  
    6161      INTEGER ::   jk, jn, jl    ! dummy loop indices 
    6262      CHARACTER (len=25) :: charout 
    63       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta   ! 4D  workspace 
    6463      !!--------------------------------------------------------------------- 
    6564      ! 
     
    121120        IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping 
    122121            ! 
    123             CALL wrk_alloc( jpi, jpj, jpk, ztrcdta )    ! Memory allocation 
    124             ! 
    125122            DO jn = 1, jptra 
    126123               IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
    127124                  jl = n_trc_index(jn)  
    128                   CALL trc_dta( nit000, sf_trcdta(jl),rf_trfac(jl) )   ! read tracer data at nit000 
    129                   ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) 
    130                   trn(:,:,:,jn) = ztrcdta(:,:,:) * tmask(:,:,:)   
     125                  CALL trc_dta( nit000, sf_trcdta(jl) )   ! read tracer data at nit000 
     126                  trn(:,:,:,jn) = sf_trcdta(jl)%fnow(:,:,:) * tmask(:,:,:) * rf_trfac(jl) 
     127                  ! 
    131128                  IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN      !== deallocate data structure   ==! 
    132129                     !                                                    (data used only for initialisation) 
     
    138135               ENDIF 
    139136            ENDDO 
    140             CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 
     137            ! 
    141138        ENDIF 
    142139        ! 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/DMP_TOOLS/src/zoom.F90

    r4739 r6455  
    2929      NAMELIST/nam_zoom_dmp/lzoom_n,lzoom_e,lzoom_w,lzoom_s 
    3030      !!---------------------------------------------------------------------- 
    31       ! 
    32       IF( nn_timing == 1 )  CALL timing_start( 'dtacof_zoom') 
    33       ! 
    3431       
    3532      ! Read namelist 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/MISCELLANEOUS/icb_pp.py

    r4990 r6455  
    5555if procnum < 1: 
    5656   print('Need some files to collate! procnum = ',procnum) 
    57    sys.exit() 
     57   sys.exit(11) 
    5858 
    5959icu = [] 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/MPP_PREP/src/mpp_optimiz_zoom_nc.f90

    r2143 r6455  
    258258                 ijlb=ijdom(jni2,jnj2) 
    259259              ENDIF 
     260 
     261              ! Check wet points over the entire domain to preserve the MPI communication stencil 
    260262              isurf=0 
    261               DO jj=1+jprecj,ippdj(jni2,jnj2)-jprecj 
    262                  DO  ji=1+jpreci,ippdi(jni2,jnj2)-jpreci 
     263              DO jj=1,ippdj(jni2,jnj2) 
     264                 DO  ji=1,ippdi(jni2,jnj2) 
    263265                    IF(zmask(ji+iilb-1,jj+ijlb-1).EQ.1.) isurf=isurf+1 
    264266                 END DO 
    265267              END DO 
     268 
    266269              IF(isurf.EQ.0) THEN 
    267270                 ivide=ivide+1 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/MPP_PREP/src/mppopt_showproc_nc.f90

    r2143 r6455  
    289289                 ijlb=ijdom(jni2,jnj2) 
    290290              ENDIF 
     291 
     292              ! Check wet points over the entire domain to preserve the MPI communication stencil 
    291293              isurf=0 
    292  
    293               DO jj=1+jprecj,ippdj(jni2,jnj2)-jprecj 
    294                  DO  ji=1+jpreci,ippdi(jni2,jnj2)-jpreci 
     294              DO jj=1,ippdj(jni2,jnj2) 
     295                 DO  ji=1,ippdi(jni2,jnj2) 
    295296                    IF(zmask(ji+iilb-1,jj+ijlb-1).EQ.1.) isurf=isurf+1 
    296297                 END DO 
    297298              END DO 
     299 
    298300              IF(isurf.EQ.0) THEN 
    299301                 ivide=ivide+1 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/REBUILD_NEMO/src/rebuild_nemo.f90

    r3025 r6455  
    200200      WRITE(numerr,*) 'Attribute DOMAIN_number_total is : ', ndomain_file 
    201201      WRITE(numerr,*) 'Number of files specified in namelist is: ', ndomain 
    202       STOP 
     202      STOP 9 
    203203   ENDIF 
    204204   
     
    268268      WRITE(numerr,*) 'Attribute DOMAIN_local_sizes is : ', local_sizes 
    269269      WRITE(numerr,*) 'Dimensions to be rebuilt are of size : ', outdimlens(rebuild_dims(1)), outdimlens(rebuild_dims(2))  
    270       STOP 
     270      STOP 9 
    271271   ENDIF 
    272272 
     
    384384            SELECT CASE( xtype ) 
    385385               CASE( NF90_BYTE ) 
     386                  globaldata_0d_i1 = 0 
    386387                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_i1 ) ) 
    387388               CASE( NF90_SHORT ) 
     389                  globaldata_0d_i2 = 0 
    388390                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_i2 ) ) 
    389391               CASE( NF90_INT ) 
     392                  globaldata_0d_i4 = 0 
    390393                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_i4 ) ) 
    391394               CASE( NF90_FLOAT ) 
     395                  globaldata_0d_sp = 0. 
    392396                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_sp ) ) 
    393397               CASE( NF90_DOUBLE ) 
     398                  globaldata_0d_dp = 0. 
    394399                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_dp ) ) 
    395400               CASE DEFAULT 
    396401                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype 
    397                   STOP 
     402                  STOP 9 
    398403            END SELECT 
    399404 
     
    403408               CASE( NF90_BYTE ) 
    404409                  ALLOCATE(globaldata_1d_i1(indimlens(dimids(1)))) 
     410                  globaldata_1d_i1(:) = 0 
    405411                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_i1 ) ) 
    406412               CASE( NF90_SHORT ) 
    407413                  ALLOCATE(globaldata_1d_i2(indimlens(dimids(1)))) 
     414                  globaldata_1d_i2(:) = 0 
    408415                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_i2 ) ) 
    409416               CASE( NF90_INT ) 
    410417                  ALLOCATE(globaldata_1d_i4(indimlens(dimids(1)))) 
     418                  globaldata_1d_i4(:) = 0 
    411419                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_i4 ) ) 
    412420               CASE( NF90_FLOAT ) 
    413421                  ALLOCATE(globaldata_1d_sp(indimlens(dimids(1)))) 
     422                  globaldata_1d_sp(:) = 0. 
    414423                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_sp ) ) 
    415424               CASE( NF90_DOUBLE ) 
    416425                  ALLOCATE(globaldata_1d_dp(indimlens(dimids(1)))) 
     426                  globaldata_1d_dp(:) = 0. 
    417427                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_dp ) ) 
    418428               CASE DEFAULT 
    419429                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype 
    420                   STOP 
     430                  STOP 9 
    421431            END SELECT 
    422432 
     
    426436               CASE( NF90_BYTE ) 
    427437                  ALLOCATE(globaldata_2d_i1(indimlens(dimids(1)),indimlens(dimids(2)))) 
     438                  globaldata_2d_i1(:,:) = 0 
    428439                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_i1 ) ) 
    429440               CASE( NF90_SHORT ) 
    430441                  ALLOCATE(globaldata_2d_i2(indimlens(dimids(1)),indimlens(dimids(2)))) 
     442                  globaldata_2d_i2(:,:) = 0 
    431443                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_i2 ) ) 
    432444               CASE( NF90_INT ) 
    433445                  ALLOCATE(globaldata_2d_i4(indimlens(dimids(1)),indimlens(dimids(2)))) 
     446                  globaldata_2d_i4(:,:) = 0 
    434447                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_i4 ) ) 
    435448               CASE( NF90_FLOAT ) 
    436449                  ALLOCATE(globaldata_2d_sp(indimlens(dimids(1)),indimlens(dimids(2)))) 
     450                  globaldata_2d_sp(:,:) = 0. 
    437451                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_sp ) ) 
    438452               CASE( NF90_DOUBLE ) 
    439453                  ALLOCATE(globaldata_2d_dp(indimlens(dimids(1)),indimlens(dimids(2)))) 
     454                  globaldata_2d_dp(:,:) = 0. 
    440455                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_dp ) ) 
    441456               CASE DEFAULT 
    442457                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype 
    443                   STOP 
     458                  STOP 9 
    444459            END SELECT 
    445460 
     
    450465                  ALLOCATE(globaldata_3d_i1(indimlens(dimids(1)),indimlens(dimids(2)),       & 
    451466                     &                      indimlens(dimids(3)))) 
     467                  globaldata_3d_i1(:,:,:) = 0 
    452468                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_i1 ) ) 
    453469               CASE( NF90_SHORT ) 
    454470                  ALLOCATE(globaldata_3d_i2(indimlens(dimids(1)),indimlens(dimids(2)),       & 
    455471                     &                      indimlens(dimids(3)))) 
     472                  globaldata_3d_i2(:,:,:) = 0 
    456473                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_i2 ) ) 
    457474               CASE( NF90_INT ) 
    458475                  ALLOCATE(globaldata_3d_i4(indimlens(dimids(1)),indimlens(dimids(2)),       & 
    459476                     &                      indimlens(dimids(3)))) 
     477                  globaldata_3d_i4(:,:,:) = 0 
    460478                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_i4 ) ) 
    461479               CASE( NF90_FLOAT ) 
    462480                  ALLOCATE(globaldata_3d_sp(indimlens(dimids(1)),indimlens(dimids(2)),       & 
    463481                     &                      indimlens(dimids(3)))) 
     482                  globaldata_3d_sp(:,:,:) = 0. 
    464483                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_sp ) ) 
    465484               CASE( NF90_DOUBLE ) 
    466485                  ALLOCATE(globaldata_3d_dp(indimlens(dimids(1)),indimlens(dimids(2)),       & 
    467486                     &                      indimlens(dimids(3)))) 
     487                  globaldata_3d_dp(:,:,:) = 0. 
    468488                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_dp ) ) 
    469489               CASE DEFAULT 
    470490                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype 
    471                   STOP 
     491                  STOP 9 
    472492            END SELECT 
    473493 
     
    478498                  ALLOCATE(globaldata_4d_i1(indimlens(dimids(1)),indimlens(dimids(2)),       & 
    479499                     &                      indimlens(dimids(3)),ntchunk)) 
     500                  globaldata_4d_i1(:,:,:,:) = 0 
    480501                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_i1, start=(/1,1,1,nt/) ) ) 
    481502               CASE( NF90_SHORT ) 
    482503                  ALLOCATE(globaldata_4d_i2(indimlens(dimids(1)),indimlens(dimids(2)),       & 
    483504                     &                      indimlens(dimids(3)),ntchunk)) 
     505                  globaldata_4d_i2(:,:,:,:) = 0 
    484506                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_i2, start=(/1,1,1,nt/) ) ) 
    485507               CASE( NF90_INT ) 
    486508                  ALLOCATE(globaldata_4d_i4(indimlens(dimids(1)),indimlens(dimids(2)),       & 
    487509                     &                      indimlens(dimids(3)),ntchunk)) 
     510                  globaldata_4d_i4(:,:,:,:) = 0 
    488511                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_i4, start=(/1,1,1,nt/) ) ) 
    489512               CASE( NF90_FLOAT ) 
    490513                  ALLOCATE(globaldata_4d_sp(indimlens(dimids(1)),indimlens(dimids(2)),       & 
    491514                     &                      indimlens(dimids(3)),ntchunk)) 
     515                  globaldata_4d_sp(:,:,:,:) = 0. 
    492516                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_sp, start=(/1,1,1,nt/) ) ) 
    493517               CASE( NF90_DOUBLE ) 
    494518                  ALLOCATE(globaldata_4d_dp(indimlens(dimids(1)),indimlens(dimids(2)),       & 
    495519                     &                      indimlens(dimids(3)),ntchunk)) 
     520                  globaldata_4d_dp(:,:,:,:) = 0. 
    496521                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_dp, start=(/1,1,1,nt/) ) ) 
    497522               CASE DEFAULT 
    498523                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype 
    499                   STOP 
     524                  STOP 9 
    500525            END SELECT 
    501526 
     
    517542               CASE( NF90_BYTE ) 
    518543                  ALLOCATE(globaldata_1d_i1(outdimlens(dimids(1)))) 
     544                  globaldata_1d_i1(:) = 0 
    519545               CASE( NF90_SHORT ) 
    520546                  ALLOCATE(globaldata_1d_i2(outdimlens(dimids(1)))) 
     547                  globaldata_1d_i2(:) = 0 
    521548               CASE( NF90_INT ) 
    522549                  ALLOCATE(globaldata_1d_i4(outdimlens(dimids(1)))) 
     550                  globaldata_1d_i4(:) = 0 
    523551               CASE( NF90_FLOAT ) 
    524552                  ALLOCATE(globaldata_1d_sp(outdimlens(dimids(1)))) 
     553                  globaldata_1d_sp(:) = 0. 
    525554               CASE( NF90_DOUBLE ) 
    526555                  ALLOCATE(globaldata_1d_dp(outdimlens(dimids(1)))) 
     556                  globaldata_1d_dp(:) = 0. 
    527557               CASE DEFAULT 
    528558                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype 
    529                   STOP 
     559                  STOP 9 
    530560            END SELECT 
    531561 
     
    535565               CASE( NF90_BYTE ) 
    536566                  ALLOCATE(globaldata_2d_i1(outdimlens(dimids(1)),outdimlens(dimids(2)))) 
     567                  globaldata_2d_i1(:,:) = 0 
    537568               CASE( NF90_SHORT ) 
    538569                  ALLOCATE(globaldata_2d_i2(outdimlens(dimids(1)),outdimlens(dimids(2)))) 
     570                  globaldata_2d_i2(:,:) = 0 
    539571               CASE( NF90_INT ) 
    540572                  ALLOCATE(globaldata_2d_i4(outdimlens(dimids(1)),outdimlens(dimids(2)))) 
     573                  globaldata_2d_i4(:,:) = 0 
    541574               CASE( NF90_FLOAT ) 
    542575                  ALLOCATE(globaldata_2d_sp(outdimlens(dimids(1)),outdimlens(dimids(2)))) 
     576                  globaldata_2d_sp(:,:) = 0. 
    543577               CASE( NF90_DOUBLE ) 
    544578                  ALLOCATE(globaldata_2d_dp(outdimlens(dimids(1)),outdimlens(dimids(2)))) 
     579                  globaldata_2d_dp(:,:) = 0. 
    545580               CASE DEFAULT 
    546581                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype 
    547                   STOP 
     582                  STOP 9 
    548583            END SELECT 
    549584 
     
    554589                  ALLOCATE(globaldata_3d_i1(outdimlens(dimids(1)),outdimlens(dimids(2)),     & 
    555590                     &                      outdimlens(dimids(3)))) 
     591                  globaldata_3d_i1(:,:,:) = 0 
    556592               CASE( NF90_SHORT ) 
    557593                  ALLOCATE(globaldata_3d_i2(outdimlens(dimids(1)),outdimlens(dimids(2)),     & 
    558594                     &                      outdimlens(dimids(3)))) 
     595                  globaldata_3d_i2(:,:,:) = 0 
    559596               CASE( NF90_INT ) 
    560597                  ALLOCATE(globaldata_3d_i4(outdimlens(dimids(1)),outdimlens(dimids(2)),     & 
    561598                     &                      outdimlens(dimids(3)))) 
     599                  globaldata_3d_i4(:,:,:) = 0 
    562600               CASE( NF90_FLOAT ) 
    563601                  ALLOCATE(globaldata_3d_sp(outdimlens(dimids(1)),outdimlens(dimids(2)),     & 
    564602                     &                      outdimlens(dimids(3)))) 
     603                  globaldata_3d_sp(:,:,:) = 0. 
    565604               CASE( NF90_DOUBLE ) 
    566605                  ALLOCATE(globaldata_3d_dp(outdimlens(dimids(1)),outdimlens(dimids(2)),     & 
    567606                     &                      outdimlens(dimids(3)))) 
     607                  globaldata_3d_dp(:,:,:) = 0. 
    568608               CASE DEFAULT 
    569609                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype 
    570                   STOP 
     610                  STOP 9 
    571611            END SELECT 
    572612 
     
    577617                  ALLOCATE(globaldata_4d_i1(outdimlens(dimids(1)),outdimlens(dimids(2)),     & 
    578618                     &                      outdimlens(dimids(3)),ntchunk)) 
     619                   globaldata_4d_i1(:,:,:,:) = 0 
    579620               CASE( NF90_SHORT ) 
    580621                  ALLOCATE(globaldata_4d_i2(outdimlens(dimids(1)),outdimlens(dimids(2)),     & 
    581622                     &                      outdimlens(dimids(3)),ntchunk)) 
     623                  globaldata_4d_i2(:,:,:,:) = 0 
    582624               CASE( NF90_INT ) 
    583625                  ALLOCATE(globaldata_4d_i4(outdimlens(dimids(1)),outdimlens(dimids(2)),     & 
    584626                     &                      outdimlens(dimids(3)),ntchunk)) 
     627                  globaldata_4d_i4(:,:,:,:) = 0 
    585628               CASE( NF90_FLOAT ) 
    586629                  ALLOCATE(globaldata_4d_sp(outdimlens(dimids(1)),outdimlens(dimids(2)),     & 
    587630                     &                      outdimlens(dimids(3)),ntchunk)) 
     631                  globaldata_4d_sp(:,:,:,:) = 0. 
    588632               CASE( NF90_DOUBLE ) 
    589633                  ALLOCATE(globaldata_4d_dp(outdimlens(dimids(1)),outdimlens(dimids(2)),     & 
    590634                     &                      outdimlens(dimids(3)),ntchunk)) 
     635                  globaldata_4d_dp(:,:,:,:) = 0. 
    591636               CASE DEFAULT 
    592637                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype 
    593                   STOP 
     638                  STOP 9 
    594639            END SELECT 
    595640         ELSE 
    596641            WRITE(numerr,*) 'ERROR! : A netcdf variable has more than 4 dimensions which is not taken into account' 
    597             STOP 
     642            STOP 9 
    598643         ENDIF 
    599644 
     
    9671012            IF( nthreads == 1 .AND. istop /= nf90_noerr )  THEN 
    9681013               WRITE(numerr,*) '*** NEMO rebuild failed! ***' 
    969                STOP 
     1014               STOP 9 
    9701015            ENDIF 
    9711016         
     
    9761021         IF( istop /= nf90_noerr )  THEN 
    9771022            WRITE(numerr,*) '*** NEMO rebuild failed! ***' 
    978             STOP 
     1023            STOP 9 
    9791024         ENDIF 
    9801025 
     
    10501095            CASE DEFAULT    
    10511096               WRITE(numerr,*) 'Unknown nf90 type: ', xtype 
    1052                STOP 
     1097               STOP 9 
    10531098         END SELECT      
    10541099                       
     
    10731118            CASE DEFAULT    
    10741119               WRITE(numerr,*) 'Unknown nf90 type: ', xtype 
    1075                STOP 
     1120               STOP 9 
    10761121         END SELECT      
    10771122     
     
    10961141            CASE DEFAULT    
    10971142               WRITE(numerr,*) 'Unknown nf90 type: ', xtype 
    1098                STOP 
     1143               STOP 9 
    10991144         END SELECT      
    11001145     
     
    11461191            WRITE(numerr,*) "*** NEMO rebuild failed ***" 
    11471192            WRITE(numerr,*) 
    1148             STOP 
     1193            STOP 9 
    11491194         ENDIF 
    11501195      ENDIF 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg

    r5616 r6455  
    11# name       | units          | axis | pt| interpolation   | long name                             | standard name                                   
    2 X            | 1              | X    |   |                 |                                       | projection_x_coordinate                
    3 Y            | 1              | Y    |   |                 |                                       | projection_y_coordinate                
    4 Z            | 1              | Z    |   |                 |                                       | projection_z_coordinate                
    5 T            | 1              | T    |   |                 |                                       | projection_t_coordinate                
     2X            | unitless       | X    |   |                 |                                       | projection_x_coordinate                
     3Y            | unitless       | Y    |   |                 |                                       | projection_y_coordinate                
     4Z            | unitless       | Z    |   |                 |                                       | projection_z_coordinate                
     5T            | unitless       | T    |   |                 |                                       | projection_t_coordinate                
    66nav_lon      | degrees_east   | XY   | T | cubic           | Longitude                             | longitude                                    
    77nav_lat      | degrees_north  | XY   | T | cubic           | Latitude                              | latitude                          
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/Doxyfile

    r5037 r6455  
    4545# quick idea about the purpose of the project. Keep the description short. 
    4646 
    47 PROJECT_BRIEF          = "System and Interface for oceanic RElocable Nesting" 
     47PROJECT_BRIEF          = "System and Interface for oceanic RElocatable Nesting" 
    4848 
    4949# With the PROJECT_LOGO tag one can specify an logo or icon that is included in 
     
    20692069# The default value is: NO. 
    20702070 
    2071 HAVE_DOT               = YES 
     2071HAVE_DOT               = NO 
    20722072 
    20732073# The DOT_NUM_THREADS specifies the number of dot invocations doxygen is allowed 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/attribute.f90

    r5616 r6455  
    8383!> @date November, 2014  
    8484!> - Fix memory leaks bug 
     85!> @date September, 2015 
     86!> - manage useless (dummy) attributes 
    8587! 
    8688!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    98100   PUBLIC :: TATT       !< attribute structure 
    99101 
     102   PRIVATE :: cm_dumatt !< dummy attribute array 
     103 
    100104   ! function and subroutine 
    101105   PUBLIC :: att_init       !< initialize attribute structure 
     
    105109   PUBLIC :: att_get_index  !< get attribute index, in an array of attribute structure 
    106110   PUBLIC :: att_get_id     !< get attribute id, read from file 
     111   PUBLIC :: att_get_dummy  !< fill dummy attribute array 
     112   PUBLIC :: att_is_dummy   !< check if attribute is defined as dummy attribute 
    107113 
    108114   PRIVATE :: att__clean_unit ! clean attribute strcuture 
     
    135141   END TYPE TATT 
    136142 
     143   CHARACTER(LEN=lc), DIMENSION(ip_maxdum), SAVE :: cm_dumatt !< dummy attribute 
     144 
    137145   INTERFACE att_init 
    138146      MODULE PROCEDURE att__init_c     
     
    12511259 
    12521260   END SUBROUTINE att__clean_arr 
     1261   !------------------------------------------------------------------- 
     1262   !> @brief This subroutine fill dummy attribute array 
     1263   ! 
     1264   !> @author J.Paul 
     1265   !> @date September, 2015 - Initial Version 
     1266   !> @date Marsh, 2016 
     1267   !> - close file (bugfix) 
     1268   ! 
     1269   !> @param[in] cd_dummy dummy configuration file 
     1270   !------------------------------------------------------------------- 
     1271   SUBROUTINE att_get_dummy( cd_dummy ) 
     1272      IMPLICIT NONE 
     1273      ! Argument 
     1274      CHARACTER(LEN=*), INTENT(IN) :: cd_dummy 
     1275 
     1276      ! local variable 
     1277      INTEGER(i4)   :: il_fileid 
     1278      INTEGER(i4)   :: il_status 
     1279 
     1280      LOGICAL       :: ll_exist 
     1281 
     1282      ! loop indices 
     1283      ! namelist 
     1284      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumvar 
     1285      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumdim 
     1286      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumatt 
     1287 
     1288      !---------------------------------------------------------------- 
     1289      NAMELIST /namdum/ &   !< dummy namelist 
     1290      &  cn_dumvar, &       !< variable  name 
     1291      &  cn_dumdim, &       !< dimension name 
     1292      &  cn_dumatt          !< attribute name 
     1293      !---------------------------------------------------------------- 
     1294 
     1295      ! init 
     1296      cm_dumatt(:)='' 
     1297 
     1298      ! read namelist 
     1299      INQUIRE(FILE=TRIM(cd_dummy), EXIST=ll_exist) 
     1300      IF( ll_exist )THEN 
     1301     
     1302         il_fileid=fct_getunit() 
     1303    
     1304         OPEN( il_fileid, FILE=TRIM(cd_dummy), & 
     1305         &                FORM='FORMATTED',       & 
     1306         &                ACCESS='SEQUENTIAL',    & 
     1307         &                STATUS='OLD',           & 
     1308         &                ACTION='READ',          & 
     1309         &                IOSTAT=il_status) 
     1310         CALL fct_err(il_status) 
     1311         IF( il_status /= 0 )THEN 
     1312            CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_dummy)) 
     1313         ENDIF 
     1314    
     1315         READ( il_fileid, NML = namdum ) 
     1316         cm_dumatt(:)=cn_dumatt(:) 
     1317 
     1318         CLOSE( il_fileid ) 
     1319 
     1320      ENDIF 
     1321    
     1322   END SUBROUTINE att_get_dummy 
     1323   !------------------------------------------------------------------- 
     1324   !> @brief This function check if attribute is defined as dummy attribute 
     1325   !> in configuraton file 
     1326   !> 
     1327   !> @author J.Paul 
     1328   !> @date September, 2015 - Initial Version 
     1329   ! 
     1330   !> @param[in] td_att attribute structure 
     1331   !> @return true if attribute is dummy attribute 
     1332   !------------------------------------------------------------------- 
     1333   FUNCTION att_is_dummy(td_att) 
     1334      IMPLICIT NONE 
     1335 
     1336      ! Argument       
     1337      TYPE(TATT), INTENT(IN) :: td_att 
     1338       
     1339      ! function 
     1340      LOGICAL :: att_is_dummy 
     1341       
     1342      ! loop indices 
     1343      INTEGER(i4) :: ji 
     1344      !---------------------------------------------------------------- 
     1345 
     1346      att_is_dummy=.FALSE. 
     1347      DO ji=1,ip_maxdum 
     1348         IF( fct_lower(td_att%c_name) == fct_lower(cm_dumatt(ji)) )THEN 
     1349            att_is_dummy=.TRUE. 
     1350            EXIT 
     1351         ENDIF 
     1352      ENDDO 
     1353 
     1354   END FUNCTION att_is_dummy 
    12531355END MODULE att 
    12541356 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/boundary.f90

    r5608 r6455  
    482482   !> ex : cn_north='index1,first1,last1(width)|index2,first2,last2' 
    483483   !> 
    484    !> @note Boundaries are compute on T point, but expressed on U,V point. 
     484   !> @warn Boundaries are compute on T point, but expressed on U,V point. 
    485485   !> change will be done to get data on other point when need be.  
    486486   !> 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/create_bathy.f90

    r5616 r6455  
    88!> @file 
    99!> @brief  
    10 !> This program create fine grid bathymetry file. 
     10!> This program creates fine grid bathymetry file. 
    1111!> 
    1212!> @details 
     
    2727!>    you could find a template of the namelist in templates directory. 
    2828!> 
    29 !>    create_bathy.nam comprise 7 namelists:<br/> 
     29!>    create_bathy.nam contains 7 namelists:<br/> 
    3030!>       - logger namelist (namlog) 
    3131!>       - config namelist (namcfg) 
     
    3636!>       - output namelist (namout) 
    3737!>     
    38 !>    @note  
    39 !>       All namelists have to be in file create_bathy.nam, however variables of 
    40 !>       those namelists are all optional. 
    41 !> 
    4238!>    * _logger namelist (namlog)_:<br/> 
    4339!>       - cn_logfile   : log filename 
     
    4945!>       - cn_varcfg : variable configuration file  
    5046!> (see ./SIREN/cfg/variable.cfg) 
     47!>       - cn_dumcfg : useless (dummy) configuration file, for useless  
     48!> dimension or variable (see ./SIREN/cfg/dummy.cfg). 
    5149!> 
    5250!>    * _coarse grid namelist (namcrs)_:<br/> 
     
    6159!> 
    6260!>    * _variable namelist (namvar)_:<br/> 
    63 !>       - cn_varinfo : list of variable and extra information about request(s)  
    64 !>       to be used.<br/> 
    65 !>          each elements of *cn_varinfo* is a string character 
    66 !>          (separated by ',').<br/> 
    67 !>          it is composed of the variable name follow by ':',  
    68 !>          then request(s) to be used on this variable.<br/>  
    69 !>          request could be: 
    70 !>             - int = interpolation method 
    71 !>             - ext = extrapolation method 
    72 !>             - flt = filter method 
    73 !>             - min = minimum value 
    74 !>             - max = maximum value 
    75 !>             - unt = new units 
    76 !>             - unf = unit scale factor (linked to new units) 
    77 !> 
    78 !>                requests must be separated by ';'.<br/> 
    79 !>                order of requests does not matter.<br/> 
    80 !> 
    81 !>          informations about available method could be find in @ref interp, 
    82 !>          @ref extrap and @ref filter modules.<br/> 
    83 !>          Example: 'Bathymetry: flt=2*hamming(2,3); min=0' 
    84 !>          @note  
    85 !>             If you do not specify a method which is required,  
    86 !>             default one is apply. 
    87 !>          @warning  
    88 !>             variable name must be __Bathymetry__ here. 
    8961!>       - cn_varfile : list of variable, and corresponding file.<br/>  
    9062!>          *cn_varfile* is the path and filename of the file where find 
     
    10880!>             - 'Bathymetry:5000,5000,5000/5000,3000,5000/5000,5000,5000' 
    10981!> 
     82!>       - cn_varinfo : list of variable and extra information about request(s)  
     83!>       to be used.<br/> 
     84!>          each elements of *cn_varinfo* is a string character 
     85!>          (separated by ',').<br/> 
     86!>          it is composed of the variable name follow by ':',  
     87!>          then request(s) to be used on this variable.<br/>  
     88!>          request could be: 
     89!>             - int = interpolation method 
     90!>             - ext = extrapolation method 
     91!>             - flt = filter method 
     92!>             - min = minimum value 
     93!>             - max = maximum value 
     94!>             - unt = new units 
     95!>             - unf = unit scale factor (linked to new units) 
     96!> 
     97!>                requests must be separated by ';'.<br/> 
     98!>                order of requests does not matter.<br/> 
     99!> 
     100!>          informations about available method could be find in @ref interp, 
     101!>          @ref extrap and @ref filter modules.<br/> 
     102!>          Example: 'Bathymetry: flt=2*hamming(2,3); min=0' 
     103!>          @note  
     104!>             If you do not specify a method which is required,  
     105!>             default one is apply. 
     106!>          @warning  
     107!>             variable name must be __Bathymetry__ here. 
     108!> 
    110109!>    * _nesting namelist (namnst)_:<br/> 
    111110!>       - in_rhoi  : refinement factor in i-direction 
     
    127126!> - extrapolate all land points. 
    128127!> - allow to change unit. 
     128!> @date September, 2015 
     129!> - manage useless (dummy) variable, attributes, and dimension 
     130!> @date January,2016 
     131!> - add create_bathy_check_depth as in create_boundary 
     132!> - add create_bathy_check_time  as in create_boundary 
     133!> @date February, 2016 
     134!> - do not closed sea for east-west cyclic domain 
    129135! 
    130136!> @todo 
    131 !> - use create_bathy_check_depth as in create_boundary 
    132 !> - use create_bathy_check_time  as in create_boundary 
    133137!> - check tl_multi is not empty 
    134138!> 
     
    167171   INTEGER(i4)                                        :: il_status 
    168172   INTEGER(i4)                                        :: il_fileid 
    169    INTEGER(i4)                                        :: il_varid 
    170173   INTEGER(i4)                                        :: il_attid 
    171174   INTEGER(i4)                                        :: il_imin0 
     
    179182 
    180183   LOGICAL                                            :: ll_exist 
     184   LOGICAL                                            :: ll_fillclosed 
    181185 
    182186   TYPE(TMPP)                                         :: tl_coord0 
     
    208212   ! namelist variable 
    209213   ! namlog 
    210    CHARACTER(LEN=lc) :: cn_logfile = 'create_bathy.log'  
    211    CHARACTER(LEN=lc) :: cn_verbosity = 'warning'  
    212    INTEGER(i4)       :: in_maxerror = 5 
     214   CHARACTER(LEN=lc)                       :: cn_logfile = 'create_bathy.log'  
     215   CHARACTER(LEN=lc)                       :: cn_verbosity = 'warning'  
     216   INTEGER(i4)                             :: in_maxerror = 5 
    213217 
    214218   ! namcfg 
    215    CHARACTER(LEN=lc) :: cn_varcfg = 'variable.cfg'  
     219   CHARACTER(LEN=lc)                       :: cn_varcfg = './cfg/variable.cfg'  
     220   CHARACTER(LEN=lc)                       :: cn_dumcfg = './cfg/dummy.cfg'  
    216221 
    217222   ! namcrs 
    218    CHARACTER(LEN=lc) :: cn_coord0 = ''  
    219    INTEGER(i4)       :: in_perio0 = -1 
     223   CHARACTER(LEN=lc)                       :: cn_coord0 = ''  
     224   INTEGER(i4)                             :: in_perio0 = -1 
    220225 
    221226   ! namfin 
    222    CHARACTER(LEN=lc) :: cn_coord1 = '' 
    223    INTEGER(i4)       :: in_perio1 = -1 
    224    LOGICAL           :: ln_fillclosed = .TRUE. 
     227   CHARACTER(LEN=lc)                       :: cn_coord1 = '' 
     228   INTEGER(i4)                             :: in_perio1 = -1 
     229   LOGICAL                                 :: ln_fillclosed = .TRUE. 
    225230 
    226231   ! namvar 
     232   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = '' 
    227233   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = '' 
    228    CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = '' 
    229234 
    230235   ! namnst 
    231    INTEGER(i4)       :: in_rhoi  = 1 
    232    INTEGER(i4)       :: in_rhoj  = 1 
     236   INTEGER(i4)                             :: in_rhoi  = 1 
     237   INTEGER(i4)                             :: in_rhoj  = 1 
    233238 
    234239   ! namout 
    235    CHARACTER(LEN=lc) :: cn_fileout = 'bathy_fine.nc'  
     240   CHARACTER(LEN=lc)                       :: cn_fileout = 'bathy_fine.nc'  
    236241   !------------------------------------------------------------------- 
    237242 
     
    242247 
    243248   NAMELIST /namcfg/ &   !< configuration namelist 
    244    &  cn_varcfg          !< variable configuration file 
     249   &  cn_varcfg, &       !< variable configuration file 
     250   &  cn_dumcfg          !< dummy configuration file 
    245251 
    246252   NAMELIST /namcrs/ &   !< coarse grid namelist 
     
    254260  
    255261   NAMELIST /namvar/ &   !< variable namelist 
    256    &  cn_varinfo, &      !< list of variable and interpolation method to be used. (ex: 'votemper:linear','vosaline:cubic' ) 
    257    &  cn_varfile         !< list of variable file 
     262   &  cn_varfile, &      !< list of variable file 
     263   &  cn_varinfo         !< list of variable and interpolation method to be used. (ex: 'votemper:linear','vosaline:cubic' ) 
    258264    
    259265   NAMELIST /namnst/ &   !< nesting namelist 
     
    302308      CALL var_def_extra(TRIM(cn_varcfg)) 
    303309 
     310      ! get dummy variable 
     311      CALL var_get_dummy(TRIM(cn_dumcfg)) 
     312      ! get dummy dimension 
     313      CALL dim_get_dummy(TRIM(cn_dumcfg)) 
     314      ! get dummy attribute 
     315      CALL att_get_dummy(TRIM(cn_dumcfg)) 
     316 
    304317      READ( il_fileid, NML = namcrs ) 
    305318      READ( il_fileid, NML = namfin ) 
     
    309322      ! match variable with file 
    310323      tl_multi=multi_init(cn_varfile) 
    311        
     324  
    312325      READ( il_fileid, NML = namnst ) 
    313326      READ( il_fileid, NML = namout ) 
     
    322335 
    323336      PRINT *,"ERROR in create_bathy: can't find "//TRIM(cl_namelist) 
     337      STOP 
    324338 
    325339   ENDIF 
     
    343357      &     "check namelist") 
    344358   ENDIF 
     359 
     360   ! do not closed sea for east-west cyclic domain 
     361   ll_fillclosed=ln_fillclosed 
     362   IF( tl_coord1%i_perio == 1 ) ll_fillclosed=.FALSE. 
    345363 
    346364   ! check 
     
    417435 
    418436            ! get or check depth value 
    419             IF( tl_multi%t_mpp(ji)%t_proc(1)%i_depthid /= 0 )THEN 
    420                il_varid=tl_multi%t_mpp(ji)%t_proc(1)%i_depthid 
    421                IF( ASSOCIATED(tl_depth%d_value) )THEN 
    422                   tl_tmp=iom_mpp_read_var(tl_mpp,il_varid) 
    423                   IF( ANY( tl_depth%d_value(:,:,:,:) /= & 
    424                   &        tl_tmp%d_value(:,:,:,:) ) )THEN 
    425                      CALL logger_fatal("CREATE BATHY: depth value from "//& 
    426                      &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& 
    427                      &  " to those from former file(s).") 
    428                   ENDIF 
    429                   CALL var_clean(tl_tmp) 
    430                ELSE 
    431                   tl_depth=iom_mpp_read_var(tl_mpp,il_varid) 
    432                ENDIF 
    433             ENDIF 
     437            CALL create_bathy_check_depth( tl_mpp, tl_depth ) 
    434438 
    435439            ! get or check time value 
    436             IF( tl_multi%t_mpp(ji)%t_proc(1)%i_timeid /= 0 )THEN 
    437                il_varid=tl_multi%t_mpp(ji)%t_proc(1)%i_timeid 
    438                IF( ASSOCIATED(tl_time%d_value) )THEN 
    439                   tl_tmp=iom_mpp_read_var(tl_mpp,il_varid) 
    440                   IF( ANY( tl_time%d_value(:,:,:,:) /= & 
    441                   &        tl_tmp%d_value(:,:,:,:) ) )THEN 
    442                      CALL logger_fatal("CREATE BATHY: time value from "//& 
    443                      &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& 
    444                      &  " to those from former file(s).") 
    445                   ENDIF 
    446                   CALL var_clean(tl_tmp) 
    447                ELSE 
    448                   tl_time=iom_mpp_read_var(tl_mpp,il_varid) 
    449                ENDIF 
    450             ENDIF 
     440            CALL create_bathy_check_time( tl_mpp, tl_time ) 
    451441 
    452442            ! close mpp file 
    453443            CALL iom_mpp_close(tl_mpp) 
    454444 
    455             IF( ANY( tl_mpp%t_dim(1:2)%i_len /= & 
    456             &        tl_coord0%t_dim(1:2)%i_len) )THEN 
     445            IF( ANY(tl_mpp%t_dim(1:2)%i_len /= tl_coord0%t_dim(1:2)%i_len).OR.& 
     446            &   ALL(il_rho(:)==1) )THEN 
    457447               !- extract bathymetry from fine grid bathymetry  
    458448               DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
     
    505495 
    506496         ! fill closed sea 
    507          IF( ln_fillclosed )THEN 
     497         IF( ll_fillclosed )THEN 
    508498            ALLOCATE( il_mask(tl_var(jk)%t_dim(1)%i_len, & 
    509499            &                 tl_var(jk)%t_dim(2)%i_len) ) 
     
    526516         &   dl_minbat <= 0._dp  )THEN 
    527517            CALL logger_debug("CREATE BATHY: min value "//TRIM(fct_str(dl_minbat))) 
    528             CALL logger_error("CREATE BATHY: Bathymetry has value <= 0") 
     518            CALL logger_fatal("CREATE BATHY: Bathymetry has value <= 0") 
    529519         ENDIF 
    530520 
     
    973963      CALL dom_del_extra( tl_var, tl_dom, il_rho(:) ) 
    974964 
     965      CALL dom_clean_extra( tl_dom ) 
     966 
    975967      !- add ghost cell 
    976968      CALL grid_add_ghost(tl_var,tl_dom%i_ghost(:,:)) 
     
    11091101 
    11101102   END SUBROUTINE create_bathy_interp 
     1103   !------------------------------------------------------------------- 
     1104   !> @brief 
     1105   !> This subroutine get depth variable value in an open mpp structure 
     1106   !> and check if agree with already input depth variable. 
     1107   !>  
     1108   !> @details  
     1109   !> 
     1110   !> @author J.Paul 
     1111   !> @date January, 2016 - Initial Version 
     1112   !> 
     1113   !> @param[in] td_mpp       mpp structure 
     1114   !> @param[inout] td_depth  depth variable structure  
     1115   !------------------------------------------------------------------- 
     1116   SUBROUTINE create_bathy_check_depth( td_mpp, td_depth ) 
     1117 
     1118      IMPLICIT NONE 
     1119 
     1120      ! Argument 
     1121      TYPE(TMPP) , INTENT(IN   ) :: td_mpp 
     1122      TYPE(TVAR) , INTENT(INOUT) :: td_depth 
     1123 
     1124      ! local variable 
     1125      INTEGER(i4) :: il_varid 
     1126      TYPE(TVAR)  :: tl_depth 
     1127      ! loop indices 
     1128      !---------------------------------------------------------------- 
     1129 
     1130      ! get or check depth value 
     1131      IF( td_mpp%t_proc(1)%i_depthid /= 0 )THEN 
     1132 
     1133         il_varid=td_mpp%t_proc(1)%i_depthid 
     1134         IF( ASSOCIATED(td_depth%d_value) )THEN 
     1135 
     1136            tl_depth=iom_mpp_read_var(td_mpp, il_varid) 
     1137 
     1138            IF( ANY( td_depth%d_value(:,:,:,:) /= & 
     1139            &        tl_depth%d_value(:,:,:,:) ) )THEN 
     1140 
     1141               CALL logger_warn("CREATE BATHY: depth value from "//& 
     1142               &  TRIM(td_mpp%c_name)//" not conform "//& 
     1143               &  " to those from former file(s).") 
     1144 
     1145            ENDIF 
     1146            CALL var_clean(tl_depth) 
     1147 
     1148         ELSE 
     1149            td_depth=iom_mpp_read_var(td_mpp,il_varid) 
     1150         ENDIF 
     1151 
     1152      ENDIF 
     1153       
     1154   END SUBROUTINE create_bathy_check_depth 
     1155   !------------------------------------------------------------------- 
     1156   !> @brief 
     1157   !> This subroutine get date and time in an open mpp structure 
     1158   !> and check if agree with date and time already read. 
     1159   !>  
     1160   !> @details  
     1161   !> 
     1162   !> @author J.Paul 
     1163   !> @date January, 2016 - Initial Version 
     1164   !> 
     1165   !> @param[in] td_mpp      mpp structure 
     1166   !> @param[inout] td_time  time variable structure  
     1167   !------------------------------------------------------------------- 
     1168   SUBROUTINE create_bathy_check_time( td_mpp, td_time ) 
     1169 
     1170      IMPLICIT NONE 
     1171 
     1172      ! Argument 
     1173      TYPE(TMPP), INTENT(IN   ) :: td_mpp 
     1174      TYPE(TVAR), INTENT(INOUT) :: td_time 
     1175 
     1176      ! local variable 
     1177      INTEGER(i4) :: il_varid 
     1178      TYPE(TVAR)  :: tl_time 
     1179 
     1180      TYPE(TDATE) :: tl_date1 
     1181      TYPE(TDATE) :: tl_date2 
     1182      ! loop indices 
     1183      !---------------------------------------------------------------- 
     1184 
     1185      ! get or check depth value 
     1186      IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN 
     1187 
     1188         il_varid=td_mpp%t_proc(1)%i_timeid 
     1189         IF( ASSOCIATED(td_time%d_value) )THEN 
     1190 
     1191            tl_time=iom_mpp_read_var(td_mpp, il_varid) 
     1192 
     1193            tl_date1=var_to_date(td_time) 
     1194            tl_date2=var_to_date(tl_time) 
     1195            IF( tl_date1 - tl_date2 /= 0 )THEN 
     1196 
     1197               CALL logger_warn("CREATE BATHY: date from "//& 
     1198               &  TRIM(td_mpp%c_name)//" not conform "//& 
     1199               &  " to those from former file(s).") 
     1200 
     1201            ENDIF 
     1202            CALL var_clean(tl_time) 
     1203 
     1204         ELSE 
     1205            td_time=iom_mpp_read_var(td_mpp,il_varid) 
     1206         ENDIF 
     1207 
     1208      ENDIF 
     1209       
     1210   END SUBROUTINE create_bathy_check_time 
    11111211END PROGRAM create_bathy 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/create_coord.f90

    r5608 r6455  
    99!> @file 
    1010!> @brief  
    11 !> This program create fine grid coordinate file. 
     11!> This program creates fine grid coordinate file. 
    1212!> 
    1313!> @details 
     
    2727!>    you could find a template of the namelist in templates directory. 
    2828!> 
    29 !>    create_coord.nam comprise 6 namelists:<br/> 
     29!>    create_coord.nam contains 6 namelists:<br/> 
    3030!>       - logger namelist (namlog) 
    3131!>       - config namelist (namcfg) 
     
    3535!>       - output namelist (namout) 
    3636!>     
    37 !>    @note  
    38 !>       All namelists have to be in file create_coord.nam,  
    39 !>       however variables of those namelists are all optional. 
    40 !> 
    4137!>    * _logger namelist (namlog)_:<br/> 
    4238!>       - cn_logfile   : log filename 
     
    4844!>       - cn_varcfg : variable configuration file  
    4945!> (see ./SIREN/cfg/variable.cfg) 
     46!>       - cn_dumcfg : useless (dummy) configuration file, for useless  
     47!> dimension or variable (see ./SIREN/cfg/dummy.cfg). 
    5048!> 
    5149!>    * _coarse grid namelist (namcrs)_:<br/> 
     
    6462!>             - int = interpolation method 
    6563!>             - ext = extrapolation method 
    66 !>             - flt = filter method 
    6764!>  
    6865!>                requests must be separated by ';' .<br/> 
     
    7269!>          @ref extrap and @ref filter modules.<br/> 
    7370!> 
    74 !>          Example: 'votemper: int=linear; flt=hann(2,3); ext=dist_weight',  
    75 !>          'vosaline: int=cubic'<br/> 
     71!>          Example: 'glamt: int=linear; ext=dist_weight',  
     72!>          'e1t: int=cubic/rhoi'<br/> 
    7673!>          @note  
    7774!>             If you do not specify a method which is required,  
     
    103100!> - compute offset considering grid point 
    104101!> - add global attributes in output file 
     102!> @date September, 2015 
     103!> - manage useless (dummy) variable, attributes, and dimension 
    105104!> 
    106105!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    167166 
    168167   ! namcfg 
    169    CHARACTER(LEN=lc) :: cn_varcfg = '../cfg/variable.cfg'  
     168   CHARACTER(LEN=lc) :: cn_varcfg = './cfg/variable.cfg'  
     169   CHARACTER(LEN=lc) :: cn_dumcfg = './cfg/dummy.cfg' 
    170170 
    171171   ! namcrs 
     
    194194 
    195195   NAMELIST /namcfg/ &  !  config namelist 
    196    &  cn_varcfg         !< variable configuration file 
     196   &  cn_varcfg, &       !< variable configuration file 
     197   &  cn_dumcfg          !< dummy configuration file 
    197198 
    198199   NAMELIST /namcrs/ &  !  coarse grid namelist 
     
    254255      CALL var_def_extra(TRIM(cn_varcfg)) 
    255256 
     257      ! get dummy variable 
     258      CALL var_get_dummy(TRIM(cn_dumcfg)) 
     259      ! get dummy dimension 
     260      CALL dim_get_dummy(TRIM(cn_dumcfg)) 
     261      ! get dummy attribute 
     262      CALL att_get_dummy(TRIM(cn_dumcfg)) 
     263 
    256264      READ( il_fileid, NML = namcrs ) 
    257265      READ( il_fileid, NML = namvar ) 
     
    354362   ENDDO 
    355363 
     364   ! clean 
     365   CALL dom_clean_extra( tl_dom ) 
     366 
    356367   ! close mpp files 
    357368   CALL iom_dom_close(tl_coord0) 
     
    388399   CALL file_add_att(tl_fileout, tl_att)    
    389400 
    390    tl_att=att_init("src_i_indices",(/in_imin0,in_imax0/)) 
     401   tl_att=att_init("src_i_indices",(/tl_dom%i_imin,tl_dom%i_imax/)) 
    391402   CALL file_add_att(tl_fileout, tl_att)    
    392    tl_att=att_init("src_j_indices",(/in_jmin0,in_jmax0/)) 
     403   tl_att=att_init("src_j_indices",(/tl_dom%i_jmin,tl_dom%i_jmax/)) 
    393404   CALL file_add_att(tl_fileout, tl_att) 
    394405   IF( .NOT. ALL(il_rho(:)==1) )THEN 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/create_restart.f90

    r5616 r6455  
    99!> @file 
    1010!> @brief  
    11 !> This program create restart file. 
     11!> This program creates restart file. 
    1212!> 
    1313!> @details 
    1414!> @section sec1 method 
    1515!> Variables could be extracted from fine grid file, interpolated from coarse 
    16 !> grid file or restart file, or manually written.<br/>  
    17 !> Then they are split over new decomposition.  
     16!> grid file or restart file. Variables could also be manually written.<br/>  
     17!> Then they are split over new layout.  
    1818!> @note  
    1919!>    method could be different for each variable. 
     
    2828!>    you could find a template of the namelist in templates directory. 
    2929!> 
    30 !>    create_restart.nam comprise 9 namelists:<br/> 
     30!>    create_restart.nam contains 9 namelists:<br/> 
    3131!>       - logger namelist (namlog) 
    3232!>       - config namelist (namcfg) 
     
    3939!>       - output namelist (namout) 
    4040!>     
    41 !>    @note  
    42 !>       All namelists have to be in file create_restart.nam  
    43 !>       however variables of those namelists are all optional. 
    44 !> 
    4541!>    * _logger namelist (namlog)_:<br/> 
    4642!>       - cn_logfile   : log filename 
     
    5248!>       - cn_varcfg : variable configuration file 
    5349!> (see ./SIREN/cfg/variable.cfg) 
     50!>       - cn_dumcfg : useless (dummy) configuration file, for useless  
     51!> dimension or variable (see ./SIREN/cfg/dummy.cfg). 
    5452!> 
    5553!>    * _coarse grid namelist (namcrs):<br/> 
     
    8280!> 
    8381!>    * _variable namelist (namvar)_:<br/> 
    84 !>       - cn_varinfo : list of variable and extra information about request(s)  
    85 !>       to be used.<br/> 
    86 !>          each elements of *cn_varinfo* is a string character 
    87 !>          (separated by ',').<br/> 
    88 !>          it is composed of the variable name follow by ':',  
    89 !>          then request(s) to be used on this variable.<br/>  
    90 !>          request could be: 
    91 !>             - int = interpolation method 
    92 !>             - ext = extrapolation method 
    93 !>             - flt = filter method 
    94 !>             - min = minimum value 
    95 !>             - max = maximum value 
    96 !>             - unt = new units 
    97 !>             - unf = unit scale factor (linked to new units) 
    98 !> 
    99 !>             requests must be separated by ';'.<br/> 
    100 !>             order of requests does not matter.<br/> 
    101 !> 
    102 !>          informations about available method could be find in @ref interp, 
    103 !>          @ref extrap and @ref filter.<br/> 
    104 !>          Example: 'votemper: int=linear; flt=hann; ext=dist_weight','vosaline: int=cubic' 
    105 !>          @note  
    106 !>             If you do not specify a method which is required,  
    107 !>             default one is apply. 
    108 !>       - cn_varfile : list of variable, and corresponding file<br/>  
     82!>       - cn_varfile : list of variable, and associated file<br/>  
    10983!>          *cn_varfile* is the path and filename of the file where find 
    11084!>          variable.<br/> 
     
    131105!>             - 'all:restart.dimg' 
    132106!> 
     107!>       - cn_varinfo : list of variable and extra information about request(s)  
     108!>       to be used.<br/> 
     109!>          each elements of *cn_varinfo* is a string character 
     110!>          (separated by ',').<br/> 
     111!>          it is composed of the variable name follow by ':',  
     112!>          then request(s) to be used on this variable.<br/>  
     113!>          request could be: 
     114!>             - int = interpolation method 
     115!>             - ext = extrapolation method 
     116!>             - flt = filter method 
     117!>             - min = minimum value 
     118!>             - max = maximum value 
     119!>             - unt = new units 
     120!>             - unf = unit scale factor (linked to new units) 
     121!> 
     122!>             requests must be separated by ';'.<br/> 
     123!>             order of requests does not matter.<br/> 
     124!> 
     125!>          informations about available method could be find in @ref interp, 
     126!>          @ref extrap and @ref filter.<br/> 
     127!>          Example: 'votemper: int=linear; flt=hann; ext=dist_weight', 
     128!>                   'vosaline: int=cubic' 
     129!>          @note  
     130!>             If you do not specify a method which is required,  
     131!>             default one is apply. 
     132!> 
    133133!>    * _nesting namelist (namnst)_:<br/> 
    134134!>       - in_rhoi  : refinement factor in i-direction 
    135135!>       - in_rhoj  : refinement factor in j-direction 
    136136!>       @note  
    137 !>          coarse grid indices will be deduced from fine grid 
     137!>          coarse grid indices will be computed from fine grid 
    138138!>          coordinate file. 
    139139!> 
     
    141141!>       - cn_fileout : output file 
    142142!>       - ln_extrap : extrapolate land point or not 
    143 !>       - in_niproc : i-direction number of processor 
    144 !>       - in_njproc : j-direction numebr of processor 
     143!>       - in_niproc : number of processor in i-direction 
     144!>       - in_njproc : number of processor in j-direction 
    145145!>       - in_nproc  : total number of processor to be used 
    146146!>       - cn_type   : output format ('dimg', 'cdf') 
     
    156156!> - extrapolate all land points, and add ln_extrap in namelist. 
    157157!> - allow to change unit. 
     158!> @date September, 2015 
     159!> - manage useless (dummy) variable, attributes, and dimension 
    158160!> 
    159161!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    173175   USE iom                             ! I/O manager 
    174176   USE grid                            ! grid manager 
    175    USE vgrid                            ! vertical grid manager 
     177   USE vgrid                           ! vertical grid manager 
    176178   USE extrap                          ! extrapolation manager 
    177179   USE interp                          ! interpolation manager 
     
    183185 
    184186   IMPLICIT NONE 
    185  
    186187 
    187188   ! local variable 
     
    212213 
    213214   LOGICAL                                            :: ll_exist 
     215   LOGICAL                                            :: ll_sameGrid 
    214216 
    215217   TYPE(TDOM)                                         :: tl_dom1 
     
    242244   ! namelist variable 
    243245   ! namlog 
    244    CHARACTER(LEN=lc) :: cn_logfile = 'create_restart.log'  
    245    CHARACTER(LEN=lc) :: cn_verbosity = 'warning'  
    246    INTEGER(i4)       :: in_maxerror = 5 
     246   CHARACTER(LEN=lc)                       :: cn_logfile = 'create_restart.log'  
     247   CHARACTER(LEN=lc)                       :: cn_verbosity = 'warning'  
     248   INTEGER(i4)                             :: in_maxerror = 5 
    247249 
    248250   ! namcfg 
    249    CHARACTER(LEN=lc) :: cn_varcfg = 'variable.cfg'  
     251   CHARACTER(LEN=lc)                       :: cn_varcfg = 'variable.cfg'  
     252   CHARACTER(LEN=lc)                       :: cn_dumcfg = 'dummy.cfg' 
    250253 
    251254   ! namcrs 
    252    CHARACTER(LEN=lc) :: cn_coord0 = ''  
    253    INTEGER(i4)       :: in_perio0 = -1 
     255   CHARACTER(LEN=lc)                       :: cn_coord0 = ''  
     256   INTEGER(i4)                             :: in_perio0 = -1 
    254257 
    255258   ! namfin 
    256    CHARACTER(LEN=lc) :: cn_coord1 = '' 
    257    CHARACTER(LEN=lc) :: cn_bathy1 = '' 
    258    INTEGER(i4)       :: in_perio1 = -1 
     259   CHARACTER(LEN=lc)                       :: cn_coord1 = '' 
     260   CHARACTER(LEN=lc)                       :: cn_bathy1 = '' 
     261   INTEGER(i4)                             :: in_perio1 = -1 
    259262 
    260263   !namzgr 
    261    REAL(dp)          :: dn_pp_to_be_computed = 0._dp 
    262    REAL(dp)          :: dn_ppsur     = -3958.951371276829_dp 
    263    REAL(dp)          :: dn_ppa0      =   103.9530096000000_dp 
    264    REAL(dp)          :: dn_ppa1      =     2.4159512690000_dp 
    265    REAL(dp)          :: dn_ppa2      =   100.7609285000000_dp 
    266    REAL(dp)          :: dn_ppkth     =    15.3510137000000_dp 
    267    REAL(dp)          :: dn_ppkth2    =    48.0298937200000_dp 
    268    REAL(dp)          :: dn_ppacr     =     7.0000000000000_dp 
    269    REAL(dp)          :: dn_ppacr2    =    13.000000000000_dp 
    270    REAL(dp)          :: dn_ppdzmin  = 6._dp 
    271    REAL(dp)          :: dn_pphmax    = 5750._dp 
    272    INTEGER(i4)       :: in_nlevel    = 75 
     264   REAL(dp)                                :: dn_pp_to_be_computed = 0._dp 
     265   REAL(dp)                                :: dn_ppsur   = -3958.951371276829_dp 
     266   REAL(dp)                                :: dn_ppa0    =   103.953009600000_dp 
     267   REAL(dp)                                :: dn_ppa1    =     2.415951269000_dp 
     268   REAL(dp)                                :: dn_ppa2    =   100.760928500000_dp 
     269   REAL(dp)                                :: dn_ppkth   =    15.351013700000_dp 
     270   REAL(dp)                                :: dn_ppkth2  =    48.029893720000_dp 
     271   REAL(dp)                                :: dn_ppacr   =     7.000000000000_dp 
     272   REAL(dp)                                :: dn_ppacr2  =    13.000000000000_dp 
     273   REAL(dp)                                :: dn_ppdzmin = 6._dp 
     274   REAL(dp)                                :: dn_pphmax  = 5750._dp 
     275   INTEGER(i4)                             :: in_nlevel  = 75 
    273276 
    274277   !namzps 
    275    REAL(dp)          :: dn_e3zps_min = 25._dp 
    276    REAL(dp)          :: dn_e3zps_rat = 0.2_dp 
     278   REAL(dp)                                :: dn_e3zps_min = 25._dp 
     279   REAL(dp)                                :: dn_e3zps_rat = 0.2_dp 
    277280 
    278281   ! namvar 
     282   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = '' 
    279283   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = '' 
    280    CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = '' 
    281284 
    282285   ! namnst 
    283    INTEGER(i4)       :: in_rhoi = 0 
    284    INTEGER(i4)       :: in_rhoj = 0 
     286   INTEGER(i4)                             :: in_rhoi = 0 
     287   INTEGER(i4)                             :: in_rhoj = 0 
    285288 
    286289   ! namout 
    287    CHARACTER(LEN=lc) :: cn_fileout = 'restart.nc'  
    288    LOGICAL           :: ln_extrap  = .FALSE. 
    289    INTEGER(i4)       :: in_nproc   = 0 
    290    INTEGER(i4)       :: in_niproc  = 0 
    291    INTEGER(i4)       :: in_njproc  = 0 
    292    CHARACTER(LEN=lc) :: cn_type    = '' 
     290   CHARACTER(LEN=lc)                       :: cn_fileout = 'restart.nc'  
     291   LOGICAL                                 :: ln_extrap  = .FALSE. 
     292   INTEGER(i4)                             :: in_nproc   = 0 
     293   INTEGER(i4)                             :: in_niproc  = 0 
     294   INTEGER(i4)                             :: in_njproc  = 0 
     295   CHARACTER(LEN=lc)                       :: cn_type    = '' 
    293296 
    294297   !------------------------------------------------------------------- 
     
    300303 
    301304   NAMELIST /namcfg/ &  !< configuration namelist 
    302    &  cn_varcfg         !< variable configuration file 
     305   &  cn_varcfg, &      !< variable configuration file 
     306   &  cn_dumcfg         !< dummy configuration file 
    303307 
    304308   NAMELIST /namcrs/ &  !< coarse grid namelist 
     
    330334 
    331335   NAMELIST /namvar/ &  !< variable namelist 
    332    &  cn_varinfo, &     !< list of variable and interpolation method to be used. 
    333    &  cn_varfile        !< list of variable file 
     336   &  cn_varfile, &     !< list of variable file 
     337   &  cn_varinfo        !< list of variable and interpolation method to be used. 
    334338    
    335339   NAMELIST /namnst/ &  !< nesting namelist 
     
    382386      ! get variable extra information 
    383387      CALL var_def_extra(TRIM(cn_varcfg)) 
     388 
     389      ! get dummy variable 
     390      CALL var_get_dummy(TRIM(cn_dumcfg)) 
     391      ! get dummy dimension 
     392      CALL dim_get_dummy(TRIM(cn_dumcfg)) 
     393      ! get dummy attribute 
     394      CALL att_get_dummy(TRIM(cn_dumcfg)) 
    384395 
    385396      READ( il_fileid, NML = namcrs ) 
     
    509520 
    510521               jvar=jvar+1 
    511                 
     522 
    512523               WRITE(*,'(2x,a,a)') "work on variable "//& 
    513524               &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 
     
    541552            CALL iom_mpp_open(tl_mpp) 
    542553 
    543  
    544554            ! get or check depth value 
    545555            CALL create_restart_check_depth( tl_mpp, tl_depth ) 
     
    551561            CALL iom_mpp_close(tl_mpp) 
    552562 
    553             IF( ANY( tl_mpp%t_dim(1:2)%i_len /= & 
    554             &        tl_coord0%t_dim(1:2)%i_len) )THEN 
     563            IF( ANY(tl_mpp%t_dim(1:2)%i_len /= tl_coord0%t_dim(1:2)%i_len) .OR.& 
     564            &   ALL(il_rho(:)==1) )THEN 
    555565            !!! extract value from fine grid  
    556566 
    557                IF( ANY( tl_mpp%t_dim(1:2)%i_len <= & 
     567               IF( ANY( tl_mpp%t_dim(1:2)%i_len < & 
    558568               &        tl_coord1%t_dim(1:2)%i_len) )THEN 
    559                   CALL logger_fatal("CREATE RESTART: dimension in file "//& 
     569                  CALL logger_fatal("CREATE RESTART: dimensions in file "//& 
    560570                  &  TRIM(tl_mpp%c_name)//" smaller than those in fine"//& 
    561571                  &  " grid coordinates.") 
    562572               ENDIF 
    563573 
     574               ! use coord0 instead of mpp for restart file case  
     575               !  (without lon,lat) 
     576               ll_sameGrid=.FALSE. 
     577               IF( ALL(tl_mpp%t_dim(1:2)%i_len /= tl_coord0%t_dim(1:2)%i_len) & 
     578               &   )THEN 
     579                  ll_sameGrid=.TRUE.  
     580               ENDIF 
     581 
    564582               ! compute domain on fine grid 
    565                il_ind(:,:)=grid_get_coarse_index(tl_mpp, tl_coord1 ) 
     583               IF( ll_sameGrid )THEN 
     584                  il_ind(:,:)=grid_get_coarse_index(tl_mpp, tl_coord1 ) 
     585               ELSE 
     586                  il_ind(:,:)=grid_get_coarse_index(tl_coord0, tl_coord1 ) 
     587               ENDIF 
    566588 
    567589               il_imin1=il_ind(1,1) ; il_imax1=il_ind(1,2) 
     
    569591 
    570592               !- check grid coincidence 
    571                CALL grid_check_coincidence( tl_mpp, tl_coord1, & 
    572                &                            il_imin1, il_imax1, & 
    573                &                            il_jmin1, il_jmax1, & 
    574                &                            il_rho(:) ) 
     593               IF( ll_sameGrid )THEN 
     594                  CALL grid_check_coincidence( tl_mpp, tl_coord1, & 
     595                  &                            il_imin1, il_imax1, & 
     596                  &                            il_jmin1, il_jmax1, & 
     597                  &                            il_rho(:) ) 
     598               ELSE 
     599                  CALL grid_check_coincidence( tl_coord0, tl_coord1, & 
     600                  &                            il_imin1, il_imax1, & 
     601                  &                            il_jmin1, il_jmax1, & 
     602                  &                            il_rho(:) ) 
     603               ENDIF 
    575604 
    576605               ! compute domain 
     
    754783 
    755784   DO ji=1,ip_maxdim 
     785 
    756786      IF( tl_dim(ji)%l_use )THEN 
    757787         CALL mpp_move_dim(tl_mppout, tl_dim(ji)) 
     
    763793         END SELECT  
    764794      ENDIF 
     795 
    765796   ENDDO 
    766797 
     
    879910   !> and with dimension of the coordinate file.<br/>  
    880911   !> Then the variable array of value is split into equal subdomain. 
    881    !> Each subdomain is filled with the corresponding value of the matrix. 
     912   !> Each subdomain is filled with the associated value of the matrix. 
    882913   !> 
    883914   !> @author J.Paul 
     
    11691200            &        tl_depth%d_value(:,:,:,:) ) )THEN 
    11701201 
    1171                CALL logger_fatal("CREATE BOUNDARY: depth value from "//& 
    1172                &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& 
     1202               CALL logger_warn("CREATE BOUNDARY: depth value from "//& 
     1203               &  TRIM(td_mpp%c_name)//" not conform "//& 
    11731204               &  " to those from former file(s).") 
    11741205 
     
    12261257            IF( tl_date1 - tl_date2 /= 0 )THEN 
    12271258 
    1228                CALL logger_fatal("CREATE BOUNDARY: date from "//& 
    1229                &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& 
     1259               CALL logger_warn("CREATE BOUNDARY: date from "//& 
     1260               &  TRIM(td_mpp%c_name)//" not conform "//& 
    12301261               &  " to those from former file(s).") 
    12311262 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/dimension.f90

    r5616 r6455  
    154154! REVISION HISTORY: 
    155155!> @date November, 2013 - Initial Version 
     156!> @date Spetember, 2015 
     157!> - manage useless (dummy) dimension 
    156158!> 
    157159!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    167169   ! type and variable 
    168170   PUBLIC :: TDIM              !< dimension structure 
     171 
     172   PRIVATE :: cm_dumdim        !< dummy dimension array 
    169173 
    170174   ! function and subroutine 
     
    182186   PUBLIC :: dim_get_index     !< get dimension index in array of dimension structure 
    183187   PUBLIC :: dim_get_id        !< get dimension id in array of dimension structure 
     188   PUBLIC :: dim_get_dummy     !< fill dummy dimension array 
     189   PUBLIC :: dim_is_dummy      !< check if dimension is defined as dummy dimension 
    184190 
    185191   PRIVATE :: dim__reshape_2xyzt_dp ! reshape real(8) 4D array to ('x','y','z','t') 
     
    209215   END TYPE 
    210216 
     217   CHARACTER(LEN=lc), DIMENSION(ip_maxdum), SAVE :: cm_dumdim !< dummy dimension 
     218 
    211219   INTERFACE dim_print 
    212220      MODULE PROCEDURE dim__print_unit ! print information on one dimension 
     
    518526   !> @param[in] ld_uld    dimension unlimited 
    519527   !> @param[in] cd_sname  dimension short name 
    520    !> @param[in] ld_uld    dimension use or not 
     528   !> @param[in] ld_use    dimension use or not 
    521529   !> @return dimension structure 
    522530   !------------------------------------------------------------------- 
    523    TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname, ld_use) 
     531   TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname, ld_use ) 
    524532      IMPLICIT NONE 
    525533 
     
    14011409 
    14021410   END SUBROUTINE dim__clean_arr 
     1411   !------------------------------------------------------------------- 
     1412   !> @brief This subroutine fill dummy dimension array 
     1413   ! 
     1414   !> @author J.Paul 
     1415   !> @date September, 2015 - Initial Version 
     1416   ! 
     1417   !> @param[in] cd_dummy dummy configuration file 
     1418   !------------------------------------------------------------------- 
     1419   SUBROUTINE dim_get_dummy( cd_dummy ) 
     1420      IMPLICIT NONE 
     1421      ! Argument 
     1422      CHARACTER(LEN=*), INTENT(IN) :: cd_dummy 
     1423 
     1424      ! local variable 
     1425      INTEGER(i4)   :: il_fileid 
     1426      INTEGER(i4)   :: il_status 
     1427 
     1428      LOGICAL       :: ll_exist 
     1429 
     1430      ! loop indices 
     1431      ! namelist 
     1432      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumvar 
     1433      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumdim 
     1434      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumatt 
     1435 
     1436      !---------------------------------------------------------------- 
     1437      NAMELIST /namdum/ &   !< dummy namelist 
     1438      &  cn_dumvar, &       !< variable  name 
     1439      &  cn_dumdim, &       !< dimension name 
     1440      &  cn_dumatt          !< attribute name 
     1441      !---------------------------------------------------------------- 
     1442 
     1443      ! init 
     1444      cm_dumdim(:)='' 
     1445 
     1446      ! read namelist 
     1447      INQUIRE(FILE=TRIM(cd_dummy), EXIST=ll_exist) 
     1448      IF( ll_exist )THEN 
     1449 
     1450         il_fileid=fct_getunit() 
     1451 
     1452         OPEN( il_fileid, FILE=TRIM(cd_dummy), & 
     1453         &                FORM='FORMATTED',       & 
     1454         &                ACCESS='SEQUENTIAL',    & 
     1455         &                STATUS='OLD',           & 
     1456         &                ACTION='READ',          & 
     1457         &                IOSTAT=il_status) 
     1458         CALL fct_err(il_status) 
     1459         IF( il_status /= 0 )THEN 
     1460            CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_dummy)) 
     1461         ENDIF 
     1462 
     1463         READ( il_fileid, NML = namdum ) 
     1464         cm_dumdim(:)=cn_dumdim(:) 
     1465 
     1466         CLOSE( il_fileid ) 
     1467 
     1468      ENDIF 
     1469 
     1470   END SUBROUTINE dim_get_dummy 
     1471   !------------------------------------------------------------------- 
     1472   !> @brief This function check if dimension is defined as dummy dimension 
     1473   !> in configuraton file 
     1474   !> 
     1475   !> @author J.Paul 
     1476   !> @date September, 2015 - Initial Version 
     1477   ! 
     1478   !> @param[in] td_dim dimension structure 
     1479   !> @return true if dimension is dummy dimension  
     1480   !------------------------------------------------------------------- 
     1481   FUNCTION dim_is_dummy(td_dim) 
     1482      IMPLICIT NONE 
     1483 
     1484      ! Argument       
     1485      TYPE(TDIM), INTENT(IN) :: td_dim 
     1486       
     1487      ! function 
     1488      LOGICAL :: dim_is_dummy 
     1489       
     1490      ! loop indices 
     1491      INTEGER(i4) :: ji 
     1492      !---------------------------------------------------------------- 
     1493 
     1494      dim_is_dummy=.FALSE. 
     1495      DO ji=1,ip_maxdum 
     1496         IF( fct_lower(td_dim%c_name) == fct_lower(cm_dumdim(ji)) )THEN 
     1497            dim_is_dummy=.TRUE. 
     1498            EXIT 
     1499         ENDIF 
     1500      ENDDO 
     1501 
     1502   END FUNCTION dim_is_dummy 
    14031503END MODULE dim 
    14041504 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/docsrc/1_install.md

    r5616 r6455  
    1 # How to Install 
     1# Download 
    22 
    3 # Install NEMO 
    4 to install SIREN, you should first install NEMO. 
    5 see [here](http://www.nemo-ocean.eu/Using-NEMO/User-Guides/Basics/NEMO-Quick-Start-Guide) 
     3# Download NEMO # 
     4to install SIREN, you should first download NEMO. 
     5see [NEMO quick start guide](http://www.nemo-ocean.eu/Using-NEMO/User-Guides/Basics/NEMO-Quick-Start-Guide) 
    66 
    7 # Compile SIREN 
     7# Compile SIREN # 
    88when NEMO is installed, you just have to compile SIREN codes: 
    9 1. go to ./NEMOGCM/TOOLS 
    10 2. use maketools <br/> 
    11    to get help: maketools -h  
     9   1. go to ./NEMOGCM/TOOLS 
     10   2. run maketools (ex: ./maketools -n SIREN -m ifort_mpi_beaufix) 
    1211 
    13 # Fortran Compiler 
    14    SIREN codes were succesfully tested with : 
    15    - ifort (version 15.0.1) 
    16    - gfortran (version 4.8.2 20140120)  
    17 <!--   - pgf95 (version 13.9-0) --> 
     12      @note to get help on maketools: ./maketools -h 
    1813 
    19  <HR> 
    20    <b> 
    21    - @ref index 
    22    - @ref md_docsrc_3_codingRules 
    23    - @ref md_docsrc_4_changeLog 
    24    - @ref todo 
    25    </b> 
     14# Fortran Compiler # 
     15SIREN codes were succesfully tested with : 
     16  - ifort (version 15.0.1) 
     17  - gfortran (version 4.8.2 20140120)  
     18 
     19<HR> 
     20  <b> 
     21  - @ref index 
     22  - @ref md_docsrc_2_quickstart 
     23  - @ref md_docsrc_3_support_bug 
     24  - @ref md_docsrc_4_codingRules 
     25  - @ref md_docsrc_5_changeLog 
     26  - @ref todo 
     27  </b> 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/docsrc/main.dox

    r5037 r6455  
    11/*! 
    2  @mainpage Main Page 
    3  @section descr Generic Description 
    4  SIREN is a software to create regional configuration with 
    5  [NEMO](http://www.nemo-ocean.eu).<br/>  
     2 @mainpage About  
     3 
     4 SIREN is a software to create regional configuration with [NEMO](http://www.nemo-ocean.eu).<br/>  
    65 Actually SIREN create input files needed for a basic NEMO configuration.<br/> 
     6 
     7 SIREN allows you to create your own regional configuration embedded in a wider one.<br/> 
     8 In order to help you, a set of GLORYS files (global reanalysis on ORCA025 grid), as well as examples 
     9 of namelists are available in dods repository. 
     10 
     11 @note This software was created, and is maintain by the Configuration Manager Working Group, composed 
     12 of NEMO system team members. 
    713  
    8  SIREN is composed of a set of 5 Fortran programs : 
    9    - create_coord.f90 to create fine grid coordinate file from coarse grid coordinate file. 
    10    - create_bathy.f90 to create fine grid bathymetry file over domain. 
    11    - merge_bathy.f90 to merge fine grid bathymetry with coarse grid bathymetry at boundaries. 
    12    - create_restart.f90 to create initial state file from coarse grid restart or standard outputs. 
    13    - create_boundary.f90 to create boundary condition from coarse grid standard outputs. 
     14 To know how to install SIREN see @ref md_docsrc_1_install. 
    1415 
    15 To install those programs see @ref md_docsrc_1_install. 
    16  
    17  @note SIREN can not: 
    18  - create global configuration 
    19  - create configuarion around or close to north pole 
    20  - change number of vertical level 
    21  - change grid (horizontal or vertical) 
    22  
    23  @section howto How to use 
    24    @subsection howto_coord to create fine grid coordinate file 
    25    see create_coord.f90 
    26    @subsection howto_bathy to create fine grid bathymetry 
    27    see create_bathy.f90 
    28    @subsection howto_merge to merge fine grid bathymetry 
    29    see merge_bathy.f90 
    30    @subsection howto_restart to create initial state file 
    31    see create_restart.f90 
    32    @subsection howto_boundary to create boundary condition 
    33    see create_boundary.f90 
     16 You could find a tutorial for a quick start with SIREN in @ref md_docsrc_2_quickstart.<br/> 
     17 For more information about how to use each component of SIREN 
     18 - see create_coord.f90 to create fine grid coordinate file 
     19 - see create_bathy.f90 to create fine grid bathymetry 
     20 - see merge_bathy.f90 to merge fine grid bathymetry 
     21 - see create_restart.f90 to create initial state file, or other fields. 
     22 - see create_boundary.F90 to create boundary condition 
    3423 
    3524<HR> 
    3625   <b> 
    3726   - @ref md_docsrc_1_install 
    38    - @ref md_docsrc_3_codingRules 
    39    - @ref md_docsrc_4_changeLog 
     27   - @ref md_docsrc_2_quickstart 
     28   - @ref md_docsrc_3_support_bug 
     29   - @ref md_docsrc_4_codingRules 
     30   - @ref md_docsrc_5_changeLog 
    4031   - @ref todo 
    4132   </b> 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/domain.f90

    r5616 r6455  
    12971297   !> @date September, 2014 
    12981298   !> - take into account number of ghost cell 
     1299   !> @date February, 2016 
     1300   !> - number of extra point is the MAX (not the MIN) of zero and asess value.  
    12991301   ! 
    13001302   !> @param[inout] td_dom domain strcuture 
     
    13441346                  td_dom%i_imin      = td_dom%i_imin - td_dom%i_iextra(1) 
    13451347               ELSE ! td_dom%i_imin - il_iext <= td_dom%i_ghost0(jp_I,1)*ip_ghost 
    1346                   td_dom%i_iextra(1) = MIN(0, & 
     1348                  td_dom%i_iextra(1) = MAX(0, & 
    13471349                  &                         td_dom%i_imin - & 
    13481350                  &                         td_dom%i_ghost0(jp_I,1)*ip_ghost -1) 
     
    13561358               ELSE ! td_dom%i_imax + il_iext >= & 
    13571359                    !  td_dom%t_dim0(1)%i_len - td_dom%i_ghost0(jp_I,2)*ip_ghost 
    1358                   td_dom%i_iextra(2) = MIN(0, & 
     1360                  td_dom%i_iextra(2) = MAX( 0, & 
    13591361                  &                         td_dom%t_dim0(1)%i_len - & 
    13601362                  &                         td_dom%i_ghost0(jp_I,2)*ip_ghost - & 
     
    13641366 
    13651367            ELSE ! td_dom%i_ew0 >= 0 
     1368 
    13661369               ! EW cyclic 
    13671370               IF( td_dom%i_imin - il_iext > 0 )THEN 
     
    13911394            ! nothing to be done 
    13921395         ELSE 
     1396 
    13931397            IF( td_dom%i_jmin - il_jext > td_dom%i_ghost0(jp_J,1)*ip_ghost )THEN 
    13941398               td_dom%i_jextra(1) = il_jext 
    13951399               td_dom%i_jmin      = td_dom%i_jmin - td_dom%i_jextra(1) 
    13961400            ELSE ! td_dom%i_jmin - il_jext <= td_dom%i_ghost0(jp_J,1)*ip_ghost 
    1397                td_dom%i_jextra(1) = MIN(0, & 
     1401               td_dom%i_jextra(1) = MAX( 0, & 
    13981402               &                         td_dom%i_jmin - & 
    13991403               &                         td_dom%i_ghost0(jp_J,1)*ip_ghost - 1) 
     
    14071411            ELSE ! td_dom%i_jmax + il_jext >= & 
    14081412                 !  td_dom%t_dim0(2)%i_len - td_dom%i_ghost0(jp_J,2)*ip_ghost 
    1409                td_dom%i_jextra(2) = MIN(0, & 
     1413               td_dom%i_jextra(2) = MAX( 0, & 
    14101414               &                         td_dom%t_dim0(2)%i_len - & 
    14111415               &                         td_dom%i_ghost0(jp_J,2)*ip_ghost - & 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/file.f90

    r5616 r6455  
    694694   !> @date November, 2013 - Initial Version 
    695695   !> @date September, 2014 
    696    !> - add dimension to file if need be 
     696   !> - add dimension in file if need be 
    697697   !> - do not reorder dimension from variable, before put in file 
     698   !> @date September, 2015 
     699   !> - check variable dimension expected 
    698700   ! 
    699701   !> @param[inout] td_file   file structure 
     
    705707      ! Argument       
    706708      TYPE(TFILE), INTENT(INOUT) :: td_file 
    707       TYPE(TVAR) , INTENT(IN   ) :: td_var 
     709      TYPE(TVAR) , INTENT(INOUT) :: td_var 
    708710 
    709711      ! local variable 
     
    761763               IF( file_check_var_dim(td_file, td_var) )THEN 
    762764 
     765                  ! check variable dimension expected 
     766                  CALL var_check_dim(td_var) 
     767 
    763768                  ! update dimension if need be 
    764769                  DO ji=1,ip_maxdim 
     
    10501055                  ! new number of variable in file 
    10511056                  td_file%i_nvar=td_file%i_nvar-1 
    1052  
    10531057                  SELECT CASE(td_var%i_ndim) 
    10541058                     CASE(0) 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/function.f90

    r5608 r6455  
    363363      IF( id_status /= 0 )THEN 
    364364         !CALL ERRSNS() ! not F95 standard 
    365          PRINT *, "FORTRAN ERROR" 
     365         PRINT *, "FORTRAN ERROR ",id_status 
    366366         !STOP 
    367367      ENDIF 
     
    740740   ! 
    741741   !> @param[in] cd_var character 
    742    !> @return character is numeric 
     742   !> @return character is real number 
    743743   !------------------------------------------------------------------- 
    744744   PURE LOGICAL FUNCTION fct_is_real(cd_var) 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/global.f90

    r5037 r6455  
    1212! REVISION HISTORY: 
    1313!> @date November, 2013 - Initial Version 
     14!> @date September, 2015 
     15!> - define fill value for each variable type 
    1416! 
    1517!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    9597   &     'gauss      '/) 
    9698 
    97    REAL(dp)                                , PARAMETER :: dp_fill=NF90_FILL_DOUBLE !< default fill value 
     99   REAL(dp)                                , PARAMETER :: dp_fill_i1=NF90_FILL_BYTE   !< byte fill value 
     100   REAL(dp)                                , PARAMETER :: dp_fill_i2=NF90_FILL_SHORT  !< short fill value 
     101   REAL(dp)                                , PARAMETER :: dp_fill_i4=NF90_FILL_INT    !< INT fill value 
     102   REAL(dp)                                , PARAMETER :: dp_fill_sp=NF90_FILL_FLOAT  !< real fill value 
     103   REAL(dp)                                , PARAMETER :: dp_fill=NF90_FILL_DOUBLE !< double fill value 
    98104 
    99105   INTEGER(i4)                             , PARAMETER :: ip_npoint=4 
     
    125131   INTEGER(i4), PARAMETER :: jp_west =4 
    126132 
    127  
     133   INTEGER(i4)                             , PARAMETER :: ip_maxdum = 10 !< maximum dummy variable, dimension, attribute 
    128134 
    129135END MODULE global 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/grid.f90

    r5616 r6455  
    8080!> point:<br/> 
    8181!> @code 
    82 !>    il_index(:)=grid_get_closest(dd_lon0(:,:), dd_lat0(:,:), dd_lon1, dd_lat1) 
     82!>    il_index(:)=grid_get_closest(dd_lon0(:,:), dd_lat0(:,:), dd_lon1, dd_lat1 
     83!>                                 [,dd_fill] [,cd_pos]) 
    8384!> @endcode 
    8485!>       - il_index(:) is  coarse grid indices (/ i0, j0 /) 
     
    8788!>       - dd_lon1 is fine grid longitude value (real(8)) 
    8889!>       - dd_lat1 is fine grid latitude  value (real(8)) 
     90!>       - dd_fill 
     91!>       - cd_pos 
    8992!> 
    9093!>    to compute distance between a point A and grid points:<br/> 
     
    215218!> @date February, 2015 
    216219!> - add function grid_fill_small_msk to fill small domain inside bigger one 
     220!> @February, 2016 
     221!> - improve way to check coincidence (bug fix) 
     222!> - manage grid cases for T,U,V or F point, with even or odd refinment (bug fix) 
    217223! 
    218224!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    664670             
    665671            ! no pivot point found 
    666             CALL logger_error("GRID GET PIVOT: something wrong "//& 
     672            CALL logger_warn("GRID GET PIVOT: something wrong "//& 
    667673            &  "when computing pivot point with variable "//& 
    668674            &  TRIM(td_var%c_name)) 
     
    685691 
    686692               IF( grid__get_pivot_var /= -1 )THEN 
    687                   CALL logger_warn("GRID GET PIVOT: variable "//& 
     693                  CALL logger_info("GRID GET PIVOT: variable "//& 
    688694                  &  TRIM(td_var%c_name)//" seems to be on grid point "//& 
    689695                  &  TRIM(cp_grid_point(jj)) ) 
     
    13351341         il_dim(:)=td_var%t_dim(:)%i_len 
    13361342 
    1337          CALL logger_info("GRID GET PERIO: use varibale "//TRIM(td_var%c_name)) 
    1338          CALL logger_info("GRID GET PERIO: fill value "//TRIM(fct_str(td_var%d_fill))) 
    1339          CALL logger_info("GRID GET PERIO: fill value "//TRIM(fct_str(td_var%d_value(1,1,1,1)))) 
     1343         CALL logger_debug("GRID GET PERIO: use varibale "//TRIM(td_var%c_name)) 
     1344         CALL logger_debug("GRID GET PERIO: fill value "//TRIM(fct_str(td_var%d_fill))) 
     1345         CALL logger_debug("GRID GET PERIO: first value "//TRIM(fct_str(td_var%d_value(1,1,1,1)))) 
    13401346 
    13411347         IF(ALL(td_var%d_value(    1    ,    :    ,1,1)/=td_var%d_fill).AND.& 
     
    13441350         &  ALL(td_var%d_value(    :    ,il_dim(2),1,1)/=td_var%d_fill))THEN 
    13451351         ! no boundary closed 
    1346             CALL logger_warn("GRID GET PERIO: can't determined periodicity. "//& 
     1352            CALL logger_error("GRID GET PERIO: can't determined periodicity. "//& 
    13471353            &             "there is no boundary closed for variable "//& 
    13481354            &              TRIM(td_var%c_name) ) 
     1355            ! check pivot 
     1356            SELECT CASE(id_pivot) 
     1357               CASE(0) 
     1358                  ! F pivot 
     1359                  CALL logger_warn("GRID GET PERIO: assume domain is global") 
     1360                  grid__get_perio_var=6 
     1361               CASE(1) 
     1362                  ! T pivot 
     1363                  CALL logger_warn("GRID GET PERIO: assume domain is global") 
     1364                  grid__get_perio_var=4 
     1365            END SELECT 
    13491366         ELSE 
    13501367            ! check periodicity 
     
    22872304         &                                                    il_rho(:), cl_point ) 
    22882305 
    2289           
    22902306         CALL var_clean(tl_lon1) 
    22912307         CALL var_clean(tl_lat1)          
     
    24632479   !> - check grid point 
    24642480   !> - take into account EW overlap 
     2481   !> @date February, 2016 
     2482   !> - use delta (lon or lat) 
     2483   !> - manage cases for T,U,V or F point, with even or odd refinment 
    24652484   !> 
    24662485   !> @param[in] td_lon0   coarse grid longitude 
     
    24902509 
    24912510      ! local variable 
    2492       REAL(dp)    :: dl_lon1_ll 
    2493       REAL(dp)    :: dl_lon1_ul 
    2494       REAL(dp)    :: dl_lon1_lr 
    2495       REAL(dp)    :: dl_lon1_ur 
    2496  
    2497       REAL(dp)    :: dl_lat1_ll 
    2498       REAL(dp)    :: dl_lat1_ul 
    2499       REAL(dp)    :: dl_lat1_lr 
    2500       REAL(dp)    :: dl_lat1_ur 
     2511      CHARACTER(LEN= 1)                      :: cl_point0 
     2512      CHARACTER(LEN= 1)                      :: cl_point1 
     2513 
     2514      LOGICAL    , DIMENSION(2)              :: ll_even 
     2515 
     2516      REAL(dp)                               :: dl_lon1 
     2517      REAL(dp)                               :: dl_dlon 
     2518      REAL(dp)                               :: dl_lat1 
     2519      REAL(dp)                               :: dl_dlat 
     2520 
     2521      INTEGER(i4)                            :: il_ew0  
     2522      INTEGER(i4)                            :: il_imin0 
     2523      INTEGER(i4)                            :: il_imax0 
     2524      INTEGER(i4)                            :: il_jmin0 
     2525      INTEGER(i4)                            :: il_jmax0 
     2526 
     2527      INTEGER(i4)                            :: il_ew1  
     2528      INTEGER(i4)                            :: il_imin1 
     2529      INTEGER(i4)                            :: il_imax1 
     2530      INTEGER(i4)                            :: il_jmin1 
     2531      INTEGER(i4)                            :: il_jmax1 
     2532 
     2533      INTEGER(i4)                            :: il_imin 
     2534      INTEGER(i4)                            :: il_imax 
     2535      INTEGER(i4)                            :: il_jmin 
     2536      INTEGER(i4)                            :: il_jmax       
    25012537 
    25022538      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 
    25032539 
    2504       INTEGER(i4), DIMENSION(2) :: il_ill 
    2505       INTEGER(i4), DIMENSION(2) :: il_ilr 
    2506       INTEGER(i4), DIMENSION(2) :: il_iul 
    2507       INTEGER(i4), DIMENSION(2) :: il_iur 
    2508  
    2509       INTEGER(i4) :: il_ew0  
    2510       INTEGER(i4) :: il_imin0 
    2511       INTEGER(i4) :: il_imax0 
    2512       INTEGER(i4) :: il_jmin0 
    2513       INTEGER(i4) :: il_jmax0 
    2514  
    2515       INTEGER(i4) :: il_ew1  
    2516       INTEGER(i4) :: il_imin1 
    2517       INTEGER(i4) :: il_imax1 
    2518       INTEGER(i4) :: il_jmin1 
    2519       INTEGER(i4) :: il_jmax1 
    2520  
    2521       INTEGER(i4) :: il_imin 
    2522       INTEGER(i4) :: il_imax 
    2523       INTEGER(i4) :: il_jmin 
    2524       INTEGER(i4) :: il_jmax       
    2525  
    2526       INTEGER(i4), DIMENSION(2,2) :: il_xghost0 
    2527       INTEGER(i4), DIMENSION(2,2) :: il_yghost0 
    2528       INTEGER(i4), DIMENSION(2,2) :: il_xghost1 
    2529       INTEGER(i4), DIMENSION(2,2) :: il_yghost1 
    2530  
    2531       TYPE(TVAR) :: tl_lon0 
    2532       TYPE(TVAR) :: tl_lat0 
    2533       TYPE(TVAR) :: tl_lon1 
    2534       TYPE(TVAR) :: tl_lat1 
    2535  
    2536       CHARACTER(LEN= 1) :: cl_point0 
    2537       CHARACTER(LEN= 1) :: cl_point1 
    2538        
     2540      INTEGER(i4), DIMENSION(2)              :: il_ill 
     2541      INTEGER(i4), DIMENSION(2)              :: il_ilr 
     2542      INTEGER(i4), DIMENSION(2)              :: il_iul 
     2543      INTEGER(i4), DIMENSION(2)              :: il_iur 
     2544 
     2545      INTEGER(i4), DIMENSION(2,2)            :: il_xghost0 
     2546      INTEGER(i4), DIMENSION(2,2)            :: il_yghost0 
     2547      INTEGER(i4), DIMENSION(2,2)            :: il_xghost1 
     2548      INTEGER(i4), DIMENSION(2,2)            :: il_yghost1 
     2549 
     2550      TYPE(TVAR)                             :: tl_lon0 
     2551      TYPE(TVAR)                             :: tl_lat0 
     2552      TYPE(TVAR)                             :: tl_lon1 
     2553      TYPE(TVAR)                             :: tl_lat1 
     2554 
    25392555      ! loop indices 
    2540       INTEGER(i4) :: ji 
    2541       INTEGER(i4) :: jj 
    25422556      !---------------------------------------------------------------- 
    25432557      ! init 
     
    25472561      il_rho(:)=1 
    25482562      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:) 
     2563 
     2564      ll_even(:)=(/ (MOD(id_rho(jp_I),2)==0), (MOD(id_rho(jp_J),2)==0) /) 
    25492565 
    25502566      cl_point0='T' 
     
    26452661            ! get indices for each corner 
    26462662            !1- search lower left corner indices 
    2647             dl_lon1_ll=tl_lon1%d_value( il_imin1, il_jmin1, 1, 1 ) 
    2648             dl_lat1_ll=tl_lat1%d_value( il_imin1, il_jmin1, 1, 1 ) 
    2649  
    2650             IF( dl_lon1_ll == tl_lon1%d_fill .OR. & 
    2651             &   dl_lat1_ll == tl_lat1%d_fill )THEN 
    2652                CALL logger_debug("GRID GET COARSE INDEX: lon "//& 
    2653                &  TRIM(fct_str(dl_lon1_ll))//" "//& 
    2654                &  TRIM(fct_str(tl_lon1%d_fill)) ) 
    2655                CALL logger_debug("GRID GET COARSE INDEX: lat "//& 
    2656                &  TRIM(fct_str(dl_lat1_ll))//" "//& 
    2657                &  TRIM(fct_str(tl_lat1%d_fill)) ) 
     2663            dl_lon1=tl_lon1%d_value( il_imin1, il_jmin1, 1, 1 ) 
     2664            dl_lat1=tl_lat1%d_value( il_imin1, il_jmin1, 1, 1 ) 
     2665 
     2666            IF( dl_lon1 == tl_lon1%d_fill .OR. & 
     2667            &   dl_lat1 == tl_lat1%d_fill )THEN 
    26582668               CALL logger_error("GRID GET COARSE INDEX: lower left corner "//& 
    26592669               &                 "point is FillValue. remove ghost cell "//& 
    26602670               &                 "before running grid_get_coarse_index.") 
    26612671            ENDIF 
     2672 
     2673            !!!!! i-direction !!!!! 
     2674            IF( ll_even(jp_I) )THEN 
     2675               ! even 
     2676               SELECT CASE(TRIM(cl_point1)) 
     2677                  CASE('F','U') 
     2678                     dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmin1,1,1) -   & 
     2679                        &       tl_lon1%d_value(il_imin1  ,il_jmin1,1,1) ) / & 
     2680                        &     2. 
     2681                  CASE DEFAULT 
     2682                     dl_dlon=0 
     2683               END SELECT 
     2684            ELSE 
     2685               ! odd 
     2686               dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmin1,1,1) -   & 
     2687                  &       tl_lon1%d_value(il_imin1  ,il_jmin1,1,1) ) / & 
     2688                  &     2. 
     2689            ENDIF 
     2690 
     2691            !!!!! j-direction !!!!! 
     2692            IF( ll_even(jp_J) )THEN 
     2693               ! even 
     2694               SELECT CASE(TRIM(cl_point1)) 
     2695                  CASE('F','V') 
     2696                     dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmin1+1,1,1) -   & 
     2697                        &       tl_lat1%d_value(il_imin1,il_jmin1  ,1,1) ) / & 
     2698                        &     2. 
     2699                  CASE DEFAULT 
     2700                     dl_dlat=0 
     2701               END SELECT 
     2702            ELSE 
     2703               ! odd 
     2704               dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmin1+1,1,1) -   & 
     2705                  &       tl_lat1%d_value(il_imin1,il_jmin1  ,1,1) ) / & 
     2706                  &     2. 
     2707            ENDIF 
     2708 
     2709            dl_lon1 = dl_lon1 + dl_dlon 
     2710            dl_lat1 = dl_lat1 + dl_dlat 
     2711 
    26622712            ! look for closest point on coarse grid 
    26632713            il_ill(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, & 
     
    26672717            &                                           il_jmin0:il_jmax0, & 
    26682718            &                                           1,1), & 
    2669             &                           dl_lon1_ll, dl_lat1_ll   ) 
    2670  
    2671             ! coarse grid point should be south west of fine grid domain 
    2672             ji = il_ill(1) 
    2673             jj = il_ill(2) 
    2674  
    2675             IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_ll) > dp_delta )THEN 
    2676                IF(tl_lon0%d_value(ji,jj,1,1) > dl_lon1_ll )THEN 
    2677                   il_ill(1)=il_ill(1)-1 
    2678                   IF( il_ill(1) <= 0 )THEN 
    2679                      IF( tl_lon0%i_ew >= 0 )THEN 
    2680                         il_ill(1)=tl_lon0%t_dim(jp_I)%i_len-tl_lon0%i_ew 
    2681                      ELSE 
    2682                         CALL logger_error("GRID GET COARSE INDEX: error "//& 
    2683                         &                 "computing lower left corner "//& 
    2684                         &                 "index for longitude") 
    2685                      ENDIF 
    2686                   ENDIF 
    2687                ENDIF 
    2688             ENDIF 
    2689             IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_ll) > dp_delta )THEN 
    2690                IF(tl_lat0%d_value(ji,jj,1,1) > dl_lat1_ll )THEN 
    2691                   il_ill(2)=il_ill(2)-1 
    2692                   IF( il_ill(2)-1 <= 0 )THEN 
    2693                      CALL logger_error("GRID GET COARSE INDEX: error "//& 
    2694                      &                 "computing lower left corner "//& 
    2695                      &                 "index for latitude") 
    2696                   ENDIF 
    2697                ENDIF 
    2698             ENDIF 
     2719            &                           dl_lon1, dl_lat1, 'll'   ) 
     2720 
    26992721 
    27002722            !2- search upper left corner indices 
    2701             dl_lon1_ul=tl_lon1%d_value( il_imin1, il_jmax1, 1, 1 ) 
    2702             dl_lat1_ul=tl_lat1%d_value( il_imin1, il_jmax1, 1, 1 ) 
    2703  
    2704             IF( dl_lon1_ul == tl_lon1%d_fill .OR. & 
    2705             &   dl_lat1_ul == tl_lat1%d_fill )THEN 
     2723            dl_lon1=tl_lon1%d_value( il_imin1, il_jmax1, 1, 1 ) 
     2724            dl_lat1=tl_lat1%d_value( il_imin1, il_jmax1, 1, 1 ) 
     2725 
     2726            IF( dl_lon1 == tl_lon1%d_fill .OR. & 
     2727            &   dl_lat1 == tl_lat1%d_fill )THEN 
    27062728               CALL logger_error("GRID GET COARSE INDEX: upper left corner "//& 
    27072729               &                 "point is FillValue. remove ghost cell "//& 
    27082730               &                 "running grid_get_coarse_index.") 
    27092731            ENDIF             
     2732 
     2733            !!!!! i-direction !!!!! 
     2734            IF( ll_even(jp_I) )THEN 
     2735               ! even 
     2736               SELECT CASE(TRIM(cl_point1)) 
     2737                  CASE('F','U') 
     2738                     dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmax1,1,1) -   & 
     2739                        &       tl_lon1%d_value(il_imin1  ,il_jmax1,1,1) ) / & 
     2740                        &     2. 
     2741                  CASE DEFAULT 
     2742                     dl_dlon=0 
     2743               END SELECT 
     2744            ELSE 
     2745               ! odd 
     2746               dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmax1,1,1) -   & 
     2747                  &       tl_lon1%d_value(il_imin1  ,il_jmax1,1,1) ) / & 
     2748                  &     2. 
     2749            ENDIF 
     2750 
     2751            !!!!! j-direction !!!!! 
     2752            IF( ll_even(jp_J) )THEN 
     2753               ! even 
     2754               SELECT CASE(TRIM(cl_point1)) 
     2755                  CASE('F','V') 
     2756                     dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmax1  ,1,1) -   & 
     2757                        &       tl_lat1%d_value(il_imin1,il_jmax1-1,1,1) ) / & 
     2758                        &     2. 
     2759                  CASE DEFAULT 
     2760                     dl_dlat=0 
     2761               END SELECT 
     2762            ELSE 
     2763               ! odd 
     2764               dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmax1  ,1,1) -   & 
     2765                  &       tl_lat1%d_value(il_imin1,il_jmax1-1,1,1) ) / & 
     2766                  &     2. 
     2767            ENDIF 
     2768 
     2769            dl_lon1 = dl_lon1 + dl_dlon 
     2770            dl_lat1 = dl_lat1 - dl_dlat 
     2771 
    27102772            ! look for closest point on coarse grid 
    27112773            il_iul(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, & 
     
    27152777            &                                           il_jmin0:il_jmax0, & 
    27162778            &                                           1,1), & 
    2717             &                           dl_lon1_ul, dl_lat1_ul   ) 
    2718  
    2719             ! coarse grid point should be north west of fine grid domain 
    2720             ji = il_iul(1) 
    2721             jj = il_iul(2) 
    2722             IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_ul) > dp_delta )THEN 
    2723                IF(tl_lon0%d_value(ji,jj,1,1) > dl_lon1_ul )THEN 
    2724                   il_iul(1)=il_iul(1)-1 
    2725                   IF( il_iul(1) <= 0 )THEN 
    2726                      IF( tl_lon0%i_ew >= 0 )THEN 
    2727                         il_iul(1)=tl_lon0%t_dim(jp_I)%i_len-tl_lon0%i_ew 
    2728                      ELSE 
    2729                         CALL logger_error("GRID GET COARSE INDEX: error "//& 
    2730                         &                 "computing upper left corner "//& 
    2731                         &                 "index for longitude") 
    2732                      ENDIF 
    2733                   ENDIF 
    2734                ENDIF 
    2735             ENDIF 
    2736             IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_ul) > dp_delta )THEN 
    2737                IF(tl_lat0%d_value(ji,jj,1,1) < dl_lat1_ul )THEN 
    2738                   il_iul(2)=il_iul(2)+1 
    2739                   IF( il_ill(2) > tl_lat0%t_dim(jp_J)%i_len )THEN 
    2740                      CALL logger_error("GRID GET COARSE INDEX: error "//& 
    2741                      &                 "computing upper left corner "//& 
    2742                      &                 "index for latitude") 
    2743                   ENDIF 
    2744                ENDIF 
    2745             ENDIF 
     2779            &                           dl_lon1, dl_lat1, 'ul' ) 
    27462780 
    27472781            !3- search lower right corner indices 
    2748             dl_lon1_lr=tl_lon1%d_value( il_imax1, il_jmin1, 1, 1 ) 
    2749             dl_lat1_lr=tl_lat1%d_value( il_imax1, il_jmin1, 1, 1 ) 
    2750  
    2751             IF( dl_lon1_lr == tl_lon1%d_fill .OR. & 
    2752             &   dl_lat1_lr == tl_lat1%d_fill )THEN 
     2782            dl_lon1=tl_lon1%d_value( il_imax1, il_jmin1, 1, 1 ) 
     2783            dl_lat1=tl_lat1%d_value( il_imax1, il_jmin1, 1, 1 ) 
     2784 
     2785            IF( dl_lon1 == tl_lon1%d_fill .OR. & 
     2786            &   dl_lat1 == tl_lat1%d_fill )THEN 
    27532787               CALL logger_error("GRID GET COARSE INDEX: lower right corner "//& 
    27542788               &                 "point is FillValue. remove ghost cell "//& 
    27552789               &                 "running grid_get_coarse_index.") 
    27562790            ENDIF             
     2791 
     2792            !!!!! i-direction !!!!! 
     2793            IF( ll_even(jp_I) )THEN 
     2794               ! even 
     2795               SELECT CASE(TRIM(cl_point1)) 
     2796                  CASE('F','U') 
     2797                     dl_dlon= ( tl_lon1%d_value(il_imax1  ,il_jmin1,1,1) -   & 
     2798                        &       tl_lon1%d_value(il_imax1-1,il_jmin1,1,1) ) / & 
     2799                        &     2. 
     2800                  CASE DEFAULT 
     2801                     dl_dlon=0 
     2802               END SELECT 
     2803            ELSE 
     2804               ! odd 
     2805               dl_dlon= ( tl_lon1%d_value(il_imax1  ,il_jmin1,1,1) -   & 
     2806                  &       tl_lon1%d_value(il_imax1-1,il_jmin1,1,1) ) / & 
     2807                  &     2. 
     2808            ENDIF 
     2809 
     2810            !!!!! j-direction !!!!! 
     2811            IF( ll_even(jp_J) )THEN 
     2812               ! even 
     2813               SELECT CASE(TRIM(cl_point1)) 
     2814                  CASE('F','V') 
     2815                     dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmin1+1,1,1) -   & 
     2816                        &       tl_lat1%d_value(il_imax1,il_jmin1  ,1,1) ) / & 
     2817                        &     2. 
     2818                  CASE DEFAULT 
     2819                     dl_dlat=0 
     2820               END SELECT 
     2821            ELSE 
     2822               ! odd 
     2823               dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmin1+1,1,1) -   & 
     2824                  &       tl_lat1%d_value(il_imax1,il_jmin1  ,1,1) ) / & 
     2825                  &     2. 
     2826            ENDIF 
     2827 
     2828            dl_lon1 = dl_lon1 - dl_dlon 
     2829            dl_lat1 = dl_lat1 + dl_dlat 
     2830 
    27572831            ! look for closest point on coarse grid 
    27582832            il_ilr(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, & 
     
    27622836            &                                           il_jmin0:il_jmax0, & 
    27632837            &                                           1,1), & 
    2764             &                           dl_lon1_lr, dl_lat1_lr   ) 
    2765  
    2766             ! coarse grid point should be south east of fine grid domain 
    2767             ji = il_ilr(1) 
    2768             jj = il_ilr(2) 
    2769             IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_lr) > dp_delta )THEN 
    2770                IF( tl_lon0%d_value(ji,jj,1,1) < dl_lon1_lr )THEN 
    2771                   il_ilr(1)=il_ilr(1)+1 
    2772                   IF( il_ilr(1) > tl_lon0%t_dim(jp_I)%i_len )THEN 
    2773                      IF( tl_lon0%i_ew >= 0 )THEN 
    2774                         il_ilr(1)=tl_lon0%i_ew+1 
    2775                      ELSE 
    2776                         CALL logger_error("GRID GET COARSE INDEX: error "//& 
    2777                         &                 "computing lower right corner "//& 
    2778                         &                 "index for longitude") 
    2779                      ENDIF 
    2780                   ENDIF 
    2781                ENDIF 
    2782             ENDIF 
    2783             IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_lr) > dp_delta )THEN 
    2784                IF( tl_lat0%d_value(ji,jj,1,1) > dl_lat1_lr )THEN 
    2785                   il_ilr(2)=il_ilr(2)-1 
    2786                   IF( il_ilr(2) <= 0 )THEN 
    2787                      CALL logger_error("GRID GET COARSE INDEX: error "//& 
    2788                      &                 "computing lower right corner "//& 
    2789                      &                 "index for latitude") 
    2790                   ENDIF 
    2791                ENDIF 
    2792             ENDIF 
     2838            &                           dl_lon1, dl_lat1, 'lr' ) 
    27932839 
    27942840            !4- search upper right corner indices 
    2795             dl_lon1_ur=tl_lon1%d_value( il_imax1, il_jmax1, 1, 1 ) 
    2796             dl_lat1_ur=tl_lat1%d_value( il_imax1, il_jmax1, 1, 1 ) 
    2797  
    2798             IF( dl_lon1_ur == tl_lon1%d_fill .OR. & 
    2799             &   dl_lat1_ur == tl_lat1%d_fill )THEN 
     2841            dl_lon1=tl_lon1%d_value( il_imax1, il_jmax1, 1, 1 ) 
     2842            dl_lat1=tl_lat1%d_value( il_imax1, il_jmax1, 1, 1 ) 
     2843 
     2844            IF( dl_lon1 == tl_lon1%d_fill .OR. & 
     2845            &   dl_lat1 == tl_lat1%d_fill )THEN 
    28002846               CALL logger_error("GRID GET COARSE INDEX: upper right corner "//& 
    28012847               &                 "point is FillValue. remove ghost cell "//& 
    2802                &                 "running grid_get_coarse_index.") 
     2848               &                 "before running grid_get_coarse_index.") 
    28032849            ENDIF             
     2850 
     2851            !!!!! i-direction !!!!! 
     2852            IF( ll_even(jp_I) )THEN 
     2853               ! even 
     2854               SELECT CASE(TRIM(cl_point1)) 
     2855                  CASE('F','U') 
     2856                     dl_dlon= ( tl_lon1%d_value(il_imax1  ,il_jmax1,1,1) -   & 
     2857                        &       tl_lon1%d_value(il_imax1-1,il_jmax1,1,1) ) / & 
     2858                        &     2. 
     2859                  CASE DEFAULT 
     2860                     dl_dlon=0 
     2861               END SELECT 
     2862            ELSE 
     2863               ! odd 
     2864               dl_dlon= ( tl_lon1%d_value(il_imax1  ,il_jmax1,1,1) -   & 
     2865                  &       tl_lon1%d_value(il_imax1-1,il_jmax1,1,1) ) / & 
     2866                  &     2. 
     2867            ENDIF 
     2868 
     2869            !!!!! j-direction !!!!! 
     2870            IF( ll_even(jp_J) )THEN 
     2871               ! even 
     2872               SELECT CASE(TRIM(cl_point1)) 
     2873                  CASE('F','V') 
     2874                     dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmax1  ,1,1) -   & 
     2875                        &       tl_lat1%d_value(il_imax1,il_jmax1-1,1,1) ) / & 
     2876                        &     2. 
     2877                  CASE DEFAULT 
     2878                     dl_dlat=0 
     2879               END SELECT 
     2880            ELSE 
     2881               ! odd 
     2882               dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmax1  ,1,1) -   & 
     2883                  &       tl_lat1%d_value(il_imax1,il_jmax1-1,1,1) ) / & 
     2884                  &     2. 
     2885            ENDIF 
     2886 
     2887            dl_lon1 = dl_lon1 - dl_dlon 
     2888            dl_lat1 = dl_lat1 - dl_dlat 
     2889 
    28042890            ! look for closest point on coarse grid 
    28052891            il_iur(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, & 
     
    28092895            &                                           il_jmin0:il_jmax0, & 
    28102896            &                                           1,1), & 
    2811             &                           dl_lon1_ur, dl_lat1_ur   ) 
    2812  
    2813             ! coarse grid point should be north east fine grid domain 
    2814             ji = il_iur(1) 
    2815             jj = il_iur(2) 
    2816             IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_ur) > dp_delta )THEN 
    2817                IF( tl_lon0%d_value(ji,jj,1,1) < dl_lon1_ur )THEN 
    2818                   il_iur(1)=il_iur(1)+1 
    2819                   IF( il_iur(1) > tl_lon0%t_dim(jp_I)%i_len )THEN 
    2820                      IF( tl_lon0%i_ew >= 0 )THEN 
    2821                         il_iur(1)=tl_lon0%i_ew+1 
    2822                      ELSE 
    2823                         CALL logger_error("GRID GET COARSE INDEX: error "//& 
    2824                         &                 "computing upper right corner "//& 
    2825                         &                 "index for longitude") 
    2826                      ENDIF 
    2827                   ENDIF 
    2828                ENDIF 
    2829             ENDIF 
    2830             IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_ur) > dp_delta )THEN 
    2831                IF( tl_lat0%d_value(ji,jj,1,1) < dl_lat1_ur )THEN 
    2832                   il_iur(2)=il_iur(2)+1 
    2833                   IF( il_iur(2) > tl_lat0%t_dim(jp_J)%i_len )THEN 
    2834                      CALL logger_error("GRID GET COARSE INDEX: error "//& 
    2835                      &                 "computing upper right corner "//& 
    2836                      &                 "index for latitude") 
    2837                   ENDIF 
    2838                ENDIF 
    2839             ENDIF 
     2897            &                           dl_lon1, dl_lat1, 'ur' ) 
    28402898 
    28412899            ! coarse grid indices 
     
    29433001   END FUNCTION grid_is_global 
    29443002   !------------------------------------------------------------------- 
    2945    !> @brief This function return coarse grid indices of the closest point 
    2946    !> from fine grid point (lon1,lat1)  
     3003   !> @brief This function return grid indices of the closest point 
     3004   !> from point (lon1,lat1)  
    29473005   !>  
    29483006   !> @details 
     
    29513009   !> of longitude and latitude, before running this function 
    29523010   !> 
     3011   !> if you add cd_pos argument, you could choice to return closest point at 
     3012   !> - lower left  (ll) of the point 
     3013   !> - lower right (lr) of the point 
     3014   !> - upper left  (ul) of the point 
     3015   !> - upper right (ur) of the point 
     3016   !> - lower       (lo) of the point 
     3017   !> - upper       (up) of the point 
     3018   !> -       left  (le) of the point 
     3019   !> -       right (ri) of the point 
     3020   !> 
    29533021   !> @author J.Paul 
    29543022   !> @date November, 2013 - Initial Version 
    2955    !> @date February, 2015 - change dichotomy method to manage ORCA grid 
     3023   !> @date February, 2015 
     3024   !> - change dichotomy method to manage ORCA grid 
     3025   !> @date February, 2016 
     3026   !> - add optional use of relative position 
    29563027   ! 
    29573028   !> @param[in] dd_lon0   coarse grid array of longitude 
     
    29593030   !> @param[in] dd_lon1   fine   grid longitude 
    29603031   !> @param[in] dd_lat1   fine   grid latitude 
     3032   !> @param[in] cd_pos    relative position of grid point from point  
    29613033   !> @param[in] dd_fill   fill value 
    29623034   !> @return coarse grid indices of closest point of fine grid point 
    29633035   !------------------------------------------------------------------- 
    2964    FUNCTION grid_get_closest( dd_lon0, dd_lat0, dd_lon1, dd_lat1, dd_fill ) 
     3036   FUNCTION grid_get_closest( dd_lon0, dd_lat0, dd_lon1, dd_lat1, cd_pos, dd_fill ) 
    29653037      IMPLICIT NONE 
    29663038      ! Argument 
     
    29693041      REAL(dp),                 INTENT(IN) :: dd_lon1 
    29703042      REAL(dp),                 INTENT(IN) :: dd_lat1 
     3043      CHARACTER(LEN=*),         INTENT(IN), OPTIONAL :: cd_pos 
    29713044      REAL(dp),                 INTENT(IN), OPTIONAL :: dd_fill 
    29723045 
     
    31473220      &                          dl_lon1, dd_lat1 ) 
    31483221 
     3222      IF( PRESENT(cd_pos) )THEN 
     3223         !  
     3224         SELECT CASE(TRIM(cd_pos)) 
     3225            CASE('le') 
     3226               WHERE( dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) > dd_lat1 ) 
     3227                  dl_dist(:,:)=NF90_FILL_DOUBLE 
     3228               END WHERE 
     3229            CASE('ri') 
     3230               WHERE( dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) < dd_lat1 ) 
     3231                  dl_dist(:,:)=NF90_FILL_DOUBLE 
     3232               END WHERE 
     3233            CASE('up') 
     3234               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) < dl_lon1 ) 
     3235                  dl_dist(:,:)=NF90_FILL_DOUBLE 
     3236               END WHERE 
     3237            CASE('lo') 
     3238               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) > dl_lon1 ) 
     3239                  dl_dist(:,:)=NF90_FILL_DOUBLE 
     3240               END WHERE 
     3241            CASE('ll') 
     3242               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) > dl_lon1 .OR. & 
     3243                    & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) > dd_lat1 ) 
     3244                  dl_dist(:,:)=NF90_FILL_DOUBLE 
     3245               END WHERE 
     3246            CASE('lr') 
     3247               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) < dl_lon1 .OR. & 
     3248                    & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) > dd_lat1 ) 
     3249                  dl_dist(:,:)=NF90_FILL_DOUBLE 
     3250               END WHERE                
     3251            CASE('ul') 
     3252               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) > dl_lon1 .OR. & 
     3253                    & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) < dd_lat1 ) 
     3254                  dl_dist(:,:)=NF90_FILL_DOUBLE 
     3255               END WHERE                
     3256            CASE('ur') 
     3257               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) < dl_lon1 .OR. & 
     3258                    & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) < dd_lat1 ) 
     3259                  dl_dist(:,:)=NF90_FILL_DOUBLE 
     3260               END WHERE 
     3261         END SELECT 
     3262      ENDIF 
    31493263      grid_get_closest(:)=MINLOC(dl_dist(:,:),dl_dist(:,:)/=NF90_FILL_DOUBLE) 
    31503264 
     
    34433557         &                                         il_imax0, il_jmax0, & 
    34443558         &                                         dl_lon1(:,:), dl_lat1(:,:),& 
    3445          &                                         id_rho(:) ) 
     3559         &                                         id_rho(:), cl_point ) 
    34463560  
    34473561         DEALLOCATE(dl_lon0, dl_lat0) 
     
    35883702         &                                         id_imax0, id_jmax0, & 
    35893703         &                                         dl_lon1(:,:), dl_lat1(:,:),& 
    3590          &                                         id_rho(:) ) 
     3704         &                                         id_rho(:), cl_point ) 
    35913705          
    35923706         DEALLOCATE(dl_lon1, dl_lat1) 
     
    36683782      ! init 
    36693783      grid__get_fine_offset_fc(:,:)=-1 
    3670  
    36713784      ALLOCATE(il_rho(ip_maxdim)) 
    36723785      il_rho(:)=1 
     
    36903803         CALL iom_mpp_open(tl_coord0) 
    36913804 
    3692          ! read coarse longitue and latitude 
     3805         ! read coarse longitude and latitude 
    36933806         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
    36943807         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name) 
     
    37103823         ENDIF 
    37113824         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
    3712           
     3825  
    37133826         ! close mpp files 
    37143827         CALL iom_mpp_close(tl_coord0) 
     
    37163829         CALL grid_del_ghost(tl_lon0, il_xghost0(:,:)) 
    37173830         CALL grid_del_ghost(tl_lat0, il_xghost0(:,:)) 
     3831 
    37183832 
    37193833         ALLOCATE(dl_lon0(tl_lon0%t_dim(jp_I)%i_len, & 
     
    37383852         il_jmax0=id_jmax0-il_xghost0(jp_J,1) 
    37393853 
    3740        
    37413854         !3- compute 
    37423855         grid__get_fine_offset_fc(:,:)=grid_get_fine_offset(& 
     
    37453858         &                                         il_imax0, il_jmax0, & 
    37463859         &                                         dd_lon1(:,:), dd_lat1(:,:),& 
    3747          &                                         id_rho(:) ) 
     3860         &                                         id_rho(:), cl_point ) 
    37483861          
    37493862         DEALLOCATE(dl_lon0, dl_lat0) 
     
    37673880   !> @date May, 2015  
    37683881   !> - improve way to find offset 
     3882   !> @date July, 2015 
     3883   !> - manage case close to greenwich meridian 
     3884   !> @date February, 2016 
     3885   !> - use grid_get_closest to assess offset 
     3886   !> - use delta (lon or lat) 
     3887   !> - manage cases for T,U,V or F point, with even or odd refinment 
     3888   !> - check lower left(upper right) fine grid point inside lower left(upper 
     3889   !> right) coarse grid cell. 
     3890   !>  
     3891   !> @todo check case close from North fold. 
    37693892   !> 
    37703893   !> @param[in] dd_lon0   coarse grid longitude array  
     
    37773900   !> @param[in] dd_lat1   fine   grid latitude  array 
    37783901   !> @param[in] id_rho    array of refinement factor 
     3902   !> @param[in] cd_point  Arakawa grid point 
    37793903   !> @return offset array (/ (/i_offset_left,i_offset_right/),(/j_offset_lower,j_offset_upper/) /) 
    37803904   !------------------------------------------------------------------- 
    37813905   FUNCTION grid__get_fine_offset_cc( dd_lon0, dd_lat0, & 
    37823906   &                                  id_imin0, id_jmin0, id_imax0, id_jmax0, & 
    3783    &                                  dd_lon1, dd_lat1, id_rho ) 
     3907   &                                  dd_lon1, dd_lat1, id_rho, cd_point ) 
    37843908      IMPLICIT NONE 
    37853909      ! Argument 
    3786       REAL(dp)   , DIMENSION(:,:), INTENT(IN) :: dd_lon0 
    3787       REAL(dp)   , DIMENSION(:,:), INTENT(IN) :: dd_lat0 
    3788       REAL(dp)   , DIMENSION(:,:), INTENT(IN) :: dd_lon1 
    3789       REAL(dp)   , DIMENSION(:,:), INTENT(IN) :: dd_lat1 
    3790  
    3791       INTEGER(i4),                 INTENT(IN) :: id_imin0 
    3792       INTEGER(i4),                 INTENT(IN) :: id_jmin0 
    3793       INTEGER(i4),                 INTENT(IN) :: id_imax0 
    3794       INTEGER(i4),                 INTENT(IN) :: id_jmax0 
    3795  
    3796       INTEGER(i4), DIMENSION(:)  , INTENT(IN) :: id_rho 
     3910      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lon0 
     3911      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lat0 
     3912      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lon1 
     3913      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lat1 
     3914 
     3915      INTEGER(i4)     ,                 INTENT(IN) :: id_imin0 
     3916      INTEGER(i4)     ,                 INTENT(IN) :: id_jmin0 
     3917      INTEGER(i4)     ,                 INTENT(IN) :: id_imax0 
     3918      INTEGER(i4)     ,                 INTENT(IN) :: id_jmax0 
     3919 
     3920      INTEGER(i4)     , DIMENSION(:)  , INTENT(IN) :: id_rho 
     3921      CHARACTER(LEN=*)                , INTENT(IN), OPTIONAL :: cd_point 
    37973922 
    37983923      ! function 
     
    38003925 
    38013926      ! local variable 
     3927      CHARACTER(LEN= 1)                        :: cl_point 
     3928 
     3929      INTEGER(i4)                              :: i1 
     3930      INTEGER(i4)                              :: i2 
     3931      INTEGER(i4)                              :: j1 
     3932      INTEGER(i4)                              :: j2 
     3933 
    38023934      INTEGER(i4), DIMENSION(2)                :: il_shape0 
    38033935      INTEGER(i4), DIMENSION(2)                :: il_shape1 
    38043936 
     3937      INTEGER(i4), DIMENSION(2)                :: il_ind 
     3938 
    38053939      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0 
    38063940      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon1 
    38073941 
    3808       LOGICAL                                  :: ll_ii 
    3809       LOGICAL                                  :: ll_ij 
     3942      REAL(dp)                                 :: dl_lonmax0 
     3943      REAL(dp)                                 :: dl_latmax0 
     3944      REAL(dp)                                 :: dl_lonmin0 
     3945      REAL(dp)                                 :: dl_latmin0 
     3946 
     3947      REAL(dp)                                 :: dl_lon0F 
     3948      REAL(dp)                                 :: dl_lat0F 
     3949      REAL(dp)                                 :: dl_dlon 
     3950      REAL(dp)                                 :: dl_dlat 
     3951 
     3952      LOGICAL    , DIMENSION(2)                :: ll_even 
     3953      LOGICAL                                  :: ll_greenwich 
    38103954       
    38113955      ! loop indices 
    3812       INTEGER(i4) :: ji 
    3813       INTEGER(i4) :: jj 
    3814  
    38153956      INTEGER(i4) :: ii 
    38163957      INTEGER(i4) :: ij 
     
    38243965         CALL logger_fatal("GRID GET FINE OFFSET: dimension of fine "//& 
    38253966         &              "longitude and latitude differ") 
    3826       ENDIF       
     3967      ENDIF 
     3968 
     3969      ll_even(:)=(/ (MOD(id_rho(jp_I),2)==0), (MOD(id_rho(jp_J),2)==0) /) 
     3970 
     3971      cl_point='T' 
     3972      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point)) 
    38273973 
    38283974      il_shape0(:)=SHAPE(dd_lon0(:,:)) 
    38293975      ALLOCATE( dl_lon0(il_shape0(1),il_shape0(2)) ) 
    38303976 
     3977      il_shape1(:)=SHAPE(dd_lon1(:,:)) 
     3978      ALLOCATE( dl_lon1(il_shape1(1),il_shape1(2)) ) 
     3979 
    38313980      dl_lon0(:,:)=dd_lon0(:,:) 
    38323981      WHERE( dd_lon0(:,:) < 0 ) dl_lon0(:,:)=dd_lon0(:,:)+360. 
    38333982 
    3834       il_shape1(:)=SHAPE(dd_lon1(:,:)) 
    3835       ALLOCATE( dl_lon1(il_shape1(1),il_shape1(2)) ) 
    3836  
    38373983      dl_lon1(:,:)=dd_lon1(:,:) 
    3838       WHERE( dd_lon1(:,:) < 0 ) dl_lon1(:,:)=dd_lon1(:,:)+360.          
     3984      WHERE( dd_lon1(:,:) < 0 ) dl_lon1(:,:)=dd_lon1(:,:)+360. 
    38393985 
    38403986      ! init 
    38413987      grid__get_fine_offset_cc(:,:)=-1 
     3988      ll_greenwich=.FALSE. 
    38423989 
    38433990      IF( il_shape1(jp_J) == 1 )THEN 
    3844            
     3991  
    38453992         grid__get_fine_offset_cc(jp_J,:)=((id_rho(jp_J)-1)/2) 
    38463993 
    3847          ! work on i-direction 
    3848          ! look for i-direction left offset 
    3849          IF( dl_lon1(1,1) < dl_lon0(id_imin0+1,id_jmin0) )THEN 
    3850             DO ji=1,id_rho(jp_I)+2 
    3851                IF( dl_lon1(ji,1) > dl_lon0(id_imin0+1,id_jmin0) - dp_delta )THEN 
    3852                   grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ji 
    3853                   EXIT 
    3854                ENDIF 
    3855             ENDDO 
     3994         !!! work on i-direction 
     3995         !!! look for i-direction left offset 
     3996         i1=1 ; i2=MIN((id_rho(jp_I)+2),il_shape1(jp_I)) 
     3997         j1=1 ; j2=1 
     3998 
     3999         ! check if cross greenwich meridien 
     4000         IF( minval(dl_lon0(id_imin0:id_imin0+1,id_jmin0))<5. .OR. & 
     4001           & maxval(dl_lon0(id_imin0:id_imin0+1,id_jmin0))>355. )THEN 
     4002            ! close to greenwich meridien 
     4003            ll_greenwich=.TRUE. 
     4004            ! 0:360 => -180:180 
     4005            WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0) > 180. ) 
     4006               dl_lon0(id_imin0:id_imin0+1,id_jmin0) = & 
     4007                  & dl_lon0(id_imin0:id_imin0+1,id_jmin0)-360. 
     4008            END WHERE 
     4009 
     4010            WHERE( dl_lon1(i1:i2,j1:j2) > 180. ) 
     4011               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360. 
     4012            END WHERE 
     4013         ENDIF 
     4014 
     4015         ! max lognitude of the left cell 
     4016         dl_lonmax0=dl_lon0(id_imin0+1,id_jmin0) 
     4017         IF( dl_lon1(1,1) < dl_lonmax0 )THEN 
     4018 
     4019            !!!!! i-direction !!!!! 
     4020            IF( ll_even(jp_I) )THEN 
     4021               ! even 
     4022               SELECT CASE(TRIM(cl_point)) 
     4023                  CASE('F','U') 
     4024                     dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0) -   & 
     4025                        &       dl_lon0(id_imin0  ,id_jmin0) ) / & 
     4026                        &     ( 2.*id_rho(jp_I) ) 
     4027                  CASE DEFAULT 
     4028                     dl_dlon=0 
     4029               END SELECT 
     4030            ELSE 
     4031               ! odd 
     4032               dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0) -   & 
     4033                  &       dl_lon0(id_imin0  ,id_jmin0) ) / & 
     4034                  &     ( 2.*id_rho(jp_I) ) 
     4035            ENDIF 
     4036 
     4037            dl_lon0F= dl_lon0(id_imin0+1,id_jmin0) + dl_dlon 
     4038            dl_lat0F= dd_lat0(id_imin0+1,id_jmin0) 
     4039 
     4040            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), & 
     4041            &                           dl_lon0F, dl_lat0F, 'le' ) 
     4042       
     4043            ii=il_ind(1) 
     4044 
     4045            !!!!! i-direction !!!!! 
     4046            IF( ll_even(jp_I) )THEN 
     4047               ! even 
     4048               SELECT CASE(TRIM(cl_point)) 
     4049                  CASE('T','V') 
     4050                     grid__get_fine_offset_cc(jp_I,1)=id_rho(jp_I)-ii 
     4051                  CASE DEFAULT !'F','U'  
     4052                     grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii 
     4053               END SELECT 
     4054            ELSE 
     4055               ! odd 
     4056               grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii 
     4057            ENDIF 
     4058 
    38564059         ELSE 
    38574060            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
    3858             &                 " not match fine grid lower left corner.") 
    3859          ENDIF 
    3860          ! look for i-direction right offset 
    3861          IF( dl_lon1(il_shape1(jp_I),1) > dl_lon0(id_imax0-1,id_jmin0) )THEN 
    3862             DO ji=1,id_rho(jp_I)+2 
    3863                ii=il_shape1(jp_I)-ji+1 
    3864                IF( dl_lon1(ii,1) < dl_lon0(id_imax0-1,id_jmin0) + dp_delta )THEN 
    3865                   grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ji 
    3866                   EXIT 
    3867                ENDIF 
    3868             ENDDO 
     4061            &                 " not match fine grid left corner.") 
     4062         ENDIF 
     4063 
     4064         IF( ll_greenwich )THEN 
     4065            ! close to greenwich meridien 
     4066            ll_greenwich=.FALSE. 
     4067            ! -180:180 => 0:360 
     4068            WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0) < 0. ) 
     4069               dl_lon0(id_imin0:id_imin0+1,id_jmin0) = & 
     4070                  & dl_lon0(id_imin0:id_imin0+1,id_jmin0)+360. 
     4071            END WHERE 
     4072 
     4073            WHERE( dl_lon1(i1:i2,j1:j2) < 0. ) 
     4074               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360. 
     4075            END WHERE 
     4076         ENDIF 
     4077 
     4078         !!!!!! look for i-direction right offset !!!!!! 
     4079         i1=MAX(1,il_shape1(jp_I)-(id_rho(jp_I)+2)+1) ; i2=il_shape1(jp_I) 
     4080         j1=1                                         ; j2=1 
     4081 
     4082         ! check if cross greenwich meridien 
     4083         IF( minval(dl_lon0(id_imax0-1:id_imax0,id_jmin0))<5. .OR. & 
     4084           & maxval(dl_lon0(id_imax0-1:id_imax0,id_jmin0))>355. )THEN 
     4085            ! close to greenwich meridien 
     4086            ll_greenwich=.TRUE. 
     4087            ! 0:360 => -180:180 
     4088            WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmin0) > 180. ) 
     4089               dl_lon0(id_imax0-1:id_imax0,id_jmin0) = & 
     4090                  & dl_lon0(id_imax0-1:id_imax0,id_jmin0)-360. 
     4091            END WHERE 
     4092 
     4093            WHERE( dl_lon1(i1:i2,j1:j2) > 180. ) 
     4094               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360. 
     4095            END WHERE 
     4096         ENDIF 
     4097 
     4098         ! min lognitude of the right cell 
     4099         dl_lonmin0=dl_lon0(id_imax0-1,id_jmin0) 
     4100         IF( dl_lon1(il_shape1(jp_I),il_shape1(jp_J)) > dl_lonmin0 )THEN 
     4101 
     4102            !!!!! i-direction !!!!! 
     4103            IF( ll_even(jp_I) )THEN 
     4104               ! even 
     4105               SELECT CASE(TRIM(cl_point)) 
     4106                  CASE('F','U') 
     4107                     dl_dlon= ( dl_lon0(id_imax0  ,id_jmin0) -   & 
     4108                        &       dl_lon0(id_imax0-1,id_jmin0) ) / & 
     4109                        &     ( 2.*id_rho(jp_I) ) 
     4110                  CASE DEFAULT 
     4111                     dl_dlon=0 
     4112               END SELECT 
     4113            ELSE 
     4114               ! odd 
     4115               dl_dlon= ( dl_lon0(id_imax0  ,id_jmin0) -   & 
     4116                  &       dl_lon0(id_imax0-1,id_jmin0) ) / & 
     4117                  &     ( 2.*id_rho(jp_I) ) 
     4118            ENDIF 
     4119 
     4120            dl_lon0F= dl_lon0(id_imax0-1,id_jmin0) - dl_dlon 
     4121            dl_lat0F= dd_lat0(id_imax0-1,id_jmin0) 
     4122 
     4123            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), & 
     4124            &                           dl_lon0F, dl_lat0F, 'ri' ) 
     4125 
     4126            ii=(MIN(il_shape1(jp_I),(id_rho(jp_I)+2))-il_ind(1)+1) 
     4127 
     4128            !!!!! i-direction !!!!! 
     4129            IF( ll_even(jp_I) )THEN 
     4130               ! even 
     4131               SELECT CASE(TRIM(cl_point)) 
     4132                  CASE('T','V') 
     4133                     grid__get_fine_offset_cc(jp_I,2)=id_rho(jp_I)-ii 
     4134                  CASE DEFAULT !'F','U'  
     4135                     grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ii 
     4136               END SELECT 
     4137            ELSE 
     4138               ! odd 
     4139               grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ii 
     4140            ENDIF 
     4141 
    38694142         ELSE 
    38704143            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
    3871             &                 " not match fine grid lower right corner.") 
     4144            &                 " not match fine grid right corner.") 
     4145         ENDIF 
     4146 
     4147         IF( ll_greenwich )THEN 
     4148            ! close to greenwich meridien 
     4149            ll_greenwich=.FALSE. 
     4150            ! -180:180 => 0:360 
     4151            WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmin0) < 0. ) 
     4152               dl_lon0(id_imax0-1:id_imax0,id_jmin0) = & 
     4153                  & dl_lon0(id_imax0-1:id_imax0,id_jmin0)+360. 
     4154            END WHERE 
     4155 
     4156            WHERE( dl_lon1(i1:i2,j1:j2) < 0. ) 
     4157               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360. 
     4158            END WHERE 
    38724159         ENDIF 
    38734160 
     
    38764163         grid__get_fine_offset_cc(jp_I,:)=((id_rho(jp_I)-1)/2) 
    38774164          
    3878          ! work on j-direction 
    3879  
    3880          ! look for j-direction lower offset  
    3881          IF( dd_lat1(1,1) < dd_lat0(id_imin0,id_jmin0+1) )THEN 
    3882             DO jj=1,id_rho(jp_J)+2 
    3883                IF( dd_lat1(1,jj) > dd_lat0(id_imin0,id_jmin0+1) - dp_delta )THEN 
    3884                   grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-jj 
    3885                   EXIT 
    3886                ENDIF 
    3887             ENDDO 
     4165         !!! work on j-direction 
     4166         !!! look for j-direction lower offset  
     4167         i1=1 ; i2=1 
     4168         j1=1 ; j2=MIN((id_rho(jp_J)+2),il_shape1(jp_J)) 
     4169 
     4170 
     4171         ! max latitude of the lower cell 
     4172         dl_latmax0=dd_lat0(id_imin0,id_jmin0+1) 
     4173         IF( dd_lat1(1,1) < dl_latmax0 )THEN 
     4174 
     4175            IF( ll_even(jp_J) )THEN 
     4176               ! even 
     4177               SELECT CASE(TRIM(cl_point)) 
     4178                  CASE('F','V') 
     4179                     dl_dlat= ( dd_lat0(id_imin0,id_jmin0+1) -   & 
     4180                        &       dd_lat0(id_imin0,id_jmin0  ) ) / & 
     4181                        &     ( 2.*id_rho(jp_J) ) 
     4182                  CASE DEFAULT 
     4183                     dl_dlat=0 
     4184               END SELECT 
     4185            ELSE 
     4186               ! odd 
     4187               dl_dlat= ( dd_lat0(id_imin0,id_jmin0+1) -   & 
     4188                  &       dd_lat0(id_imin0,id_jmin0  ) ) / & 
     4189                  &     ( 2.*id_rho(jp_J) ) 
     4190            ENDIF 
     4191 
     4192            dl_lon0F= dl_lon0(id_imin0,id_jmin0+1) 
     4193            dl_lat0F= dd_lat0(id_imin0,id_jmin0+1) + dl_dlat  
     4194             
     4195            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), & 
     4196            &                           dl_lon0F, dl_lat0F, 'lo' ) 
     4197 
     4198            ij=il_ind(2) 
     4199 
     4200            !!!!! i-direction !!!!! 
     4201            IF( ll_even(jp_I) )THEN 
     4202               ! even 
     4203               SELECT CASE(TRIM(cl_point)) 
     4204                  CASE('T','V') 
     4205                     grid__get_fine_offset_cc(jp_I,1)=id_rho(jp_I)-ii 
     4206                  CASE DEFAULT !'F','U'  
     4207                     grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii 
     4208               END SELECT 
     4209            ELSE 
     4210               ! odd 
     4211               grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii 
     4212            ENDIF 
     4213 
    38884214         ELSE 
    38894215            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
    3890             &                 " not match fine grid upper left corner.") 
    3891          ENDIF 
    3892  
    3893          ! look for j-direction upper offset  
    3894          IF( dd_lat1(1,il_shape1(jp_J)) > dd_lat0(id_imin0,id_jmax0-1) )THEN 
    3895             DO jj=1,id_rho(jp_J)+2 
    3896                ij=il_shape1(jp_J)-jj+1 
    3897                IF( dd_lat1(1,ij) < dd_lat0(id_imin0,id_jmax0-1) + dp_delta )THEN 
    3898                   grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-jj 
    3899                   EXIT 
    3900                ENDIF 
    3901             ENDDO 
     4216            &                 " not match fine grid lower corner.") 
     4217         ENDIF 
     4218 
     4219         !!! look for j-direction upper offset  
     4220         i1=1                                         ; i2=1 
     4221         j1=MAX(1,il_shape1(jp_J)-(id_rho(jp_J)+2)+1) ; j2=il_shape1(jp_J) 
     4222 
     4223         ! min latitude of the upper cell 
     4224         dl_latmin0=dd_lat0(id_imin0,id_jmax0-1) 
     4225         IF( dd_lat1(il_shape1(jp_I),il_shape1(jp_J)) > dl_latmin0 )THEN 
     4226 
     4227            IF( ll_even(jp_J) )THEN 
     4228               ! even 
     4229               SELECT CASE(TRIM(cl_point)) 
     4230                  CASE('F','V') 
     4231                     dl_dlat= ( dd_lat0(id_imin0,id_jmax0  ) -   & 
     4232                        &       dd_lat0(id_imin0,id_jmax0-1) ) / & 
     4233                        &     ( 2.*id_rho(jp_J) ) 
     4234                  CASE DEFAULT 
     4235                     dl_dlat=0 
     4236               END SELECT 
     4237            ELSE 
     4238               ! odd 
     4239               dl_dlat= ( dd_lat0(id_imin0,id_jmax0  ) -   & 
     4240                  &       dd_lat0(id_imin0,id_jmax0-1) ) / & 
     4241                  &     ( 2*id_rho(jp_J) ) 
     4242            ENDIF 
     4243 
     4244            dl_lon0F= dl_lon0(id_imin0,id_jmax0-1)  
     4245            dl_lat0F= dd_lat0(id_imin0,id_jmax0-1) - dl_dlat 
     4246             
     4247            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), & 
     4248            &                           dl_lon0F, dl_lat0F, 'up' ) 
     4249 
     4250            ij=(MIN(il_shape1(jp_J),(id_rho(jp_J)+2))-il_ind(2)+1) 
     4251 
     4252            !!!!! j-direction !!!!! 
     4253            IF( ll_even(jp_J) )THEN 
     4254               ! even 
     4255               SELECT CASE(TRIM(cl_point)) 
     4256                  CASE('T','U') 
     4257                     grid__get_fine_offset_cc(jp_J,2)=id_rho(jp_J)-ij 
     4258                  CASE DEFAULT !'F','V' 
     4259                     grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-ij 
     4260               END SELECT 
     4261            ELSE 
     4262               ! odd 
     4263               grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-ij 
     4264            ENDIF 
     4265 
    39024266         ELSE 
    39034267            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
     4268            &                 " not match fine grid upper corner.") 
     4269         ENDIF 
     4270 
     4271      ELSE ! il_shape1(1) > 1 .AND. il_shape1(2) > 1  
     4272 
     4273         !!!!!! look for lower left offset !!!!!! 
     4274         i1=1 ; i2=MIN((id_rho(jp_I)+2),il_shape1(jp_I)) 
     4275         j1=1 ; j2=MIN((id_rho(jp_J)+2),il_shape1(jp_J)) 
     4276 
     4277         ! check if cross greenwich meridien 
     4278         IF( minval(dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1))<5. .OR. & 
     4279           & maxval(dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1))>355. )THEN 
     4280            ! close to greenwich meridien 
     4281            ll_greenwich=.TRUE. 
     4282            ! 0:360 => -180:180 
     4283            WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) > 180. ) 
     4284               dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) = & 
     4285                  & dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1)-360. 
     4286            END WHERE 
     4287 
     4288            WHERE( dl_lon1(i1:i2,j1:j2) > 180. ) 
     4289               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360. 
     4290            END WHERE 
     4291         ENDIF 
     4292 
     4293         ! max longitude of the lower left cell 
     4294         dl_lonmax0=MAX(dl_lon0(id_imin0+1,id_jmin0),dl_lon0(id_imin0+1,id_jmin0+1)) 
     4295         ! max latitude of the lower left cell 
     4296         dl_latmax0=MAX(dd_lat0(id_imin0,id_jmin0+1),dd_lat0(id_imin0+1,id_jmin0+1)) 
     4297         IF( dl_lon1(1,1) < dl_lonmax0 .AND. & 
     4298           & dd_lat1(1,1) < dl_latmax0 )THEN 
     4299 
     4300            !!!!! i-direction !!!!! 
     4301            IF( ll_even(jp_I) )THEN 
     4302               ! even 
     4303               SELECT CASE(TRIM(cl_point)) 
     4304                  CASE('F','U') 
     4305                     dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0+1) -   & 
     4306                        &       dl_lon0(id_imin0  ,id_jmin0+1) ) / & 
     4307                        &     ( 2.*id_rho(jp_I) ) 
     4308                  CASE DEFAULT 
     4309                     dl_dlon=0 
     4310               END SELECT 
     4311            ELSE 
     4312               ! odd 
     4313               dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0+1) -   & 
     4314                  &       dl_lon0(id_imin0  ,id_jmin0+1) ) / & 
     4315                  &     ( 2.*id_rho(jp_I) ) 
     4316            ENDIF 
     4317 
     4318            !!!!! j-direction !!!!! 
     4319            IF( ll_even(jp_J) )THEN 
     4320               ! even 
     4321               SELECT CASE(TRIM(cl_point)) 
     4322                  CASE('F','V') 
     4323                     dl_dlat= ( dd_lat0(id_imin0+1,id_jmin0+1) -   & 
     4324                        &       dd_lat0(id_imin0+1,id_jmin0  ) ) / & 
     4325                        &     ( 2.*id_rho(jp_J) ) 
     4326                  CASE DEFAULT 
     4327                     dl_dlat=0 
     4328               END SELECT 
     4329            ELSE 
     4330               ! odd 
     4331               dl_dlat= ( dd_lat0(id_imin0+1,id_jmin0+1) -   & 
     4332                  &       dd_lat0(id_imin0+1,id_jmin0  ) ) / & 
     4333                  &     ( 2.*id_rho(jp_J) ) 
     4334            ENDIF 
     4335 
     4336            dl_lon0F= dl_lon0(id_imin0+1,id_jmin0+1) + dl_dlon 
     4337            dl_lat0F= dd_lat0(id_imin0+1,id_jmin0+1) + dl_dlat 
     4338 
     4339            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), & 
     4340            &                           dl_lon0F, dl_lat0F, 'll' ) 
     4341 
     4342            ii=il_ind(1) 
     4343            ij=il_ind(2) 
     4344 
     4345            !!!!! i-direction !!!!! 
     4346            IF( ll_even(jp_I) )THEN 
     4347               ! even 
     4348               SELECT CASE(TRIM(cl_point)) 
     4349                  CASE('T','V') 
     4350                     grid__get_fine_offset_cc(jp_I,1)=id_rho(jp_I)-ii 
     4351                  CASE DEFAULT !'F','U'  
     4352                     grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii 
     4353               END SELECT 
     4354            ELSE 
     4355               ! odd 
     4356               grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii 
     4357            ENDIF 
     4358 
     4359            !!!!! j-direction !!!!! 
     4360            IF( ll_even(jp_J) )THEN 
     4361               ! even 
     4362               SELECT CASE(TRIM(cl_point)) 
     4363                  CASE('T','U') 
     4364                     grid__get_fine_offset_cc(jp_J,1)=id_rho(jp_J)-ij 
     4365                  CASE DEFAULT !'F','V' 
     4366                     grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-ij 
     4367               END SELECT 
     4368            ELSE 
     4369               ! odd 
     4370               grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-ij 
     4371            ENDIF 
     4372 
     4373         ELSE 
     4374            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do"//& 
     4375            &                 " not match fine grid lower left corner.") 
     4376         ENDIF 
     4377 
     4378         IF( ll_greenwich )THEN 
     4379            ! close to greenwich meridien 
     4380            ll_greenwich=.FALSE. 
     4381            ! -180:180 => 0:360  
     4382            WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) < 0. ) 
     4383               dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) = & 
     4384                  & dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1)+360. 
     4385            END WHERE 
     4386 
     4387            WHERE( dl_lon1(i1:i2,j1:j2) < 0. ) 
     4388               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360. 
     4389            END WHERE 
     4390         ENDIF 
     4391 
     4392         !!!!!! look for upper right offset !!!!!! 
     4393         i1=MAX(1,il_shape1(jp_I)-(id_rho(jp_I)+2)+1) ; i2=il_shape1(jp_I) 
     4394         j1=MAX(1,il_shape1(jp_J)-(id_rho(jp_J)+2)+1) ; j2=il_shape1(jp_J) 
     4395 
     4396         ! check if cross greenwich meridien 
     4397         IF( minval(dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0))<5. .OR. & 
     4398           & maxval(dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0))>355. )THEN 
     4399            ! close to greenwich meridien 
     4400            ll_greenwich=.TRUE. 
     4401            ! 0:360 => -180:180 
     4402            WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) > 180. ) 
     4403               dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) = & 
     4404                  & dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0)-360. 
     4405            END WHERE 
     4406 
     4407            WHERE( dl_lon1(i1:i2,j1:j2) > 180. ) 
     4408               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360. 
     4409            END WHERE 
     4410         ENDIF 
     4411 
     4412         ! min latitude of the upper right cell 
     4413         dl_lonmin0=MIN(dl_lon0(id_imax0-1,id_jmax0-1),dl_lon0(id_imax0-1,id_jmax0)) 
     4414         ! min latitude of the upper right cell 
     4415         dl_latmin0=MIN(dd_lat0(id_imax0-1,id_jmax0-1),dd_lat0(id_imax0,id_jmax0-1)) 
     4416         IF( dl_lon1(il_shape1(jp_I),il_shape1(jp_J)) > dl_lonmin0 .AND. & 
     4417           & dd_lat1(il_shape1(jp_I),il_shape1(jp_J)) > dl_latmin0 )THEN 
     4418 
     4419            !!!!! i-direction !!!!! 
     4420            IF( ll_even(jp_I) )THEN 
     4421               ! even 
     4422               SELECT CASE(TRIM(cl_point)) 
     4423                  CASE('F','U') 
     4424                     dl_dlon= ( dl_lon0(id_imax0  ,id_jmax0-1) -   & 
     4425                        &       dl_lon0(id_imax0-1,id_jmax0-1) ) / & 
     4426                        &     ( 2.*id_rho(jp_I) ) 
     4427                  CASE DEFAULT 
     4428                     dl_dlon=0 
     4429               END SELECT                
     4430            ELSE 
     4431               ! odd 
     4432               dl_dlon= ( dl_lon0(id_imax0  ,id_jmax0-1) -   & 
     4433                  &       dl_lon0(id_imax0-1,id_jmax0-1) ) / & 
     4434                  &     ( 2*id_rho(jp_I) ) 
     4435            ENDIF 
     4436 
     4437            !!!!! j-direction !!!!! 
     4438            IF( ll_even(jp_J) )THEN 
     4439               ! even 
     4440               SELECT CASE(TRIM(cl_point)) 
     4441                  CASE('F','V') 
     4442                     dl_dlat= ( dd_lat0(id_imax0-1,id_jmax0  ) -   & 
     4443                        &       dd_lat0(id_imax0-1,id_jmax0-1) ) / & 
     4444                        &     ( 2.*id_rho(jp_J) ) 
     4445                  CASE DEFAULT 
     4446                     dl_dlat=0 
     4447               END SELECT 
     4448            ELSE 
     4449               ! odd 
     4450               dl_dlat= ( dd_lat0(id_imax0-1,id_jmax0  ) -   & 
     4451                  &       dd_lat0(id_imax0-1,id_jmax0-1) ) / & 
     4452                  &     ( 2*id_rho(jp_J) ) 
     4453            ENDIF 
     4454 
     4455            dl_lon0F= dl_lon0(id_imax0-1,id_jmax0-1) - dl_dlon 
     4456            dl_lat0F= dd_lat0(id_imax0-1,id_jmax0-1) - dl_dlat 
     4457 
     4458            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), & 
     4459            &                           dl_lon0F, dl_lat0F, 'ur' ) 
     4460 
     4461            ii=(MIN(il_shape1(jp_I),(id_rho(jp_I)+2))-il_ind(1)+1) 
     4462            ij=(MIN(il_shape1(jp_J),(id_rho(jp_J)+2))-il_ind(2)+1) 
     4463 
     4464            !!!!! i-direction !!!!! 
     4465            IF( ll_even(jp_I) )THEN 
     4466               ! even 
     4467               SELECT CASE(TRIM(cl_point)) 
     4468                  CASE('T','V') 
     4469                     grid__get_fine_offset_cc(jp_I,2)=id_rho(jp_I)-ii 
     4470                  CASE DEFAULT !'F','U'  
     4471                     grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ii 
     4472               END SELECT 
     4473            ELSE 
     4474               ! odd 
     4475               grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ii 
     4476            ENDIF 
     4477 
     4478            !!!!! j-direction !!!!! 
     4479            IF( ll_even(jp_J) )THEN 
     4480               ! even 
     4481               SELECT CASE(TRIM(cl_point)) 
     4482                  CASE('T','U') 
     4483                     grid__get_fine_offset_cc(jp_J,2)=id_rho(jp_J)-ij 
     4484                  CASE DEFAULT !'F','V' 
     4485                     grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-ij 
     4486               END SELECT 
     4487            ELSE 
     4488               ! odd 
     4489               grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-ij 
     4490            ENDIF 
     4491 
     4492         ELSE 
     4493            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do"//& 
    39044494            &                 " not match fine grid upper right corner.") 
    3905          ENDIF          
    3906  
    3907       ELSE ! il_shape1(1) > 1 .AND. il_shape1(2) > 1  
    3908  
    3909          ! look for lower left offset 
    3910          IF( dl_lon1(1,1) < dl_lon0(id_imin0+1,id_jmin0+1) )THEN 
    3911  
    3912             ii=1 
    3913             ij=1 
    3914             DO ji=1,(id_rho(jp_I)+2)*(id_rho(jp_J)+2) 
    3915  
    3916                ll_ii=.FALSE. 
    3917                ll_ij=.FALSE. 
    3918  
    3919                IF( dl_lon1(ii,ij) >= dl_lon0(id_imin0+1,id_jmin0+1)-dp_delta .AND. & 
    3920                &   dd_lat1(ii,ij) >= dd_lat0(id_imin0+1,id_jmin0+1)-dp_delta )THEN 
    3921                   grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii 
    3922                   grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-ij 
    3923                   EXIT 
    3924                ENDIF 
    3925  
    3926                IF( dl_lon1(ii+1,ij) <= dl_lon0(id_imin0+1,id_jmin0+1)+dp_delta .AND. & 
    3927                &   dd_lat1(ii+1,ij) <= dd_lat0(id_imin0+1,id_jmin0+1)+dp_delta )THEN 
    3928                   ll_ii=.TRUE. 
    3929                ENDIF 
    3930                IF( dl_lon1(ii,ij+1) <= dl_lon0(id_imin0+1,id_jmin0+1)+dp_delta .AND. & 
    3931                &   dd_lat1(ii,ij+1) <= dd_lat0(id_imin0+1,id_jmin0+1)+dp_delta )THEN 
    3932                   ll_ij=.TRUE. 
    3933                ENDIF 
    3934  
    3935                IF( ll_ii ) ii=ii+1 
    3936                IF( ll_ij ) ij=ij+1 
    3937  
    3938             ENDDO 
    3939  
    3940          ELSE 
    3941             CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
    3942             &                 " not match fine grid lower left corner.") 
    3943          ENDIF 
    3944  
    3945          ! look for upper right offset 
    3946          IF( dl_lon1(il_shape1(jp_I),il_shape1(jp_J)) > & 
    3947             & dl_lon0(id_imax0-1,id_jmax0-1) )THEN 
    3948  
    3949             ii=il_shape1(jp_I) 
    3950             ij=il_shape1(jp_J) 
    3951             DO ji=1,(id_rho(jp_I)+2)*(id_rho(jp_J)+2) 
    3952  
    3953                ll_ii=.FALSE. 
    3954                ll_ij=.FALSE. 
    3955  
    3956                IF( dl_lon1(ii,ij) <= dl_lon0(id_imax0-1,id_jmax0-1)+dp_delta .AND. & 
    3957                &   dd_lat1(ii,ij) <= dd_lat0(id_imax0-1,id_jmax0-1)+dp_delta )THEN 
    3958                   grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-(il_shape1(jp_I)+1-ii) 
    3959                   grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-(il_shape1(jp_J)+1-ij) 
    3960                   EXIT 
    3961                ENDIF 
    3962  
    3963                IF( dl_lon1(ii-1,ij) >= dl_lon0(id_imax0-1,id_jmax0-1)-dp_delta .AND. & 
    3964                &   dd_lat1(ii-1,ij) >= dd_lat0(id_imax0-1,id_jmax0-1)-dp_delta )THEN 
    3965                   ll_ii=.TRUE. 
    3966                ENDIF 
    3967                IF( dl_lon1(ii,ij-1) >= dl_lon0(id_imax0-1,id_jmax0-1)-dp_delta .AND. & 
    3968                &   dd_lat1(ii,ij-1) >= dd_lat0(id_imax0-1,id_jmax0-1)-dp_delta )THEN 
    3969                   ll_ij=.TRUE. 
    3970                ENDIF 
    3971  
    3972                IF( ll_ii ) ii=ii-1 
    3973                IF( ll_ij ) ij=ij-1 
    3974  
    3975             ENDDO 
    3976  
    3977          ELSE 
    3978             CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
    3979             &                 " not match fine grid upper right corner.") 
     4495         ENDIF 
     4496 
     4497         IF( ll_greenwich )THEN 
     4498            ! close to greenwich meridien 
     4499            ll_greenwich=.FALSE. 
     4500            ! -180:180 => 0:360 
     4501            WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) < 0. ) 
     4502               dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) = & 
     4503                  & dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0)+360. 
     4504            END WHERE 
     4505 
     4506            WHERE( dl_lon1(i1:i2,j1:j2) < 0. ) 
     4507               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360. 
     4508            END WHERE 
    39804509         ENDIF 
    39814510 
     
    39844513      DEALLOCATE( dl_lon0 ) 
    39854514      DEALLOCATE( dl_lon1 ) 
     4515 
     4516      IF( ANY(grid__get_fine_offset_cc(:,:)==-1) )THEN 
     4517         CALL logger_fatal("GRID GET FINE OFFSET: can not found "//& 
     4518         &                 " offset between coarse and fine grid.") 
     4519      ENDIF 
    39864520 
    39874521   END FUNCTION grid__get_fine_offset_cc 
     
    39954529   !> @date October, 2014 
    39964530   !> - work on mpp file structure instead of file structure 
    3997    ! 
     4531   !> @date February, 2016 
     4532   !> - use F-point to check coincidence for even refinment 
     4533   !> - use F-point estimation, if can not read it. 
     4534   !> 
    39984535   !> @param[in] td_coord0 coarse grid coordinate file structure  
    39994536   !> @param[in] td_coord1 fine   grid coordinate file structure  
     
    40204557 
    40214558      ! local variable 
    4022       INTEGER(i4) :: il_imid1 
    4023       INTEGER(i4) :: il_jmid1 
     4559      INTEGER(i4)               :: il_imid1 
     4560      INTEGER(i4)               :: il_jmid1 
    40244561       
    4025       INTEGER(i4) :: il_ew0 
    4026       INTEGER(i4) :: il_ew1 
    4027  
    4028       INTEGER(i4) :: il_imin1 
    4029       INTEGER(i4) :: il_imax1 
    4030       INTEGER(i4) :: il_jmin1 
    4031       INTEGER(i4) :: il_jmax1 
    4032  
    4033       INTEGER(i4), DIMENSION(2) :: il_indC 
    4034       INTEGER(i4), DIMENSION(2) :: il_indF 
    4035       INTEGER(i4), DIMENSION(2) :: il_iind 
    4036       INTEGER(i4), DIMENSION(2) :: il_jind 
    4037  
    4038       REAL(dp)    :: dl_lon0 
    4039       REAL(dp)    :: dl_lat0 
    4040       REAL(dp)    :: dl_lon1 
    4041       REAL(dp)    :: dl_lat1 
    4042  
    4043       REAL(dp)    :: dl_lon1p 
    4044       REAL(dp)    :: dl_lat1p 
    4045  
    4046       LOGICAL     :: ll_coincidence 
    4047  
    4048       TYPE(TVAR)  :: tl_lon0 
    4049       TYPE(TVAR)  :: tl_lat0 
    4050       TYPE(TVAR)  :: tl_lon1 
    4051       TYPE(TVAR)  :: tl_lat1 
    4052  
    4053       TYPE(TMPP)  :: tl_coord0 
    4054       TYPE(TMPP)  :: tl_coord1 
    4055  
    4056       TYPE(TDOM)  :: tl_dom0 
     4562      INTEGER(i4)               :: il_ew0 
     4563      INTEGER(i4)               :: il_ew1 
     4564 
     4565      INTEGER(i4)               :: il_ind 
     4566 
     4567      INTEGER(i4)               :: il_imin1 
     4568      INTEGER(i4)               :: il_imax1 
     4569      INTEGER(i4)               :: il_jmin1 
     4570      INTEGER(i4)               :: il_jmax1 
     4571 
     4572      INTEGER(i4), DIMENSION(2) :: il_ind0 
     4573      INTEGER(i4), DIMENSION(2) :: il_ind1 
     4574 
     4575      INTEGER(i4), DIMENSION(2) :: il_ill1 
     4576      INTEGER(i4), DIMENSION(2) :: il_ilr1 
     4577      INTEGER(i4), DIMENSION(2) :: il_iul1 
     4578      INTEGER(i4), DIMENSION(2) :: il_iur1 
     4579 
     4580      REAL(dp)                  :: dl_lon0F 
     4581      REAL(dp)                  :: dl_lat0F 
     4582      REAL(dp)                  :: dl_lon0 
     4583      REAL(dp)                  :: dl_lat0 
     4584      REAL(dp)                  :: dl_lon1F 
     4585      REAL(dp)                  :: dl_lat1F 
     4586      REAL(dp)                  :: dl_lon1 
     4587      REAL(dp)                  :: dl_lat1 
     4588 
     4589      REAL(dp)                  :: dl_delta 
     4590 
     4591      LOGICAL                   :: ll_coincidence 
     4592      LOGICAL                   :: ll_even 
     4593      LOGICAL                   :: ll_grid0F 
     4594      LOGICAL                   :: ll_grid1F 
     4595 
     4596      TYPE(TVAR)                :: tl_lon0 
     4597      TYPE(TVAR)                :: tl_lat0 
     4598      TYPE(TVAR)                :: tl_lon0F 
     4599      TYPE(TVAR)                :: tl_lat0F 
     4600      TYPE(TVAR)                :: tl_lon1 
     4601      TYPE(TVAR)                :: tl_lat1 
     4602      TYPE(TVAR)                :: tl_lon1F 
     4603      TYPE(TVAR)                :: tl_lat1F 
     4604 
     4605      TYPE(TMPP)                :: tl_coord0 
     4606      TYPE(TMPP)                :: tl_coord1 
     4607 
     4608      TYPE(TDOM)                :: tl_dom0 
    40574609 
    40584610      ! loop indices 
     
    40634615      ll_coincidence=.TRUE. 
    40644616 
     4617      ll_even=.FALSE. 
     4618      IF( MOD(id_rho(jp_I)*id_rho(jp_J),2) == 0 )THEN 
     4619         ll_even=.TRUE. 
     4620      ENDIF 
     4621 
    40654622      ! copy structure 
    40664623      tl_coord0=mpp_copy(td_coord0) 
     
    40754632 
    40764633      ! read variable value on domain 
    4077       tl_lon0=iom_dom_read_var(tl_coord0,'longitude',tl_dom0) 
    4078       tl_lat0=iom_dom_read_var(tl_coord0,'latitude' ,tl_dom0) 
     4634      il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'longitude_T') 
     4635      IF( il_ind /= 0 )THEN 
     4636         tl_lon0=iom_dom_read_var(tl_coord0,'longitude_T',tl_dom0) 
     4637      ELSE 
     4638         tl_lon0=iom_dom_read_var(tl_coord0,'longitude',tl_dom0) 
     4639      ENDIF 
     4640 
     4641      il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'latitude_T') 
     4642      IF( il_ind /= 0 )THEN 
     4643         tl_lat0=iom_dom_read_var(tl_coord0,'latitude_T' ,tl_dom0) 
     4644      ELSE 
     4645         tl_lat0=iom_dom_read_var(tl_coord0,'latitude' ,tl_dom0) 
     4646      ENDIF 
     4647 
     4648      IF( ll_even )THEN 
     4649         ! look for variable value on domain for F point 
     4650         il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'longitude_F') 
     4651         IF( il_ind /= 0 )THEN 
     4652            tl_lon0F=iom_dom_read_var(tl_coord0,'longitude_F',tl_dom0) 
     4653         ENDIF 
     4654 
     4655         il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'latitude_F') 
     4656         IF( il_ind /= 0 )THEN 
     4657            tl_lat0F=iom_dom_read_var(tl_coord0,'latitude_F' ,tl_dom0) 
     4658         ENDIF 
     4659 
     4660         ll_grid0F=.FALSE. 
     4661         IF( ASSOCIATED(tl_lon0F%d_value) .AND. & 
     4662         &   ASSOCIATED(tl_lat0F%d_value) )THEN 
     4663            ll_grid0F=.TRUE. 
     4664         ENDIF 
     4665 
     4666      ENDIF 
    40794667 
    40804668      ! close mpp files 
     
    40924680 
    40934681      ! read fine longitue and latitude 
    4094       tl_lon1=iom_mpp_read_var(tl_coord1,'longitude') 
    4095       tl_lat1=iom_mpp_read_var(tl_coord1,'latitude') 
     4682      il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), TRIM(tl_lon0%c_longname)) 
     4683      IF( il_ind /= 0 )THEN 
     4684         tl_lon1=iom_mpp_read_var(tl_coord1,TRIM(tl_lon0%c_longname)) 
     4685      ELSE 
     4686         tl_lon1=iom_mpp_read_var(tl_coord1,'longitude') 
     4687      ENDIF 
     4688      il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), TRIM(tl_lat0%c_longname)) 
     4689      IF( il_ind /= 0 )THEN 
     4690         tl_lat1=iom_mpp_read_var(tl_coord1,TRIM(tl_lat0%c_longname)) 
     4691      ELSE 
     4692         tl_lat1=iom_mpp_read_var(tl_coord1,'latitude') 
     4693      ENDIF 
    40964694       
     4695      IF( ll_even )THEN 
     4696 
     4697         ! look for variable value on domain for F point 
     4698         il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), 'longitude_F') 
     4699         IF( il_ind /= 0 )THEN 
     4700            tl_lon1F=iom_mpp_read_var(tl_coord1,'longitude_F') 
     4701         ENDIF 
     4702 
     4703         il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), 'latitude_F') 
     4704         IF( il_ind /= 0 )THEN 
     4705            tl_lat1F=iom_mpp_read_var(tl_coord1,'latitude_F') 
     4706         ENDIF 
     4707 
     4708         ll_grid1F=.FALSE. 
     4709         IF( ASSOCIATED(tl_lon1F%d_value) .AND. & 
     4710         &   ASSOCIATED(tl_lat1F%d_value) )THEN 
     4711            ll_grid1F=.TRUE. 
     4712         ENDIF 
     4713 
     4714      ENDIF 
     4715 
    40974716      ! close mpp files 
    4098       CALL iom_dom_close(tl_coord1) 
     4717      CALL iom_mpp_close(tl_coord1) 
    40994718      ! clean structure 
    41004719      CALL mpp_clean(tl_coord1) 
     
    41584777         IF( .NOT. ll_coincidence )THEN 
    41594778            CALL logger_fatal("GRID CHECK COINCIDENCE: no coincidence "//& 
    4160             &              "between fine grid and coarse grid. invalid domain" ) 
     4779            &              "between fine grid and coarse grid: invalid domain." ) 
    41614780         ENDIF 
    41624781 
     
    41724791 
    41734792      ! select closest point on coarse grid 
    4174       il_indC(:)=grid_get_closest(tl_lon0%d_value(:,:,1,1),& 
     4793      il_ind0(:)=grid_get_closest(tl_lon0%d_value(:,:,1,1),& 
    41754794      &                           tl_lat0%d_value(:,:,1,1),& 
    41764795      &                           dl_lon1, dl_lat1   ) 
    41774796 
    4178       IF( ANY(il_indC(:)==0) )THEN 
     4797      IF( ANY(il_ind0(:)==0) )THEN 
    41794798         CALL logger_fatal("GRID CHECK COINCIDENCE: can not find valid "//& 
    4180          &              "coarse grid indices. invalid domain" ) 
    4181       ENDIF 
    4182  
    4183       dl_lon0=tl_lon0%d_value(il_indC(1),il_indC(2),1,1) 
    4184       dl_lat0=tl_lat0%d_value(il_indC(1),il_indC(2),1,1) 
    4185  
    4186       ! look for closest fine grid point from selected coarse grid point 
    4187       il_iind(:)=MAXLOC( tl_lon1%d_value(:,:,1,1), & 
    4188       &                  tl_lon1%d_value(:,:,1,1) <= dl_lon0 ) 
    4189  
    4190       il_jind(:)=MAXLOC( tl_lat1%d_value(:,:,1,1), & 
    4191       &                  tl_lat1%d_value(:,:,1,1) <= dl_lat0 ) 
    4192  
    4193       il_indF(1)=il_iind(1) 
    4194       il_indF(2)=il_jind(2) 
    4195  
    4196       IF( ANY(il_indF(:)==0) )THEN 
    4197          CALL logger_fatal("GRID CHECK COINCIDENCE: can not find valid "//& 
    4198          &              "fine grid indices. invalid domain" ) 
    4199       ENDIF 
    4200  
    4201       dl_lon1=tl_lon1%d_value(il_indF(1),il_indF(2),1,1) 
    4202       dl_lat1=tl_lat1%d_value(il_indF(1),il_indF(2),1,1) 
    4203  
    4204       ! check i-direction refinement factor 
    4205       DO ji=1,MIN(3,il_imid1) 
    4206  
    4207          IF( il_indF(1)+ji*id_rho(jp_I)+1 > tl_lon1%t_dim(1)%i_len )THEN 
    4208             CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//& 
    4209             &  " to check i-direction refinement factor ") 
    4210             EXIT 
    4211          ELSE 
    4212             dl_lon1=tl_lon1%d_value(il_indF(1)+ji*id_rho(jp_I),il_indF(2),1,1) 
    4213             dl_lon0=tl_lon0%d_value(il_indC(1)+ji,il_indC(2),1,1) 
    4214  
    4215             dl_lon1p=tl_lon1%d_value(il_indF(1)+ji*id_rho(jp_I)+1,il_indF(2),1,1) 
    4216  
    4217             SELECT CASE(MOD(id_rho(jp_I),2)) 
    4218  
    4219             CASE(0) 
    4220  
    4221                IF( dl_lon1 >= dl_lon0 .OR. dl_lon0 >= dl_lon1p )THEN 
    4222                   ll_coincidence=.FALSE. 
    4223                   CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//& 
    4224                   &  "i-direction refinement factor ("//& 
    4225                   &   TRIM(fct_str(id_rho(jp_I)))//& 
    4226                   &   ") between fine grid and coarse grid ") 
    4227                ENDIF 
    4228  
    4229             CASE DEFAULT          
    4230              
     4799         &              "coarse grid indices: invalid domain." ) 
     4800      ENDIF 
     4801 
     4802      IF( .NOT. ll_even )THEN 
     4803         ! case odd refinment in both direction 
     4804         ! work on T-point 
     4805 
     4806         dl_lon0=tl_lon0%d_value(il_ind0(1),il_ind0(2),1,1) 
     4807         dl_lat0=tl_lat0%d_value(il_ind0(1),il_ind0(2),1,1) 
     4808 
     4809         il_ind1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),& 
     4810         &                           tl_lat1%d_value(:,:,1,1),& 
     4811         &                           dl_lon0, dl_lat0 ) 
     4812 
     4813         ! check i-direction refinement factor 
     4814         DO ji=0,MIN(3,il_imid1) 
     4815 
     4816            IF( il_ind1(1)+ji*id_rho(jp_I)+1 > tl_lon1%t_dim(1)%i_len )THEN 
     4817               CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//& 
     4818               &  " to check i-direction refinement factor ") 
     4819               EXIT 
     4820            ELSE 
     4821               dl_lon0=tl_lon0%d_value(il_ind0(1)+ji             ,il_ind0(2),1,1) 
     4822               dl_lon1=tl_lon1%d_value(il_ind1(1)+ji*id_rho(jp_I),il_ind1(2),1,1) 
     4823 
     4824               ! assume there could be little difference due to interpolation 
    42314825               IF( ABS(dl_lon1 - dl_lon0) > dp_delta )THEN 
    42324826                  ll_coincidence=.FALSE. 
     
    42364830                  &  ") between fine grid and coarse grid ") 
    42374831               ENDIF 
    4238              
    4239             END SELECT 
    4240          ENDIF 
    4241  
    4242       ENDDO 
    4243  
    4244       ! check j-direction refinement factor 
    4245       DO jj=1,MIN(3,il_jmid1) 
    4246  
    4247          IF( il_indF(2)+jj*id_rho(jp_J)+1 > tl_lat1%t_dim(2)%i_len )THEN 
    4248             CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//& 
    4249             &  " to check j-direction refinement factor ") 
    4250             EXIT 
    4251          ELSE       
    4252             dl_lat1=tl_lat1%d_value(il_indF(1),il_indF(2)+jj*id_rho(jp_J),1,1) 
    4253             dl_lat0=tl_lat0%d_value(il_indC(1),il_indC(2)+jj,1,1) 
    4254  
    4255             dl_lat1p=tl_lat1%d_value(il_indF(1),il_indF(2)+jj*id_rho(jp_J)+1,1,1) 
    4256  
    4257             SELECT CASE(MOD(id_rho(jp_J),2)) 
    4258  
    4259             CASE(0) 
    4260                 
    4261                IF( dl_lat1 >= dl_lat0 .OR. dl_lat0 >= dl_lat1p )THEN 
    4262                   ll_coincidence=.FALSE. 
    4263                   CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//& 
    4264                   &  "j-direction refinement factor ("//& 
    4265                   &   TRIM(fct_str(id_rho(jp_J)))//& 
    4266                   &  ") between fine grid and coarse grid ") 
    4267                ENDIF 
    4268  
    4269             CASE DEFAULT 
    4270  
     4832            ENDIF 
     4833 
     4834         ENDDO 
     4835 
     4836         ! check j-direction refinement factor 
     4837         DO jj=0,MIN(3,il_jmid1) 
     4838 
     4839            IF( il_ind1(2)+jj*id_rho(jp_J)+1 > tl_lat1%t_dim(2)%i_len )THEN 
     4840               CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//& 
     4841               &  " to check j-direction refinement factor ") 
     4842               EXIT 
     4843            ELSE       
     4844               dl_lat0=tl_lat0%d_value(il_ind0(1),il_ind0(2)+jj             ,1,1) 
     4845               dl_lat1=tl_lat1%d_value(il_ind1(1),il_ind1(2)+jj*id_rho(jp_J),1,1) 
     4846 
     4847               ! assume there could be little difference due to interpolation 
    42714848               IF( ABS(dl_lat1-dl_lat0) > dp_delta )THEN 
    42724849                  ll_coincidence=.FALSE. 
     
    42764853                  &  ") between fine grid and coarse grid ") 
    42774854               ENDIF 
    4278  
    4279             END SELECT 
    4280          ENDIF 
    4281  
    4282       ENDDO 
     4855            ENDIF 
     4856 
     4857         ENDDO 
     4858 
     4859      ELSE 
     4860         ! case even refinment at least in one direction 
     4861         ! work on F-point 
     4862 
     4863         dl_delta=dp_delta 
     4864         ! look for lower left fine point in coarse cell. 
     4865         IF( ll_grid0F )THEN 
     4866       
     4867            ! lower left corner of coarse cell 
     4868            dl_lon0F=tl_lon0F%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1) 
     4869            dl_lat0F=tl_lat0F%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1) 
     4870 
     4871         ELSE 
     4872 
     4873            ! approximate lower left corner of coarse cell (with T point) 
     4874            dl_lon0F=( tl_lon0%d_value(il_ind0(1)  ,il_ind0(2)  ,1,1) + & 
     4875            &          tl_lon0%d_value(il_ind0(1)  ,il_ind0(2)-1,1,1) + & 
     4876            &          tl_lon0%d_value(il_ind0(1)-1,il_ind0(2)  ,1,1) + & 
     4877            &          tl_lon0%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1) ) * 0.25 
     4878 
     4879            dl_lat0F=( tl_lat0%d_value(il_ind0(1)  ,il_ind0(2)  ,1,1) + & 
     4880            &          tl_lat0%d_value(il_ind0(1)  ,il_ind0(2)-1,1,1) + & 
     4881            &          tl_lat0%d_value(il_ind0(1)-1,il_ind0(2)  ,1,1) + & 
     4882            &          tl_lat0%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1) ) * 0.25 
     4883 
     4884            ! as we use approximation of F-point we relax condition 
     4885            dl_delta=100*dp_delta 
     4886 
     4887         ENDIF 
     4888 
     4889         IF( ll_grid1F )THEN 
     4890       
     4891            il_ind1(:)=grid_get_closest(tl_lon1F%d_value(:,:,1,1),& 
     4892            &                           tl_lat1F%d_value(:,:,1,1),& 
     4893            &                           dl_lon0F, dl_lat0F ) 
     4894 
     4895         ELSE 
     4896 
     4897            il_ill1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),& 
     4898            &                           tl_lat1%d_value(:,:,1,1),& 
     4899            &                           dl_lon0F, dl_lat0F, 'll' ) 
     4900 
     4901            il_ilr1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),& 
     4902            &                           tl_lat1%d_value(:,:,1,1),& 
     4903            &                           dl_lon0F, dl_lat0F, 'lr' ) 
     4904 
     4905            il_iul1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),& 
     4906            &                           tl_lat1%d_value(:,:,1,1),& 
     4907            &                           dl_lon0F, dl_lat0F, 'ul' ) 
     4908 
     4909            il_iur1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),& 
     4910            &                           tl_lat1%d_value(:,:,1,1),& 
     4911            &                           dl_lon0F, dl_lat0F, 'ur' ) 
     4912 
     4913            ! as we use approximation of F-point we relax condition 
     4914            dl_delta=100*dp_delta 
     4915 
     4916         ENDIF 
     4917 
     4918         ! check i-direction refinement factor 
     4919         DO ji=0,MIN(3,il_imid1) 
     4920 
     4921            IF( il_ind1(1)+ji*id_rho(jp_I)+1 > tl_lon1%t_dim(1)%i_len )THEN 
     4922               CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//& 
     4923               &  " to check i-direction refinement factor ") 
     4924               EXIT 
     4925            ELSE 
     4926               IF( ll_grid0F )THEN 
     4927                  dl_lon0F=tl_lon0F%d_value(il_ind0(1)+ji-1, il_ind0(2)-1,1,1) 
     4928               ELSE 
     4929                  dl_lon0F= 0.25 * & 
     4930                  & ( tl_lon0%d_value(il_ind0(1)+ji  , il_ind0(2)  ,1,1) + & 
     4931                  &   tl_lon0%d_value(il_ind0(1)+ji-1, il_ind0(2)  ,1,1) + & 
     4932                  &   tl_lon0%d_value(il_ind0(1)+ji  , il_ind0(2)-1,1,1) + & 
     4933                  &   tl_lon0%d_value(il_ind0(1)+ji-1, il_ind0(2)-1,1,1) ) 
     4934               ENDIF 
     4935 
     4936               IF( ll_grid1F )THEN 
     4937                  dl_lon1F= tl_lon1F%d_value( il_ind1(1)+ji*id_rho(jp_I), & 
     4938                                            & il_ind1(2),1,1) 
     4939               ELSE 
     4940                  dl_lon1F= 0.25 * & 
     4941                  & ( tl_lon1%d_value( il_ill1(1)+ji*id_rho(jp_I), & 
     4942                                     & il_ill1(2),1,1) + & 
     4943                  &   tl_lon1%d_value( il_ilr1(1)+ji*id_rho(jp_I), & 
     4944                                     & il_ilr1(2),1,1) + & 
     4945                  &   tl_lon1%d_value( il_iul1(1)+ji*id_rho(jp_I), & 
     4946                                     & il_iul1(2),1,1) + & 
     4947                  &   tl_lon1%d_value( il_iur1(1)+ji*id_rho(jp_I), & 
     4948                                     & il_iur1(2),1,1) ) 
     4949                   
     4950               ENDIF 
     4951 
     4952               ! assume there could be little difference due to interpolation 
     4953               IF( ABS(dl_lon1F - dl_lon0F) > dl_delta )THEN 
     4954                  ll_coincidence=.FALSE. 
     4955                  CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//& 
     4956                  &  "i-direction refinement factor ("//& 
     4957                  &   TRIM(fct_str(id_rho(jp_I)))//& 
     4958                  &  ") between fine grid and coarse grid ") 
     4959               ENDIF 
     4960            ENDIF 
     4961 
     4962         ENDDO 
     4963 
     4964         ! check j-direction refinement factor 
     4965         DO jj=0,MIN(3,il_jmid1) 
     4966 
     4967            IF( il_ind1(2)+jj*id_rho(jp_J)+1 > tl_lat1%t_dim(2)%i_len )THEN 
     4968               CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//& 
     4969               &  " to check j-direction refinement factor ") 
     4970               EXIT 
     4971            ELSE       
     4972               IF( ll_grid0F )THEN 
     4973                  dl_lat0F=tl_lat0F%d_value(il_ind0(1)-1, il_ind0(2)+jj-1,1,1) 
     4974               ELSE 
     4975                  dl_lat0F= 0.25 * & 
     4976                  & ( tl_lat0%d_value(il_ind0(1)  , il_ind0(2)+jj  ,1,1) + & 
     4977                  &   tl_lat0%d_value(il_ind0(1)-1, il_ind0(2)+jj  ,1,1) + & 
     4978                  &   tl_lat0%d_value(il_ind0(1)  , il_ind0(2)+jj-1,1,1) + & 
     4979                  &   tl_lat0%d_value(il_ind0(1)-1, il_ind0(2)+jj-1,1,1) ) 
     4980               ENDIF 
     4981 
     4982               IF( ll_grid1F )THEN 
     4983                  dl_lat1F= tl_lat1F%d_value( il_ind1(1), & 
     4984                                            & il_ind1(2)+jj*id_rho(jp_J),1,1) 
     4985               ELSE 
     4986                  dl_lat1F= 0.25 * & 
     4987                  & ( tl_lat1%d_value( il_ill1(1), & 
     4988                                     & il_ill1(2)+jj*id_rho(jp_J),1,1) + & 
     4989                  &   tl_lat1%d_value( il_ilr1(1), & 
     4990                                     & il_ilr1(2)+jj*id_rho(jp_J),1,1) + & 
     4991                  &   tl_lat1%d_value( il_iul1(1), & 
     4992                                     & il_iul1(2)+jj*id_rho(jp_J),1,1) + & 
     4993                  &   tl_lat1%d_value( il_iur1(1), & 
     4994                                     & il_iur1(2)+jj*id_rho(jp_J),1,1) ) 
     4995                   
     4996               ENDIF 
     4997 
     4998               ! assume there could be little difference due to interpolation 
     4999               IF( ABS(dl_lat1F - dl_lat0F) > dl_delta )THEN 
     5000                  ll_coincidence=.FALSE. 
     5001                  CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//& 
     5002                  &  "i-direction refinement factor ("//& 
     5003                  &   TRIM(fct_str(id_rho(jp_I)))//& 
     5004                  &  ") between fine grid and coarse grid ") 
     5005               ENDIF 
     5006            ENDIF 
     5007 
     5008         ENDDO 
     5009      ENDIF 
    42835010 
    42845011      ! clean  
     
    48515578 
    48525579         ! copy structure 
    4853           tl_mpp=mpp_copy(td_mpp) 
    4854  
    4855           CALL logger_info("GRID GET FINE GHOST perio"//TRIM(fct_str(tl_mpp%i_perio))) 
    4856           IF( tl_mpp%i_perio < 0 )THEN 
    4857              ! compute NEMO periodicity index 
    4858              CALL grid_get_info(tl_mpp) 
    4859           ENDIF 
     5580         tl_mpp=mpp_copy(td_mpp) 
     5581 
     5582         CALL logger_info("GRID GET FINE GHOST perio"//TRIM(fct_str(tl_mpp%i_perio))) 
     5583         IF( tl_mpp%i_perio < 0 )THEN 
     5584            ! compute NEMO periodicity index 
     5585            CALL grid_get_info(tl_mpp) 
     5586         ENDIF 
    48605587 
    48615588         SELECT CASE(tl_mpp%i_perio) 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/interp_linear.f90

    r5616 r6455  
    627627       
    628628      IF( ld_even(jp_I) )THEN 
    629          dl_dx=1./REAL(id_rho(jp_I)-1) 
     629         dl_dx=1._dp/REAL(id_rho(jp_I)-1,dp) 
    630630      ELSE ! odd refinement 
    631          dl_dx=1./REAL(id_rho(jp_I)) 
     631         dl_dx=1._dp/REAL(id_rho(jp_I),dp) 
    632632      ENDIF 
    633633 
    634634      IF( ld_even(jp_J) )THEN 
    635          dl_dy=1./REAL(id_rho(jp_J)-1) 
     635         dl_dy=1._dp/REAL(id_rho(jp_J)-1,dp) 
    636636      ELSE ! odd refinement 
    637          dl_dy=1./REAL(id_rho(jp_J)) 
     637         dl_dy=1._dp/REAL(id_rho(jp_J),dp) 
    638638      ENDIF 
    639639 
     
    642642 
    643643         IF( ld_even(jp_J) )THEN 
    644             dl_y=(jj-1)*dl_dy - dl_dy*0.5  
     644            dl_y=REAL(jj-1,dp)*dl_dy - dl_dy*0.5_dp 
    645645         ELSE ! odd refinement 
    646             dl_y=(jj-1)*dl_dy  
     646            dl_y=REAL(jj-1,dp)*dl_dy  
    647647         ENDIF 
    648648 
     
    653653 
    654654            IF( ld_even(jp_I) )THEN 
    655                dl_x=(ji-1)*dl_dx - dl_dx*0.5  
     655               dl_x=REAL(ji-1,dp)*dl_dx - dl_dx*0.5_dp  
    656656            ELSE ! odd refinement 
    657                dl_x=(ji-1)*dl_dx  
     657               dl_x=REAL(ji-1,dp)*dl_dx  
    658658            ENDIF 
    659659 
     
    692692       
    693693      IF( ld_even )THEN 
    694          dl_dx=1./REAL(id_rho-1) 
     694         dl_dx=1._dp/REAL(id_rho-1,dp) 
    695695      ELSE ! odd refinement 
    696          dl_dx=1./REAL(id_rho) 
     696         dl_dx=1._dp/REAL(id_rho,dp) 
    697697      ENDIF 
    698698 
    699699      DO ji=1,id_rho+1 
    700700         IF( ld_even )THEN 
    701             dl_x=(ji-1)*dl_dx - dl_dx*0.5  
     701            dl_x=REAL(ji-1,dp)*dl_dx - dl_dx*0.5_dp  
    702702         ELSE ! odd refinement 
    703             dl_x=(ji-1)*dl_dx  
     703            dl_x=REAL(ji-1,dp)*dl_dx  
    704704         ENDIF 
    705705 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90

    r5616 r6455  
    214214            &                       cmode=NF90_64BIT_OFFSET,& 
    215215            &                       ncid=td_file%i_id) 
    216          !NF90_WRITE,               & 
    217216            CALL iom_cdf__check(il_status," IOM CDF CREATE: ") 
    218217 
     
    222221 
    223222      ELSE 
     223 
    224224         IF( td_file%i_id /= 0 )THEN 
    225225 
     
    239239               CALL iom_cdf__check(il_status," IOM CDF OPEN: ") 
    240240 
    241                CALL logger_trace("IOM CDF OPEN "//TRIM(td_file%c_name)//" "//& 
    242                   &  TRIM(fct_str(td_file%i_id))) 
    243241            ELSE 
    244242 
     
    363361      ! Argument       
    364362      TYPE(TFILE), INTENT(INOUT) :: td_file 
     363      ! local variable 
     364      TYPE(TDIM) :: tl_dim 
    365365 
    366366      ! loop indices 
    367367      INTEGER(i4) :: ji 
     368      INTEGER(i4) :: ii 
    368369      !---------------------------------------------------------------- 
    369370 
     
    374375 
    375376      IF( td_file%i_ndim > 0 )THEN 
     377         ii=1 
    376378         DO ji = 1, td_file%i_ndim 
    377379            ! read dimension information 
    378             td_file%t_dim(ji)=iom_cdf_read_dim( td_file, ji) 
     380            tl_dim=iom_cdf_read_dim( td_file, ji) 
     381            IF( .NOT. dim_is_dummy(tl_dim) )THEN 
     382               IF( ii > ip_maxdim )THEN 
     383                  CALL logger_fatal("IOM CDF OPEN: too much dimension "//& 
     384                  & "to be read. you should remove dummy dimension using "//& 
     385                  & " configuration file") 
     386               ENDIF 
     387               td_file%t_dim(ii)=dim_copy(tl_dim) 
     388               ii=ii+1 
     389            ENDIF 
    379390         ENDDO 
    380391 
     
    418429 
    419430      ! local variable 
     431      TYPE(TATT) :: tl_att 
     432 
    420433      ! loop indices 
    421434      INTEGER(i4) :: ji 
     435      INTEGER(i4) :: ii 
    422436      !---------------------------------------------------------------- 
    423437 
     
    429443         ALLOCATE(td_file%t_att(td_file%i_natt)) 
    430444 
     445         ii=1 
    431446         DO ji = 1, td_file%i_natt 
    432447            ! read global attribute 
    433             td_file%t_att(ji)=iom_cdf_read_att( td_file, NF90_GLOBAL, ji) 
     448            tl_att=iom_cdf_read_att( td_file, NF90_GLOBAL, ji) 
     449            IF( .NOT. att_is_dummy(tl_att) )THEN 
     450               td_file%t_att(ii)=att_copy(tl_att) 
     451               ii=ii+1 
     452            ENDIF 
    434453             
    435454         ENDDO 
     
    450469   !> @author J.Paul 
    451470   !> @date November, 2013 - Initial Version 
     471   !> @date September, 2015 
     472   !> - manage useless (dummy) variable 
     473   !> @date January, 2016 
     474   !> - increment n3d for 4D variable 
    452475   ! 
    453476   !> @param[inout] td_file   file structure 
     
    460483      ! local variable 
    461484      INTEGER(i4) :: il_attid 
     485      INTEGER(i4) :: il_nvar 
     486 
     487      TYPE(TVAR), DIMENSION(:), ALLOCATABLE  :: tl_var 
    462488 
    463489      ! loop indices 
    464490      INTEGER(i4) :: ji 
     491      INTEGER(i4) :: ii 
    465492      !---------------------------------------------------------------- 
    466493 
    467494      IF( td_file%i_nvar > 0 )THEN 
     495 
    468496         IF(ASSOCIATED(td_file%t_var))THEN 
    469497            CALL var_clean(td_file%t_var(:)) 
    470498            DEALLOCATE(td_file%t_var) 
    471499         ENDIF 
     500 
     501         il_nvar=td_file%i_nvar 
     502         ALLOCATE(tl_var(il_nvar)) 
     503         ii=0 
     504         DO ji = 1, il_nvar 
     505           ! read variable information 
     506           tl_var(ji)=iom_cdf__read_var_meta( td_file, ji)  
     507           IF( .NOT. var_is_dummy(tl_var(ji)) )THEN 
     508              ii=ii+1 
     509           ENDIF 
     510         ENDDO 
     511 
     512         ! update number of variable used 
     513         td_file%i_nvar=ii 
     514 
    472515         ALLOCATE(td_file%t_var(td_file%i_nvar)) 
    473516 
    474          DO ji = 1, td_file%i_nvar 
    475             ! read dimension information 
    476             td_file%t_var(ji)=iom_cdf__read_var_meta( td_file, ji) 
    477             SELECT CASE(td_file%t_var(ji)%i_ndim) 
    478                CASE(0) 
    479                   td_file%i_n0d=td_file%i_n0d+1 
    480                CASE(1) 
    481                   td_file%i_n1d=td_file%i_n1d+1 
    482                   td_file%i_rhd=td_file%i_rhd+1 
    483                CASE(2) 
    484                   td_file%i_n2d=td_file%i_n2d+1 
    485                   td_file%i_rhd=td_file%i_rhd+1 
    486                CASE(3) 
    487                   td_file%i_n3d=td_file%i_n3d+1 
    488                   td_file%i_rhd=td_file%i_rhd+td_file%t_dim(3)%i_len 
    489             END SELECT 
    490  
    491             ! look for depth id 
    492             IF( INDEX(TRIM(fct_lower(td_file%t_var(ji)%c_name)),'depth')/=0 )THEN 
    493                IF( td_file%i_depthid == 0 )THEN 
    494                   td_file%i_depthid=ji 
    495                ELSE 
    496                   IF( td_file%i_depthid /= ji )THEN 
    497                      CALL logger_error("IOM CDF GET FILE VAR: find more"//& 
    498                         &  " than one depth variable in file "//& 
    499                         &  TRIM(td_file%c_name) ) 
     517         ii=0 
     518         DO ji = 1, il_nvar 
     519            IF( .NOT. var_is_dummy(tl_var(ji)) )THEN 
     520               ii=ii+1 
     521               td_file%t_var(ii)=var_copy(tl_var(ji)) 
     522               SELECT CASE(td_file%t_var(ii)%i_ndim) 
     523                  CASE(0) 
     524                     td_file%i_n0d=td_file%i_n0d+1 
     525                  CASE(1) 
     526                     td_file%i_n1d=td_file%i_n1d+1 
     527                     td_file%i_rhd=td_file%i_rhd+1 
     528                  CASE(2) 
     529                     td_file%i_n2d=td_file%i_n2d+1 
     530                     td_file%i_rhd=td_file%i_rhd+1 
     531                  CASE(3,4) 
     532                     td_file%i_n3d=td_file%i_n3d+1 
     533                     td_file%i_rhd=td_file%i_rhd+td_file%t_dim(3)%i_len 
     534               END SELECT 
     535 
     536               ! look for depth id 
     537               IF( INDEX(TRIM(fct_lower(td_file%t_var(ii)%c_name)),'depth')/=0 )THEN 
     538                  IF( td_file%i_depthid == 0 )THEN 
     539                     td_file%i_depthid=ji 
     540                  ELSE 
     541                     IF( td_file%i_depthid /= ji )THEN 
     542                        CALL logger_error("IOM CDF GET FILE VAR: find more"//& 
     543                           &  " than one depth variable in file "//& 
     544                           &  TRIM(td_file%c_name) ) 
     545                     ENDIF 
    500546                  ENDIF 
    501547               ENDIF 
    502             ENDIF 
    503  
    504             ! look for time id 
    505             IF( INDEX(TRIM(fct_lower(td_file%t_var(ji)%c_name)),'time')/=0 )THEN 
    506                IF( td_file%i_timeid == 0 )THEN 
    507                   td_file%i_timeid=ji 
    508                ELSE 
    509                   il_attid=0 
    510                   IF( ASSOCIATED(td_file%t_var(ji)%t_att) )THEN 
    511                      il_attid=att_get_id(td_file%t_var(ji)%t_att(:),'calendar') 
    512                   ENDIF 
    513                   IF( il_attid /= 0 )THEN 
     548 
     549               ! look for time id 
     550               IF( INDEX(TRIM(fct_lower(td_file%t_var(ii)%c_name)),'time')/=0 )THEN 
     551                  IF( td_file%i_timeid == 0 )THEN 
    514552                     td_file%i_timeid=ji 
    515                   !ELSE 
    516                   !   CALL logger_error("IOM CDF GET FILE VAR: find more "//& 
    517                   !   &                 "than one time variable in file "//& 
    518                   !   &                 TRIM(td_file%c_name) ) 
     553                  ELSE 
     554                     il_attid=0 
     555                     IF( ASSOCIATED(td_file%t_var(ii)%t_att) )THEN 
     556                        il_attid=att_get_id(td_file%t_var(ii)%t_att(:),'calendar') 
     557                     ENDIF 
     558                     IF( il_attid /= 0 )THEN 
     559                        td_file%i_timeid=ji 
     560                     !ELSE 
     561                     !   CALL logger_error("IOM CDF GET FILE VAR: find more "//& 
     562                     !   &                 "than one time variable in file "//& 
     563                     !   &                 TRIM(td_file%c_name) ) 
     564                     ENDIF 
    519565                  ENDIF 
    520566               ENDIF 
     567 
    521568            ENDIF 
    522  
    523569         ENDDO 
     570 
     571         CALL var_clean(tl_var(:)) 
     572         DEALLOCATE(tl_var) 
    524573 
    525574      ELSE 
     
    605654      ELSE       
    606655 
    607          iom_cdf__read_dim_id%i_id=id_dimid 
    608  
    609656         CALL logger_trace( & 
    610657         &  " IOM CDF READ DIM: dimension "//TRIM(fct_str(id_dimid))//& 
     
    627674      ENDIF 
    628675 
     676      iom_cdf__read_dim_id%i_id=id_dimid 
     677 
    629678   END FUNCTION iom_cdf__read_dim_id 
    630679   !------------------------------------------------------------------- 
     
    748797               IF( LEN(cl_value) < il_len )THEN 
    749798 
    750                   CALL logger_error( & 
     799                  CALL logger_warn( & 
    751800                  &  " IOM CDF READ ATT: not enough space to put "//& 
    752801                  &  "attribute "//TRIM(cl_name) ) 
     
    12231272   !> @date September, 2014 
    12241273   !> - force to use FillValue=1.e20 if no FillValue for coordinate variable. 
     1274   !> @date September, 2015 
     1275   !> - manage useless (dummy) attribute 
    12251276   ! 
    12261277   !> @param[in] td_file   file structure 
     
    12501301 
    12511302      ! loop indices 
     1303      INTEGER(i4) :: ji 
    12521304      !---------------------------------------------------------------- 
    12531305      ! check if file opened 
     
    12751327         &                                il_natt ) 
    12761328         CALL iom_cdf__check(il_status,"IOM CDF READ VAR META: ") 
     1329 
    12771330         !!! fill variable dimension structure 
    1278          tl_dim(:)=iom_cdf__read_var_dim( td_file, il_ndim, il_dimid(:) ) 
     1331         tl_dim(:)=iom_cdf__read_var_dim( td_file, il_ndim, cl_name, il_dimid(:) ) 
    12791332 
    12801333         IF( il_natt /= 0 )THEN 
     
    13531406         &                                tl_att(:), id_id=id_varid ) 
    13541407 
     1408         !! look for dummy attribute 
     1409         DO ji=il_natt,1,-1 
     1410            IF( att_is_dummy(tl_att(ji)) )THEN 
     1411               CALL var_del_att(iom_cdf__read_var_meta, tl_att(ji)) 
     1412            ENDIF 
     1413         ENDDO 
     1414 
    13551415         ! clean 
    13561416         CALL dim_clean(tl_dim(:)) 
     
    13731433   !> So the array of dimension structure of a variable is always compose of 4 
    13741434   !> dimension (use or not).  
    1375    ! 
     1435   !> 
     1436   !> @warn dummy dimension are not used.  
     1437   !> 
    13761438   !> @author J.Paul 
    13771439   !> @date November, 2013 - Initial Version 
    13781440   !> @date July, 2015  
    13791441   !> - Bug fix: use order to disorder table (see dim_init) 
     1442   !> @date September, 2015 
     1443   !> - check dummy dimension 
    13801444   !> 
    13811445   !> @param[in] td_file   file structure 
    13821446   !> @param[in] id_ndim   number of dimension 
     1447   !> @param[in] cd_name   variable name 
    13831448   !> @param[in] id_dimid  array of dimension id 
    13841449   !> @return array dimension structure  
    13851450   !------------------------------------------------------------------- 
    1386    FUNCTION iom_cdf__read_var_dim(td_file, id_ndim, id_dimid) 
     1451   FUNCTION iom_cdf__read_var_dim(td_file, id_ndim, cd_name, id_dimid) 
    13871452      IMPLICIT NONE 
    13881453      ! Argument       
    13891454      TYPE(TFILE),               INTENT(IN) :: td_file 
    13901455      INTEGER(i4),               INTENT(IN) :: id_ndim 
     1456      CHARACTER(LEN=*)         , INTENT(IN) :: cd_name 
    13911457      INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_dimid 
    13921458 
     
    14011467      ! loop indices 
    14021468      INTEGER(i4) :: ji 
     1469      INTEGER(i4) :: ii 
    14031470      !---------------------------------------------------------------- 
    14041471 
     
    14151482         CALL dim_clean(tl_dim(:)) 
    14161483 
    1417       ELSE IF( id_ndim > 0 .AND. id_ndim <= 4 )THEN 
    1418  
    1419  
     1484      ELSE IF( id_ndim > 0 )THEN 
     1485 
     1486 
     1487         ii=1 
    14201488         DO ji = 1, id_ndim 
    1421             CALL logger_debug( " IOM CDF READ VAR DIM: get variable "//& 
    1422                &  "dimension "//TRIM(fct_str(ji)) ) 
    1423  
    1424             il_xyzt2(ji)=td_file%t_dim(id_dimid(ji))%i_xyzt2 
    1425  
    1426             ! read dimension information 
    1427             tl_dim(ji) = dim_init( td_file%t_dim(il_xyzt2(ji))%c_name, & 
    1428             &                      td_file%t_dim(il_xyzt2(ji))%i_len ) 
     1489 
     1490            !!! check no dummy dimension to be used 
     1491            IF( ANY(td_file%t_dim(:)%i_id == id_dimid(ji)) )THEN 
     1492               IF( ii > ip_maxdim )THEN 
     1493                  CALL logger_error(" IOM CDF READ VAR DIM: "//& 
     1494                  &  "too much dimensions for variable "//& 
     1495                  &  TRIM(cd_name)//". check dummy configuration file.") 
     1496               ENDIF 
     1497 
     1498               CALL logger_debug( " IOM CDF READ VAR DIM: get variable "//& 
     1499                  &  "dimension "//TRIM(fct_str(ji)) ) 
     1500 
     1501               il_xyzt2(ii)=td_file%t_dim(id_dimid(ji))%i_xyzt2 
     1502 
     1503               ! read dimension information 
     1504               tl_dim(ii) = dim_init( td_file%t_dim(il_xyzt2(ii))%c_name, & 
     1505               &                      td_file%t_dim(il_xyzt2(ii))%i_len ) 
     1506             
     1507               ii=ii+1 
     1508            ELSE 
     1509               CALL logger_debug( " IOM CDF READ VAR DIM: dummy variable "//& 
     1510               &  "dimension "//TRIM(fct_str(ji))//" not used." ) 
     1511            ENDIF 
    14291512         ENDDO 
    14301513 
     
    14361519         ! clean 
    14371520         CALL dim_clean(tl_dim(:)) 
    1438  
    1439       ELSE 
    1440  
    1441          CALL logger_error(" IOM CDF READ VAR DIM: can't manage "//& 
    1442          &              TRIM(fct_str(id_ndim))//" dimension(s)" ) 
    14431521 
    14441522      ENDIF 
     
    19432021   !> @author J.Paul 
    19442022   !> @date November, 2013 - Initial Version 
     2023   !> @date September, 2015 
     2024   !> - do not force to use zero as FillValue for any meshmask variable 
    19452025   ! 
    19462026   !> @param[inout] td_file   file structure 
     
    19762056      ! check if file and variable dimension conform 
    19772057      IF( file_check_var_dim(td_file, td_var) )THEN 
    1978  
    1979          ! check variable dimension expected 
    1980          CALL var_check_dim(td_var) 
    19812058 
    19822059         ll_chg=.TRUE. 
     
    19982075               CASE('nav_lon','nav_lat', & 
    19992076                  & 'glamt','glamu','glamv','glamf', & 
    2000                   & 'gphit','gphiu','gphiv','gphif') 
     2077                  & 'gphit','gphiu','gphiv','gphif', & 
     2078                  & 'e1t','e1u','e1v','e1f',         & 
     2079                  & 'e2t','e2u','e2v','e2f','ff',    & 
     2080                  & 'gcost','gcosu','gcosv','gcosf', & 
     2081                  & 'gsint','gsinu','gsinv','gsinf', & 
     2082                  & 'mbathy','misf','isf_draft',     & 
     2083                  & 'hbatt','hbatu','hbatv','hbatf', & 
     2084                  & 'gsigt','gsigu','gsigv','gsigf', & 
     2085                  & 'e3t_0','e3u_0','e3v_0','e3w_0', & 
     2086                  & 'e3f_0','gdepw_1d','gdept_1d',   & 
     2087                  & 'e3tp','e3wp','gdepw_0','rx1',   & 
     2088                  & 'gdept_0','gdepu','gdepv',       & 
     2089                  & 'hdept','hdepw','e3w_1d','e3t_1d',& 
     2090                  & 'tmask','umask','vmask','fmask'  ) 
     2091                  ! do not change for coordinates and meshmask variables 
    20012092            END SELECT 
    20022093         ENDIF 
     
    21182209         ENDIF 
    21192210 
    2120          IF( tl_var%t_att(ji)%i_type == NF90_CHAR )THEN 
    2121             IF( TRIM(tl_var%t_att(ji)%c_value) /= '' )THEN 
    2122                il_status = NF90_PUT_ATT(td_file%i_id, iom_cdf__write_var_def, & 
    2123                &                        TRIM(tl_var%t_att(ji)%c_name),        & 
    2124                &                        TRIM(tl_var%t_att(ji)%c_value)        ) 
    2125                CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ") 
    2126             ENDIF 
    2127          ELSE 
    2128             SELECT CASE(tl_var%t_att(ji)%i_type) 
    2129                CASE(NF90_BYTE) 
    2130                   il_status = NF90_PUT_ATT(td_file%i_id,                   & 
    2131                   &                        iom_cdf__write_var_def,         & 
    2132                   &                        TRIM(tl_var%t_att(ji)%c_name),  & 
    2133                   &                        INT(tl_var%t_att(ji)%d_value(:),i1)) 
    2134                CASE(NF90_SHORT) 
    2135                   il_status = NF90_PUT_ATT(td_file%i_id,                   & 
    2136                   &                        iom_cdf__write_var_def,         & 
    2137                   &                        TRIM(tl_var%t_att(ji)%c_name),  & 
    2138                   &                        INT(tl_var%t_att(ji)%d_value(:),i2)) 
    2139                CASE(NF90_INT) 
    2140                   il_status = NF90_PUT_ATT(td_file%i_id,                   & 
    2141                   &                        iom_cdf__write_var_def,         & 
    2142                   &                        TRIM(tl_var%t_att(ji)%c_name),  & 
    2143                   &                        INT(tl_var%t_att(ji)%d_value(:),i4)) 
    2144                CASE(NF90_FLOAT) 
    2145                   il_status = NF90_PUT_ATT(td_file%i_id,                   & 
    2146                   &                        iom_cdf__write_var_def,         & 
    2147                   &                        TRIM(tl_var%t_att(ji)%c_name),  & 
    2148                   &                        REAL(tl_var%t_att(ji)%d_value(:),sp)) 
    2149                CASE(NF90_DOUBLE) 
    2150                   il_status = NF90_PUT_ATT(td_file%i_id,                   & 
    2151                   &                        iom_cdf__write_var_def,         & 
    2152                   &                        TRIM(tl_var%t_att(ji)%c_name),  & 
    2153                   &                        REAL(tl_var%t_att(ji)%d_value(:),dp)) 
    2154             END SELECT 
    2155             CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ") 
    2156          ENDIF 
     2211         SELECT CASE(tl_var%t_att(ji)%i_type) 
     2212            CASE(NF90_CHAR) 
     2213               IF( TRIM(tl_var%t_att(ji)%c_value) /= '' )THEN 
     2214                  il_status = NF90_PUT_ATT(td_file%i_id, iom_cdf__write_var_def, & 
     2215                  &                        TRIM(tl_var%t_att(ji)%c_name),        & 
     2216                  &                        TRIM(tl_var%t_att(ji)%c_value)        ) 
     2217               ENDIF 
     2218            CASE(NF90_BYTE) 
     2219               il_status = NF90_PUT_ATT(td_file%i_id,                   & 
     2220               &                        iom_cdf__write_var_def,         & 
     2221               &                        TRIM(tl_var%t_att(ji)%c_name),  & 
     2222               &                        INT(tl_var%t_att(ji)%d_value(:),i1)) 
     2223            CASE(NF90_SHORT) 
     2224               il_status = NF90_PUT_ATT(td_file%i_id,                   & 
     2225               &                        iom_cdf__write_var_def,         & 
     2226               &                        TRIM(tl_var%t_att(ji)%c_name),  & 
     2227               &                        INT(tl_var%t_att(ji)%d_value(:),i2)) 
     2228            CASE(NF90_INT) 
     2229               il_status = NF90_PUT_ATT(td_file%i_id,                   & 
     2230               &                        iom_cdf__write_var_def,         & 
     2231               &                        TRIM(tl_var%t_att(ji)%c_name),  & 
     2232               &                        INT(tl_var%t_att(ji)%d_value(:),i4)) 
     2233            CASE(NF90_FLOAT) 
     2234               il_status = NF90_PUT_ATT(td_file%i_id,                   & 
     2235               &                        iom_cdf__write_var_def,         & 
     2236               &                        TRIM(tl_var%t_att(ji)%c_name),  & 
     2237               &                        REAL(tl_var%t_att(ji)%d_value(:),sp)) 
     2238            CASE(NF90_DOUBLE) 
     2239               il_status = NF90_PUT_ATT(td_file%i_id,                   & 
     2240               &                        iom_cdf__write_var_def,         & 
     2241               &                        TRIM(tl_var%t_att(ji)%c_name),  & 
     2242               &                        REAL(tl_var%t_att(ji)%d_value(:),dp)) 
     2243         END SELECT 
     2244         CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ") 
     2245 
    21572246      ENDDO 
    21582247 
     
    22002289         &  (td_var%d_value(:,:,:,:)-td_var%d_ofs)/td_var%d_scf 
    22012290      END WHERE 
    2202        
     2291 
    22032292      jj=0 
    22042293      DO ji = 1, ip_maxdim 
     
    22262315 
    22272316      ! put value 
    2228       CALL logger_trace( & 
     2317      CALL logger_debug( & 
    22292318      &  "IOM CDF WRITE VAR VALUE: put "//TRIM(td_var%c_name)//" value "//& 
    22302319      &  "in file "//TRIM(td_file%c_name)) 
    22312320 
    22322321      il_status = NF90_PUT_VAR( td_file%i_id, td_var%i_id, dl_value(:,:,:,:)) 
    2233       CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR VALUE: ") 
     2322      CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR VALUE ("//& 
     2323         &  TRIM(td_var%c_name)//") :" ) 
    22342324 
    22352325      DEALLOCATE( dl_value ) 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/iom_dom.f90

    r5616 r6455  
    234234               CALL logger_error( & 
    235235               &  " IOM DOM READ VAR: there is no variable with "//& 
    236                &  "name or standard name"//TRIM(cd_name)//& 
     236               &  "name or standard name "//TRIM(cd_name)//& 
    237237               &  " in processor/file "//TRIM(td_mpp%t_proc(1)%c_name)) 
    238238            ENDIF 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90

    r5616 r6455  
    415415            ELSE 
    416416 
    417                CALL logger_error( & 
     417               CALL logger_fatal( & 
    418418               &  " IOM MPP READ VAR: there is no variable with "//& 
    419419               &  "name or standard name "//TRIM(cd_name)//& 
     
    648648         DO ji=1, td_mpp%i_nproc 
    649649            IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN 
    650                !CALL file_del_att(td_mpp%t_proc(ji), 'periodicity') 
    651                !CALL file_del_att(td_mpp%t_proc(ji), 'ew_overlap') 
    652  
    653650               CALL iom_write_file(td_mpp%t_proc(ji), cd_dimorder) 
    654651            ELSE 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/iom_rstdimg.f90

    r5616 r6455  
    395395   !> @author J.Paul 
    396396   !> @date November, 2013 - Initial Version 
    397    ! 
     397   !> @date January, 2016 
     398   !> - mismatch with "halo" indices 
     399   !> 
    398400   !> @param[inout] td_file   file structure 
    399401   !------------------------------------------------------------------- 
     
    494496      ENDIF 
    495497 
    496       tl_att=att_init( "DOMAIN_position_first", (/il_impp(il_area), il_jmpp(il_area)/)) 
     498      tl_att=att_init( "SUBDOMAIN_I_left_bottom_indices", il_impp(:) ) 
    497499      CALL file_move_att(td_file, tl_att) 
    498  
    499       tl_att=att_init( "DOMAIN_position_last", (/il_lci(il_area), il_lcj(il_area)/)) 
     500      tl_att=att_init( "SUBDOMAIN_J_left_bottom_indices", il_jmpp(:) ) 
    500501      CALL file_move_att(td_file, tl_att) 
    501502 
    502       tl_att=att_init( "DOMAIN_halo_size_start", (/il_ldi(il_area), il_ldj(il_area)/)) 
     503      tl_att=att_init( "SUBDOMAIN_I_dimensions", il_lci(:)) 
    503504      CALL file_move_att(td_file, tl_att) 
    504  
    505       tl_att=att_init( "DOMAIN_halo_size_end", (/il_lei(il_area), il_lej(il_area)/)) 
     505      tl_att=att_init( "SUBDOMAIN_J_dimensions", il_lcj(:)) 
    506506      CALL file_move_att(td_file, tl_att) 
    507507 
    508       tl_att=att_init( "DOMAIN_I_position_first", il_impp(:) ) 
     508      tl_att=att_init( "SUBDOMAIN_I_first_indoor_indices", il_ldi(:)) 
    509509      CALL file_move_att(td_file, tl_att) 
    510       tl_att=att_init( "DOMAIN_J_position_first", il_jmpp(:) ) 
     510      tl_att=att_init( "SUBDOMAIN_J_first_indoor_indices", il_ldj(:)) 
    511511      CALL file_move_att(td_file, tl_att) 
    512512 
    513       tl_att=att_init( "DOMAIN_I_position_last", il_lci(:) ) 
     513      tl_att=att_init( "SUBDOMAIN_I_last_indoor_indices", il_lei(:)) 
    514514      CALL file_move_att(td_file, tl_att) 
    515       tl_att=att_init( "DOMAIN_J_position_last", il_lcj(:) ) 
    516       CALL file_move_att(td_file, tl_att) 
    517  
    518       tl_att=att_init( "DOMAIN_I_halo_size_start", il_ldi(:) ) 
    519       CALL file_move_att(td_file, tl_att) 
    520       tl_att=att_init( "DOMAIN_J_halo_size_start", il_ldj(:) ) 
    521       CALL file_move_att(td_file, tl_att) 
    522  
    523       tl_att=att_init( "DOMAIN_I_halo_size_end", il_lei(:) ) 
    524       CALL file_move_att(td_file, tl_att) 
    525       tl_att=att_init( "DOMAIN_J_halo_size_end", il_lej(:) ) 
     515      tl_att=att_init( "SUBDOMAIN_J_last_indoor_indices", il_lej(:)) 
    526516      CALL file_move_att(td_file, tl_att) 
    527517 
     
    10381028   !> @author J.Paul 
    10391029   !> @date November, 2013 - Initial Version 
     1030   !> @date February, 2016 
     1031   !> - use temporary array to read value from file 
    10401032   ! 
    10411033   !> @param[in] td_file   file structure 
     
    10591051      INTEGER(i4), DIMENSION(ip_maxdim)            :: il_count 
    10601052 
     1053      REAL(dp),    DIMENSION(:,:,:)  , ALLOCATABLE :: dl_tmp 
    10611054      REAL(dp),    DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value 
    10621055 
     
    11421135         IF( ALL(td_var%t_dim(1:3)%l_use) )THEN 
    11431136            ! 3D variable (X,Y,Z) 
     1137            ALLOCATE(dl_tmp( td_var%t_dim(1)%i_len, & 
     1138            &                td_var%t_dim(2)%i_len, & 
     1139            &                td_var%t_dim(4)%i_len) )            
    11441140            DO ji=1,td_var%t_dim(3)%i_len 
    11451141               READ(td_file%i_id, IOSTAT=il_status, REC=td_var%i_rec +ji-1) & 
    1146                &  dl_value(:,:,ji,:) 
     1142               &  dl_tmp(:,:,:) 
    11471143               CALL fct_err(il_status) 
    11481144               IF( il_status /= 0 )THEN 
     
    11501146                  &              TRIM(td_var%c_name)) 
    11511147               ENDIF 
     1148               dl_value(:,:,ji,:)=dl_tmp(:,:,:) 
    11521149            ENDDO 
     1150            DEALLOCATE(dl_tmp) 
    11531151         ELSEIF( ALL(td_var%t_dim(1:2)%l_use) )THEN 
    11541152            ! 2D variable (X,Y) 
     
    14271425   !> @author J.Paul 
    14281426   !> @date November, 2013 - Initial Version 
    1429    ! 
     1427   !> @date January, 2016 
     1428   !> - mismatch with "halo" indices 
     1429   !> 
    14301430   !> @param[inout] td_file   file structure 
    14311431   !------------------------------------------------------------------- 
     
    15421542      &         il_lei(il_nproc),  il_lej(il_nproc) ) 
    15431543 
    1544       ! get domain first poistion 
    1545       il_ind=att_get_index( td_file%t_att, "DOMAIN_I_position_first" ) 
     1544      ! get left bottom indices 
     1545      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_I_left_bottom_indices" ) 
    15461546      il_impp(:) = 0 
    15471547      IF( il_ind /= 0 )THEN 
     
    15491549      ENDIF 
    15501550 
    1551       il_ind=att_get_index( td_file%t_att, "DOMAIN_J_position_first" ) 
     1551      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_J_left_bottom_indices" ) 
    15521552      il_jmpp(:) = 0 
    15531553      IF( il_ind /= 0 )THEN 
     
    15551555      ENDIF 
    15561556       
    1557       ! check domain first poistion 
     1557      ! check left bottom indices 
    15581558      IF( ANY(il_impp(:)==0) .OR. ANY(il_jmpp(:)==0) )THEN 
    1559          CALL logger_warn("WRITE FILE: no data for domain first position") 
    1560       ENDIF 
    1561  
    1562       ! get domain last poistion 
    1563       il_ind=att_get_index( td_file%t_att, "DOMAIN_I_position_last" ) 
     1559         CALL logger_warn("WRITE FILE: no data for subdomain left bottom indices") 
     1560      ENDIF 
     1561 
     1562      ! get subdomain dimensions 
     1563      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_I_dimensions" ) 
    15641564      il_lci(:) = 0 
    15651565      IF( il_ind /= 0 )THEN 
     
    15671567      ENDIF 
    15681568 
    1569       il_ind=att_get_index( td_file%t_att, "DOMAIN_J_position_last" ) 
     1569      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_J_dimensions" ) 
    15701570      il_lcj(:) = 0 
    15711571      IF( il_ind /= 0 )THEN 
     
    15731573      ENDIF 
    15741574 
    1575       ! check domain last poistion 
     1575      ! check subdomain dimension 
    15761576      IF( ANY(il_lci(:)==0) .OR. ANY(il_lcj(:)==0) )THEN 
    1577          CALL logger_warn("WRITE FILE: no data for domain last position") 
    1578       ENDIF 
    1579  
    1580       ! get halo size start 
    1581       il_ind=att_get_index( td_file%t_att, "DOMAIN_I_halo_size_start" ) 
     1577         CALL logger_warn("WRITE FILE: no data for subdomain dimensions") 
     1578      ENDIF 
     1579 
     1580      ! get first indoor indices 
     1581      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_I_first_indoor_indices" ) 
    15821582      il_ldi(:) = 0 
    15831583      IF( il_ind /= 0 )THEN 
     
    15851585      ENDIF 
    15861586 
    1587       il_ind=att_get_index( td_file%t_att, "DOMAIN_J_halo_size_start" ) 
     1587      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_J_first_indoor_indices" ) 
    15881588      il_ldj(:) = 0 
    15891589      IF( il_ind /= 0 )THEN 
     
    15911591      ENDIF 
    15921592       
    1593       ! check halo size start 
     1593      ! check first indoor indices 
    15941594      IF( ANY(il_ldi(:)==0) .OR. ANY(il_ldj(:)==0) )THEN 
    1595          CALL logger_warn("WRITE FILE: no data for halo size start") 
    1596       ENDIF 
    1597  
    1598       ! get halo size end 
    1599       il_ind=att_get_index( td_file%t_att, "DOMAIN_I_halo_size_end" ) 
     1595         CALL logger_warn("WRITE FILE: no data for subdomain first indoor indices") 
     1596      ENDIF 
     1597 
     1598      ! get last indoor indices 
     1599      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_I_last_indoor_indices" ) 
    16001600      il_lei(:) = 0 
    16011601      IF( il_ind /= 0 )THEN 
     
    16031603      ENDIF 
    16041604 
    1605       il_ind=att_get_index( td_file%t_att, "DOMAIN_J_halo_size_end" ) 
     1605      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_J_last_indoor_indices" ) 
    16061606      il_lej(:) = 0 
    16071607      IF( il_ind /= 0 )THEN 
     
    16091609      ENDIF 
    16101610 
    1611       ! check halo size end 
     1611      ! check last indoor indices 
    16121612      IF( ANY(il_lei(:)==0) .OR. ANY(il_lej(:)==0) )THEN 
    1613          CALL logger_warn("WRITE FILE: no data for halo size end") 
     1613         CALL logger_warn("WRITE FILE: no data for subdomain last indoor indices") 
    16141614      ENDIF       
    16151615 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/logger.f90

    r5616 r6455  
    66! 
    77! DESCRIPTION: 
    8 !> @brief This module create logger file and allow to fill it depending of verbosity. 
     8!> @brief This module manage log file. 
    99!> @details 
     10!> This module create log file and fill it depending of verbosity. 
     11!> 
    1012!> verbosity could be choosen between : 
    1113!>    - trace : Most detailed information. 
     
    1719!>    - error : Other runtime errors or unexpected conditions. 
    1820!>    - fatal : Severe errors that cause premature termination. 
    19 !>  default verbosity is warning 
    2021!>    - none  : to not create and write any information in logger file.<br /> 
    21 ! 
     22!>       @warn in this case only FATAL ERROR will be detected.<br /> 
     23!> 
     24!> @note default verbosity is warning 
     25!> 
    2226!> If total number of error exceeded maximum number  
    2327!> authorized, program stop. 
     
    3539!> @code 
    3640!> CALL logger_close() 
     41!> @endcode 
     42!> 
     43!> to clean logger file:<br/> 
     44!> @code 
     45!> CALL logger_clean() 
    3746!> @endcode 
    3847!> 
     
    104113!>   CALL logger_footer() 
    105114!>   CALL logger_close() 
     115!>   CALL logger_clean() 
    106116!> @endcode 
    107117!> 
     
    116126!>   CALL logger_footer() 
    117127!>   CALL logger_close() 
     128!>   CALL logger_clean() 
    118129!> @endcode 
    119130! 
     
    125136!> - check verbosity validity 
    126137!> - add 'none' verbosity level to not used logger file 
     138!> @date January, 2016 
     139!> - add logger_clean subroutine 
    127140!> 
    128141!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    144157   PUBLIC :: logger_open        !< create a log file with given verbosity 
    145158   PUBLIC :: logger_close       !< close log file 
     159   PUBLIC :: logger_clean       !< clean log structure 
    146160   PUBLIC :: logger_header      !< write header on log file 
    147161   PUBLIC :: logger_footer      !< write footer on log file 
     
    273287      IMPLICIT NONE 
    274288      ! local variable 
    275       INTEGER(i4) :: il_status 
    276       !---------------------------------------------------------------- 
    277       IF( tm_logger%l_use )THEN 
    278          IF( tm_logger%i_id /= 0 )THEN 
    279             tm_logger%i_id = 0 
     289      INTEGER(i4)   :: il_status 
     290      !---------------------------------------------------------------- 
     291      IF( tm_logger%l_use )THEN 
     292         IF( tm_logger%i_id /= 0 )THEN 
     293            !tm_logger%i_id = 0 
    280294            CLOSE( tm_logger%i_id, & 
    281295            &      IOSTAT=il_status)       
     
    289303 
    290304   END SUBROUTINE logger_close 
     305   !------------------------------------------------------------------- 
     306   !> @brief This subroutine clean a log structure. 
     307   !> 
     308   !> @author J.Paul 
     309   !> @date January, 2016 - Initial Version 
     310   !------------------------------------------------------------------- 
     311   SUBROUTINE logger_clean() 
     312      IMPLICIT NONE 
     313      ! local variable 
     314      TYPE(TLOGGER) :: tl_logger 
     315      !---------------------------------------------------------------- 
     316      tm_logger = tl_logger 
     317 
     318   END SUBROUTINE logger_clean 
    291319   !------------------------------------------------------------------- 
    292320   !> @brief This subroutine flushing output into log file. 
     
    537565      IF( tm_logger%l_use )THEN 
    538566         IF( tm_logger%i_id /= 0 )THEN 
    539             IF( TRIM(tm_logger%c_verb) /= 'none' )THEN 
    540                ! increment the error number 
    541                tm_logger%i_nerror=tm_logger%i_nerror+1 
    542             ENDIF 
     567            ! increment the error number 
     568            tm_logger%i_nerror=tm_logger%i_nerror+1 
    543569 
    544570            IF( INDEX(TRIM(tm_logger%c_verb),'error')/=0 )THEN 
     
    571597   !> @author J.Paul 
    572598   !> @date November, 2013 - Initial Version 
     599   !> @date September, 2015 
     600   !> - stop program for FATAL ERROR if verbosity is none 
    573601   ! 
    574602   !> @param[in] cd_msg message to write 
     
    598626             CALL logger_fatal('you must have create logger to use logger_fatal') 
    599627         ENDIF 
     628      ELSE 
     629         PRINT *,"FATAL ERROR :"//TRIM(cd_msg) 
     630         STOP 
    600631      ENDIF 
    601632   END SUBROUTINE logger_fatal 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/math.f90

    r5616 r6455  
    12241224          
    12251225      CASE('K') 
     1226 
     1227         ALLOCATE( dl_value(il_shape(1),il_shape(2),3) ) 
    12261228         ! compute derivative in k-direction 
    12271229         DO jk=1,il_shape(3) 
     
    12661268            ENDIF          
    12671269 
    1268             WHERE( dl_value(:,:, 2) /= dd_fill .AND. & ! jk 
    1269                &   dl_value(:,:, 3) /= dd_fill .AND. & ! jk+1 
    1270                &   dl_value(:,:, 1) /= dd_fill )       ! jk-1 
     1270            WHERE( dl_value(:,:,2) /= dd_fill .AND. & ! jk 
     1271               &   dl_value(:,:,3) /= dd_fill .AND. & ! jk+1 
     1272               &   dl_value(:,:,1) /= dd_fill )       ! jk-1 
    12711273 
    12721274               math_deriv_3D(:,:,jk)=& 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/merge_bathy.f90

    r5608 r6455  
    99!> @file 
    1010!> @brief  
    11 !> This program merge bathymetry file at boundaries. 
     11!> This program merges bathymetry file at boundaries. 
    1212!> 
    1313!> @details 
    1414!> @section sec1 method 
    15 !> Coarse grid Bathymetry is interpolated on fine grid.  
     15!> Coarse grid Bathymetry is interpolated on fine grid  
     16!> (nearest interpolation method is used).   
    1617!> Then fine Bathymetry and refined coarse bathymetry are merged at boundaries.<br/> 
    1718!>    @f[BathyFine= Weight * BathyCoarse + (1-Weight)*BathyFine@f] 
     
    3132!>    you could find a template of the namelist in templates directory. 
    3233!> 
    33 !>    merge_bathy.nam comprise 8 namelists: 
     34!>    merge_bathy.nam contains 7 namelists: 
    3435!>       - logger namelist (namlog) 
    3536!>       - config namelist (namcfg) 
    3637!>       - coarse grid namelist (namcrs) 
    3738!>       - fine grid namelist (namfin) 
    38 !>       - variable namelist (namvar) 
     39!       - variable namelist (namvar) 
    3940!>       - nesting namelist (namnst) 
    4041!>       - boundary namelist (nambdy) 
    4142!>       - output namelist (namout) 
    4243!>  
    43 !>    @note  
    44 !>       All namelists have to be in file merge_bathy.nam,  
    45 !>       however variables of those namelists are all optional. 
    46 !> 
    4744!>    * _logger namelist (namlog)_: 
    4845!>       - cn_logfile   : logger filename 
     
    5249!> 
    5350!>    * _config namelist (namcfg)_: 
    54 !>       - cn_varcfg : variable configuration file (see ./SIREN/cfg/variable.cfg) 
     51!>       - cn_varcfg : variable configuration file  
     52!> (see ./SIREN/cfg/variable.cfg) 
     53!>       - cn_dumcfg : useless (dummy) configuration file, for useless  
     54!> dimension or variable (see ./SIREN/cfg/dummy.cfg). 
    5555!> 
    5656!>    * _coarse grid namelist (namcrs)_: 
     
    6363!>       - in_perio1 : NEMO periodicity index 
    6464!> 
    65 !>    * _variable namelist (namvar)_: 
    66 !>       - cn_varinfo : list of variable and extra information about request(s)  
    67 !>       to be used (separated by ',').<br/> 
    68 !>          each elements of *cn_varinfo* is a string character.<br/> 
    69 !>          it is composed of the variable name follow by ':',  
    70 !>          then request(s) to be used on this variable.<br/>  
    71 !>          request could be: 
    72 !>             - int = interpolation method 
    73 !>  
    74 !>                requests must be separated by ';'.<br/> 
    75 !>                order of requests does not matter.<br/> 
    76 !> 
    77 !>          informations about available method could be find in  
    78 !>          @ref interp modules.<br/> 
    79 !>          Example: 'bathymetry: int=cubic' 
    80 !>          @note  
    81 !>             If you do not specify a method which is required,  
    82 !>             default one is apply. 
    83 !>          @warning  
    84 !>             variable name must be __Bathymetry__ here. 
     65!    * _variable namelist (namvar)_: 
     66!       - cn_varinfo : list of variable and extra information about request(s)  
     67!       to be used (separated by ',').<br/> 
     68!          each elements of *cn_varinfo* is a string character.<br/> 
     69!          it is composed of the variable name follow by ':',  
     70!          then request(s) to be used on this variable.<br/>  
     71!          request could be: 
     72!             - int = interpolation method 
     73!  
     74!                requests must be separated by ';'.<br/> 
     75!                order of requests does not matter.<br/> 
     76! 
     77!          informations about available method could be find in  
     78!          @ref interp modules.<br/> 
     79!          Example: 'bathymetry: int=cubic' 
     80!          @note  
     81!             If you do not specify a method which is required,  
     82!             default one is apply. 
     83!          @warning  
     84!             variable name must be __Bathymetry__ here. 
    8585!> 
    8686!>    * _nesting namelist (namnst)_: 
     
    128128!> - extrapolate all land points 
    129129!> - add attributes with boundary string character (as in namelist) 
     130!> @date September, 2015 
     131!> - manage useless (dummy) variable, attributes, and dimension 
    130132!> 
    131133!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    207209   ! namcfg 
    208210   CHARACTER(LEN=lc)                       :: cn_varcfg = 'variable.cfg'  
     211   CHARACTER(LEN=lc)                       :: cn_dumcfg = 'dummy.cfg' 
    209212 
    210213   ! namcrs 
     
    216219   INTEGER(i4)                             :: in_perio1 = -1 
    217220 
    218    ! namvar 
    219    CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = '' 
     221!   ! namvar 
     222!   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = '' 
    220223 
    221224   ! namnst 
     
    244247 
    245248   NAMELIST /namcfg/ &  !< config namelist 
    246    &  cn_varcfg         !< variable configuration file 
     249   &  cn_varcfg, &       !< variable configuration file 
     250   &  cn_dumcfg          !< dummy configuration file 
    247251 
    248252   NAMELIST /namcrs/ &  !< coarse grid namelist 
     
    254258   &  in_perio1         !< periodicity index 
    255259  
    256    NAMELIST /namvar/ &  !< variable namelist 
    257    &  cn_varinfo        !< list of variable and interpolation  
    258                         !< method to be used.  
    259                         !< (ex: 'votemper|linear','vosaline|cubic' )  
     260!   NAMELIST /namvar/ &  !< variable namelist 
     261!   &  cn_varinfo        !< list of variable and interpolation  
     262!                        !< method to be used.  
     263!                        !< (ex: 'votemper|linear','vosaline|cubic' )  
    260264    
    261265   NAMELIST /namnst/ &  !< nesting namelist 
     
    315319      CALL var_def_extra(TRIM(cn_varcfg)) 
    316320 
     321      ! get dummy variable 
     322      CALL var_get_dummy(TRIM(cn_dumcfg)) 
     323      ! get dummy dimension 
     324      CALL dim_get_dummy(TRIM(cn_dumcfg)) 
     325      ! get dummy attribute 
     326      CALL att_get_dummy(TRIM(cn_dumcfg)) 
     327 
    317328      READ( il_fileid, NML = namcrs ) 
    318329      READ( il_fileid, NML = namfin ) 
    319       READ( il_fileid, NML = namvar ) 
    320       ! add user change in extra information 
    321       CALL var_chg_extra(cn_varinfo) 
     330!      READ( il_fileid, NML = namvar ) 
     331!      ! add user change in extra information 
     332!      CALL var_chg_extra(cn_varinfo) 
    322333 
    323334      READ( il_fileid, NML = namnst ) 
     
    630641   !> @param[inout] dd_weight    array of weight 
    631642   !> @param[in] dd_fill         fillValue 
     643   !> 
     644   !> @todo improve boundary weight function 
    632645   !------------------------------------------------------------------- 
    633646   SUBROUTINE merge_bathy_get_boundary( td_bathy0, td_bathy1, td_bdy, & 
     
    690703               il_jmax1=td_bdy%t_seg(jl)%i_index 
    691704 
     705               ! do not used grid point to compute  
     706               ! boundaries indices (cf create_boundary) 
     707               ! as Bathymetry always on T point 
     708 
    692709            CASE('south') 
    693710 
     
    703720               il_jmin1=td_bdy%t_seg(jl)%i_first 
    704721               il_jmax1=td_bdy%t_seg(jl)%i_last  
     722 
     723               ! do not used grid point to compute  
     724               ! boundaries indices (cf create_boundary) 
     725               ! as Bathymetry always on T point 
    705726 
    706727            CASE('west') 
     
    777798            tl_var0=iom_dom_read_var(tl_bathy0,'Bathymetry',tl_dom0) 
    778799 
     800            ! force to use nearest interpolation 
     801            tl_var0%c_interp(1)='nearest' 
     802 
    779803            ! close mpp files 
    780804            CALL iom_dom_close(tl_bathy0) 
     
    814838            CASE('north') 
    815839 
     840!               ! npoint coarse 
     841!               il_width=td_bdy%t_seg(jl)%i_width-id_npoint 
     842!               ! compute "distance" 
     843!               dl_tmp1d(:)=(/(ji,ji=il_width-1,1,-1),(0,ji=1,id_npoint)/) 
     844!               ! compute weight on segment 
     845!               dl_tmp1d(:)= 0.5 + 0.5*COS( (dp_pi*dl_tmp1d(:)) / & 
     846!               &                           (il_width) ) 
     847 
    816848               ! compute "distance" 
    817                dl_tmp1d(:)=(/(ji-1,ji=td_bdy%t_seg(jl)%i_width,1,-1)/) 
     849               dl_tmp1d(:)=(/(ji-1,ji=td_bdy%t_seg(jl)%i_width-1,1,-1),0/) 
    818850 
    819851               ! compute weight on segment 
     
    831863 
    832864               ! compute "distance" 
    833                dl_tmp1d(:)=(/(ji-1,ji=1,td_bdy%t_seg(jl)%i_width)/)                
     865               dl_tmp1d(:)=(/0,(ji-1,ji=1,td_bdy%t_seg(jl)%i_width-1)/)                
    834866 
    835867               ! compute weight on segment 
     
    847879 
    848880               ! compute "distance" 
    849                dl_tmp1d(:)=(/(ji-1,ji=td_bdy%t_seg(jl)%i_width,1,-1)/) 
     881               dl_tmp1d(:)=(/(ji-1,ji=td_bdy%t_seg(jl)%i_width-1,1,-1),0/) 
    850882 
    851883               ! compute weight on segment 
     
    863895 
    864896               ! compute "distance" 
    865                dl_tmp1d(:)=(/(ji-1,ji=1,td_bdy%t_seg(jl)%i_width)/)                
     897               dl_tmp1d(:)=(/0,(ji-1,ji=1,td_bdy%t_seg(jl)%i_width-1)/)                
    866898 
    867899               ! compute weight on segment 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/mpp.f90

    r5616 r6455  
    196196! REVISION HISTORY: 
    197197!> @date November, 2013 - Initial Version 
    198 !> @date November, 2014 - Fix memory leaks bug 
     198!> @date November, 2014  
     199!> - Fix memory leaks bug 
     200!> @date October, 2015 
     201!> - improve way to compute domain layout 
     202!> @date January, 2016 
     203!> - allow to print layout file (use lm_layout, hard coded) 
     204!> - add mpp__compute_halo and mpp__read_halo 
    199205! 
    200206!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    214220 
    215221   ! type and variable 
    216    PUBLIC :: TMPP       !< mpp structure 
     222   PUBLIC  :: TMPP       !< mpp structure 
     223   PRIVATE :: TLAY       !< domain layout structure 
    217224 
    218225   ! function and subroutine 
     
    239246   PUBLIC :: mpp_get_proc_size  !< get processor domain size 
    240247 
    241    PRIVATE :: mpp__add_proc            ! add one proc strucutre in mpp structure 
     248   PRIVATE :: mpp__add_proc            ! add proc strucutre in mpp structure 
     249   PRIVATE :: mpp__add_proc_unit       ! add one proc strucutre in mpp structure 
    242250   PRIVATE :: mpp__del_proc            ! delete one proc strucutre in mpp structure 
    243251   PRIVATE :: mpp__del_proc_id         ! delete one proc strucutre in mpp structure, given procesor id 
    244252   PRIVATE :: mpp__del_proc_str        ! delete one proc strucutre in mpp structure, given procesor file structure  
    245253   PRIVATE :: mpp__move_proc           ! overwrite proc strucutre in mpp structure 
    246    PRIVATE :: mpp__compute             ! compute domain decomposition 
    247    PRIVATE :: mpp__del_land            ! remove land sub domain from domain decomposition 
     254   PRIVATE :: mpp__create_layout       ! create mpp structure using domain layout 
    248255   PRIVATE :: mpp__optimiz             ! compute optimum domain decomposition 
    249    PRIVATE :: mpp__land_proc           ! check if processor is a land processor 
    250256   PRIVATE :: mpp__check_dim           ! check mpp structure dimension with proc or variable dimension 
    251257   PRIVATE :: mpp__check_proc_dim      ! check if processor and mpp structure use same dimension 
     
    267273   PRIVATE :: mpp__clean_unit          ! clean mpp strcuture 
    268274   PRIVATE :: mpp__clean_arr           ! clean array of mpp strcuture 
     275   PRIVATE :: mpp__compute_halo        ! compute subdomain indices defined with halo  
     276   PRIVATE :: mpp__read_halo           ! read subdomain indices defined with halo 
     277 
     278   PRIVATE :: layout__init             ! initialise domain layout structure 
     279   PRIVATE :: layout__copy             ! clean domain layout structure 
     280   PRIVATE :: layout__clean            ! copy  domain layout structure 
    269281 
    270282   TYPE TMPP !< mpp structure 
    271  
    272283      ! general  
    273284      CHARACTER(LEN=lc)                  :: c_name = ''   !< base name  
     
    284295 
    285296      CHARACTER(LEN=lc)                  :: c_type = ''   !< type of the files (cdf, cdf4, dimg) 
    286       CHARACTER(LEN=lc)                  :: c_dom  = ''   !< type of domain (full, overlap, nooverlap) 
     297      CHARACTER(LEN=lc)                  :: c_dom  = ''   !< type of domain (full, noextra, nooverlap) 
    287298 
    288299      INTEGER(i4)                        :: i_ndim = 0    !< number of dimensions used in mpp 
     
    290301 
    291302      TYPE(TFILE), DIMENSION(:), POINTER :: t_proc => NULL()     !< files/processors composing mpp 
    292  
    293303   END TYPE 
     304 
     305   TYPE TLAY !< domain layout structure 
     306      INTEGER(i4)                          :: i_niproc = 0  !< number of processors following i 
     307      INTEGER(i4)                          :: i_njproc = 0  !< number of processors following j 
     308      INTEGER(i4)                          :: i_nland  = 0       !< number of land processors 
     309      INTEGER(i4)                          :: i_nsea   = 0       !< number of sea  processors 
     310      INTEGER(i4)                          :: i_mean   = 0       !< mean sea point per proc 
     311      INTEGER(i4)                          :: i_min    = 0       !< min  sea point per proc 
     312      INTEGER(i4)                          :: i_max    = 0       !< max  sea point per proc 
     313      INTEGER(i4), DIMENSION(:,:), POINTER :: i_msk   => NULL()  !< sea/land processor mask  
     314      INTEGER(i4), DIMENSION(:,:), POINTER :: i_impp  => NULL()  !< i-indexes for mpp-subdomain left bottom  
     315      INTEGER(i4), DIMENSION(:,:), POINTER :: i_jmpp  => NULL()  !< j-indexes for mpp-subdomain left bottom  
     316      INTEGER(i4), DIMENSION(:,:), POINTER :: i_lci   => NULL()  !< i-dimensions of subdomain  
     317      INTEGER(i4), DIMENSION(:,:), POINTER :: i_lcj   => NULL()  !< j-dimensions of subdomain  
     318   END TYPE 
     319 
     320   ! module variable 
     321   INTEGER(i4) :: im_iumout = 44 
     322   LOGICAL     :: lm_layout =.FALSE. 
    294323 
    295324   INTERFACE mpp_get_use 
    296325      MODULE PROCEDURE mpp__get_use_unit  
    297326   END INTERFACE mpp_get_use 
     327 
     328   INTERFACE mpp__add_proc 
     329      MODULE PROCEDURE mpp__add_proc_unit  
     330   END INTERFACE mpp__add_proc 
    298331 
    299332   INTERFACE mpp_clean 
     
    560593            ALLOCATE( il_lci(td_mpp%i_niproc,td_mpp%i_njproc) ) 
    561594            ALLOCATE( il_lcj(td_mpp%i_niproc,td_mpp%i_njproc) ) 
     595            il_proc(:,:)=-1 
     596            il_lci(:,:) =-1 
     597            il_lcj(:,:) =-1 
    562598 
    563599            DO jk=1,td_mpp%i_nproc 
    564600               ji=td_mpp%t_proc(jk)%i_iind 
    565601               jj=td_mpp%t_proc(jk)%i_jind 
    566                il_proc(ji,jj)=jk 
     602               il_proc(ji,jj)=jk-1 
    567603               il_lci(ji,jj)=td_mpp%t_proc(jk)%i_lci 
    568604               il_lcj(ji,jj)=td_mpp%t_proc(jk)%i_lcj 
     
    594630      ENDIF 
    595631 
    596  
    5976329400   FORMAT('     ***',20('*************',a3)) 
    5986339403   FORMAT('     *     ',20('         *   ',a3)) 
     
    615650   !> @author J.Paul 
    616651   !> @date November, 2013 - Initial version 
     652   !> @date September, 2015 
     653   !> - allow to define dimension with array of dimension structure 
     654   !> @date January, 2016 
     655   !> - use RESULT to rename output 
     656   !> - mismatch with "halo" indices 
    617657   ! 
    618658   !> @param[in] cd_file   file name of one file composing mpp domain 
     
    627667   !> @param[in] id_perio  NEMO periodicity index 
    628668   !> @param[in] id_pivot  NEMO pivot point index F(0),T(1) 
     669   !> @param[in] td_dim    array of dimension structure 
    629670   !> @return mpp structure 
    630671   !------------------------------------------------------------------- 
    631    TYPE(TMPP) FUNCTION mpp__init_mask(cd_file, id_mask,              & 
    632    &                                  id_niproc, id_njproc, id_nproc,& 
    633    &                                  id_preci, id_precj,            & 
    634                                       cd_type, id_ew, id_perio, id_pivot) 
     672   FUNCTION mpp__init_mask(cd_file, id_mask,                   & 
     673   &                       id_niproc, id_njproc, id_nproc,     & 
     674   &                       id_preci, id_precj,                 & 
     675   &                       cd_type, id_ew, id_perio, id_pivot, & 
     676   &                       td_dim )                            & 
     677   & RESULT(td_mpp) 
    635678      IMPLICIT NONE 
    636679      ! Argument 
    637       CHARACTER(LEN=*),            INTENT(IN) :: cd_file 
    638       INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_mask 
    639       INTEGER(i4),                 INTENT(IN), OPTIONAL :: id_niproc 
    640       INTEGER(i4),                 INTENT(IN), OPTIONAL :: id_njproc 
    641       INTEGER(i4),                 INTENT(IN), OPTIONAL :: id_nproc 
    642       INTEGER(i4),                 INTENT(IN), OPTIONAL :: id_preci 
    643       INTEGER(i4),                 INTENT(IN), OPTIONAL :: id_precj 
    644       CHARACTER(LEN=*),            INTENT(IN), OPTIONAL :: cd_type 
    645       INTEGER(i4),                 INTENT(IN), OPTIONAL :: id_ew 
    646       INTEGER(i4),                 INTENT(IN), OPTIONAL :: id_perio 
    647       INTEGER(i4),                 INTENT(IN), OPTIONAL :: id_pivot 
     680      CHARACTER(LEN=*),                  INTENT(IN) :: cd_file 
     681      INTEGER(i4), DIMENSION(:,:),       INTENT(IN) :: id_mask 
     682      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_niproc 
     683      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_njproc 
     684      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_nproc 
     685      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_preci 
     686      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_precj 
     687      CHARACTER(LEN=*),                  INTENT(IN), OPTIONAL :: cd_type 
     688      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_ew 
     689      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_perio 
     690      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_pivot 
     691      TYPE(TDIM) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: td_dim 
     692 
     693      ! function 
     694      TYPE(TMPP) :: td_mpp 
    648695 
    649696      ! local variable 
    650       CHARACTER(LEN=lc)                :: cl_type 
    651  
    652       INTEGER(i4)      , DIMENSION(2) :: il_shape 
    653  
    654       TYPE(TDIM)                      :: tl_dim 
    655  
    656       TYPE(TATT)                      :: tl_att 
     697      CHARACTER(LEN=lc)                            :: cl_type 
     698 
     699      INTEGER(i4)      , DIMENSION(2)              :: il_shape 
     700 
     701      TYPE(TDIM)                                   :: tl_dim 
     702 
     703      TYPE(TATT)                                   :: tl_att 
     704 
     705      TYPE(TLAY)                                   :: tl_lay 
     706 
    657707      ! loop indices 
    658708      INTEGER(i4) :: ji 
     
    660710 
    661711      ! clean mpp 
    662       CALL mpp_clean(mpp__init_mask) 
     712      CALL mpp_clean(td_mpp) 
    663713 
    664714      ! check type 
     
    669719         SELECT CASE(TRIM(cd_type)) 
    670720            CASE('cdf') 
    671                mpp__init_mask%c_type='cdf' 
     721               td_mpp%c_type='cdf' 
    672722            CASE('dimg') 
    673                mpp__init_mask%c_type='dimg' 
     723               td_mpp%c_type='dimg' 
    674724            CASE DEFAULT 
    675725               CALL logger_warn( "MPP INIT: type "//TRIM(cd_type)//& 
    676726               & " unknown. type dimg will be used for mpp "//& 
    677                &  TRIM(mpp__init_mask%c_name) ) 
    678                mpp__init_mask%c_type='dimg' 
     727               &  TRIM(td_mpp%c_name) ) 
     728               td_mpp%c_type='dimg' 
    679729         END SELECT 
    680730      ELSE 
    681          mpp__init_mask%c_type=TRIM(file_get_type(cd_file)) 
     731         td_mpp%c_type=TRIM(file_get_type(cd_file)) 
    682732      ENDIF 
    683733 
    684734      ! get mpp name 
    685       mpp__init_mask%c_name=TRIM(file_rename(cd_file)) 
     735      td_mpp%c_name=TRIM(file_rename(cd_file)) 
    686736 
    687737      ! get global domain dimension 
    688738      il_shape(:)=SHAPE(id_mask) 
    689739 
    690       tl_dim=dim_init('X',il_shape(1)) 
    691       CALL mpp_add_dim(mpp__init_mask, tl_dim) 
    692  
    693       tl_dim=dim_init('Y',il_shape(2)) 
    694       CALL mpp_add_dim(mpp__init_mask, tl_dim) 
    695  
    696       ! clean 
    697       CALL dim_clean(tl_dim) 
     740      IF( PRESENT(td_dim) )THEN 
     741         DO ji=1,ip_maxdim 
     742            IF( td_dim(ji)%l_use )THEN 
     743               CALL mpp_add_dim(td_mpp, td_dim(ji)) 
     744            ENDIF 
     745         ENDDO 
     746      ELSE 
     747         tl_dim=dim_init('X',il_shape(1)) 
     748         CALL mpp_add_dim(td_mpp, tl_dim) 
     749 
     750         tl_dim=dim_init('Y',il_shape(2)) 
     751         CALL mpp_add_dim(td_mpp, tl_dim) 
     752 
     753         ! clean 
     754         CALL dim_clean(tl_dim) 
     755      ENDIF 
    698756 
    699757      IF( (       PRESENT(id_niproc)  .AND. (.NOT. PRESENT(id_njproc))) .OR. & 
     
    703761      ELSE 
    704762         ! get number of processors following I and J 
    705          IF( PRESENT(id_niproc) ) mpp__init_mask%i_niproc=id_niproc 
    706          IF( PRESENT(id_njproc) ) mpp__init_mask%i_njproc=id_njproc 
     763         IF( PRESENT(id_niproc) ) td_mpp%i_niproc=id_niproc 
     764         IF( PRESENT(id_njproc) ) td_mpp%i_njproc=id_njproc 
    707765      ENDIF 
    708766 
    709767      ! get maximum number of processors to be used 
    710       IF( PRESENT(id_nproc) ) mpp__init_mask%i_nproc = id_nproc 
     768      IF( PRESENT(id_nproc) ) td_mpp%i_nproc = id_nproc 
    711769 
    712770      ! get overlap region length 
    713       IF( PRESENT(id_preci) ) mpp__init_mask%i_preci= id_preci 
    714       IF( PRESENT(id_precj) ) mpp__init_mask%i_precj= id_precj 
     771      IF( PRESENT(id_preci) ) td_mpp%i_preci= id_preci 
     772      IF( PRESENT(id_precj) ) td_mpp%i_precj= id_precj 
    715773 
    716774      ! east-west overlap 
    717       IF( PRESENT(id_ew) ) mpp__init_mask%i_ew= id_ew 
     775      IF( PRESENT(id_ew) ) td_mpp%i_ew= id_ew 
    718776      ! NEMO periodicity 
    719       IF( PRESENT(id_perio) ) mpp__init_mask%i_perio= id_perio 
    720       IF( PRESENT(id_pivot) ) mpp__init_mask%i_pivot= id_pivot 
    721  
    722       IF( mpp__init_mask%i_nproc  /= 0 .AND. & 
    723       &   mpp__init_mask%i_niproc /= 0 .AND. & 
    724       &   mpp__init_mask%i_njproc /= 0 .AND. & 
    725       &   mpp__init_mask%i_nproc > & 
    726       &   mpp__init_mask%i_niproc * mpp__init_mask%i_njproc )THEN 
     777      IF( PRESENT(id_perio) ) td_mpp%i_perio= id_perio 
     778      IF( PRESENT(id_pivot) ) td_mpp%i_pivot= id_pivot 
     779 
     780      IF( td_mpp%i_nproc  /= 0 .AND. & 
     781      &   td_mpp%i_niproc /= 0 .AND. & 
     782      &   td_mpp%i_njproc /= 0 .AND. & 
     783      &   td_mpp%i_nproc > & 
     784      &   td_mpp%i_niproc * td_mpp%i_njproc )THEN 
    727785 
    728786         CALL logger_error("MPP INIT: invalid domain decomposition ") 
    729787         CALL logger_debug("MPP INIT: "// & 
    730          & TRIM(fct_str(mpp__init_mask%i_nproc))//" > "//& 
    731          & TRIM(fct_str(mpp__init_mask%i_niproc))//" x "//& 
    732          & TRIM(fct_str(mpp__init_mask%i_njproc)) ) 
     788         & TRIM(fct_str(td_mpp%i_nproc))//" > "//& 
     789         & TRIM(fct_str(td_mpp%i_niproc))//" x "//& 
     790         & TRIM(fct_str(td_mpp%i_njproc)) ) 
    733791 
    734792      ELSE 
    735  
    736          IF( mpp__init_mask%i_niproc /= 0 .AND. & 
    737          &   mpp__init_mask%i_njproc /= 0 )THEN 
    738             ! compute domain decomposition 
    739             CALL mpp__compute( mpp__init_mask ) 
    740             ! remove land sub domain 
    741             CALL mpp__del_land( mpp__init_mask, id_mask ) 
    742          ELSEIF( mpp__init_mask%i_nproc  /= 0 )THEN 
     793         IF( lm_layout )THEN 
     794            OPEN(im_iumout,FILE='processor.layout') 
     795            WRITE(im_iumout,*) 
     796            WRITE(im_iumout,*) ' optimisation de la partition' 
     797            WRITE(im_iumout,*) ' ----------------------------' 
     798            WRITE(im_iumout,*) 
     799         ENDIF 
     800 
     801         IF( td_mpp%i_niproc /= 0 .AND. & 
     802         &   td_mpp%i_njproc /= 0 )THEN 
     803            ! compute domain layout 
     804            tl_lay=layout__init( td_mpp, id_mask, td_mpp%i_niproc, td_mpp%i_njproc ) 
     805            ! create mpp domain layout 
     806            CALL mpp__create_layout( td_mpp, tl_lay ) 
     807            ! clean 
     808            CALL layout__clean( tl_lay ) 
     809         ELSEIF( td_mpp%i_nproc  /= 0 )THEN 
    743810            ! optimiz 
    744             CALL mpp__optimiz( mpp__init_mask, id_mask ) 
     811            CALL mpp__optimiz( td_mpp, id_mask, td_mpp%i_nproc ) 
    745812 
    746813         ELSE 
    747814            CALL logger_warn("MPP INIT: number of processor to be used "//& 
    748815            &                "not specify. force to one.") 
    749             mpp__init_mask%i_nproc  = 1 
    750816            ! optimiz 
    751             CALL mpp__optimiz( mpp__init_mask, id_mask ) 
     817            CALL mpp__optimiz( td_mpp, id_mask, 1 ) 
    752818         ENDIF 
     819 
     820 
    753821         CALL logger_info("MPP INIT: domain decoposition : "//& 
    754          &  'niproc('//TRIM(fct_str(mpp__init_mask%i_niproc))//') * '//& 
    755          &  'njproc('//TRIM(fct_str(mpp__init_mask%i_njproc))//') = '//& 
    756          &  'nproc('//TRIM(fct_str(mpp__init_mask%i_nproc))//')' ) 
     822         &  'niproc('//TRIM(fct_str(td_mpp%i_niproc))//') * '//& 
     823         &  'njproc('//TRIM(fct_str(td_mpp%i_njproc))//') = '//& 
     824         &  'nproc('//TRIM(fct_str(td_mpp%i_nproc))//')' ) 
    757825 
    758826         ! get domain type 
    759          CALL mpp_get_dom( mpp__init_mask ) 
    760  
    761          DO ji=1,mpp__init_mask%i_nproc 
     827         CALL mpp_get_dom( td_mpp ) 
     828 
     829         DO ji=1,td_mpp%i_nproc 
    762830 
    763831            ! get processor size 
    764             il_shape(:)=mpp_get_proc_size( mpp__init_mask, ji ) 
     832            il_shape(:)=mpp_get_proc_size( td_mpp, ji ) 
    765833 
    766834            tl_dim=dim_init('X',il_shape(1)) 
    767             CALL file_move_dim(mpp__init_mask%t_proc(ji), tl_dim) 
     835            CALL file_move_dim(td_mpp%t_proc(ji), tl_dim) 
    768836 
    769837            tl_dim=dim_init('Y',il_shape(2)) 
    770             CALL file_move_dim(mpp__init_mask%t_proc(ji), tl_dim)             
    771  
     838            CALL file_move_dim(td_mpp%t_proc(ji), tl_dim)             
     839 
     840            IF( PRESENT(td_dim) )THEN 
     841               IF( td_dim(jp_K)%l_use )THEN 
     842                  CALL file_move_dim(td_mpp%t_proc(ji), td_dim(jp_K)) 
     843               ENDIF 
     844               IF( td_dim(jp_L)%l_use )THEN 
     845                  CALL file_move_dim(td_mpp%t_proc(ji), td_dim(jp_L)) 
     846               ENDIF 
     847            ENDIF 
    772848            ! add type 
    773             mpp__init_mask%t_proc(ji)%c_type=TRIM(mpp__init_mask%c_type) 
     849            td_mpp%t_proc(ji)%c_type=TRIM(td_mpp%c_type) 
    774850 
    775851            ! clean 
    776852            CALL dim_clean(tl_dim) 
     853 
    777854         ENDDO 
    778855 
    779856         ! add global attribute 
    780          tl_att=att_init("DOMAIN_number_total",mpp__init_mask%i_nproc) 
    781          CALL mpp_add_att(mpp__init_mask, tl_att) 
    782  
    783          tl_att=att_init("DOMAIN_I_number_total",mpp__init_mask%i_niproc) 
    784          CALL mpp_add_att(mpp__init_mask, tl_att) 
    785  
    786          tl_att=att_init("DOMAIN_J_number_total",mpp__init_mask%i_njproc) 
    787          CALL mpp_add_att(mpp__init_mask, tl_att) 
    788  
    789          tl_att=att_init("DOMAIN_size_global",mpp__init_mask%t_dim(1:2)%i_len) 
    790          CALL mpp_add_att(mpp__init_mask, tl_att) 
    791  
    792          tl_att=att_init( "DOMAIN_I_position_first", & 
    793          &                mpp__init_mask%t_proc(:)%i_impp ) 
    794          CALL mpp_add_att(mpp__init_mask, tl_att) 
    795  
    796          tl_att=att_init( "DOMAIN_J_position_first", & 
    797          &                mpp__init_mask%t_proc(:)%i_jmpp ) 
    798          CALL mpp_add_att(mpp__init_mask, tl_att) 
    799  
    800          tl_att=att_init( "DOMAIN_I_position_last", & 
    801          &                mpp__init_mask%t_proc(:)%i_lci ) 
    802          CALL mpp_add_att(mpp__init_mask, tl_att) 
    803  
    804          tl_att=att_init( "DOMAIN_J_position_last", & 
    805          &                mpp__init_mask%t_proc(:)%i_lcj ) 
    806          CALL mpp_add_att(mpp__init_mask, tl_att) 
    807  
    808          tl_att=att_init( "DOMAIN_I_halo_size_start", & 
    809          &                mpp__init_mask%t_proc(:)%i_ldi ) 
    810          CALL mpp_add_att(mpp__init_mask, tl_att) 
    811  
    812          tl_att=att_init( "DOMAIN_J_halo_size_start", & 
    813          &                mpp__init_mask%t_proc(:)%i_ldj ) 
    814          CALL mpp_add_att(mpp__init_mask, tl_att) 
    815  
    816          tl_att=att_init( "DOMAIN_I_halo_size_end", & 
    817          &                mpp__init_mask%t_proc(:)%i_lei ) 
    818          CALL mpp_add_att(mpp__init_mask, tl_att) 
    819  
    820          tl_att=att_init( "DOMAIN_J_halo_size_end", & 
    821          &                mpp__init_mask%t_proc(:)%i_lej ) 
    822          CALL mpp_add_att(mpp__init_mask, tl_att)          
    823  
    824          ! clean 
    825          CALL att_clean(tl_att) 
     857         tl_att=att_init("DOMAIN_number_total",td_mpp%i_nproc) 
     858         CALL mpp_add_att(td_mpp, tl_att) 
     859 
     860         tl_att=att_init("DOMAIN_LOCAL",TRIM(td_mpp%c_dom)) 
     861         CALL mpp_add_att(td_mpp, tl_att) 
     862 
     863         tl_att=att_init("DOMAIN_I_number_total",td_mpp%i_niproc) 
     864         CALL mpp_add_att(td_mpp, tl_att) 
     865 
     866         tl_att=att_init("DOMAIN_J_number_total",td_mpp%i_njproc) 
     867         CALL mpp_add_att(td_mpp, tl_att) 
     868 
     869         tl_att=att_init("DOMAIN_size_global",td_mpp%t_dim(1:2)%i_len) 
     870         CALL mpp_add_att(td_mpp, tl_att) 
     871 
     872         CALL mpp__compute_halo(td_mpp)  
    826873      ENDIF 
    827874 
     
    880927         il_mask(:,:,:)=var_get_mask(td_var) 
    881928          
     929         CALL logger_info("MPP INIT: mask compute from variable "//& 
     930            &             TRIM(td_var%c_name)) 
    882931         mpp__init_var=mpp_init( cd_file, il_mask(:,:,1),       & 
    883932         &                       id_niproc, id_njproc, id_nproc,& 
     
    907956   !>    - DOMAIN_halo_size_end 
    908957   !>  or the file is assume to be no mpp file. 
    909    !>   
    910    !>  
    911958   !> 
    912959   !> @author J.Paul 
    913960   !> @date November, 2013 - Initial Version 
     961   !> @date January, 2016 
     962   !> - mismatch with "halo" indices, use mpp__compute_halo 
    914963   ! 
    915964   !> @param[in] td_file   file strcuture 
     
    929978 
    930979      ! local variable 
    931       TYPE(TMPP)  :: tl_mpp 
    932        
    933       TYPE(TFILE) :: tl_file 
    934        
    935       TYPE(TDIM)  :: tl_dim 
    936  
    937       TYPE(TATT)  :: tl_att 
    938  
    939       INTEGER(i4) :: il_nproc 
    940       INTEGER(i4) :: il_attid 
    941  
     980      INTEGER(i4)               :: il_nproc 
     981      INTEGER(i4)               :: il_attid 
    942982      INTEGER(i4), DIMENSION(2) :: il_shape 
     983 
     984      TYPE(TDIM)                :: tl_dim 
     985 
     986      TYPE(TATT)                :: tl_att 
     987 
     988      TYPE(TFILE)               :: tl_file 
     989 
     990      TYPE(TMPP)                :: tl_mpp 
     991 
    943992      ! loop indices 
    944993      INTEGER(i4) :: ji 
     
    9561005            ! open file 
    9571006            CALL iom_open(tl_file) 
    958  
    9591007            ! read first file domain decomposition 
    9601008            tl_mpp=mpp__init_file_cdf(tl_file) 
     
    10291077            CALL mpp_move_att(mpp__init_file, tl_att) 
    10301078 
    1031             tl_att=att_init( "DOMAIN_I_position_first", mpp__init_file%t_proc(:)%i_impp ) 
    1032             CALL mpp_move_att(mpp__init_file, tl_att) 
    1033  
    1034             tl_att=att_init( "DOMAIN_J_position_first", mpp__init_file%t_proc(:)%i_jmpp ) 
    1035             CALL mpp_move_att(mpp__init_file, tl_att) 
    1036  
    1037             tl_att=att_init( "DOMAIN_I_position_last", mpp__init_file%t_proc(:)%i_lci ) 
    1038             CALL mpp_move_att(mpp__init_file, tl_att) 
    1039  
    1040             tl_att=att_init( "DOMAIN_J_position_last", mpp__init_file%t_proc(:)%i_lcj ) 
    1041             CALL mpp_move_att(mpp__init_file, tl_att) 
    1042  
    1043             tl_att=att_init( "DOMAIN_I_halo_size_start", mpp__init_file%t_proc(:)%i_ldi ) 
    1044             CALL mpp_move_att(mpp__init_file, tl_att) 
    1045  
    1046             tl_att=att_init( "DOMAIN_J_halo_size_start", mpp__init_file%t_proc(:)%i_ldj ) 
    1047             CALL mpp_move_att(mpp__init_file, tl_att) 
    1048  
    1049             tl_att=att_init( "DOMAIN_I_halo_size_end", mpp__init_file%t_proc(:)%i_lei ) 
    1050             CALL mpp_move_att(mpp__init_file, tl_att) 
    1051  
    1052             tl_att=att_init( "DOMAIN_J_halo_size_end", mpp__init_file%t_proc(:)%i_lej ) 
    1053             CALL mpp_move_att(mpp__init_file, tl_att) 
    1054              
     1079            CALL mpp__compute_halo(mpp__init_file) 
     1080  
    10551081            ! clean 
    10561082            CALL mpp_clean(tl_mpp) 
     
    11301156   !> @author J.Paul 
    11311157   !> @date November, 2013 - Initial Version 
    1132    !> @date July, 2015 - add only use dimension in MPP structure 
     1158   !> @date July, 2015  
     1159   !> - add only use dimension in MPP structure 
     1160   !> @date January, 2016 
     1161   !> - mismatch with "halo" indices, use mpp__read_halo 
    11331162   !> 
    11341163   !> @param[in] td_file   file strcuture 
     
    12181247            tl_proc%t_dim(:)=dim_copy(td_file%t_dim(:)) 
    12191248 
    1220             ! DOMAIN_position_first 
    1221             il_attid = 0 
    1222             IF( ASSOCIATED(td_file%t_att) )THEN 
    1223                il_attid=att_get_id( td_file%t_att, "DOMAIN_position_first" ) 
    1224             ENDIF 
    1225             IF( il_attid /= 0 )THEN 
    1226                tl_proc%i_impp = INT(td_file%t_att(il_attid)%d_value(1)) 
    1227                tl_proc%i_jmpp = INT(td_file%t_att(il_attid)%d_value(2)) 
    1228             ELSE 
    1229                tl_proc%i_impp = 1 
    1230                tl_proc%i_jmpp = 1 
    1231             ENDIF 
    1232  
    1233             ! DOMAIN_position_last 
    1234             il_attid = 0 
    1235             IF( ASSOCIATED(td_file%t_att) )THEN 
    1236                il_attid=att_get_id( td_file%t_att, "DOMAIN_position_last" ) 
    1237             ENDIF 
    1238             IF( il_attid /= 0 )THEN 
    1239                tl_proc%i_lci = INT(td_file%t_att(il_attid)%d_value(1)) + tl_proc%i_impp 
    1240                tl_proc%i_lcj = INT(td_file%t_att(il_attid)%d_value(2)) + tl_proc%i_jmpp 
    1241             ELSE 
    1242                tl_proc%i_lci = mpp__init_file_cdf%t_dim(1)%i_len 
    1243                tl_proc%i_lcj = mpp__init_file_cdf%t_dim(2)%i_len 
    1244             ENDIF 
    1245  
    1246             ! DOMAIN_halo_size_start 
    1247             il_attid = 0 
    1248             IF( ASSOCIATED(td_file%t_att) )THEN 
    1249                il_attid=att_get_id( td_file%t_att, "DOMAIN_halo_size_start" ) 
    1250             ENDIF 
    1251             IF( il_attid /= 0 )THEN 
    1252                tl_proc%i_ldi = INT(td_file%t_att(il_attid)%d_value(1)) 
    1253                tl_proc%i_ldj = INT(td_file%t_att(il_attid)%d_value(2)) 
    1254             ELSE 
    1255                tl_proc%i_ldi = 1 
    1256                tl_proc%i_ldj = 1 
    1257             ENDIF 
    1258  
    1259             ! DOMAIN_halo_size_end 
    1260             il_attid = 0 
    1261             IF( ASSOCIATED(td_file%t_att) )THEN 
    1262                il_attid=att_get_id( td_file%t_att, "DOMAIN_halo_size_end" ) 
    1263             ENDIF 
    1264             IF( il_attid /= 0 )THEN 
    1265                tl_proc%i_lei = INT(td_file%t_att(il_attid)%d_value(1)) 
    1266                tl_proc%i_lej = INT(td_file%t_att(il_attid)%d_value(2)) 
    1267             ELSE 
    1268                tl_proc%i_lei = mpp__init_file_cdf%t_dim(1)%i_len 
    1269                tl_proc%i_lej = mpp__init_file_cdf%t_dim(2)%i_len 
    1270             ENDIF 
     1249            CALL mpp__read_halo(tl_proc, mpp__init_file_cdf%t_dim(:) ) 
    12711250 
    12721251            ! add attributes 
     
    12781257            CALL file_move_att(tl_proc, tl_att) 
    12791258 
    1280             tl_att=att_init( "DOMAIN_position_first", & 
    1281             &                (/tl_proc%i_impp, tl_proc%i_jmpp /) ) 
    1282             CALL file_move_att(tl_proc, tl_att) 
    1283  
    1284             tl_att=att_init( "DOMAIN_position_last", & 
    1285             &                (/tl_proc%i_lci, tl_proc%i_lcj /) ) 
    1286             CALL file_move_att(tl_proc, tl_att) 
    1287  
    1288             tl_att=att_init( "DOMAIN_halo_size_start", & 
    1289             &                (/tl_proc%i_ldi, tl_proc%i_ldj /) ) 
    1290             CALL file_move_att(tl_proc, tl_att) 
    1291  
    1292             tl_att=att_init( "DOMAIN_halo_size_end", & 
    1293             &                (/tl_proc%i_lei, tl_proc%i_lej /) ) 
    1294             CALL file_move_att(tl_proc, tl_att) 
    1295  
    12961259            ! add processor to mpp structure 
    12971260            CALL mpp__add_proc(mpp__init_file_cdf, tl_proc) 
     
    12991262            ! clean  
    13001263            CALL file_clean(tl_proc) 
     1264            CALL dim_clean(tl_dim) 
    13011265            CALL att_clean(tl_att) 
    13021266         ENDIF 
     
    13071271         &  " do not exist") 
    13081272 
    1309       ENDIF       
     1273      ENDIF 
     1274 
    13101275   END FUNCTION mpp__init_file_cdf 
    13111276   !------------------------------------------------------------------- 
     
    13171282   !> @author J.Paul 
    13181283   !> @date November, 2013 - Initial Version 
    1319    ! 
     1284   !> @date January, 2016 
     1285   !> - mismatch with "halo" indices, use mpp__compute_halo 
     1286   !> 
    13201287   !> @param[in] td_file   file strcuture 
    13211288   !> @return mpp structure 
     
    13361303      INTEGER(i4)       :: il_pni, il_pnj, il_pnij          ! domain decomposition 
    13371304      INTEGER(i4)       :: il_area                          ! domain index 
     1305 
     1306      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lci 
     1307      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldi 
     1308      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lei 
     1309      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_impp 
     1310      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lcj 
     1311      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldj 
     1312      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lej 
     1313      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jmpp 
    13381314 
    13391315      LOGICAL           ::  ll_exist 
     
    13891365            ALLOCATE( mpp__init_file_rstdimg%t_proc(il_pnij) , stat=il_status ) 
    13901366 
     1367            ALLOCATE(il_lci (il_pnij)) 
     1368            ALLOCATE(il_lcj (il_pnij)) 
     1369            ALLOCATE(il_ldi (il_pnij)) 
     1370            ALLOCATE(il_ldj (il_pnij)) 
     1371            ALLOCATE(il_lei (il_pnij)) 
     1372            ALLOCATE(il_lej (il_pnij)) 
     1373            ALLOCATE(il_impp(il_pnij)) 
     1374            ALLOCATE(il_jmpp(il_pnij)) 
     1375 
    13911376            tl_proc=file_copy(td_file) 
    13921377            ! remove dimension from file 
     
    14111396            &     il_area,                         & 
    14121397            &     il_iglo, il_jglo,                & 
    1413             &     mpp__init_file_rstdimg%t_proc(:)%i_lci,    & 
    1414             &     mpp__init_file_rstdimg%t_proc(:)%i_lcj,    & 
    1415             &     mpp__init_file_rstdimg%t_proc(:)%i_ldi,    & 
    1416             &     mpp__init_file_rstdimg%t_proc(:)%i_ldj,    & 
    1417             &     mpp__init_file_rstdimg%t_proc(:)%i_lei,    & 
    1418             &     mpp__init_file_rstdimg%t_proc(:)%i_lej,    & 
    1419             &     mpp__init_file_rstdimg%t_proc(:)%i_impp,   & 
    1420             &     mpp__init_file_rstdimg%t_proc(:)%i_jmpp 
     1398            &     il_lci(1:il_pnij),    & 
     1399            &     il_lcj(1:il_pnij),    & 
     1400            &     il_ldi(1:il_pnij),    & 
     1401            &     il_ldj(1:il_pnij),    & 
     1402            &     il_lei(1:il_pnij),    & 
     1403            &     il_lej(1:il_pnij),    & 
     1404            &     il_impp(1:il_pnij),   & 
     1405            &     il_jmpp(1:il_pnij) 
    14211406            CALL fct_err(il_status) 
    14221407            IF( il_status /= 0 )THEN 
     
    14241409               &              TRIM(td_file%c_name)) 
    14251410            ENDIF 
     1411 
     1412            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_lci = il_lci (1:il_pnij) 
     1413            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_lcj = il_lcj (1:il_pnij)  
     1414            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_ldi = il_ldi (1:il_pnij)  
     1415            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_ldj = il_ldj (1:il_pnij)  
     1416            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_lei = il_lei (1:il_pnij)  
     1417            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_lej = il_lej (1:il_pnij)  
     1418            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_impp= il_impp(1:il_pnij) 
     1419            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_jmpp= il_jmpp(1:il_pnij) 
     1420 
     1421            DEALLOCATE(il_lci)  
     1422            DEALLOCATE(il_lcj)  
     1423            DEALLOCATE(il_ldi)  
     1424            DEALLOCATE(il_ldj)  
     1425            DEALLOCATE(il_lei)  
     1426            DEALLOCATE(il_lej)  
     1427            DEALLOCATE(il_impp) 
     1428            DEALLOCATE(il_jmpp) 
    14261429 
    14271430            ! global domain size 
     
    14351438 
    14361439            DO ji=1,mpp__init_file_rstdimg%i_nproc 
     1440 
    14371441               ! get file name 
    14381442               cl_file =  file_rename(td_file%c_name,ji) 
     
    14451449               CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att)  
    14461450 
    1447                tl_att=att_init( "DOMAIN_position_first", & 
    1448                &                (/mpp__init_file_rstdimg%t_proc(ji)%i_impp, & 
    1449                &                  mpp__init_file_rstdimg%t_proc(ji)%i_jmpp /) ) 
    1450                CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att) 
    1451  
    1452                tl_att=att_init( "DOMAIN_position_last", & 
    1453                &                (/mpp__init_file_rstdimg%t_proc(ji)%i_lci, & 
    1454                &                  mpp__init_file_rstdimg%t_proc(ji)%i_lcj /) ) 
    1455                CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att) 
    1456  
    1457                tl_att=att_init( "DOMAIN_halo_size_start", & 
    1458                &                (/mpp__init_file_rstdimg%t_proc(ji)%i_ldi, & 
    1459                &                  mpp__init_file_rstdimg%t_proc(ji)%i_ldj /) ) 
    1460                CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att)                
    1461  
    1462                tl_att=att_init( "DOMAIN_halo_size_end", & 
    1463                &                (/mpp__init_file_rstdimg%t_proc(ji)%i_lei, & 
    1464                &                  mpp__init_file_rstdimg%t_proc(ji)%i_lej /) ) 
    1465                CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att) 
    14661451            ENDDO 
    14671452  
     
    14861471            CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 
    14871472 
    1488             tl_att=att_init( "DOMAIN_I_position_first", & 
    1489             &                 mpp__init_file_rstdimg%t_proc(:)%i_impp ) 
    1490             CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 
    1491  
    1492             tl_att=att_init( "DOMAIN_J_position_first", & 
    1493             &                 mpp__init_file_rstdimg%t_proc(:)%i_jmpp ) 
    1494             CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 
    1495  
    1496             tl_att=att_init( "DOMAIN_I_position_last", & 
    1497             &                 mpp__init_file_rstdimg%t_proc(:)%i_lci ) 
    1498             CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 
    1499  
    1500             tl_att=att_init( "DOMAIN_J_position_last", & 
    1501             &                 mpp__init_file_rstdimg%t_proc(:)%i_lcj ) 
    1502             CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 
    1503  
    1504             tl_att=att_init( "DOMAIN_I_halo_size_start", & 
    1505             &                 mpp__init_file_rstdimg%t_proc(:)%i_ldi ) 
    1506             CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 
    1507  
    1508             tl_att=att_init( "DOMAIN_J_halo_size_start", & 
    1509             &                 mpp__init_file_rstdimg%t_proc(:)%i_ldj ) 
    1510             CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 
    1511  
    1512             tl_att=att_init( "DOMAIN_I_halo_size_end", & 
    1513             &                 mpp__init_file_rstdimg%t_proc(:)%i_lei ) 
    1514             CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 
    1515  
    1516             tl_att=att_init( "DOMAIN_J_halo_size_end", & 
    1517             &                 mpp__init_file_rstdimg%t_proc(:)%i_lej ) 
    1518             CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 
     1473            CALL mpp_get_dom( mpp__init_file_rstdimg ) 
     1474 
     1475            CALL mpp__compute_halo( mpp__init_file_rstdimg ) 
    15191476 
    15201477            ! clean 
     
    15981555      ! Argument 
    15991556      TYPE(TMPP), INTENT(INOUT) :: td_mpp 
    1600       TYPE(TVAR), INTENT(IN)    :: td_var 
     1557      TYPE(TVAR), INTENT(INOUT) :: td_var 
    16011558 
    16021559      ! local variable 
     
    16461603               ! check used dimension  
    16471604               IF( mpp__check_dim(td_mpp, td_var) )THEN 
     1605          
     1606                  ! check variable dimension expected 
     1607                  CALL var_check_dim(td_var) 
    16481608 
    16491609                  ! update dimension if need be 
     
    19151875      TYPE(TVAR) :: tl_var 
    19161876      !---------------------------------------------------------------- 
    1917       ! copy variable 
     1877      ! copy variablie 
    19181878      tl_var=var_copy(td_var) 
    19191879 
     
    19421902   !> - check proc type 
    19431903   !------------------------------------------------------------------- 
    1944    SUBROUTINE mpp__add_proc( td_mpp, td_proc ) 
     1904   SUBROUTINE mpp__add_proc_unit( td_mpp, td_proc ) 
    19451905      IMPLICIT NONE 
    19461906      ! Argument 
     
    19571917      CHARACTER(LEN=lc)                            :: cl_name 
    19581918      !---------------------------------------------------------------- 
     1919 
     1920!      ALLOCATE(tl_proc(1)) 
     1921!      tl_proc(1)=file_copy(td_proc) 
     1922! 
     1923!      CALL mpp__add_proc(td_mpp, tl_proc(:)) 
     1924! 
     1925!      CALL file_clean(tl_proc(:)) 
     1926!      DEALLOCATE(tl_proc) 
    19591927 
    19601928      ! check file name 
     
    20562024 
    20572025      ENDIF 
    2058    END SUBROUTINE mpp__add_proc 
     2026 
     2027   END SUBROUTINE mpp__add_proc_unit 
    20592028   !------------------------------------------------------------------- 
    20602029   !> @brief 
     
    25752544   !------------------------------------------------------------------- 
    25762545   !> @brief 
    2577    !>    This subroutine compute domain decomposition for niproc and njproc  
    2578    !> processors following I and J. 
    2579    !> 
     2546   !>    This function initialise domain layout 
     2547   !>  
    25802548   !> @detail 
    2581    !> To do so, it need to know : 
    2582    !> - global domain dimension 
    2583    !> - overlap region length 
    2584    !> - number of processors following I and J 
     2549   !> Domain layout is first compute, with domain dimension, overlap between subdomain, 
     2550   !> and the number of processors following I and J. 
     2551   !> Then the number of sea/land processors is compute with mask 
    25852552   ! 
    25862553   !> @author J.Paul 
    2587    !> @date November, 2013 - Initial version 
     2554   !> @date October, 2015 - Initial version 
     2555   ! 
     2556   !> @param[in] td_mpp mpp strcuture 
     2557   !> @param[in] id_mask   sub domain mask (sea=1, land=0) 
     2558   !> @pâram[in] id_niproc number of processors following I 
     2559   !> @pâram[in] id_njproc number of processors following J 
     2560   !> @return domain layout structure 
     2561   !------------------------------------------------------------------- 
     2562   FUNCTION layout__init( td_mpp, id_mask, id_niproc, id_njproc ) RESULT(td_lay) 
     2563      IMPLICIT NONE 
     2564      ! Argument 
     2565      TYPE(TMPP)                 , INTENT(IN) :: td_mpp 
     2566      INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_mask 
     2567      INTEGER(i4)                , INTENT(IN) :: id_niproc 
     2568      INTEGER(i4)                , INTENT(IN) :: id_njproc 
     2569 
     2570      ! function 
     2571      TYPE(TLAY) :: td_lay 
     2572 
     2573      ! local variable 
     2574      INTEGER(i4) :: ii1, ii2 
     2575      INTEGER(i4) :: ij1, ij2 
     2576 
     2577      INTEGER(i4) :: il_ldi 
     2578      INTEGER(i4) :: il_ldj 
     2579      INTEGER(i4) :: il_lei 
     2580      INTEGER(i4) :: il_lej 
     2581 
     2582      INTEGER(i4) :: il_isize !< i-direction maximum sub domain size  
     2583      INTEGER(i4) :: il_jsize !< j-direction maximum sub domain size 
     2584      INTEGER(i4) :: il_resti !<   
     2585      INTEGER(i4) :: il_restj !<   
     2586 
     2587      ! loop indices 
     2588      INTEGER(i4) :: ji 
     2589      INTEGER(i4) :: jj 
     2590      !---------------------------------------------------------------- 
     2591 
     2592      ! intialise 
     2593      td_lay%i_niproc=id_niproc 
     2594      td_lay%i_njproc=id_njproc 
     2595 
     2596      CALL logger_info( "MPP COMPUTE LAYOUT: compute domain layout with "//& 
     2597      &               TRIM(fct_str(td_lay%i_niproc))//" x "//& 
     2598      &               TRIM(fct_str(td_lay%i_njproc))//" processors") 
     2599 
     2600      ! maximum size of sub domain 
     2601      il_isize = ((td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci + (td_lay%i_niproc-1))/ & 
     2602      &           td_lay%i_niproc) + 2*td_mpp%i_preci 
     2603      il_jsize = ((td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj + (td_lay%i_njproc-1))/ & 
     2604      &           td_lay%i_njproc) + 2*td_mpp%i_precj 
     2605 
     2606      il_resti = MOD(td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci, td_lay%i_niproc) 
     2607      il_restj = MOD(td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj, td_lay%i_njproc) 
     2608      IF( il_resti == 0 ) il_resti = td_lay%i_niproc 
     2609      IF( il_restj == 0 ) il_restj = td_lay%i_njproc 
     2610 
     2611      ! compute dimension of each sub domain 
     2612      ALLOCATE( td_lay%i_lci(td_lay%i_niproc,td_lay%i_njproc) ) 
     2613      ALLOCATE( td_lay%i_lcj(td_lay%i_niproc,td_lay%i_njproc) ) 
     2614 
     2615      td_lay%i_lci( 1          : il_resti       , : ) = il_isize 
     2616      td_lay%i_lci( il_resti+1 : td_lay%i_niproc, : ) = il_isize-1 
     2617 
     2618      td_lay%i_lcj( : , 1          : il_restj       ) = il_jsize 
     2619      td_lay%i_lcj( : , il_restj+1 : td_lay%i_njproc) = il_jsize-1 
     2620 
     2621      ! compute first index of each sub domain 
     2622      ALLOCATE( td_lay%i_impp(td_lay%i_niproc,td_lay%i_njproc) ) 
     2623      ALLOCATE( td_lay%i_jmpp(td_lay%i_niproc,td_lay%i_njproc) ) 
     2624 
     2625      td_lay%i_impp(:,:)=1 
     2626      td_lay%i_jmpp(:,:)=1 
     2627 
     2628      IF( td_lay%i_niproc > 1 )THEN 
     2629         DO jj=1,td_lay%i_njproc 
     2630            DO ji=2,td_lay%i_niproc 
     2631               td_lay%i_impp(ji,jj) = td_lay%i_impp(ji-1,jj) + & 
     2632               &                       td_lay%i_lci (ji-1,jj) - 2*td_mpp%i_preci 
     2633            ENDDO 
     2634         ENDDO 
     2635      ENDIF 
     2636 
     2637      IF( td_lay%i_njproc > 1 )THEN 
     2638         DO jj=2,td_lay%i_njproc 
     2639            DO ji=1,td_lay%i_niproc 
     2640               td_lay%i_jmpp(ji,jj) = td_lay%i_jmpp(ji,jj-1) + & 
     2641               &                       td_lay%i_lcj (ji,jj-1) - 2*td_mpp%i_precj 
     2642            ENDDO 
     2643         ENDDO  
     2644      ENDIF 
     2645 
     2646      ALLOCATE(td_lay%i_msk(td_lay%i_niproc,td_lay%i_njproc)) 
     2647      td_lay%i_msk(:,:)=0 
     2648      ! init number of sea/land proc 
     2649      td_lay%i_nsea=0 
     2650      td_lay%i_nland=td_lay%i_njproc*td_lay%i_niproc 
     2651 
     2652      ! check if processor is land or sea 
     2653      DO jj = 1,td_lay%i_njproc 
     2654         DO ji = 1,td_lay%i_niproc 
     2655 
     2656            ! compute first and last indoor indices 
     2657            ! west boundary 
     2658            IF( ji == 1 )THEN 
     2659               il_ldi = 1  
     2660            ELSE 
     2661               il_ldi = 1 + td_mpp%i_preci 
     2662            ENDIF 
     2663 
     2664            ! south boundary 
     2665            IF( jj == 1 )THEN 
     2666               il_ldj = 1  
     2667            ELSE 
     2668               il_ldj = 1 + td_mpp%i_precj 
     2669            ENDIF 
     2670 
     2671            ! east boundary 
     2672            IF( ji == td_mpp%i_niproc )THEN 
     2673               il_lei = td_lay%i_lci(ji,jj) 
     2674            ELSE 
     2675               il_lei = td_lay%i_lci(ji,jj) - td_mpp%i_preci 
     2676            ENDIF 
     2677 
     2678            ! north boundary 
     2679            IF( jj == td_mpp%i_njproc )THEN 
     2680               il_lej = td_lay%i_lcj(ji,jj) 
     2681            ELSE 
     2682               il_lej = td_lay%i_lcj(ji,jj) - td_mpp%i_precj 
     2683            ENDIF 
     2684 
     2685            ii1=td_lay%i_impp(ji,jj) + il_ldi - 1 
     2686            ii2=td_lay%i_impp(ji,jj) + il_lei - 1 
     2687 
     2688            ij1=td_lay%i_jmpp(ji,jj) + il_ldj - 1 
     2689            ij2=td_lay%i_jmpp(ji,jj) + il_lej - 1 
     2690 
     2691            td_lay%i_msk(ji,jj)=SUM( id_mask(ii1:ii2,ij1:ij2) ) 
     2692            IF( td_lay%i_msk(ji,jj) > 0 )THEN ! sea 
     2693               td_lay%i_nsea =td_lay%i_nsea +1 
     2694               td_lay%i_nland=td_lay%i_nland-1 
     2695            ENDIF 
     2696 
     2697         ENDDO 
     2698      ENDDO 
     2699 
     2700      CALL logger_info( "MPP COMPUTE LAYOUT: sea proc "//TRIM(fct_str(td_lay%i_nsea))) 
     2701      CALL logger_info( "MPP COMPUTE LAYOUT: land proc "//TRIM(fct_str(td_lay%i_nland))) 
     2702      CALL logger_info( "MPP COMPUTE LAYOUT: sum "//TRIM(fct_str( SUM(td_lay%i_msk(:,:))))) 
     2703 
     2704      td_lay%i_mean= SUM(td_lay%i_msk(:,:)) / td_lay%i_nsea 
     2705      td_lay%i_min = MINVAL(td_lay%i_msk(:,:),td_lay%i_msk(:,:)/=0) 
     2706      td_lay%i_max = MAXVAL(td_lay%i_msk(:,:)) 
     2707 
     2708      IF( lm_layout )THEN 
     2709         ! print info  
     2710         WRITE(im_iumout,*) ' ' 
     2711         WRITE(im_iumout,*) " jpni=",td_lay%i_niproc ," jpnj=",td_lay%i_njproc 
     2712         WRITE(im_iumout,*) " jpi= ",il_isize," jpj= ",il_jsize 
     2713         WRITE(im_iumout,*) " iresti=",td_mpp%i_preci," irestj=",td_mpp%i_precj 
     2714 
     2715 
     2716         WRITE(im_iumout,*) ' nombre de processeurs       ',td_lay%i_niproc*td_lay%i_njproc 
     2717         WRITE(im_iumout,*) ' nombre de processeurs mer   ',td_lay%i_nsea 
     2718         WRITE(im_iumout,*) ' nombre de processeurs terre ',td_lay%i_nland 
     2719         WRITE(im_iumout,*) ' moyenne de recouvrement     ',td_lay%i_mean 
     2720         WRITE(im_iumout,*) ' minimum de recouvrement     ',td_lay%i_min 
     2721         WRITE(im_iumout,*) ' maximum de recouvrement     ',td_lay%i_max 
     2722      ENDIF 
     2723 
     2724   END FUNCTION layout__init 
     2725   !------------------------------------------------------------------- 
     2726   !> @brief  
     2727   !>  This subroutine clean domain layout strcuture. 
     2728   !> 
     2729   !> @author J.Paul 
     2730   !> @date October, 2015 - Initial version 
     2731   !> 
     2732   !> @param[inout] td_lay domain layout strcuture 
     2733   !------------------------------------------------------------------- 
     2734   SUBROUTINE layout__clean( td_lay ) 
     2735      IMPLICIT NONE 
     2736      ! Argument 
     2737      TYPE(TLAY),  INTENT(INOUT) :: td_lay 
     2738      !---------------------------------------------------------------- 
     2739 
     2740      IF( ASSOCIATED(td_lay%i_msk) )THEN 
     2741         DEALLOCATE(td_lay%i_msk) 
     2742      ENDIF 
     2743      IF( ASSOCIATED(td_lay%i_impp) )THEN 
     2744         DEALLOCATE(td_lay%i_impp) 
     2745      ENDIF 
     2746      IF( ASSOCIATED(td_lay%i_jmpp) )THEN 
     2747         DEALLOCATE(td_lay%i_jmpp) 
     2748      ENDIF 
     2749      IF( ASSOCIATED(td_lay%i_lci) )THEN 
     2750         DEALLOCATE(td_lay%i_lci) 
     2751      ENDIF 
     2752      IF( ASSOCIATED(td_lay%i_lcj) )THEN 
     2753         DEALLOCATE(td_lay%i_lcj) 
     2754      ENDIF 
     2755 
     2756      td_lay%i_niproc=0 
     2757      td_lay%i_njproc=0 
     2758      td_lay%i_nland =0 
     2759      td_lay%i_nsea  =0 
     2760 
     2761      td_lay%i_mean  =0 
     2762      td_lay%i_min   =0 
     2763      td_lay%i_max   =0 
     2764 
     2765   END SUBROUTINE layout__clean 
     2766   !------------------------------------------------------------------- 
     2767   !> @brief 
     2768   !> This subroutine copy domain layout structure in another one. 
     2769   !> 
     2770   !> @warning do not use on the output of a function who create or read a 
     2771   !> structure (ex: tl_seg=seg__copy(seg__init()) is forbidden). 
     2772   !> This will create memory leaks. 
     2773   !> @warning to avoid infinite loop, do not use any function inside  
     2774   !> this subroutine 
     2775   !> 
     2776   !> @author J.Paul 
     2777   !> @date October, 2015 - Initial Version 
     2778   ! 
     2779   !> @param[in] td_lay   domain layout structure 
     2780   !> @return copy of input domain layout structure 
     2781   !------------------------------------------------------------------- 
     2782   FUNCTION layout__copy( td_lay ) 
     2783      IMPLICIT NONE 
     2784      ! Argument 
     2785      TYPE(TLAY), INTENT(IN)  :: td_lay 
     2786      ! function 
     2787      TYPE(TLAY) :: layout__copy 
     2788 
     2789      ! local variable 
     2790      INTEGER(i4), DIMENSION(2)                :: il_shape 
     2791      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_tmp 
     2792      ! loop indices 
     2793      !---------------------------------------------------------------- 
     2794 
     2795      ! copy scalar  
     2796      layout__copy%i_niproc   = td_lay%i_niproc 
     2797      layout__copy%i_njproc   = td_lay%i_njproc 
     2798      layout__copy%i_nland    = td_lay%i_nland  
     2799      layout__copy%i_nsea     = td_lay%i_nsea   
     2800      layout__copy%i_mean     = td_lay%i_mean   
     2801      layout__copy%i_min      = td_lay%i_min    
     2802      layout__copy%i_max      = td_lay%i_max    
     2803 
     2804      ! copy pointers 
     2805      IF( ASSOCIATED(layout__copy%i_msk) )THEN 
     2806         DEALLOCATE(layout__copy%i_msk) 
     2807      ENDIF 
     2808      IF( ASSOCIATED(td_lay%i_msk) )THEN 
     2809         il_shape(:)=SHAPE(td_lay%i_msk(:,:)) 
     2810         ALLOCATE( layout__copy%i_msk(il_shape(jp_I),il_shape(jp_J)) ) 
     2811         layout__copy%i_msk(:,:)=td_lay%i_msk(:,:) 
     2812      ENDIF 
     2813 
     2814      IF( ASSOCIATED(layout__copy%i_msk) ) DEALLOCATE(layout__copy%i_msk) 
     2815      IF( ASSOCIATED(td_lay%i_msk) )THEN 
     2816         il_shape(:)=SHAPE(td_lay%i_msk(:,:)) 
     2817         ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J))) 
     2818         il_tmp(:,:)=td_lay%i_msk(:,:) 
     2819 
     2820         ALLOCATE( layout__copy%i_msk(il_shape(jp_I),il_shape(jp_J)) ) 
     2821         layout__copy%i_msk(:,:)=il_tmp(:,:) 
     2822 
     2823         DEALLOCATE(il_tmp) 
     2824      ENDIF 
     2825 
     2826      IF( ASSOCIATED(layout__copy%i_impp) ) DEALLOCATE(layout__copy%i_impp) 
     2827      IF( ASSOCIATED(td_lay%i_impp) )THEN 
     2828         il_shape(:)=SHAPE(td_lay%i_impp(:,:)) 
     2829         ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J))) 
     2830         il_tmp(:,:)=td_lay%i_impp(:,:) 
     2831 
     2832         ALLOCATE( layout__copy%i_impp(il_shape(jp_I),il_shape(jp_J)) ) 
     2833         layout__copy%i_impp(:,:)=il_tmp(:,:) 
     2834 
     2835         DEALLOCATE(il_tmp) 
     2836      ENDIF 
     2837 
     2838      IF( ASSOCIATED(layout__copy%i_jmpp) ) DEALLOCATE(layout__copy%i_jmpp) 
     2839      IF( ASSOCIATED(td_lay%i_jmpp) )THEN 
     2840         il_shape(:)=SHAPE(td_lay%i_jmpp(:,:)) 
     2841         ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J))) 
     2842         il_tmp(:,:)=td_lay%i_jmpp(:,:) 
     2843 
     2844         ALLOCATE( layout__copy%i_jmpp(il_shape(jp_I),il_shape(jp_J)) ) 
     2845         layout__copy%i_jmpp(:,:)=il_tmp(:,:) 
     2846 
     2847         DEALLOCATE(il_tmp) 
     2848      ENDIF 
     2849 
     2850      IF( ASSOCIATED(layout__copy%i_lci) ) DEALLOCATE(layout__copy%i_lci) 
     2851      IF( ASSOCIATED(td_lay%i_lci) )THEN 
     2852         il_shape(:)=SHAPE(td_lay%i_lci(:,:)) 
     2853         ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J))) 
     2854         il_tmp(:,:)=td_lay%i_lci(:,:) 
     2855 
     2856         ALLOCATE( layout__copy%i_lci(il_shape(jp_I),il_shape(jp_J)) ) 
     2857         layout__copy%i_lci(:,:)=il_tmp(:,:) 
     2858 
     2859         DEALLOCATE(il_tmp) 
     2860      ENDIF 
     2861 
     2862      IF( ASSOCIATED(layout__copy%i_lcj) ) DEALLOCATE(layout__copy%i_lcj) 
     2863      IF( ASSOCIATED(td_lay%i_lcj) )THEN 
     2864         il_shape(:)=SHAPE(td_lay%i_lcj(:,:)) 
     2865         ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J))) 
     2866         il_tmp(:,:)=td_lay%i_lcj(:,:) 
     2867 
     2868         ALLOCATE( layout__copy%i_lcj(il_shape(jp_I),il_shape(jp_J)) ) 
     2869         layout__copy%i_lcj(:,:)=il_tmp(:,:) 
     2870 
     2871         DEALLOCATE(il_tmp) 
     2872      ENDIF 
     2873 
     2874   END FUNCTION layout__copy 
     2875   !------------------------------------------------------------------- 
     2876   !> @brief 
     2877   !>    This subroutine create mpp structure using domain layout 
     2878   !> 
     2879   !> @detail 
     2880   ! 
     2881   !> @author J.Paul 
     2882   !> @date October, 2015 - Initial version 
    25882883   ! 
    25892884   !> @param[inout] td_mpp mpp strcuture 
    2590    !------------------------------------------------------------------- 
    2591    SUBROUTINE mpp__compute( td_mpp ) 
     2885   !> @param[in] td_lay domain layout structure 
     2886   !------------------------------------------------------------------- 
     2887   SUBROUTINE mpp__create_layout( td_mpp, td_lay ) 
    25922888      IMPLICIT NONE 
    25932889      ! Argument 
    25942890      TYPE(TMPP), INTENT(INOUT) :: td_mpp 
     2891      TYPE(TLAY), INTENT(IN   ) :: td_lay 
    25952892 
    25962893      ! local variable 
    2597       INTEGER(i4)                              :: il_isize !< i-direction maximum sub domain size  
    2598       INTEGER(i4)                              :: il_jsize !< j-direction maximum sub domain size 
    2599       INTEGER(i4)                              :: il_resti !<   
    2600       INTEGER(i4)                              :: il_restj !<   
    2601       INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_nlci 
    2602       INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_nlcj 
    2603       INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_impp 
    2604       INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_jmpp 
    2605  
    26062894      CHARACTER(LEN=lc)                        :: cl_file 
    26072895      TYPE(TFILE)                              :: tl_proc 
     
    26172905      td_mpp%i_nproc=0 
    26182906 
    2619       CALL logger_trace( "MPP COMPUTE: compute domain decomposition with "//& 
    2620       &               TRIM(fct_str(td_mpp%i_niproc))//" x "//& 
    2621       &               TRIM(fct_str(td_mpp%i_njproc))//" processors") 
    2622       ! maximum size of sub domain 
    2623       il_isize = ((td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci + (td_mpp%i_niproc-1))/ & 
    2624       &           td_mpp%i_niproc) + 2*td_mpp%i_preci 
    2625       il_jsize = ((td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj + (td_mpp%i_njproc-1))/ & 
    2626       &           td_mpp%i_njproc) + 2*td_mpp%i_precj 
    2627  
    2628       il_resti = MOD(td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci, td_mpp%i_niproc) 
    2629       il_restj = MOD(td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj, td_mpp%i_njproc) 
    2630       IF( il_resti == 0 ) il_resti = td_mpp%i_niproc 
    2631       IF( il_restj == 0 ) il_restj = td_mpp%i_njproc 
    2632  
    2633       ! compute dimension of each sub domain 
    2634       ALLOCATE( il_nlci(td_mpp%i_niproc,td_mpp%i_njproc) ) 
    2635       ALLOCATE( il_nlcj(td_mpp%i_niproc,td_mpp%i_njproc) ) 
    2636  
    2637       il_nlci( 1 : il_resti                , : ) = il_isize 
    2638       il_nlci( il_resti+1 : td_mpp%i_niproc, : ) = il_isize-1 
    2639  
    2640       il_nlcj( : , 1 : il_restj                ) = il_jsize 
    2641       il_nlcj( : , il_restj+1 : td_mpp%i_njproc) = il_jsize-1 
    2642  
    2643       ! compute first index of each sub domain 
    2644       ALLOCATE( il_impp(td_mpp%i_niproc,td_mpp%i_njproc) ) 
    2645       ALLOCATE( il_jmpp(td_mpp%i_niproc,td_mpp%i_njproc) ) 
    2646  
    2647       il_impp(:,:)=1 
    2648       il_jmpp(:,:)=1 
    2649  
    2650       DO jj=1,td_mpp%i_njproc 
    2651          DO ji=2,td_mpp%i_niproc 
    2652             il_impp(ji,jj)=il_impp(ji-1,jj)+il_nlci(ji-1,jj)-2*td_mpp%i_preci 
     2907      CALL logger_debug( "MPP CREATE LAYOUT: create domain decomposition with "//& 
     2908      &               TRIM(fct_str(td_lay%i_niproc))//" x "//& 
     2909      &               TRIM(fct_str(td_lay%i_njproc))//" = "//& 
     2910      &               TRIM(fct_str(td_lay%i_nsea))//" processors") 
     2911 
     2912      IF( lm_layout )THEN 
     2913         WRITE(im_iumout,*) ' choix optimum' 
     2914         WRITE(im_iumout,*) ' =============' 
     2915         WRITE(im_iumout,*) 
     2916         ! print info  
     2917         WRITE(im_iumout,*) ' ' 
     2918         WRITE(im_iumout,*) " jpni=",td_lay%i_niproc ," jpnj=",td_lay%i_njproc 
     2919         WRITE(im_iumout,*) " iresti=",td_mpp%i_preci," irestj=",td_mpp%i_precj 
     2920 
     2921 
     2922         WRITE(im_iumout,*) ' nombre de processeurs       ',td_lay%i_niproc*td_lay%i_njproc 
     2923         WRITE(im_iumout,*) ' nombre de processeurs mer   ',td_lay%i_nsea 
     2924         WRITE(im_iumout,*) ' nombre de processeurs terre ',td_lay%i_nland 
     2925         WRITE(im_iumout,*) ' moyenne de recouvrement     ',td_lay%i_mean 
     2926         WRITE(im_iumout,*) ' minimum de recouvrement     ',td_lay%i_min 
     2927         WRITE(im_iumout,*) ' maximum de recouvrement     ',td_lay%i_max 
     2928      ENDIF 
     2929 
     2930      td_mpp%i_niproc=td_lay%i_niproc 
     2931      td_mpp%i_njproc=td_lay%i_njproc 
     2932      !td_mpp%i_nproc =td_lay%i_nsea 
     2933 
     2934      IF( td_mpp%i_niproc*td_mpp%i_njproc == td_lay%i_nsea )THEN 
     2935         IF( td_lay%i_nsea == 1 )THEN 
     2936            td_mpp%c_dom='full' 
     2937         ELSE 
     2938            td_mpp%c_dom='nooverlap' 
     2939         ENDIF 
     2940      ELSE 
     2941            td_mpp%c_dom='noextra' 
     2942      ENDIF 
     2943       
     2944      jk=0 
     2945      DO jj=1,td_lay%i_njproc 
     2946         DO ji=1,td_lay%i_niproc 
     2947 
     2948            IF( td_lay%i_msk(ji,jj) >= 1 )THEN 
     2949 
     2950               ! get processor file name 
     2951               cl_file=file_rename(td_mpp%c_name,jk) 
     2952               ! initialise file structure 
     2953               tl_proc=file_init(cl_file,td_mpp%c_type) 
     2954 
     2955               ! procesor id 
     2956               tl_proc%i_pid=jk 
     2957 
     2958               tl_att=att_init("DOMAIN_number",tl_proc%i_pid) 
     2959               CALL file_add_att(tl_proc, tl_att) 
     2960 
     2961               ! processor indices 
     2962               tl_proc%i_iind=ji 
     2963               tl_proc%i_jind=jj 
     2964 
     2965               ! fill processor dimension and first indices 
     2966               tl_proc%i_impp = td_lay%i_impp(ji,jj) 
     2967               tl_proc%i_jmpp = td_lay%i_jmpp(ji,jj) 
     2968 
     2969               tl_proc%i_lci  = td_lay%i_lci(ji,jj) 
     2970               tl_proc%i_lcj  = td_lay%i_lcj(ji,jj) 
     2971 
     2972               ! compute first and last indoor indices 
     2973                
     2974               ! west boundary 
     2975               IF( ji == 1 )THEN 
     2976                  tl_proc%i_ldi = 1  
     2977                  tl_proc%l_ctr = .TRUE. 
     2978               ELSE 
     2979                  tl_proc%i_ldi = 1 + td_mpp%i_preci 
     2980               ENDIF 
     2981 
     2982               ! south boundary 
     2983               IF( jj == 1 )THEN 
     2984                  tl_proc%i_ldj = 1  
     2985                  tl_proc%l_ctr = .TRUE. 
     2986               ELSE 
     2987                  tl_proc%i_ldj = 1 + td_mpp%i_precj 
     2988               ENDIF 
     2989 
     2990               ! east boundary 
     2991               IF( ji == td_mpp%i_niproc )THEN 
     2992                  tl_proc%i_lei = td_lay%i_lci(ji,jj) 
     2993                  tl_proc%l_ctr = .TRUE. 
     2994               ELSE 
     2995                  tl_proc%i_lei = td_lay%i_lci(ji,jj) - td_mpp%i_preci 
     2996               ENDIF 
     2997 
     2998               ! north boundary 
     2999               IF( jj == td_mpp%i_njproc )THEN 
     3000                  tl_proc%i_lej = td_lay%i_lcj(ji,jj) 
     3001                  tl_proc%l_ctr = .TRUE. 
     3002               ELSE 
     3003                  tl_proc%i_lej = td_lay%i_lcj(ji,jj) - td_mpp%i_precj 
     3004               ENDIF 
     3005 
     3006               ! add processor to mpp structure 
     3007               CALL mpp__add_proc(td_mpp, tl_proc) 
     3008 
     3009               ! clean 
     3010               CALL att_clean(tl_att) 
     3011               CALL file_clean(tl_proc) 
     3012 
     3013               ! update proc number 
     3014               jk=jk+1 !ji+(jj-1)*td_lay%i_niproc 
     3015 
     3016            ENDIF 
    26533017         ENDDO 
    26543018      ENDDO 
    26553019 
    2656       DO jj=2,td_mpp%i_njproc 
    2657          DO ji=1,td_mpp%i_niproc 
    2658             il_jmpp(ji,jj)=il_jmpp(ji,jj-1)+il_nlcj(ji,jj-1)-2*td_mpp%i_precj 
    2659          ENDDO 
    2660       ENDDO  
    2661  
    2662       DO jj=1,td_mpp%i_njproc 
    2663          DO ji=1,td_mpp%i_niproc 
    2664  
    2665             jk=ji+(jj-1)*td_mpp%i_niproc 
    2666  
    2667             ! get processor file name 
    2668             cl_file=file_rename(td_mpp%c_name,jk) 
    2669             ! initialise file structure 
    2670             tl_proc=file_init(cl_file,td_mpp%c_type) 
    2671  
    2672             ! procesor id 
    2673             tl_proc%i_pid=jk 
    2674  
    2675             tl_att=att_init("DOMAIN_number",tl_proc%i_pid) 
    2676             CALL file_add_att(tl_proc, tl_att) 
    2677  
    2678             ! processor indices 
    2679             tl_proc%i_iind=ji 
    2680             tl_proc%i_jind=jj 
    2681  
    2682             ! fill processor dimension and first indices 
    2683             tl_proc%i_impp = il_impp(ji,jj) 
    2684             tl_proc%i_jmpp = il_jmpp(ji,jj) 
    2685  
    2686             tl_att=att_init( "DOMAIN_poistion_first", & 
    2687             &                (/tl_proc%i_impp, tl_proc%i_jmpp/) ) 
    2688             CALL file_add_att(tl_proc, tl_att) 
    2689  
    2690             tl_proc%i_lci  = il_nlci(ji,jj) 
    2691             tl_proc%i_lcj  = il_nlcj(ji,jj) 
    2692  
    2693             tl_att=att_init( "DOMAIN_poistion_last", & 
    2694             &                (/tl_proc%i_lci, tl_proc%i_lcj/) ) 
    2695             CALL file_add_att(tl_proc, tl_att) 
    2696  
    2697             ! compute first and last indoor indices 
    2698              
    2699             ! west boundary 
    2700             IF( ji == 1 )THEN 
    2701                tl_proc%i_ldi = 1  
    2702                tl_proc%l_ctr = .TRUE. 
    2703             ELSE 
    2704                tl_proc%i_ldi = 1 + td_mpp%i_preci 
    2705             ENDIF 
    2706  
    2707             ! south boundary 
    2708             IF( jj == 1 )THEN 
    2709                tl_proc%i_ldj = 1  
    2710                tl_proc%l_ctr = .TRUE. 
    2711             ELSE 
    2712                tl_proc%i_ldj = 1 + td_mpp%i_precj 
    2713             ENDIF 
    2714  
    2715             ! east boundary 
    2716             IF( ji == td_mpp%i_niproc )THEN 
    2717                tl_proc%i_lei = il_nlci(ji,jj) 
    2718                tl_proc%l_ctr = .TRUE. 
    2719             ELSE 
    2720                tl_proc%i_lei = il_nlci(ji,jj) - td_mpp%i_preci 
    2721             ENDIF 
    2722  
    2723             ! north boundary 
    2724             IF( jj == td_mpp%i_njproc )THEN 
    2725                tl_proc%i_lej = il_nlcj(ji,jj) 
    2726                tl_proc%l_ctr = .TRUE. 
    2727             ELSE 
    2728                tl_proc%i_lej = il_nlcj(ji,jj) - td_mpp%i_precj 
    2729             ENDIF 
    2730  
    2731             tl_att=att_init( "DOMAIN_halo_size_start", & 
    2732             &                (/tl_proc%i_ldi, tl_proc%i_ldj/) ) 
    2733             CALL file_add_att(tl_proc, tl_att) 
    2734             tl_att=att_init( "DOMAIN_halo_size_end", & 
    2735             &                (/tl_proc%i_ldi, tl_proc%i_ldj/) ) 
    2736             CALL file_add_att(tl_proc, tl_att) 
    2737  
    2738             ! add processor to mpp structure 
    2739             CALL mpp__add_proc(td_mpp, tl_proc) 
    2740  
    2741             ! clean 
    2742             CALL att_clean(tl_att) 
    2743             CALL file_clean(tl_proc) 
    2744  
    2745          ENDDO 
    2746       ENDDO 
    2747  
    2748       DEALLOCATE( il_impp, il_jmpp ) 
    2749       DEALLOCATE( il_nlci, il_nlcj ) 
    2750  
    2751    END SUBROUTINE mpp__compute 
     3020   END SUBROUTINE mpp__create_layout 
    27523021   !------------------------------------------------------------------- 
    27533022   !> @brief  
    2754    !>  This subroutine remove land processor from domain decomposition. 
    2755    !> 
     3023   !>  This subroutine optimize the number of sub domain to be used, given mask. 
     3024   !> @details 
     3025   !>  Actually it get the domain decomposition with the most land  
     3026   !>  processors removed. 
     3027   !>  If no land processor could be removed, it get the decomposition with the 
     3028   !>  most sea processors. 
     3029   ! 
    27563030   !> @author J.Paul 
    27573031   !> @date November, 2013 - Initial version 
    2758    !> 
     3032   !> @date October, 2015 
     3033   !> - improve way to compute domain layout  
     3034   !> @date February, 2016 
     3035   !> - new criteria for domain layout in case no land proc 
     3036   ! 
    27593037   !> @param[inout] td_mpp mpp strcuture 
    2760    !> @param[in] id_mask   sub domain mask (sea=1, land=0) 
    2761    !------------------------------------------------------------------- 
    2762    SUBROUTINE mpp__del_land( td_mpp, id_mask ) 
     3038   !> @param[in] id_mask   sub domain mask (sea=1, land=0)  
     3039   !> @pram[in] id_nproc maximum number of processor to be used 
     3040   !------------------------------------------------------------------- 
     3041   SUBROUTINE mpp__optimiz( td_mpp, id_mask, id_nproc ) 
    27633042      IMPLICIT NONE 
    27643043      ! Argument 
    27653044      TYPE(TMPP),                  INTENT(INOUT) :: td_mpp 
    27663045      INTEGER(i4), DIMENSION(:,:), INTENT(IN)    :: id_mask 
    2767  
    2768       ! loop indices 
    2769       INTEGER(i4) :: jk 
    2770       !---------------------------------------------------------------- 
    2771  
    2772       IF( ASSOCIATED(td_mpp%t_proc) )THEN 
    2773          jk=1 
    2774          DO WHILE( jk <= td_mpp%i_nproc ) 
    2775             IF( mpp__land_proc(td_mpp, jk, id_mask(:,:)) )THEN 
    2776                CALL mpp__del_proc(td_mpp, jk) 
    2777             ELSE 
    2778                jk=jk+1 
    2779             ENDIF 
    2780          ENDDO 
    2781       ELSE 
    2782          CALL logger_error("MPP DEL LAND: domain decomposition not define.") 
    2783       ENDIF 
    2784  
    2785    END SUBROUTINE mpp__del_land 
    2786    !------------------------------------------------------------------- 
    2787    !> @brief  
    2788    !>  This subroutine optimize the number of sub domain to be used, given mask. 
    2789    !> @details 
    2790    !>  Actually it get the domain decomposition with the most land  
    2791    !>  processor removed. 
    2792    ! 
    2793    !> @author J.Paul 
    2794    !> @date November, 2013 - Initial version 
    2795    ! 
    2796    !> @param[inout] td_mpp mpp strcuture 
    2797    !> @param[in] id_mask   sub domain mask (sea=1, land=0)  
    2798    !------------------------------------------------------------------- 
    2799    SUBROUTINE mpp__optimiz( td_mpp, id_mask ) 
    2800       IMPLICIT NONE 
    2801       ! Argument 
    2802       TYPE(TMPP),                  INTENT(INOUT) :: td_mpp 
    2803       INTEGER(i4), DIMENSION(:,:), INTENT(IN)    :: id_mask 
     3046      INTEGER(i4)                , INTENT(IN)    :: id_nproc 
    28043047 
    28053048      ! local variable 
    2806       TYPE(TMPP)  :: tl_mpp 
    2807       INTEGER(i4) :: il_maxproc 
    2808  
    2809       TYPE(TFILE), DIMENSION(:), ALLOCATABLE :: tl_proc 
     3049      TYPE(TLAY) :: tl_lay 
     3050      TYPE(TLAY) :: tl_sav 
     3051 
     3052      REAL(dp)   :: dl_min 
     3053      REAL(dp)   :: dl_max 
     3054      REAL(dp)   :: dl_ratio 
     3055      REAL(dp)   :: dl_sav 
     3056 
    28103057      ! loop indices 
    28113058      INTEGER(i4) :: ji 
     
    28143061 
    28153062      CALL logger_trace("MPP OPTIMIZ: look for best domain decomposition") 
    2816       tl_mpp=mpp_copy(td_mpp) 
    2817  
    2818       ! save maximum number of processor to be used 
    2819       il_maxproc=td_mpp%i_nproc 
     3063      dl_sav=0 
    28203064      !  
    2821       td_mpp%i_nproc=0 
    2822       DO ji=1,il_maxproc 
    2823          DO jj=1,il_maxproc 
    2824  
    2825             ! clean mpp processor 
    2826             IF( ASSOCIATED(tl_mpp%t_proc) )THEN 
    2827                CALL file_clean(tl_mpp%t_proc(:)) 
    2828                DEALLOCATE(tl_mpp%t_proc) 
    2829             ENDIF 
    2830  
    2831             ! compute domain decomposition 
    2832             tl_mpp%i_niproc=ji 
    2833             tl_mpp%i_njproc=jj 
    2834              
    2835             CALL mpp__compute( tl_mpp ) 
    2836              
    2837             ! remove land sub domain 
    2838             CALL mpp__del_land( tl_mpp, id_mask ) 
    2839  
    2840             CALL logger_info("MPP OPTIMIZ: number of processor "//& 
    2841             &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//& 
    2842             &   TRIM(fct_str(tl_mpp%i_nproc)) ) 
    2843             IF( tl_mpp%i_nproc > td_mpp%i_nproc .AND. & 
    2844             &   tl_mpp%i_nproc <= il_maxproc )THEN 
    2845                ! save optimiz decomposition  
    2846  
    2847                CALL logger_info("MPP OPTIMIZ:save this decomposition "//& 
    2848                &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//& 
    2849                &   TRIM(fct_str(tl_mpp%i_nproc)) ) 
    2850  
    2851                ! clean mpp 
    2852                CALL mpp_clean(td_mpp) 
    2853  
    2854                ! save processor array 
    2855                ALLOCATE( tl_proc(tl_mpp%i_nproc) ) 
    2856                tl_proc(:)=file_copy(tl_mpp%t_proc(:)) 
    2857  
    2858                ! remove pointer on processor array 
    2859                CALL file_clean(tl_mpp%t_proc(:)) 
    2860                DEALLOCATE(tl_mpp%t_proc) 
    2861   
    2862                ! save data except processor array 
    2863                td_mpp=mpp_copy(tl_mpp) 
    2864  
    2865                ! save processor array 
    2866                ALLOCATE( td_mpp%t_proc(td_mpp%i_nproc) ) 
    2867                td_mpp%t_proc(:)=file_copy(tl_proc(:)) 
    2868  
    2869                ! clean 
    2870                CALL file_clean( tl_proc(:) ) 
    2871                DEALLOCATE(tl_proc) 
    2872  
    2873             ENDIF 
    2874              
     3065      DO ji=1,id_nproc 
     3066         DO jj=1,id_nproc 
     3067 
     3068            ! compute domain layout 
     3069            tl_lay=layout__init( td_mpp, id_mask, ji,jj ) 
     3070            IF( tl_lay%i_nsea <= id_nproc )THEN 
     3071 
     3072               IF( ASSOCIATED(tl_sav%i_lci) )THEN 
     3073                  IF( tl_sav%i_nland /= 0 )THEN 
     3074                     ! look for layout with most land proc 
     3075                     IF( tl_lay%i_nland > tl_sav%i_nland    .OR. & 
     3076                     &   ( tl_lay%i_nland == tl_sav%i_nland .AND. & 
     3077                     &     tl_lay%i_min   >  tl_sav%i_min   ) )THEN 
     3078                        ! save optimiz layout 
     3079                        CALL logger_info("MPP OPTIMIZ:save this decomposition "//& 
     3080                        &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//& 
     3081                        &   TRIM(fct_str(tl_lay%i_nsea)) ) 
     3082 
     3083                        tl_sav=layout__copy(tl_lay) 
     3084                     ENDIF 
     3085                  ELSE ! tl_sav%i_nland == 0 
     3086                     ! look for layout with most sea proc  
     3087                     ! and "square" cell  
     3088                     dl_min=MIN(tl_lay%i_lci(1,1),tl_lay%i_lcj(1,1)) 
     3089                     dl_max=MAX(tl_lay%i_lci(1,1),tl_lay%i_lcj(1,1)) 
     3090                     dl_ratio=dl_min/dl_max 
     3091                     IF( tl_lay%i_nsea > tl_sav%i_nsea    .OR. & 
     3092                     &   ( tl_lay%i_nsea == tl_sav%i_nsea .AND. & 
     3093                     &     dl_ratio   >  dl_sav ) )THEN 
     3094                        ! save optimiz layout 
     3095                        CALL logger_info("MPP OPTIMIZ:save this decomposition "//& 
     3096                        &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//& 
     3097                        &   TRIM(fct_str(tl_lay%i_nsea)) ) 
     3098 
     3099                        tl_sav=layout__copy(tl_lay) 
     3100                        dl_sav=dl_ratio 
     3101                     ENDIF 
     3102                  ENDIF 
     3103               ELSE 
     3104                  ! init tl_sav 
     3105                  tl_sav=layout__copy(tl_lay) 
     3106 
     3107                  dl_min=MIN(tl_sav%i_lci(1,1),tl_sav%i_lcj(1,1)) 
     3108                  dl_max=MAX(tl_sav%i_lci(1,1),tl_sav%i_lcj(1,1)) 
     3109                  dl_sav=dl_min/dl_max 
     3110               ENDIF 
     3111 
     3112            ENDIF 
     3113 
     3114            ! clean 
     3115            CALL layout__clean( tl_lay ) 
     3116 
    28753117         ENDDO 
    28763118      ENDDO 
    28773119 
     3120      ! create mpp domain layout 
     3121      CALL mpp__create_layout(td_mpp, tl_sav) 
     3122 
    28783123      ! clean 
    2879       CALL mpp_clean(tl_mpp) 
     3124      CALL layout__clean( tl_sav ) 
    28803125 
    28813126   END SUBROUTINE mpp__optimiz 
    2882    !------------------------------------------------------------------- 
    2883    !> @brief 
    2884    !>    This function check if processor is a land processor. 
    2885    !> 
    2886    !> @author J.Paul 
    2887    !> @date November, 2013 - Initial version 
    2888    !> 
    2889    !> @param[in] td_mpp    mpp strcuture 
    2890    !> @param[in] id_proc   processor id 
    2891    !> @param[in] id_mask   sub domain mask (sea=1, land=0) 
    2892    !------------------------------------------------------------------- 
    2893    LOGICAL FUNCTION mpp__land_proc( td_mpp , id_proc, id_mask ) 
    2894       IMPLICIT NONE 
    2895       ! Argument 
    2896       TYPE(TMPP),                  INTENT(IN) :: td_mpp 
    2897       INTEGER(i4),                 INTENT(IN) :: id_proc 
    2898       INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_mask 
    2899  
    2900       ! local variable 
    2901       INTEGER(i4), DIMENSION(2) :: il_shape 
    2902       !---------------------------------------------------------------- 
    2903  
    2904       CALL logger_trace("MPP LAND PROC: check processor "//TRIM(fct_str(id_proc))//& 
    2905       &  " of mpp "//TRIM(td_mpp%c_name) ) 
    2906       mpp__land_proc=.FALSE. 
    2907       IF( ASSOCIATED(td_mpp%t_proc) )THEN 
    2908  
    2909          il_shape(:)=SHAPE(id_mask) 
    2910          IF( il_shape(1) /= td_mpp%t_dim(1)%i_len .OR. & 
    2911          &   il_shape(2) /= td_mpp%t_dim(2)%i_len )THEN 
    2912              CALL logger_debug("MPP LAND PROC: mask size ("//& 
    2913              &                  TRIM(fct_str(il_shape(1)))//","//& 
    2914              &                  TRIM(fct_str(il_shape(2)))//")") 
    2915              CALL logger_debug("MPP LAND PROC: domain size ("//& 
    2916              &                  TRIM(fct_str(td_mpp%t_dim(1)%i_len))//","//& 
    2917              &                  TRIM(fct_str(td_mpp%t_dim(2)%i_len))//")") 
    2918              CALL logger_error("MPP LAND PROC: mask and domain size differ") 
    2919          ELSE 
    2920             IF( ALL(id_mask( td_mpp%t_proc(id_proc)%i_impp +            & 
    2921             &                       td_mpp%t_proc(id_proc)%i_ldi - 1 : & 
    2922             &                td_mpp%t_proc(id_proc)%i_impp +            & 
    2923             &                       td_mpp%t_proc(id_proc)%i_lei - 1,  & 
    2924             &                td_mpp%t_proc(id_proc)%i_jmpp +            & 
    2925             &                       td_mpp%t_proc(id_proc)%i_ldj - 1 : & 
    2926             &                td_mpp%t_proc(id_proc)%i_jmpp +            & 
    2927             &                       td_mpp%t_proc(id_proc)%i_lej - 1)  & 
    2928             &      /= 1 ) )THEN 
    2929                ! land domain 
    2930                CALL logger_info("MPP LAND PROC: processor "//TRIM(fct_str(id_proc))//& 
    2931                &             " is land processor") 
    2932                mpp__land_proc=.TRUE. 
    2933             ENDIF 
    2934          ENDIF 
    2935  
    2936       ELSE 
    2937          CALL logger_error("MPP LAND PROC: domain decomposition not define.") 
    2938       ENDIF 
    2939  
    2940    END FUNCTION mpp__land_proc 
    29413127   !------------------------------------------------------------------- 
    29423128   !> @brief  
     
    31953381         SELECT CASE(TRIM(td_mpp%c_dom)) 
    31963382            CASE('full') 
    3197                il_i1 = 1 ; il_i2 = td_mpp%t_dim(1)%i_len 
    3198                il_j1 = 1 ; il_j2 = td_mpp%t_dim(2)%i_len 
    3199             CASE('overlap') 
    3200                 il_i1 = td_mpp%t_proc(id_procid)%i_impp 
    3201                 il_j1 = td_mpp%t_proc(id_procid)%i_jmpp 
    3202  
    3203                 il_i2 = il_i1 + td_mpp%t_proc(id_procid)%i_lci - 1  
    3204                 il_j2 = il_j1 + td_mpp%t_proc(id_procid)%i_lcj - 1  
     3383               il_i1 = 1  
     3384               il_j1 = 1  
     3385 
     3386               il_i2 = td_mpp%t_dim(1)%i_len 
     3387               il_j2 = td_mpp%t_dim(2)%i_len 
     3388            CASE('noextra') 
     3389               il_i1 = td_mpp%t_proc(id_procid)%i_impp 
     3390               il_j1 = td_mpp%t_proc(id_procid)%i_jmpp 
     3391 
     3392               il_i2 = il_i1 + td_mpp%t_proc(id_procid)%i_lci - 1  
     3393               il_j2 = il_j1 + td_mpp%t_proc(id_procid)%i_lcj - 1  
    32053394            CASE('nooverlap') 
    32063395               il_i1 = td_mpp%t_proc(id_procid)%i_impp + & 
     
    32143403               &        td_mpp%t_proc(id_procid)%i_lej - 1 
    32153404            CASE DEFAULT 
    3216                CALL logger_error("MPP GET PROC INDEX: invalid decomposition type.") 
     3405               CALL logger_error("MPP GET PROC INDEX: invalid "//& 
     3406                  &              "decomposition type.") 
    32173407         END SELECT 
    32183408 
     
    32643454               il_jsize = td_mpp%t_dim(2)%i_len 
    32653455 
    3266             CASE('overlap') 
     3456            CASE('noextra') 
    32673457 
    32683458                il_isize = td_mpp%t_proc(id_procid)%i_lci 
     
    33083498      IF( ASSOCIATED(td_mpp%t_proc) )THEN 
    33093499 
    3310          IF( td_mpp%i_niproc == 0 .AND. td_mpp%i_niproc == 0 )THEN 
     3500         IF( td_mpp%i_niproc == 0 .AND. td_mpp%i_njproc == 0 )THEN 
    33113501            CALL logger_info("MPP GET DOM: use indoor indices to get domain "//& 
    33123502            &             "decomposition type.") 
     
    33233513            &       td_mpp%t_proc(1)%i_lcj                     )     )THEN 
    33243514 
    3325                td_mpp%c_dom='overlap' 
     3515               td_mpp%c_dom='noextra' 
    33263516 
    33273517            ELSEIF((td_mpp%t_proc(1)%t_dim(1)%i_len ==                     & 
     
    33683558               td_mpp%c_dom='nooverlap' 
    33693559            ELSE 
    3370                td_mpp%c_dom='overlap' 
     3560               td_mpp%c_dom='noextra' 
    33713561            ENDIF 
    33723562 
     
    33863576   !> @author J.Paul 
    33873577   !> @date November, 2013 - Initial Version 
     3578   !> @date September 2015 
     3579   !> - do not check used dimension here 
    33883580   !> 
    33893581   !> @param[in] td_mpp mpp structure 
     
    33983590 
    33993591      ! local variable 
     3592      CHARACTER(LEN=lc) :: cl_dim 
     3593      LOGICAL :: ll_error 
     3594      LOGICAL :: ll_warn 
     3595 
     3596      INTEGER(i4)       :: il_ind 
    34003597 
    34013598      ! loop indices 
     
    34033600      !---------------------------------------------------------------- 
    34043601      mpp__check_var_dim=.TRUE. 
     3602 
    34053603      ! check used dimension  
    3406       IF( ANY( td_var%t_dim(:)%l_use .AND. & 
    3407       &        td_var%t_dim(:)%i_len /= td_mpp%t_dim(:)%i_len) )THEN 
     3604      ll_error=.FALSE. 
     3605      ll_warn=.FALSE. 
     3606      DO ji=1,ip_maxdim 
     3607         il_ind=dim_get_index( td_mpp%t_dim(:), & 
     3608         &                     TRIM(td_var%t_dim(ji)%c_name), & 
     3609         &                     TRIM(td_var%t_dim(ji)%c_sname)) 
     3610         IF( il_ind /= 0 )THEN 
     3611            IF( td_var%t_dim(ji)%l_use  .AND. & 
     3612            &   td_mpp%t_dim(il_ind)%l_use .AND. & 
     3613            &   td_var%t_dim(ji)%i_len /= td_mpp%t_dim(il_ind)%i_len )THEN 
     3614               IF( INDEX( TRIM(td_var%c_axis), & 
     3615               &          TRIM(fct_upper(td_var%t_dim(ji)%c_name))) == 0 )THEN 
     3616                  ll_warn=.TRUE. 
     3617               ELSE 
     3618                  ll_error=.TRUE. 
     3619               ENDIF 
     3620            ENDIF 
     3621         ENDIF 
     3622      ENDDO 
     3623 
     3624      IF( ll_error )THEN 
     3625 
     3626         cl_dim='(/' 
     3627         DO ji = 1, td_mpp%i_ndim 
     3628            IF( td_mpp%t_dim(ji)%l_use )THEN 
     3629               cl_dim=TRIM(cl_dim)//& 
     3630               &  TRIM(fct_upper(td_mpp%t_dim(ji)%c_sname))//':'//& 
     3631               &  TRIM(fct_str(td_mpp%t_dim(ji)%i_len))//',' 
     3632            ENDIF 
     3633         ENDDO 
     3634         cl_dim=TRIM(cl_dim)//'/)' 
     3635         CALL logger_debug( " mpp dimension: "//TRIM(cl_dim) ) 
     3636 
     3637         cl_dim='(/' 
     3638         DO ji = 1, td_var%i_ndim 
     3639            IF( td_var%t_dim(ji)%l_use )THEN 
     3640               cl_dim=TRIM(cl_dim)//& 
     3641               &  TRIM(fct_upper(td_var%t_dim(ji)%c_sname))//':'//& 
     3642               &  TRIM(fct_str(td_var%t_dim(ji)%i_len))//',' 
     3643            ENDIF 
     3644         ENDDO 
     3645         cl_dim=TRIM(cl_dim)//'/)' 
     3646         CALL logger_debug( " variable dimension: "//TRIM(cl_dim) ) 
    34083647 
    34093648         mpp__check_var_dim=.FALSE. 
    34103649 
    3411          CALL logger_debug( & 
    3412          &  " mpp dimension: "//TRIM(fct_str(td_mpp%i_ndim))//& 
    3413          &  " variable dimension: "//TRIM(fct_str(td_var%i_ndim)) ) 
    3414          DO ji = 1, ip_maxdim 
    3415             CALL logger_debug( & 
    3416             &  "MPP CHECK DIM: for dimension "//& 
    3417             &  TRIM(td_mpp%t_dim(ji)%c_name)//& 
    3418             &  ", mpp length: "//& 
    3419             &  TRIM(fct_str(td_mpp%t_dim(ji)%i_len))//& 
    3420             &  ", variable length: "//& 
    3421             &  TRIM(fct_str(td_var%t_dim(ji)%i_len))//& 
    3422             &  ", variable used "//TRIM(fct_str(td_var%t_dim(ji)%l_use))) 
    3423          ENDDO 
    3424  
    34253650         CALL logger_error( & 
    3426          &  "MPP CHECK DIM: variable and mpp dimension differ"//& 
     3651         &  " MPP CHECK VAR DIM: variable and file dimension differ"//& 
    34273652         &  " for variable "//TRIM(td_var%c_name)//& 
    3428          &  " and mpp "//TRIM(td_mpp%c_name)) 
     3653         &  " and file "//TRIM(td_mpp%c_name)) 
     3654 
     3655      ELSEIF( ll_warn )THEN 
     3656         CALL logger_warn( & 
     3657         &  " MPP CHECK VAR DIM: variable and file dimension differ"//& 
     3658         &  " for variable "//TRIM(td_var%c_name)//& 
     3659         &  " and file "//TRIM(td_mpp%c_name)//". you should use"//& 
     3660         &  " var_check_dim to remove useless dimension.") 
     3661      ELSE 
     3662 
     3663         IF( td_var%i_ndim >  td_mpp%i_ndim )THEN 
     3664            CALL logger_info("MPP CHECK VAR DIM: variable "//& 
     3665            &  TRIM(td_var%c_name)//" use more dimension than file "//& 
     3666            &  TRIM(td_mpp%c_name)//" do until now.") 
     3667         ENDIF 
    34293668 
    34303669      ENDIF 
     
    35833822      ENDIF 
    35843823   END FUNCTION mpp_recombine_var 
     3824   !------------------------------------------------------------------- 
     3825   !> @brief This subroutine read subdomain indices defined with halo 
     3826   !> (NEMO netcdf way) 
     3827   !> 
     3828   !> @author J.Paul 
     3829   !> @date January, 2016 - Initial Version 
     3830   !> 
     3831   !> @param[inout] td_file   mpp structure 
     3832   !------------------------------------------------------------------- 
     3833   SUBROUTINE mpp__read_halo(td_file, td_dimglo)  
     3834   IMPLICIT NONE 
     3835      ! Argument       
     3836      TYPE(TFILE)              , INTENT(INOUT) :: td_file 
     3837      TYPE(TDIM) , DIMENSION(:), INTENT(IN   ) :: td_dimglo 
     3838 
     3839      ! local variable 
     3840      INTEGER(i4)       :: il_attid 
     3841      INTEGER(i4)       :: il_ifirst 
     3842      INTEGER(i4)       :: il_jfirst 
     3843      INTEGER(i4)       :: il_ilast 
     3844      INTEGER(i4)       :: il_jlast 
     3845      INTEGER(i4)       :: il_ihalostart 
     3846      INTEGER(i4)       :: il_jhalostart 
     3847      INTEGER(i4)       :: il_ihaloend 
     3848      INTEGER(i4)       :: il_jhaloend 
     3849 
     3850      CHARACTER(LEN=lc) :: cl_dom 
     3851      !---------------------------------------------------------------- 
     3852 
     3853      ! DOMAIN_position_first 
     3854      il_attid = 0 
     3855      IF( ASSOCIATED(td_file%t_att) )THEN 
     3856         il_attid=att_get_id( td_file%t_att, "DOMAIN_position_first" ) 
     3857      ENDIF 
     3858      IF( il_attid /= 0 )THEN 
     3859         il_ifirst = INT(td_file%t_att(il_attid)%d_value(1)) 
     3860         il_jfirst = INT(td_file%t_att(il_attid)%d_value(2)) 
     3861      ELSE 
     3862         il_ifirst = 1 
     3863         il_jfirst = 1 
     3864      ENDIF 
     3865 
     3866      ! DOMAIN_position_last 
     3867      il_attid = 0 
     3868      IF( ASSOCIATED(td_file%t_att) )THEN 
     3869         il_attid=att_get_id( td_file%t_att, "DOMAIN_position_last" ) 
     3870      ENDIF 
     3871      IF( il_attid /= 0 )THEN 
     3872         il_ilast = INT(td_file%t_att(il_attid)%d_value(1)) 
     3873         il_jlast = INT(td_file%t_att(il_attid)%d_value(2)) 
     3874      ELSE 
     3875         il_ilast = td_file%t_dim(1)%i_len 
     3876         il_jlast = td_file%t_dim(2)%i_len 
     3877      ENDIF 
     3878 
     3879      ! DOMAIN_halo_size_start 
     3880      il_attid = 0 
     3881      IF( ASSOCIATED(td_file%t_att) )THEN 
     3882         il_attid=att_get_id( td_file%t_att, "DOMAIN_halo_size_start" ) 
     3883      ENDIF 
     3884      IF( il_attid /= 0 )THEN 
     3885         il_ihalostart = INT(td_file%t_att(il_attid)%d_value(1)) 
     3886         il_jhalostart = INT(td_file%t_att(il_attid)%d_value(2)) 
     3887      ELSE 
     3888         il_ihalostart = 0 
     3889         il_jhalostart = 0 
     3890      ENDIF 
     3891 
     3892      ! DOMAIN_halo_size_end 
     3893      il_attid = 0 
     3894      IF( ASSOCIATED(td_file%t_att) )THEN 
     3895         il_attid=att_get_id( td_file%t_att, "DOMAIN_halo_size_end" ) 
     3896      ENDIF 
     3897      IF( il_attid /= 0 )THEN 
     3898         il_ihaloend = INT(td_file%t_att(il_attid)%d_value(1)) 
     3899         il_jhaloend = INT(td_file%t_att(il_attid)%d_value(2)) 
     3900      ELSE 
     3901         il_ihaloend = 0 
     3902         il_jhaloend = 0 
     3903      ENDIF 
     3904 
     3905      IF( (td_dimglo(jp_I)%i_len == td_file%t_dim(jp_I)%i_len) .AND. & 
     3906        & (td_dimglo(jp_J)%i_len == td_file%t_dim(jp_J)%i_len) )THEN 
     3907         cl_dom='full' 
     3908      ELSEIF( il_ihalostart == 0 .AND. il_jhalostart == 0 .AND. & 
     3909           &  il_ihaloend == 0 .AND. il_jhaloend == 0 )THEN 
     3910         cl_dom='nooverlap' 
     3911      ELSE 
     3912         cl_dom='noextra' 
     3913      ENDIF 
     3914 
     3915      SELECT CASE(TRIM(cl_dom)) 
     3916         CASE('full') 
     3917            td_file%i_impp = il_ifirst  
     3918            td_file%i_jmpp = il_jfirst 
     3919            td_file%i_lci  = td_file%t_dim(jp_I)%i_len  
     3920            td_file%i_lcj  = td_file%t_dim(jp_J)%i_len 
     3921            td_file%i_ldi  = il_ihalostart + 1 
     3922            td_file%i_ldj  = il_jhalostart + 1 
     3923            td_file%i_lei  = td_file%t_dim(jp_I)%i_len - il_ihaloend 
     3924            td_file%i_lej  = td_file%t_dim(jp_J)%i_len - il_jhaloend 
     3925         CASE('noextra') 
     3926            td_file%i_impp = il_ifirst 
     3927            td_file%i_jmpp = il_jfirst 
     3928            td_file%i_lci  = td_file%t_dim(jp_I)%i_len 
     3929            td_file%i_lcj  = td_file%t_dim(jp_J)%i_len 
     3930            td_file%i_ldi  = il_ihalostart + 1 
     3931            td_file%i_ldj  = il_jhalostart + 1 
     3932            td_file%i_lei  = td_file%i_lci - il_ihaloend 
     3933            td_file%i_lej  = td_file%i_lcj - il_jhaloend 
     3934         CASE('nooverlap') !!!????? 
     3935            td_file%i_impp = il_ifirst 
     3936            td_file%i_jmpp = il_jfirst 
     3937            td_file%i_lci  = td_file%t_dim(jp_I)%i_len 
     3938            td_file%i_lcj  = td_file%t_dim(jp_J)%i_len 
     3939            td_file%i_ldi  = 1 
     3940            td_file%i_ldj  = 1  
     3941            td_file%i_lei  = td_file%t_dim(jp_I)%i_len 
     3942            td_file%i_lej  = td_file%t_dim(jp_J)%i_len 
     3943      END SELECT 
     3944 
     3945   END SUBROUTINE mpp__read_halo 
     3946   !------------------------------------------------------------------- 
     3947   !> @brief This subroutine compute subdomain indices defined with halo 
     3948   !> (NEMO netcdf way) 
     3949   !> 
     3950   !> @author J.Paul 
     3951   !> @date January, 2016 - Initial Version 
     3952   !> 
     3953   !> @param[inout] td_mpp   mpp structure 
     3954   !------------------------------------------------------------------- 
     3955   SUBROUTINE mpp__compute_halo(td_mpp)  
     3956   IMPLICIT NONE 
     3957      ! Argument       
     3958      TYPE(TMPP)      , INTENT(INOUT) :: td_mpp 
     3959 
     3960      ! local variable 
     3961      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ifirst 
     3962      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jfirst 
     3963      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ilast 
     3964      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jlast 
     3965      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ihalostart 
     3966      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jhalostart 
     3967      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ihaloend 
     3968      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jhaloend 
     3969 
     3970      TYPE(TATT)                             :: tl_att 
     3971 
     3972      ! loop indices 
     3973      INTEGER(i4) :: ji 
     3974      !---------------------------------------------------------------- 
     3975 
     3976      ALLOCATE( il_ifirst    (td_mpp%i_nproc) ) 
     3977      ALLOCATE( il_jfirst    (td_mpp%i_nproc) ) 
     3978 
     3979      ALLOCATE( il_ilast     (td_mpp%i_nproc) ) 
     3980      ALLOCATE( il_jlast     (td_mpp%i_nproc) ) 
     3981 
     3982      ALLOCATE( il_ihalostart(td_mpp%i_nproc) ) 
     3983      ALLOCATE( il_jhalostart(td_mpp%i_nproc) ) 
     3984 
     3985      ALLOCATE( il_ihaloend  (td_mpp%i_nproc) ) 
     3986      ALLOCATE( il_jhaloend  (td_mpp%i_nproc) ) 
     3987 
     3988      SELECT CASE(TRIM(td_mpp%c_dom)) 
     3989         CASE('full') 
     3990             
     3991            il_ifirst(:)=td_mpp%t_proc(:)%i_impp 
     3992            il_jfirst(:)=td_mpp%t_proc(:)%i_jmpp 
     3993             
     3994            il_ilast(:)=td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%t_dim(jp_I)%i_len - 1 
     3995            il_jlast(:)=td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%t_dim(jp_J)%i_len - 1 
     3996 
     3997            il_ihalostart(:)=td_mpp%t_proc(:)%i_ldi-1 
     3998            il_jhalostart(:)=td_mpp%t_proc(:)%i_ldj-1 
     3999             
     4000            il_ihaloend(:)=td_mpp%t_proc(:)%t_dim(jp_I)%i_len - td_mpp%t_proc(:)%i_lei 
     4001            il_jhaloend(:)=td_mpp%t_proc(:)%t_dim(jp_J)%i_len - td_mpp%t_proc(:)%i_lej 
     4002 
     4003         CASE('noextra') 
     4004             
     4005            il_ifirst(:)=td_mpp%t_proc(:)%i_impp 
     4006            il_jfirst(:)=td_mpp%t_proc(:)%i_jmpp 
     4007 
     4008            il_ilast(:) =td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%i_lci - 1 
     4009            il_jlast(:) =td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%i_lcj - 1 
     4010             
     4011            il_ihalostart(:)=td_mpp%t_proc(:)%i_ldi-1 
     4012            il_jhalostart(:)=td_mpp%t_proc(:)%i_ldj-1 
     4013             
     4014            il_ihaloend(:)=td_mpp%t_proc(:)%i_lci - td_mpp%t_proc(:)%i_lei 
     4015            il_jhaloend(:)=td_mpp%t_proc(:)%i_lcj - td_mpp%t_proc(:)%i_lej 
     4016 
     4017         CASE('nooverlap') 
     4018 
     4019            il_ifirst(:)=td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%i_ldi - 1 
     4020            il_jfirst(:)=td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%i_ldj - 1 
     4021 
     4022            il_ilast(:)=td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%i_lei - 1 
     4023            il_jlast(:)=td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%i_lej - 1 
     4024 
     4025            il_ihalostart(:)=0 
     4026            il_jhalostart(:)=0 
     4027 
     4028            il_ihaloend(:)=0 
     4029            il_jhaloend(:)=0 
     4030 
     4031         CASE DEFAULT 
     4032            CALL logger_fatal("MPP INIT: invalid "//& 
     4033            &              "decomposition type.")                      
     4034      END SELECT 
     4035 
     4036      DO ji=1,td_mpp%i_nproc 
     4037         tl_att=att_init( "DOMAIN_position_first", & 
     4038         &                (/ il_ifirst(ji), il_jfirst(ji) /) ) 
     4039         CALL file_move_att(td_mpp%t_proc(ji), tl_att)       
     4040 
     4041         tl_att=att_init( "DOMAIN_position_last", & 
     4042         &                (/ il_ilast(ji), il_jlast(ji) /) ) 
     4043         CALL file_move_att(td_mpp%t_proc(ji), tl_att) 
     4044 
     4045         tl_att=att_init( "DOMAIN_halo_size_start", & 
     4046         &                (/ il_ihalostart(ji), il_jhalostart(ji) /) ) 
     4047         CALL file_move_att( td_mpp%t_proc(ji), tl_att)                
     4048 
     4049         tl_att=att_init( "DOMAIN_halo_size_end", & 
     4050         &                (/ il_ihaloend(ji), il_jhaloend(ji) /) ) 
     4051         CALL file_move_att( td_mpp%t_proc(ji), tl_att) 
     4052      ENDDO 
     4053 
     4054      DEALLOCATE( il_ifirst    ) 
     4055      DEALLOCATE( il_jfirst    ) 
     4056  
     4057      DEALLOCATE( il_ilast     ) 
     4058      DEALLOCATE( il_jlast     ) 
     4059  
     4060      DEALLOCATE( il_ihalostart) 
     4061      DEALLOCATE( il_jhalostart) 
     4062 
     4063      DEALLOCATE( il_ihaloend  ) 
     4064      DEALLOCATE( il_jhaloend  ) 
     4065 
     4066      !impp 
     4067      tl_att=att_init( "SUBDOMAIN_I_left_bottom_indices", td_mpp%t_proc(:)%i_impp) 
     4068      CALL mpp_move_att(td_mpp, tl_att) 
     4069 
     4070      tl_att=att_init( "SUBDOMAIN_J_left_bottom_indices", td_mpp%t_proc(:)%i_jmpp) 
     4071      CALL mpp_move_att(td_mpp, tl_att) 
     4072 
     4073      ! lci 
     4074      tl_att=att_init( "SUBDOMAIN_I_dimensions", td_mpp%t_proc(:)%i_lci) 
     4075      CALL mpp_move_att(td_mpp, tl_att) 
     4076 
     4077      tl_att=att_init( "SUBDOMAIN_J_dimensions", td_mpp%t_proc(:)%i_lcj) 
     4078      CALL mpp_move_att(td_mpp, tl_att) 
     4079 
     4080      ! ldi 
     4081      tl_att=att_init( "SUBDOMAIN_I_first_indoor_indices", td_mpp%t_proc(:)%i_ldi) 
     4082      CALL mpp_move_att(td_mpp, tl_att) 
     4083 
     4084      tl_att=att_init( "SUBDOMAIN_J_first_indoor_indices", td_mpp%t_proc(:)%i_ldj) 
     4085      CALL mpp_move_att(td_mpp, tl_att) 
     4086 
     4087      ! lei 
     4088      tl_att=att_init( "SUBDOMAIN_I_last_indoor_indices", td_mpp%t_proc(:)%i_lei) 
     4089      CALL mpp_move_att(td_mpp, tl_att) 
     4090 
     4091      tl_att=att_init( "SUBDOMAIN_J_last_indoor_indices", td_mpp%t_proc(:)%i_lej) 
     4092      CALL mpp_move_att(td_mpp, tl_att)          
     4093 
     4094      ! clean 
     4095      CALL att_clean(tl_att) 
     4096 
     4097   END SUBROUTINE mpp__compute_halo 
    35854098END MODULE mpp 
    35864099 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/multi.f90

    r5616 r6455  
    173173   !> @date July, 2015  
    174174   !> - check if variable to be read is in file 
     175   !> @date January, 2016 
     176   !> - read variable dimensions 
    175177   !> 
    176178   !> @param[in] cd_varfile   variable location information (from namelist)  
     
    187189 
    188190      ! local variable 
    189       CHARACTER(LEN=lc) :: cl_name 
    190       CHARACTER(LEN=lc) :: cl_lower 
    191       CHARACTER(LEN=lc) :: cl_file 
    192       CHARACTER(LEN=lc) :: cl_matrix 
    193  
    194       INTEGER(i4)       :: il_nvar 
    195       INTEGER(i4)       :: il_varid 
    196  
    197       LOGICAL           :: ll_dim 
    198  
    199       TYPE(TVAR)        :: tl_var 
    200  
    201       TYPE(TMPP)        :: tl_mpp 
     191      CHARACTER(LEN=lc)                :: cl_name 
     192      CHARACTER(LEN=lc)                :: cl_lower 
     193      CHARACTER(LEN=lc)                :: cl_file 
     194      CHARACTER(LEN=lc)                :: cl_matrix 
     195 
     196      INTEGER(i4)                      :: il_nvar 
     197      INTEGER(i4)                      :: il_varid 
     198 
     199      LOGICAL                          :: ll_dim 
     200 
     201      TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim 
     202 
     203      TYPE(TVAR)                       :: tl_var 
     204 
     205      TYPE(TMPP)                       :: tl_mpp 
    202206 
    203207      ! loop indices 
     
    216220 
    217221         IF( LEN(TRIM(cl_file)) == lc )THEN 
    218             CALL logger_fatal("MULTI INIT: file name too long (==256)."//& 
    219             &  " check namelist.") 
     222            CALL logger_fatal("MULTI INIT: file name too long (>"//& 
     223            &          TRIM(fct_str(lc))//"). check namelist.") 
    220224         ENDIF 
    221225 
     
    243247                  !  
    244248                  tl_mpp=mpp_init( file_init(TRIM(cl_file)) ) 
    245  
    246249                  ! define variable 
    247250                  IF( TRIM(fct_lower(cl_lower)) /= 'all' )THEN 
     
    255258                     ENDIF 
    256259 
    257                      ! clean var 
     260                     ! get (global) variable dimension 
     261                     tl_dim(jp_I)=dim_copy(tl_mpp%t_dim(jp_I)) 
     262                     tl_dim(jp_J)=dim_copy(tl_mpp%t_dim(jp_J)) 
     263                     tl_dim(jp_K)=dim_copy(tl_mpp%t_proc(1)%t_var(il_varid)%t_dim(jp_K)) 
     264                     tl_dim(jp_L)=dim_copy(tl_mpp%t_proc(1)%t_var(il_varid)%t_dim(jp_L)) 
     265 
     266                     ! clean all varible 
    258267                     CALL mpp_del_var(tl_mpp) 
    259268 
    260                      tl_var=var_init(TRIM(cl_lower)) 
     269                     tl_var=var_init(TRIM(cl_lower), td_dim=tl_dim(:)) 
    261270 
    262271                     ! add variable 
     
    272281 
    273282                     DO jk=tl_mpp%t_proc(1)%i_nvar,1,-1 
    274                          
     283 
    275284                        ! check if variable is dimension 
    276285                        ll_dim=.FALSE. 
     
    379388      ! print file 
    380389      IF( td_multi%i_nmpp /= 0 .AND. ASSOCIATED(td_multi%t_mpp) )THEN 
    381          WRITE(*,'(/a,i3)') 'MULTI: total number of mpp: ',& 
     390         WRITE(*,'(/a,i3)') 'MULTI: total number of file(s): ',& 
    382391         &  td_multi%i_nmpp 
    383          WRITE(*,'(6x,a,i3)') ' total number of variable: ',& 
     392         WRITE(*,'(6x,a,i3)') ' total number of variable(s): ',& 
    384393         &  td_multi%i_nvar 
    385394         DO ji=1,td_multi%i_nmpp 
    386             WRITE(*,'(3x,3a)') 'MPP FILE ',TRIM(td_multi%t_mpp(ji)%c_name),& 
     395            WRITE(*,'(3x,3a)') 'FILE ',TRIM(td_multi%t_mpp(ji)%c_name),& 
    387396            & ' CONTAINS' 
    388397            DO jj=1,td_multi%t_mpp(ji)%t_proc(1)%i_nvar 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/phycst.f90

    r5608 r6455  
    1212! REVISION HISTORY: 
    1313!> @date November, 2013 - Initial Version 
     14!> @date September, 2015 
     15!> - add physical constant to compute meshmask 
    1416! 
    1517!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    2325   PUBLIC :: dp_pi      !< pi 
    2426   PUBLIC :: dp_eps     !< epsilon value 
    25    PUBLIC :: dp_rearth  !< earth radius (km) 
     27   PUBLIC :: dp_rearth  !< earth radius [m] 
    2628   PUBLIC :: dp_deg2rad !< degree to radian ratio  
    2729   PUBLIC :: dp_rad2deg !< radian to degree ratio  
    2830   PUBLIC :: dp_delta   !<   
     31   PUBLIC :: dp_omega   !< earth rotation parameter [s-1]  
     32   PUBLIC :: dp_day     !< day                                [s] 
     33   PUBLIC :: dp_siyea   !< sideral year                       [s] 
     34   PUBLIC :: dp_siday   !< sideral day                        [s] 
     35 
     36   REAL(wp), PUBLIC ::   rday = 24.*60.*60.     !: day                                [s] 
     37   REAL(wp), PUBLIC ::   rsiyea                 !: sideral year                       [s] 
     38   REAL(wp), PUBLIC ::   rsiday                 !: sideral day                        [s] 
    2939 
    3040   REAL(dp), PARAMETER :: dp_pi = 3.14159274101257_dp 
    3141   REAL(dp), PARAMETER :: dp_eps = EPSILON(1._dp) 
    32    REAL(dp), PARAMETER :: dp_rearth = 6871._dp 
     42   REAL(dp), PARAMETER :: dp_rearth = 6371229._dp 
    3343   REAL(dp), PARAMETER :: dp_deg2rad = dp_pi/180.0 
    3444   REAL(dp), PARAMETER :: dp_rad2deg = 180.0/dp_pi 
    3545 
     46   REAL(dp), PARAMETER :: dp_day = 24.*60.*60.      
     47   REAL(dp), PARAMETER :: dp_siyea = 365.25_wp * dp_day * & 
     48      &  2._wp * dp_pi / 6.283076_dp 
     49   REAL(dp), PARAMETER :: dp_siday = dp_day / ( 1._wp + dp_day / dp_siyea ) 
     50 
    3651   REAL(dp), PARAMETER :: dp_delta=1.e-6 
     52   REAL(dp), PARAMETER :: dp_omega= 2._dp * dp_pi / dp_siday 
    3753END MODULE phycst 
    3854 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/variable.f90

    r5616 r6455  
    285285!> @date July, 2015  
    286286!> - add subroutine var_chg_unit to change unit of output variable 
     287!> @date Spetember, 2015 
     288!> - manage useless (dummy) variable 
    287289! 
    288290!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    305307 
    306308   PUBLIC :: tg_varextra !< array of variable structure with extra information. 
     309 
     310   PRIVATE :: cm_dumvar  !< dummy variable array 
    307311 
    308312   ! function and subroutine 
     
    334338   PUBLIC :: var_chg_extra     !< read variable namelist information, and modify extra information. 
    335339   PUBLIC :: var_check_dim     !< check variable dimension expected 
     340   PUBLIC :: var_get_dummy     !< fill dummy variable array 
     341   PUBLIC :: var_is_dummy      !< check if variable is defined as dummy variable 
    336342 
    337343   PRIVATE :: var__init          ! initialize variable structure without array of value 
     
    445451                                                        !< fill when running var_def_extra()  
    446452 
     453   CHARACTER(LEN=lc), DIMENSION(ip_maxdum), SAVE :: cm_dumvar !< dummy variable 
     454 
    447455   INTERFACE var_init 
    448456      MODULE PROCEDURE var__init       ! initialize variable structure without array of value 
     
    66986706   !> given variable name or standard name.  
    66996707   !> 
    6700    !> @warning only variable read from file, have an id. 
    6701    !> 
    67026708   !> @author J.Paul 
    67036709   !> @date November, 2013 - Initial Version 
     6710   !> @date July, 2015 
     6711   !> - check long name 
    67046712   ! 
    67056713   !> @param[in] td_var       array of variable structure 
     
    67356743         ELSE IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_name) .AND.& 
    67366744         &    TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN 
     6745             
     6746            var_get_id=td_var(ji)%i_id 
     6747            EXIT 
     6748 
     6749         ! look for variable long name 
     6750         ELSE IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_name) .AND.& 
     6751         &    TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN 
    67376752             
    67386753            var_get_id=td_var(ji)%i_id 
     
    67756790      IF( ASSOCIATED(td_var%d_value) )THEN 
    67766791 
    6777          CALL logger_trace( "VAR GET MASK: create mask from variable "//& 
    6778          &               TRIM(td_var%c_name) ) 
     6792         CALL logger_debug( "VAR GET MASK: create mask from variable "//& 
     6793         &               TRIM(td_var%c_name)//", FillValue ="//& 
     6794         &               TRIM(fct_str(td_var%d_fill))) 
    67796795         var_get_mask(:,:,:)=1 
    67806796         WHERE( td_var%d_value(:,:,:,1) == td_var%d_fill ) 
     
    72797295 
    72807296      ! local variable 
     7297      CHARACTER(LEN=lc) :: cl_tmp 
     7298 
    72817299      INTEGER(i4)       :: il_ind 
     7300       
    72827301      TYPE(TATT)        :: tl_att 
    72837302 
    72847303      ! loop indices 
     7304      INTEGER(i4)       :: ji 
    72857305      !---------------------------------------------------------------- 
    72867306 
     
    73357355               td_var%c_axis=TRIM(tg_varextra(il_ind)%c_axis) 
    73367356               ! create attibute 
    7337                tl_att=att_init('axis',TRIM(td_var%c_axis)) 
    7338                CALL var_move_att(td_var, tl_att)                
     7357               IF( TRIM(fct_upper(td_var%c_name)) == TRIM(td_var%c_axis) )THEN 
     7358                  tl_att=att_init('axis',TRIM(td_var%c_axis)) 
     7359               ELSE 
     7360                  cl_tmp="" 
     7361                  DO ji=LEN(TRIM(td_var%c_axis)),1,-1 
     7362                     cl_tmp=TRIM(cl_tmp)//" "//TRIM(td_var%c_axis(ji:ji)) 
     7363                  ENDDO 
     7364                  tl_att=att_init('associate',TRIM(ADJUSTL(cl_tmp))) 
     7365               ENDIF 
     7366               CALL var_move_att(td_var, tl_att) 
    73397367            ENDIF 
    73407368 
     
    74027430            ENDIF 
    74037431 
     7432         ELSE 
     7433            CALL logger_warn("VAR GET EXTRA: no extra information on "//& 
     7434               &  "variable "//TRIM(td_var%c_name)//". you should define it"//& 
     7435               &  " (see variable.cfg).") 
    74047436         ENDIF 
    74057437 
     
    74257457   !> - change way to get information in namelist,  
    74267458   !> value follows string "min =" 
     7459   !> @date Feb, 2016 
     7460   !> - check character just after keyword 
    74277461   ! 
    74287462   !> @param[in] cd_name      variable name 
     
    74477481      ! loop indices 
    74487482      INTEGER(i4) :: ji 
     7483      INTEGER(i4) :: jj 
    74497484      !---------------------------------------------------------------- 
    74507485      ! init 
     
    74577492         il_ind=INDEX(TRIM(cl_tmp),'min') 
    74587493         IF( il_ind /= 0 )THEN 
    7459             cl_min=fct_split(cl_tmp,2,'=') 
    7460             EXIT 
     7494            ! check character just after 
     7495            jj=il_ind+LEN('min') 
     7496            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 
     7497            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN 
     7498               cl_min=fct_split(cl_tmp,2,'=') 
     7499               EXIT 
     7500            ENDIF 
    74617501         ENDIF 
    74627502         ji=ji+1 
     
    74707510            &  TRIM(fct_str(var__get_min))//" for variable "//TRIM(cd_name) ) 
    74717511         ELSE 
    7472             CALL logger_error("VAR GET MIN: invalid minimum value for "//& 
    7473             &  "variable "//TRIM(cd_name)//". check namelist." ) 
     7512            CALL logger_error("VAR GET MIN: invalid minimum value ("//& 
     7513               & TRIM(cl_min)//") for variable "//TRIM(cd_name)//& 
     7514               & ". check namelist." ) 
    74747515         ENDIF 
    74757516      ENDIF 
     
    74897530   !> - change way to get information in namelist,  
    74907531   !> value follows string "max =" 
     7532   !> @date Feb, 2016 
     7533   !> - check character just after keyword 
    74917534   ! 
    74927535   !> @param[in] cd_name      variable name 
     
    75117554      ! loop indices 
    75127555      INTEGER(i4) :: ji 
     7556      INTEGER(i4) :: jj 
    75137557      !---------------------------------------------------------------- 
    75147558      ! init 
     
    75217565         il_ind=INDEX(TRIM(cl_tmp),'max') 
    75227566         IF( il_ind /= 0 )THEN 
    7523             cl_max=fct_split(cl_tmp,2,'=') 
    7524             EXIT 
     7567            ! check character just after 
     7568            jj=il_ind+LEN('max') 
     7569            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 
     7570            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN 
     7571               cl_max=fct_split(cl_tmp,2,'=') 
     7572               EXIT 
     7573            ENDIF 
    75257574         ENDIF 
    75267575         ji=ji+1 
     
    75507599   !> @author J.Paul 
    75517600   !> @date June, 2015 - Initial Version 
     7601   !> @date Feb, 2016 
     7602   !> - check character just after keyword 
    75527603   ! 
    75537604   !> @param[in] cd_name      variable name 
     
    75747625      ! loop indices 
    75757626      INTEGER(i4) :: ji 
     7627      INTEGER(i4) :: jj 
    75767628      !---------------------------------------------------------------- 
    75777629      ! init 
     
    75847636         il_ind=INDEX(TRIM(cl_tmp),'unf') 
    75857637         IF( il_ind /= 0 )THEN 
    7586             cl_unf=fct_split(cl_tmp,2,'=') 
    7587             EXIT 
     7638            ! check character just after 
     7639            jj=il_ind+LEN('unf') 
     7640            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 
     7641            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN 
     7642               cl_unf=fct_split(cl_tmp,2,'=') 
     7643               EXIT 
     7644            ENDIF 
    75887645         ENDIF 
    75897646         ji=ji+1 
     
    76267683   !> - change way to get information in namelist,  
    76277684   !> value follows string "int =" 
     7685   !> @date Feb, 2016 
     7686   !> - check character just after keyword 
    76287687   ! 
    76297688   !> @param[in] cd_name      variable name 
     
    76637722         il_ind=INDEX(TRIM(cl_tmp),'int') 
    76647723         IF( il_ind /= 0 )THEN 
    7665             cl_int=fct_split(cl_tmp,2,'=') 
    7666             EXIT 
     7724            ! check character just after 
     7725            jj=il_ind+LEN('int') 
     7726            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 
     7727            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN 
     7728               cl_int=fct_split(cl_tmp,2,'=') 
     7729               EXIT 
     7730            ENDIF 
    76677731         ENDIF 
    76687732         ji=ji+1 
     
    77467810   !> - change way to get information in namelist,  
    77477811   !> value follows string "ext =" 
     7812   !> @date Feb, 2016 
     7813   !> - check character just after keyword 
    77487814   ! 
    77497815   !> @param[in] cd_name      variable name 
     
    77787844         il_ind=INDEX(TRIM(cl_tmp),'ext') 
    77797845         IF( il_ind /= 0 )THEN 
    7780             cl_ext=fct_split(cl_tmp,2,'=') 
    7781             EXIT 
     7846            ! check character just after 
     7847            jj=il_ind+LEN('ext') 
     7848            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 
     7849            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN 
     7850               cl_ext=fct_split(cl_tmp,2,'=') 
     7851               EXIT 
     7852            ENDIF 
    77827853         ENDIF 
    77837854         ji=ji+1 
     
    78227893   !> - change way to get information in namelist,  
    78237894   !> value follows string "flt =" 
     7895   !> @date Feb, 2016 
     7896   !> - check character just after keyword 
    78247897   !> 
    78257898   !> @param[in] cd_name      variable name 
     
    78527925         il_ind=INDEX(TRIM(cl_tmp),'flt') 
    78537926         IF( il_ind /= 0 )THEN 
    7854             cl_flt=fct_split(cl_tmp,2,'=') 
    7855             EXIT 
     7927            ! check character just after 
     7928            jj=il_ind+LEN('flt') 
     7929            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 
     7930            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN 
     7931               cl_flt=fct_split(cl_tmp,2,'=') 
     7932               EXIT 
     7933            ENDIF 
    78567934         ENDIF 
    78577935         ji=ji+1 
     
    79258003   !> @author J.Paul 
    79268004   !> @date June, 2015 - Initial Version 
     8005   !> @date Feb, 2016 
     8006   !> - check character just after keyword 
    79278007   ! 
    79288008   !> @param[in] cd_name      variable name 
     
    79468026      ! loop indices 
    79478027      INTEGER(i4) :: ji 
     8028      INTEGER(i4) :: jj 
    79488029      !---------------------------------------------------------------- 
    79498030 
     
    79558036         il_ind=INDEX(TRIM(cl_tmp),'unt') 
    79568037         IF( il_ind /= 0 )THEN 
    7957             var__get_unt=fct_split(cl_tmp,2,'=') 
    7958             EXIT 
     8038            ! check character just after 
     8039            jj=il_ind+LEN('unt') 
     8040            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 
     8041            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN 
     8042               var__get_unt=fct_split(cl_tmp,2,'=') 
     8043               EXIT 
     8044            ENDIF 
    79598045         ENDIF 
    79608046         ji=ji+1 
     
    81018187 
    81028188            !- change scale factor and offset to avoid mistake 
    8103             tl_att=att_init('scale_factor',1) 
     8189            tl_att=att_init('scale_factor',1._dp) 
    81048190            CALL var_move_att(td_var, tl_att) 
    81058191 
    8106             tl_att=att_init('add_offset',0) 
     8192            tl_att=att_init('add_offset',0._dp) 
    81078193            CALL var_move_att(td_var, tl_att) 
    81088194         ENDIF 
     
    83568442 
    83578443   END FUNCTION var_to_date 
     8444   !------------------------------------------------------------------- 
     8445   !> @brief This subroutine fill dummy variable array 
     8446   ! 
     8447   !> @author J.Paul 
     8448   !> @date September, 2015 - Initial Version 
     8449   ! 
     8450   !> @param[in] cd_dummy dummy configuration file 
     8451   !------------------------------------------------------------------- 
     8452   SUBROUTINE var_get_dummy( cd_dummy ) 
     8453      IMPLICIT NONE 
     8454      ! Argument 
     8455      CHARACTER(LEN=*), INTENT(IN) :: cd_dummy 
     8456 
     8457      ! local variable 
     8458      INTEGER(i4)   :: il_fileid 
     8459      INTEGER(i4)   :: il_status 
     8460 
     8461      LOGICAL       :: ll_exist 
     8462 
     8463      ! loop indices 
     8464      ! namelist 
     8465      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumvar 
     8466      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumdim 
     8467      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumatt 
     8468 
     8469      !---------------------------------------------------------------- 
     8470      NAMELIST /namdum/ &   !< dummy namelist 
     8471      &  cn_dumvar, &       !< variable  name 
     8472      &  cn_dumdim, &       !< dimension name 
     8473      &  cn_dumatt          !< attribute name 
     8474      !---------------------------------------------------------------- 
     8475 
     8476      ! init 
     8477      cm_dumvar(:)='' 
     8478 
     8479      ! read namelist 
     8480      INQUIRE(FILE=TRIM(cd_dummy), EXIST=ll_exist) 
     8481      IF( ll_exist )THEN 
     8482     
     8483         il_fileid=fct_getunit() 
     8484    
     8485         OPEN( il_fileid, FILE=TRIM(cd_dummy), & 
     8486         &                FORM='FORMATTED',       & 
     8487         &                ACCESS='SEQUENTIAL',    & 
     8488         &                STATUS='OLD',           & 
     8489         &                ACTION='READ',          & 
     8490         &                IOSTAT=il_status) 
     8491         CALL fct_err(il_status) 
     8492         IF( il_status /= 0 )THEN 
     8493            CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_dummy)) 
     8494         ENDIF 
     8495    
     8496         READ( il_fileid, NML = namdum ) 
     8497         cm_dumvar(:)=cn_dumvar(:) 
     8498 
     8499         CLOSE( il_fileid ) 
     8500 
     8501      ENDIF 
     8502    
     8503   END SUBROUTINE var_get_dummy 
     8504   !------------------------------------------------------------------- 
     8505   !> @brief This function check if variable is defined as dummy variable 
     8506   !> in configuraton file 
     8507   !> 
     8508   !> @author J.Paul 
     8509   !> @date September, 2015 - Initial Version 
     8510   ! 
     8511   !> @param[in] td_var variable structure 
     8512   !> @return true if variable is dummy variable  
     8513   !------------------------------------------------------------------- 
     8514   FUNCTION var_is_dummy(td_var) 
     8515      IMPLICIT NONE 
     8516 
     8517      ! Argument       
     8518      TYPE(TVAR), INTENT(IN) :: td_var 
     8519       
     8520      ! function 
     8521      LOGICAL :: var_is_dummy 
     8522       
     8523      ! loop indices 
     8524      INTEGER(i4) :: ji 
     8525      !---------------------------------------------------------------- 
     8526 
     8527      var_is_dummy=.FALSE. 
     8528      DO ji=1,ip_maxdum 
     8529         IF( fct_lower(td_var%c_name) == fct_lower(cm_dumvar(ji)) )THEN 
     8530            var_is_dummy=.TRUE. 
     8531            EXIT 
     8532         ENDIF 
     8533      ENDDO 
     8534 
     8535   END FUNCTION var_is_dummy 
    83588536END MODULE var 
    83598537 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/src/vgrid.f90

    r5616 r6455  
    291291   END SUBROUTINE vgrid_zgr_z 
    292292   !------------------------------------------------------------------- 
     293   !> @brief This subroutine 
     294   !> 
     295   !> @todo add subroutine description 
     296   !> 
     297   !> @param[inout] dd_bathy 
     298   !> @param[in] dd_gdepw 
     299   !> @param[in] dd_hmin 
     300   !> @param[in] dd_fill 
    293301   !------------------------------------------------------------------- 
    294302   SUBROUTINE vgrid_zgr_bat( dd_bathy, dd_gdepw, dd_hmin, dd_fill ) 
     
    371379   !>         - gdept, gdepw and e3 are positives 
    372380   !>         - gdept_ps, gdepw_ps and e3_ps are positives 
    373    ! 
     381   !> 
    374382   !> @author A. Bozec, G. Madec 
    375383   !> @date February, 2009 - F90: Free form and module 
     
    386394   !> @param[in] dd_e3zps_min 
    387395   !> @param[in] dd_e3zps_rat 
     396   !> @param[in] dd_fill 
    388397   !------------------------------------------------------------------- 
    389398   SUBROUTINE vgrid_zgr_zps( id_mbathy, dd_bathy, id_jpkmax, & 
     
    495504   !> ** Action  : - update mbathy: level bathymetry (in level index) 
    496505   !>              - update bathy : meter bathymetry (in meters) 
    497  
     506   !> 
    498507   !> @author G.Madec 
    499508   !> @date Marsh, 2008 - Original code 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/templates/create_bathy.nam

    r5608 r6455  
    11&namlog 
    2    cn_logfile="bathy_out.log" 
     2   cn_logfile= 
    33   cn_verbosity= 
    44   in_maxerror= 
     
    66 
    77&namcfg 
    8    cn_varcfg="./cfg/variable.cfg" 
     8   cn_varcfg= 
     9   cn_dumcfg= 
    910/ 
    1011 
     
    1617&namfin 
    1718   cn_coord1= 
     19   in_perio1= 
     20   ln_fillclosed= 
    1821/ 
    1922 
     
    2932 
    3033&namout 
    31    cn_fileout="bathy_out.nc"       
     34   cn_fileout= 
    3235/ 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/templates/create_boundary.nam

    r5608 r6455  
    11&namlog 
    2    cn_logfile="boundary.log" 
     2   cn_logfile= 
    33   cn_verbosity= 
    44   in_maxerror = 
     
    66 
    77&namcfg 
    8    cn_varcfg="./cfg/variable.cfg" 
     8   cn_varcfg= 
     9   cn_dumcfg= 
    910/ 
    1011 
     
    4142 
    4243&namvar 
     44   cn_varfile= 
    4345   cn_varinfo= 
    44    cn_varfile= 
    4546/ 
    4647 
     
    6364 
    6465&namout 
    65    cn_fileout="boundary_out.nc"       
     66   cn_fileout= 
    6667   dn_dayofs= 
    6768   ln_extrap= 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/templates/create_coord.nam

    r5037 r6455  
    11&namlog 
    2    cn_logfile="coord_out.log" 
     2   cn_logfile= 
    33   cn_verbosity= 
    44   in_maxerror= 
     
    66 
    77&namcfg 
    8    cn_varcfg="./cfg/variable.cfg" 
     8   cn_varcfg= 
     9   cn_dumcfg= 
    910/ 
    1011 
     
    2930 
    3031&namout 
    31    cn_fileout="coord_out.nc" 
     32   cn_fileout= 
    3233/ 
    3334 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/templates/create_restart.nam

    r5608 r6455  
    11&namlog 
    2    cn_logfile="restart_out.log" 
     2   cn_logfile= 
    33   cn_verbosity= 
    4    in_maxerror = 
     4   in_maxerror= 
    55/ 
    66 
    77&namcfg 
    8    cn_varcfg="./cfg/variable.cfg" 
     8   cn_varcfg= 
     9   cn_dumcfg= 
    910/ 
    1011 
     
    4142 
    4243&namvar 
     44   cn_varfile= 
    4345   cn_varinfo= 
    44    cn_varfile= 
    4546/ 
    4647 
     
    5152 
    5253&namout 
    53    cn_fileout="restart_out.nc"       
     54   cn_fileout= 
    5455   ln_extrap= 
    55    in_nipro= 
     56   in_niproc= 
    5657   in_njproc= 
    5758   in_nproc= 
  • branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/TOOLS/SIREN/templates/merge_bathy.nam

    r5037 r6455  
    11&namlog 
    2    cn_logfile="merge_out.log" 
     2   cn_logfile= 
    33   cn_verbosity= 
    4    in_maxerror = 
     4   in_maxerror= 
    55/ 
    66 
    77&namcfg 
    8    cn_varcfg="./cfg/variable.cfg" 
     8   cn_varcfg= 
     9   cn_dumcfg= 
    910/ 
    1011 
     
    1718   cn_bathy1= 
    1819   in_perio1= 
    19 / 
    20  
    21 &namvar 
    22    cn_varinfo= 
    2320/ 
    2421 
     
    4138 
    4239&namout 
    43    cn_fileout="merge_out.nc"       
     40   cn_fileout= 
    4441/ 
Note: See TracChangeset for help on using the changeset viewer.